mklink.pl revision 109998
160484Sobrien#!/usr/local/bin/perl 292828Sobrien 392828Sobrien# mklink.pl 460484Sobrien 560484Sobrien# The first command line argument is a non-empty relative path 660484Sobrien# specifying the "from" directory. 760484Sobrien# Each other argument is a file name not containing / and 860484Sobrien# names a file in the current directory. 960484Sobrien# 1060484Sobrien# For each of these files, we create in the "from" directory a link 1160484Sobrien# of the same name pointing to the local file. 1260484Sobrien# 1360484Sobrien# We assume that the directory structure is a tree, i.e. that it does 1460484Sobrien# not contain symbolic links and that the parent of / is never referenced. 1560484Sobrien# Apart from this, this script should be able to handle even the most 1660484Sobrien# pathological cases. 1760484Sobrien 1860484Sobrienmy $from = shift; 1960484Sobrienmy @files = @ARGV; 2060484Sobrien 2160484Sobrienmy @from_path = split(/[\\\/]/, $from); 2260484Sobrienmy $pwd = `pwd`; 2360484Sobrienchop($pwd); 2460484Sobrienmy @pwd_path = split(/[\\\/]/, $pwd); 2560484Sobrien 2660484Sobrienmy @to_path = (); 2760484Sobrien 2860484Sobrienmy $dirname; 2960484Sobrienforeach $dirname (@from_path) { 3060484Sobrien 3160484Sobrien # In this loop, @to_path always is a relative path from 3260484Sobrien # @pwd_path (interpreted is an absolute path) to the original pwd. 3360484Sobrien 3460484Sobrien # At the end, @from_path (as a relative path from the original pwd) 3560484Sobrien # designates the same directory as the absolute path @pwd_path, 3660484Sobrien # which means that @to_path then is a path from there to the original pwd. 3760484Sobrien 3860484Sobrien next if ($dirname eq "" || $dirname eq "."); 3960484Sobrien 4060484Sobrien if ($dirname eq "..") { 4160484Sobrien @to_path = (pop(@pwd_path), @to_path); 4260484Sobrien } else { 4360484Sobrien @to_path = ("..", @to_path); 4460484Sobrien push(@pwd_path, $dirname); 4560484Sobrien } 4660484Sobrien} 4760484Sobrien 4860484Sobrienmy $to = join('/', @to_path); 4960484Sobrien 5060484Sobrienmy $file; 5160484Sobrien$symlink_exists=eval {symlink("",""); 1}; 5260484Sobrienforeach $file (@files) { 5360484Sobrien my $err = ""; 5460484Sobrien if ($symlink_exists) { 5560484Sobrien symlink("$to/$file", "$from/$file") or $err = " [$!]"; 5660484Sobrien } else { 5760484Sobrien unlink "$from/$file"; 5860484Sobrien open (OLD, "<$file") or die "Can't open $file: $!"; 5960484Sobrien open (NEW, ">$from/$file") or die "Can't open $from/$file: $!"; 6060484Sobrien binmode(OLD); 6160484Sobrien binmode(NEW); 6260484Sobrien while (<OLD>) { 6360484Sobrien print NEW $_; 6460484Sobrien } 6560484Sobrien close (OLD) or die "Can't close $file: $!"; 6660484Sobrien close (NEW) or die "Can't close $from/$file: $!"; 6760484Sobrien } 6860484Sobrien print $file . " => $from/$file$err\n"; 6960484Sobrien} 7060484Sobrien