common/smoketest/make_junction.pl
changeset 192 d5964b46ccaf
parent 191 56e7098e1ace
parent 119 18300635256d
child 193 19a76650e06d
equal deleted inserted replaced
191:56e7098e1ace 192:d5964b46ccaf
     1 #!/usr/bin/perl
       
     2 
       
     3 use strict;
       
     4 use Getopt::Long;
       
     5 use File::Spec;
       
     6 
       
     7 my $link;
       
     8 my $target;
       
     9 my $help;
       
    10 my $force = 0;
       
    11 
       
    12 sub usage($);
       
    13 sub help();
       
    14 sub usage_error();
       
    15 
       
    16 my %optmap = (  'link' => \$link,
       
    17 			    'target' => \$target,
       
    18 			    'force' => \$force, 
       
    19                 'help' => \$help);
       
    20 
       
    21 GetOptions(\%optmap,
       
    22           'link=s',
       
    23           'target=s',
       
    24           'force!',
       
    25           'help!') 
       
    26           or usage_error();
       
    27 
       
    28 if ($help) {
       
    29 	help();
       
    30 }
       
    31 
       
    32 usage_error(), unless (defined($link) && defined($target));
       
    33 
       
    34 my $junction_help = `junction /?`;
       
    35 die("Need command \"junction\". Not found\n"), if ($junction_help =~ /is not recognised/);
       
    36 die("Directory \"$target\" not found\n"), unless -d "$target";
       
    37 
       
    38 my ($vol,$dir,$file) = File::Spec->splitpath($target);
       
    39 my @subst_lines = `subst`;
       
    40 
       
    41 foreach (@subst_lines) {
       
    42     my $line = $_;
       
    43     chomp($line);
       
    44     $line =~ /^(.:)\\: => (.*)$/;
       
    45     die("Cannot parse output of 'subst'. Bailing out confused."), unless (defined($1) and defined($2));    
       
    46     my $subst_drive = $1;
       
    47     my $subst_targ = $2;
       
    48     if (lc($subst_drive) eq lc($vol)) {
       
    49         print("Target $target is in a substituted drive: $line\n");
       
    50         $target = File::Spec->catfile(($subst_targ,$dir),$file);
       
    51         print("Target $target will be used\n");
       
    52         last;
       
    53     }
       
    54 }
       
    55 
       
    56 
       
    57 if ( -e "$link") {
       
    58     print("\"$link\" already exists. ");
       
    59     if (!$force) {
       
    60         my $choice;
       
    61         while($choice ne 'y' and $choice ne 'n') {
       
    62             print "Delete? (y/n)? ";
       
    63             $choice = <STDIN>;
       
    64             chomp($choice);
       
    65             $choice = lc($choice);
       
    66         }
       
    67         $force = $choice eq 'y';
       
    68     }    
       
    69     if ($force) {
       
    70         system("junction -d \"$link\" > nul");
       
    71         if ($?) {
       
    72             die("Cannot delete \"$link\": $!\n");
       
    73         }
       
    74         else {
       
    75             print "Deleted \"$link\"\n";
       
    76         }
       
    77     }
       
    78 } 
       
    79 
       
    80 system("junction \"$link\" \"$target\" > nul");
       
    81 if ($?) {
       
    82     die("Cannot cteate junction \"$link\" -> \"$target\": $!\n");
       
    83 }
       
    84 else {
       
    85     print("Created junction \"$link\" -> \"$target\"\n");
       
    86 }
       
    87 exit 0;
       
    88 
       
    89 sub usage($)
       
    90 {
       
    91     my $error = shift;
       
    92     my $fh = $error == 0 ? *STDOUT : *STDERR;
       
    93     print $fh "make_junction.pl\n" .
       
    94             "Create a Windows junction (a.k.a symbolic link)\n" .
       
    95             "usage:\n" .
       
    96             "  make_junction.pl --help\n" .
       
    97             "  make_junction.pl --link=LINKDIR --target=TARGDIR\n " .
       
    98             "options:\n" .
       
    99             "  --help                        Display this help and exit\n" .
       
   100             "  --link=LINKDIR                LINKDIR specifies the junction to be created. Last component is the junction. The rest must exist\n" .
       
   101             "  --target=TARGDIR              TARGDIR is directory to which the junction will point.\n" .
       
   102             "                                If TARGDIR is in a substed drive, the real path will be used.\n";
       
   103     exit $error;            
       
   104 }
       
   105 
       
   106 sub help()
       
   107 {
       
   108     usage(0);
       
   109 }
       
   110 
       
   111 sub usage_error()
       
   112 {
       
   113     usage(1);
       
   114 }             
       
   115 
       
   116 # EOF
       
   117