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
|
#!/usr/bin/perl
# $Id: move3,v 1.2 2000/06/25 07:33:15 herbert Exp $
# stole this from dinstall
sub cleansymlink {
my($old, $new) = @_;
my($olddir, $newdir, $oldfile, $newfile, @olddir, @newdir);
($olddir, $oldfile) = ($old =~ m:((.*)/)?([^/]*):)[1,2];
($newdir, $newfile) = ($new =~ m:((.*)/)?([^/]*):)[1,2];
@olddir = split("/", $olddir);
@newdir = split("/", $newdir);
while (@olddir && $olddir[0] eq $newdir[0]) {
shift @olddir;
shift @newdir;
}
for (@newdir) { unshift(@olddir, ".."); }
symlink(join("/", @olddir, $oldfile), $new);
}
sub move {
(-l $_[0] || !link($_[0], $_[1])) && system("cp $_[0] $_[1]") and
return 0;
chmod(0644, $_[1]);
print "$_[0]\n";
return 1;
}
while (<>) {
split;
if ($_[0] eq "d") {
system(substr($_, 2)) and exit 0;
} elsif ($_[0] eq "h") {
unlink($_[2]);
link($_[1], $_[2]) or
warn "Could not link $_[1] to $_[2]: $!";
} elsif ($_[0] eq "l") {
unlink($_[2]);
cleansymlink($_[1], $_[2]) or
warn "Could not cleansymlink $_[1] to $_[2]: $!";
} elsif ($_[0] eq "r") {
unlink($_[2]);
rename($_[1], $_[2]) or
warn "Could not rename $_[1] to $_[2]: $!";
} elsif ($_[0] eq "s") {
unlink($_[2]);
symlink($_[1], $_[2]) or
warn "Could not symlink $_[1] to $_[2]: $!";
} else {
$mayskip = $_[0] eq "m";
if ($mayskip && $skip) {
$skip = 0;
next;
}
if (!move($_[1], $_[2])) {
$skip = !$mayskip;
warn "Could not move $_[1] to $_[2]";
}
}
}
|
