| Server IP : 180.180.241.3 / Your IP : 216.73.216.216 Web Server : Microsoft-IIS/7.5 System : Windows NT NETWORK-NHRC 6.1 build 7601 (Windows Server 2008 R2 Standard Edition Service Pack 1) i586 User : IUSR ( 0) PHP Version : 5.3.28 Disable Function : NONE MySQL : ON | cURL : ON | WGET : OFF | Perl : OFF | Python : OFF | Sudo : OFF | Pkexec : OFF Directory : C:/Program Files (x86)/Git/lib/perl5/5.8.8/B/ |
Upload File : |
use File::Find;
use Config;
if (@ARGV != 2) {
warn <<"EOT";
Usage: makeliblinks libautodir targetdir
where libautodir is the architecture-dependent auto directory
(e.g. $Config::Config{archlib}/auto).
EOT
exit 2;
}
my ($libautodir, $targetdir) = @ARGV;
# Calculate relative path prefix from $targetdir to $libautodir
sub relprefix {
my ($to, $from) = @_;
my $up;
for ($up = 0; substr($to, 0, length($from)) ne $from; $up++) {
$from =~ s(
[^/]+ (?# a group of non-slashes)
/* (?# maybe with some trailing slashes)
$ (?# at the end of the path)
)()x;
}
return (("../" x $up) . substr($to, length($from)));
}
my $relprefix = relprefix($libautodir, $targetdir);
my ($dlext, $lib_ext) = @Config::Config{qw(dlext lib_ext)};
sub link_if_library {
if (/\.($dlext|$lib_ext)$/o) {
my $ext = $1;
my $name = $File::Find::name;
if (substr($name, 0, length($libautodir) + 1) ne "$libautodir/") {
die "directory of $name doesn't match $libautodir\n";
}
substr($name, 0, length($libautodir) + 1) = '';
my @parts = split(m(/), $name);
if ($parts[-1] ne "$parts[-2].$ext") {
die "module name $_ doesn't match its directory $libautodir\n";
}
pop @parts;
my $libpath = "$targetdir/lib" . join("__", @parts) . ".$ext";
print "$libpath -> $relprefix/$name\n";
symlink("$relprefix/$name", $libpath)
or warn "above link failed with error: $!\n";
}
}
find(\&link_if_library, $libautodir);
exit 0;