diff -r 56e7098e1ace -r d5964b46ccaf common/smoketest/make_junction.pl --- a/common/smoketest/make_junction.pl Wed May 20 14:26:55 2009 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,117 +0,0 @@ -#!/usr/bin/perl - -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 /?`; -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 = ; - chomp($choice); - $choice = lc($choice); - } - $force = $choice eq 'y'; - } - if ($force) { - system("junction -d \"$link\" > nul"); - if ($?) { - die("Cannot delete \"$link\": $!\n"); - } - else { - print "Deleted \"$link\"\n"; - } - } -} - -system("junction \"$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" . - " --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 - \ No newline at end of file