lib/perl5/5.6.1/B/makeliblinks

   1 use File::Find;
   2 use Config;
   3
   4 if (@ARGV != 2) {
   5     warn <<"EOT";
   6 Usage: makeliblinks libautodir targetdir
   7 where libautodir is the architecture-dependent auto directory
   8 (e.g. $Config::Config{archlib}/auto).
   9 EOT
  10     exit 2;
  11 }
  12
  13 my ($libautodir, $targetdir) = @ARGV;
  14
  15 # Calculate relative path prefix from $targetdir to $libautodir
  16 sub 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
  29 my $relprefix = relprefix($libautodir, $targetdir);
  30
  31 my ($dlext, $lib_ext) = @Config::Config{qw(dlext lib_ext)};
  32
  33 sub 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
  53 find(\&link_if_library, $libautodir);
  54 exit 0;