]>
Commit | Line | Data |
---|---|---|
534a83fc DS |
1 | #!/usr/bin/perl -w |
2 | # vi: set ts=4: | |
3 | ||
4 | ||
5 | @LINKS=`find . -type l|xargs ls -l`; | |
6 | ||
7 | #print @LINKS; | |
8 | ||
9 | ||
10 | while($_ = shift @LINKS){ | |
11 | chomp; | |
12 | my ($perm,$nlinks,$owner,$group,$size,$month,$day,$year,$file) = | |
13 | split(' ', $_, 9); | |
14 | my $link; | |
15 | ||
16 | if($perm =~ m/^l/){ | |
17 | ($relfile, $link) = split(' -> ', $file); | |
18 | } | |
19 | ||
20 | # chop off leading . in $file | |
21 | $file = $relfile; | |
22 | $file =~ s/^\.//; | |
23 | ||
24 | if($perm =~ m/^l/){ | |
25 | my @pathcomponents = split('/', $file); | |
26 | my @linkcomponents = split('/', $link); | |
27 | ||
28 | if($link =~ m/^\//){ | |
29 | @newcomponents = @linkcomponents; | |
30 | }else{ | |
31 | @newcomponents = @pathcomponents; | |
32 | ||
33 | # chop off filename | |
34 | pop(@newcomponents); | |
35 | ||
36 | while($comp = shift @linkcomponents){ | |
37 | #print "path: ",join(':',@newcomponents)," -- $comp -- ", join(':',@linkcomponents),"\n"; | |
38 | ||
39 | if($comp eq ""){ | |
40 | # ignore | |
41 | }elsif($comp eq ".."){ | |
42 | pop(@newcomponents); | |
43 | }else{ | |
44 | push @newcomponents,$comp; | |
45 | } | |
46 | } | |
47 | } | |
48 | ||
49 | if($newcomponents[0] eq ""){ | |
50 | shift(@newcomponents); | |
51 | } | |
52 | if($pathcomponents[0] eq ""){ | |
53 | shift(@pathcomponents); | |
54 | } | |
55 | ||
56 | #print "from ",join('/',@pathcomponents),"\n"; | |
57 | #print "to ",join('/',@newcomponents),"\n"; | |
58 | ||
59 | if($newcomponents[0] eq $pathcomponents[0]){ | |
60 | #print $newcomponents[0],", ",$pathcomponents[0]; | |
61 | #print "should be relative\n"; | |
62 | while($newcomponents[0] eq $pathcomponents[0]){ | |
63 | shift(@newcomponents); | |
64 | shift(@pathcomponents); | |
65 | } | |
66 | while(@pathcomponents > 1){ | |
67 | shift(@pathcomponents); | |
68 | unshift(@newcomponents,".."); | |
69 | } | |
70 | }else{ | |
71 | #print "should be absolute\n"; | |
72 | unshift(@newcomponents,""); | |
73 | } | |
74 | $newlink=join('/',@newcomponents); | |
75 | print "ln -sf $newlink $relfile\n"; | |
76 | unlink($relfile); | |
77 | symlink($newlink,$relfile); | |
78 | } | |
79 | } | |
80 |