mklink.pl revision 68651
1272343Sngie#!/usr/local/bin/perl 2272343Sngie 3272343Sngie# mklink.pl 4272343Sngie 5272343Sngie# The first command line argument is a non-empty relative path 6272343Sngie# specifying the "from" directory. 7272343Sngie# Each other argument is a file name not containing / and 8272343Sngie# names a file in the current directory. 9272343Sngie# 10272343Sngie# For each of these files, we create in the "from" directory a link 11272343Sngie# of the same name pointing to the local file. 12272343Sngie# 13272343Sngie# We assume that the directory structure is a tree, i.e. that it does 14272343Sngie# not contain symbolic links and that the parent of / is never referenced. 15272343Sngie# Apart from this, this script should be able to handle even the most 16272343Sngie# pathological cases. 17272343Sngie 18272343Sngiemy $from = shift; 19272343Sngiemy @files = @ARGV; 20272343Sngie 21272343Sngiemy @from_path = split(/\//, $from); 22272343Sngiemy $pwd = `pwd`; 23272343Sngiechop($pwd); 24272343Sngiemy @pwd_path = split(/\//, $pwd); 25272343Sngie 26272343Sngiemy @to_path = (); 27272343Sngie 28272343Sngiemy $dirname; 29272343Sngieforeach $dirname (@from_path) { 30272343Sngie 31272343Sngie # In this loop, @to_path always is a relative path from 32272343Sngie # @pwd_path (interpreted is an absolute path) to the original pwd. 33272343Sngie 34272343Sngie # At the end, @from_path (as a relative path from the original pwd) 35272343Sngie # designates the same directory as the absolute path @pwd_path, 36272343Sngie # which means that @to_path then is a path from there to the original pwd. 37272343Sngie 38272343Sngie next if ($dirname eq "" || $dirname eq "."); 39272343Sngie 40272343Sngie if ($dirname eq "..") { 41272343Sngie @to_path = (pop(@pwd_path), @to_path); 42272343Sngie } else { 43272343Sngie @to_path = ("..", @to_path); 44272343Sngie push(@pwd_path, $dirname); 45272343Sngie } 46272343Sngie} 47272343Sngie 48272343Sngiemy $to = join('/', @to_path); 49272343Sngie 50272343Sngiemy $file; 51272343Sngieforeach $file (@files) { 52272343Sngie my $err = ""; 53272343Sngie symlink("$to/$file", "$from/$file") or $err = " [$!]"; 54272343Sngie print $file . " => $from/$file$err\n"; 55272343Sngie} 56272343Sngie