source: for-distributions/trunk/bin/windows/perl/lib/B/makeliblinks@ 14489

Last change on this file since 14489 was 14489, checked in by oranfry, 17 years ago

upgrading to perl 5.8

File size: 1.4 KB
Line 
1use File::Find;
2use Config;
3
4if (@ARGV != 2) {
5 warn <<"EOT";
6Usage: makeliblinks libautodir targetdir
7where libautodir is the architecture-dependent auto directory
8(e.g. $Config::Config{archlib}/auto).
9EOT
10 exit 2;
11}
12
13my ($libautodir, $targetdir) = @ARGV;
14
15# Calculate relative path prefix from $targetdir to $libautodir
16sub relprefix {
17 my ($to, $from) = @_;
18 my $up;
19 for ($up = 0; substr($to, 0, length($from)) ne $from; $up++) {
20 $from =~ s(
21 [^/]+ (?# a group of non-slashes)
22 /* (?# maybe with some trailing slashes)
23 $ (?# at the end of the path)
24 )()x;
25 }
26 return (("../" x $up) . substr($to, length($from)));
27}
28
29my $relprefix = relprefix($libautodir, $targetdir);
30
31my ($dlext, $lib_ext) = @Config::Config{qw(dlext lib_ext)};
32
33sub link_if_library {
34 if (/\.($dlext|$lib_ext)$/o) {
35 my $ext = $1;
36 my $name = $File::Find::name;
37 if (substr($name, 0, length($libautodir) + 1) ne "$libautodir/") {
38 die "directory of $name doesn't match $libautodir\n";
39 }
40 substr($name, 0, length($libautodir) + 1) = '';
41 my @parts = split(m(/), $name);
42 if ($parts[-1] ne "$parts[-2].$ext") {
43 die "module name $_ doesn't match its directory $libautodir\n";
44 }
45 pop @parts;
46 my $libpath = "$targetdir/lib" . join("__", @parts) . ".$ext";
47 print "$libpath -> $relprefix/$name\n";
48 symlink("$relprefix/$name", $libpath)
49 or warn "above link failed with error: $!\n";
50 }
51}
52
53find(\&link_if_library, $libautodir);
54exit 0;
Note: See TracBrowser for help on using the repository browser.