--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/common/tools/ats/make_junction.pl	Tue May 19 14:51:44 2009 +0100
@@ -0,0 +1,117 @@
+#!/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 = <STDIN>;
+            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