155714Skris#!/usr/local/bin/perl 255714Skris 355714Skris# mklink.pl 455714Skris 555714Skris# The first command line argument is a non-empty relative path 655714Skris# specifying the "from" directory. 755714Skris# Each other argument is a file name not containing / and 855714Skris# names a file in the current directory. 955714Skris# 1055714Skris# For each of these files, we create in the "from" directory a link 1155714Skris# of the same name pointing to the local file. 1255714Skris# 1355714Skris# We assume that the directory structure is a tree, i.e. that it does 1455714Skris# not contain symbolic links and that the parent of / is never referenced. 1555714Skris# Apart from this, this script should be able to handle even the most 1655714Skris# pathological cases. 1755714Skris 18238405Sjkimuse Cwd; 19160814Ssimon 2055714Skrismy $from = shift; 2155714Skrismy @files = @ARGV; 2255714Skris 23109998Smarkmmy @from_path = split(/[\\\/]/, $from); 24238405Sjkimmy $pwd = getcwd(); 25160814Ssimonchomp($pwd); 26109998Smarkmmy @pwd_path = split(/[\\\/]/, $pwd); 2755714Skris 2855714Skrismy @to_path = (); 2955714Skris 3055714Skrismy $dirname; 3155714Skrisforeach $dirname (@from_path) { 3255714Skris 3355714Skris # In this loop, @to_path always is a relative path from 3455714Skris # @pwd_path (interpreted is an absolute path) to the original pwd. 3555714Skris 3655714Skris # At the end, @from_path (as a relative path from the original pwd) 3755714Skris # designates the same directory as the absolute path @pwd_path, 3855714Skris # which means that @to_path then is a path from there to the original pwd. 3955714Skris 4055714Skris next if ($dirname eq "" || $dirname eq "."); 4155714Skris 4255714Skris if ($dirname eq "..") { 4355714Skris @to_path = (pop(@pwd_path), @to_path); 4455714Skris } else { 4555714Skris @to_path = ("..", @to_path); 4655714Skris push(@pwd_path, $dirname); 4755714Skris } 4855714Skris} 4955714Skris 5055714Skrismy $to = join('/', @to_path); 5155714Skris 5255714Skrismy $file; 5376866Skris$symlink_exists=eval {symlink("",""); 1}; 54238405Sjkimif ($^O eq "msys") { $symlink_exists=0 }; 5555714Skrisforeach $file (@files) { 5668651Skris my $err = ""; 5776866Skris if ($symlink_exists) { 58160814Ssimon unlink "$from/$file"; 5976866Skris symlink("$to/$file", "$from/$file") or $err = " [$!]"; 6076866Skris } else { 61109998Smarkm unlink "$from/$file"; 62109998Smarkm open (OLD, "<$file") or die "Can't open $file: $!"; 63109998Smarkm open (NEW, ">$from/$file") or die "Can't open $from/$file: $!"; 64109998Smarkm binmode(OLD); 65109998Smarkm binmode(NEW); 66109998Smarkm while (<OLD>) { 67109998Smarkm print NEW $_; 68109998Smarkm } 69109998Smarkm close (OLD) or die "Can't close $file: $!"; 70109998Smarkm close (NEW) or die "Can't close $from/$file: $!"; 7176866Skris } 7268651Skris print $file . " => $from/$file$err\n"; 7355714Skris} 74