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