Replaced section "Package failures by phase/step/severity" with "Package failures by package/severity"
Added internal links from the package/severity breakdown to the peices of the new section.
#!/usr/bin/perl
# Copyright (c) 2009 Symbian Foundation Ltd
# This component and the accompanying materials are made available
# under the terms of the License "Eclipse Public License v1.0"
# which accompanies this distribution, and is available
# at the URL "http://www.eclipse.org/legal/epl-v10.html".
#
# Initial Contributors:
# Symbian Foundation Ltd - initial contribution.
# Mike Kinghan, mikek@symbian.org
#
# Contributors:
#
# Description:
# This is a tool for sending an ATS3 testdrop to an ATS3 server.
use strict;
use Getopt::Long;
use File::Spec;
my $link;
my $target;
my $help;
my $force = 0;
sub usage($);
sub help();
sub usage_error();
my %optmap = ( 'link' => \$link,
'target' => \$target,
'force' => \$force,
'help' => \$help);
GetOptions(\%optmap,
'link=s',
'target=s',
'force!',
'help!')
or usage_error();
if ($help) {
help();
}
usage_error(), unless (defined($link) && defined($target));
my $junction_help = `junction /accepteula /?`;
die("Need command \"junction\". Not found\n"), if ($junction_help =~ /is not recognised/);
die("Directory \"$target\" not found\n"), unless -d "$target";
my ($vol,$dir,$file) = File::Spec->splitpath($target);
my @subst_lines = `subst`;
foreach (@subst_lines) {
my $line = $_;
chomp($line);
$line =~ /^(.:)\\: => (.*)$/;
die("Cannot parse output of 'subst'. Bailing out confused."), unless (defined($1) and defined($2));
my $subst_drive = $1;
my $subst_targ = $2;
if (lc($subst_drive) eq lc($vol)) {
print("Target $target is in a substituted drive: $line\n");
$target = File::Spec->catfile(($subst_targ,$dir),$file);
print("Target $target will be used\n");
last;
}
}
if ( -e "$link") {
print("\"$link\" already exists. ");
if (!$force) {
my $choice;
while($choice ne 'y' and $choice ne 'n') {
print "Delete? (y/n)? ";
$choice = <STDIN>;
chomp($choice);
$choice = lc($choice);
}
$force = $choice eq 'y';
}
if ($force) {
system("junction /accepteula -d \"$link\" > nul");
if ($?) {
die("Cannot delete \"$link\": $!\n");
}
else {
print "Deleted \"$link\"\n";
}
}
}
system("junction /accepteula \"$link\" \"$target\" > nul");
if ($?) {
die("Cannot cteate junction \"$link\" -> \"$target\": $!\n");
}
else {
print("Created junction \"$link\" -> \"$target\"\n");
}
exit 0;
sub usage($)
{
my $error = shift;
my $fh = $error == 0 ? *STDOUT : *STDERR;
print $fh "make_junction.pl\n" .
"Create a Windows junction (a.k.a symbolic link)\n" .
"usage:\n" .
" make_junction.pl --help\n" .
" make_junction.pl --link=LINKDIR --target=TARGDIR\n " .
"options:\n" .
" --help Display this help and exit\n" .
" --link=LINKDIR LINKDIR specifies the junction to be created. Last component is the junction. The rest must exist\n" .
" If LINKDIR is an existing junction it is pre-emptively deleted\n" .
" --target=TARGDIR TARGDIR is directory to which the junction will point.\n" .
" If TARGDIR is in a substed drive, the real path will be used.\n";
exit $error;
}
sub help()
{
usage(0);
}
sub usage_error()
{
usage(1);
}
# EOF