1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
#
# Tool to correct links in tar files.
# Author: F. Popineau
# Date : 22/12/97
# Time-stamp: <02/12/23 00:33:46 popineau>
#
# Usage:
# gzip -dc <file>.tar.gz | tar tvf - | perl tar-links.pl
#
require "newgetopt.pl";
use Cwd;
&main;
exit 0;
sub canon_dir
{
local ($p, $rep) = @_;
if ($rep eq '' || $rep eq '\\') {
$p =~ s@/@\\@g;
$p =~ s@\\[\\]+@\\@g;
$p =~ s@\\.\\@\\@g;
$p =~ s@\\([^\\]+)\\..\\@\\@g;
}
elsif ($rep eq '/') {
$p =~ s@\\@/@g;
$p =~ s@/[/]+@/@g;
$p =~ s@/./@/@g;
$p =~ s@/([^/]+)/../@/@g;
}
else {
die ("canon_dir($p) : invalid separator $rep.\n");
}
return $p;
}
# Merges all elements in the list into a single path, adding
# directory separators as needed.
sub newpath
{
local($p, $s);
# Concatenates the arguments, adding path separators as needed
$p = @_[0];
for ($i = 1; $i <= $#_; $i++) {
$p = $p . "\\" . $_[$i];
}
return &canon_dir($p);
}
sub dirname {
local ($f) = @_;
$f =~ m@^(.*[/\\])[^/\\]*@;
return $1;
}
# Copy source to dest
sub copy
{
local ($src, $dest) = @_;
print "Copying $src to $dest\n" if ($opt_verbose);
die "Copy : source file $src does not exist.\n"
unless (-f $src);
# die "Copy : destination file $dest does not exist.\n"
# unless (-f $dest || -d $dest);
if (-d $dest) {
$dest = &newpath($dest, &basename($src));
}
open IN, "<$src";
open OUT, ">$dest";
binmode(IN);
binmode(OUT);
print OUT <IN>;
close(IN);
close(OUT);
}
sub make_link {
local ($to, $from) = @_;
$to = canon_dir($to);
$from = newpath(dirname($to), $from);
print "linking $from -> $to ...";
if (-e $to) {
unlink($to);
}
if (-d $from) {
system("xcopy $from $to /f/r/i/e/d/k");
}
else {
copy($from, $to);
}
print " done\n";
}
sub main {
while (<>) {
if ($_ =~ m/([^\s]+)\s*->\s*([^\s]+)/) {
make_link($1, $2);
}
}
}
|