blob: 3e2a89afdfc14966418b4fa530029e2699d10990 (
plain)
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
|
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
use File::Spec;
use Cwd;
sub usage()
{
my $name = (File::Spec->splitpath($0))[2];
print <<EOT
Usage:
$name destination
EOT
;
exit 0;
}
sub get_first_subdir($$)
{
my @path = File::Spec->splitdir(File::Spec->rel2abs(shift));
my @base = File::Spec->splitdir(File::Spec->rel2abs(shift));
while (@path and @base and $path[0] eq $base[0])
{
shift @path;
shift @base;
}
@base ? '' : $path[0];
}
my $dst = shift;
if (not defined $dst or $dst eq '')
{
usage();
}
my $src = File::Spec->rel2abs(cwd());
$dst = File::Spec->rel2abs($dst);
if (! -d $dst)
{
my $path = '';
foreach my $d (File::Spec->splitdir($dst))
{
$path = File::Spec->catdir($path, $d);
if (! -d $path)
{
mkdir $path or die "Can't create directory $path: $!";
}
}
}
my $subdir = File::Spec->rel2abs(get_first_subdir($dst, $src), $src);
my @path = File::Spec->splitdir($dst);
my $curdir = File::Spec->catdir(@path);
find {
wanted => sub {
if ($File::Find::name eq $subdir or /^(CVS(?:\.adm)?|RCS|SCCS)$/)
{
$File::Find::prune = 1;
return;
}
elsif ($_ eq File::Spec->curdir)
{
return;
}
elsif (-d)
{
push @path, $_;
$curdir = File::Spec->catdir(@path);
mkdir $curdir unless -d $curdir;
}
else
{
my $basename = (File::Spec->splitpath($File::Find::name))[2];
my $filename = File::Spec->catfile($curdir, $basename);
unlink $filename;
symlink File::Spec->abs2rel($File::Find::name, $curdir), $filename;
}
},
postprocess => sub {
pop @path;
}
}, $src;
|