mklink.pl revision 55714 
1#!/usr/local/bin/perl
2
3# mklink.pl
4
5# The first command line argument is a non-empty relative path
6# specifying the "from" directory.
7# Each other argument is a file name not containing / and
8# names a file in the current directory.
9#
10# For each of these files, we create in the "from" directory a link
11# of the same name pointing to the local file.
12#
13# We assume that the directory structure is a tree, i.e. that it does
14# not contain symbolic links and that the parent of / is never referenced.
15# Apart from this, this script should be able to handle even the most
16# pathological cases.
17
18my $from = shift;
19my @files = @ARGV;
20
21my @from_path = split(/\//, $from);
22my $pwd = `pwd`;
23chop($pwd);
24my @pwd_path = split(/\//, $pwd);
25
26my @to_path = ();
27
28my $dirname;
29foreach $dirname (@from_path) {
30
31    # In this loop, @to_path always is a relative path from
32    # @pwd_path (interpreted is an absolute path) to the original pwd.
33
34    # At the end, @from_path (as a relative path from the original pwd)
35    # designates the same directory as the absolute path @pwd_path,
36    # which means that @to_path then is a path from there to the original pwd.
37
38    next if ($dirname eq "" || $dirname eq ".");
39
40    if ($dirname eq "..") {
41	@to_path = (pop(@pwd_path), @to_path);
42    } else {
43	@to_path = ("..", @to_path);
44	push(@pwd_path, $dirname);
45    }
46}
47
48my $to = join('/', @to_path);
49
50my $file;
51foreach $file (@files) {
52#    print "ln -s $to/$file $from/$file\n";
53    symlink("$to/$file", "$from/$file");
54    print $file . " => $from/$file\n";
55}
56