installperl

   1 #!./perl
   2
   3 BEGIN {
   4     require 5.004;
   5     chdir '..' if !-d 'lib' and -d '..\lib';
   6     @INC = 'lib';
   7     $ENV{PERL5LIB} = 'lib';
   8 }
   9
  10 use strict;
  11 my ($Is_VMS, $Is_W32, $Is_OS2, $Is_Cygwin, $nonono, $dostrip,
  12     $versiononly, $silent, $verbose, $otherperls);
  13 use vars qw /$depth/;
  14
  15 BEGIN {
  16     $Is_VMS = $^O eq 'VMS';
  17     $Is_W32 = $^O eq 'MSWin32';
  18     $Is_OS2 = $^O eq 'os2';
  19     $Is_Cygwin = $^O eq 'cygwin';
  20     if ($Is_VMS) { eval 'use VMS::Filespec;' }
  21 }
  22
  23 my $scr_ext = ($Is_VMS ? '.Com' : $Is_W32 ? '.bat' : '');
  24
  25 use File::Find;
  26 use File::Compare;
  27 use File::Copy ();
  28 use File::Path ();
  29 use ExtUtils::Packlist;
  30 use Config;
  31 use subs qw(unlink link chmod);
  32
  33 # override the ones in the rest of the script
  34 sub mkpath {
  35     File::Path::mkpath(@_) unless $nonono;
  36 }
  37
  38 my $mainperldir = "/usr/bin";
  39 my $exe_ext = $Config{exe_ext};
  40
  41 # Allow ``make install PERLNAME=something_besides_perl'':
  42 my $perl = defined($ENV{PERLNAME}) ? $ENV{PERLNAME} : 'perl';
  43
  44 # This is the base used for versioned names, like "perl5.6.0".
  45 # It's separate because a common use of $PERLNAME is to install
  46 # perl as "perl5", if that's used as base for versioned files you
  47 # get "perl55.6.0".
  48 my $perl_verbase = defined($ENV{PERLNAME_VERBASE})
  49                     ? $ENV{PERLNAME_VERBASE}
  50                     : $perl;
  51
  52 $otherperls = 1;
  53 while (@ARGV) {
  54     $nonono = 1 if $ARGV[0] eq '-n';
  55     $dostrip = 1 if $ARGV[0] eq '-s';
  56     $versiononly = 1 if $ARGV[0] eq '-v';
  57     $silent = 1 if $ARGV[0] eq '-S';
  58     $otherperls = 0 if $ARGV[0] eq '-o';
  59     $verbose = 1 if $ARGV[0] eq '-V' || $ARGV [0] eq '-n';
  60     shift;
  61 }
  62
  63 $versiononly = 1 if $Config{versiononly};
  64
  65 my @scripts = qw(utils/c2ph utils/h2ph utils/h2xs utils/perlbug utils/perldoc
  66                 utils/pl2pm utils/splain utils/perlcc utils/dprofpp
  67                 x2p/s2p x2p/find2perl
  68                 pod/pod2man pod/pod2html pod/pod2latex pod/pod2text
  69                 pod/pod2usage pod/podchecker pod/podselect);
  70
  71 if ($scr_ext) { @scripts = map { "$_$scr_ext" } @scripts; }
  72
  73 my @pods = (<pod/*.pod>);
  74
  75 # Specify here any .pm files that are actually architecture-dependent.
  76 # (Those included with XS extensions under ext/ are automatically
  77 # added later.)
  78 # Now that the default privlib has the full perl version number included,
  79 # we no longer have to play the trick of sticking version-specific .pm
  80 # files under the archlib directory.
  81 my %archpms = (
  82     Config => 1,
  83     lib => 1,
  84 );
  85
  86 if ($^O eq 'dos') {
  87     push(@scripts,'djgpp/fixpmain');
  88     $archpms{config} = $archpms{filehand} = 1;
  89 }
  90
  91 if ((-e "testcompile") && (defined($ENV{'COMPILE'})))
  92 {
  93         push(@scripts, map("$_.exe", @scripts));
  94 }
  95
  96 find(sub {
  97         if ("$File::Find::dir/$_" =~ m{^ext\b(.*)/([^/]+)\.pm$}) {
  98             my($path, $modname) = ($1,$2);
  99
 100             # strip trailing component first
 101             $path =~ s{/[^/]*$}{};
 102
 103             # strip optional "/lib";
 104             $path =~ s{/lib\b}{};
 105
 106             # strip any leading /
 107             $path =~ s{^/}{};
 108
 109             # reconstitute canonical module name
 110             $modname = "$path/$modname" if length $path;
 111
 112             # remember it
 113             $archpms{$modname} = 1;
 114         }
 115     }, 'ext');
 116
 117 # print "[$_]\n" for sort keys %archpms;
 118
 119 my $ver = $Config{version};
 120 my $release = substr($],0,3);   # Not used currently.
 121 my $patchlevel = substr($],3,2);
 122 die "Patchlevel of perl ($patchlevel)",
 123     "and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n"
 124         if $patchlevel != $Config{'PERL_VERSION'};
 125
 126 # Fetch some frequently-used items from %Config
 127 my $installbin = $Config{installbin};
 128 my $installscript = $Config{installscript};
 129 my $installprivlib = $Config{installprivlib};
 130 my $installarchlib = $Config{installarchlib};
 131 my $installsitelib = $Config{installsitelib};
 132 my $installsitearch = $Config{installsitearch};
 133 my $installman1dir = $Config{installman1dir};
 134 my $man1ext = $Config{man1ext};
 135 my $libperl = $Config{libperl};
 136 # Shared library and dynamic loading suffixes.
 137 my $so = $Config{so};
 138 my $dlext = $Config{dlext};
 139 my $dlsrc = $Config{dlsrc};
 140 if ($^O eq 'os390') {
 141     my $pwd;
 142     chomp($pwd=`pwd`);
 143     my $archlibexp = $Config{archlibexp};
 144     my $usedl = $Config{usedl};
 145     if ($usedl eq 'define') {
 146         `./$^X -pibak -e 's{$pwd\/libperl.x}{$archlibexp/CORE/libperl.x}' lib/Config.pm`;
 147     }
 148 }
 149
 150 my $d_dosuid = $Config{d_dosuid};
 151 my $binexp = $Config{binexp};
 152
 153 if ($Is_VMS) {  # Hang in there until File::Spec hits the big time
 154     foreach ( \$installbin,     \$installscript,  \$installprivlib,
 155               \$installarchlib, \$installsitelib, \$installsitearch,
 156               \$installman1dir ) {
 157       $$_ = unixify($$_);  $$_ =~ s:/$::;
 158     }
 159 }
 160
 161 # Do some quick sanity checks.
 162
 163 if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
 164
 165    $installbin          || die "No installbin directory in config.sh\n";
 166 -d $installbin          || mkpath($installbin, $verbose, 0777);
 167 -d $installbin          || $nonono || die "$installbin is not a directory\n";
 168 -w $installbin          || $nonono || die "$installbin is not writable by you\n"
 169         unless $installbin =~ m#^/afs/# || $nonono;
 170
 171 -x 'perl' . $exe_ext    || die "perl isn't executable!\n";
 172 -x 'suidperl' . $exe_ext|| die "suidperl isn't executable!\n" if $d_dosuid;
 173
 174 -f 't/rantests'         || $Is_W32
 175                         || warn "WARNING: You've never run 'make test' or",
 176                                 " some tests failed! (Installing anyway.)\n";
 177
 178 if ($Is_W32 or $Is_Cygwin) {
 179   my $perldll;
 180
 181   if ($Is_Cygwin) {
 182     $perldll = $libperl;
 183     $perldll =~ s/(\..*)?$/.$dlext/;
 184     if ($Config{useshrplib} eq 'true') {
 185       # install ld2 and perlld as well
 186       foreach ('ld2', 'perlld') {
 187         safe_unlink("$installbin/$_");
 188         copy("$_", "$installbin/$_");
 189         chmod(0755, "$installbin/$_");
 190       };
 191     };
 192   } else {
 193     $perldll = 'perl56.' . $dlext;
 194   }
 195
 196   if ($dlsrc ne "dl_none.xs") {
 197     -f $perldll || die "No perl DLL built\n";
 198   }
 199   # Install the DLL
 200
 201   safe_unlink("$installbin/$perldll");
 202   copy("$perldll", "$installbin/$perldll");
 203   chmod(0755, "$installbin/$perldll");
 204
 205 } # if ($Is_W32 or $Is_Cygwin)
 206
 207 # This will be used to store the packlist
 208 my $packlist = ExtUtils::Packlist->new("$installarchlib/.packlist");
 209
 210 # First we install the version-numbered executables.
 211
 212 if ($Is_VMS) {
 213     safe_unlink("$installbin/$perl$exe_ext");
 214     copy("perl$exe_ext", "$installbin/$perl$exe_ext");
 215     chmod(0755, "$installbin/$perl$exe_ext");
 216     safe_unlink("$installbin/${perl}shr$exe_ext");
 217     copy("perlshr$exe_ext", "$installbin/${perl}shr$exe_ext");
 218     chmod(0755, "$installbin/${perl}shr$exe_ext");
 219 }
 220 elsif ($^O eq 'mpeix') {
 221     # MPE lacks hard links and requires that executables with special
 222     # capabilities reside in the MPE namespace.
 223     safe_unlink("$installbin/perl$ver$exe_ext", $Config{perlpath});
 224     # Install the primary executable into the MPE namespace as perlpath.
 225     copy("perl$exe_ext", $Config{perlpath});
 226     chmod(0755, $Config{perlpath});
 227     # Create a backup copy with the version number.
 228     link($Config{perlpath}, "$installbin/perl$ver$exe_ext");
 229 }
 230 elsif ($^O ne 'dos') {
 231     safe_unlink("$installbin/$perl_verbase$ver$exe_ext");
 232     copy("perl$exe_ext", "$installbin/$perl_verbase$ver$exe_ext");
 233     strip("$installbin/$perl_verbase$ver$exe_ext");
 234     chmod(0755, "$installbin/$perl_verbase$ver$exe_ext");
 235 }
 236 else {
 237     safe_unlink("$installbin/$perl.exe");
 238     copy("perl.exe", "$installbin/$perl.exe");
 239 }
 240
 241 safe_unlink("$installbin/s$perl_verbase$ver$exe_ext");
 242 if ($d_dosuid) {
 243     copy("suidperl$exe_ext", "$installbin/s$perl_verbase$ver$exe_ext");
 244     chmod(04711, "$installbin/s$perl_verbase$ver$exe_ext");
 245 }
 246
 247 # Install library files.
 248
 249 my ($do_installarchlib, $do_installprivlib) = (0, 0);
 250
 251 mkpath($installprivlib, $verbose, 0777);
 252 mkpath($installarchlib, $verbose, 0777);
 253 mkpath($installsitelib, $verbose, 0777) if ($installsitelib);
 254 mkpath($installsitearch, $verbose, 0777) if ($installsitearch);
 255
 256 if (chdir "lib") {
 257     $do_installarchlib = ! samepath($installarchlib, '.');
 258     $do_installprivlib = ! samepath($installprivlib, '.');
 259     $do_installprivlib = 0 if $versiononly && !($installprivlib =~ m/\Q$ver/);
 260
 261     if ($do_installarchlib || $do_installprivlib) {
 262         find(\&installlib, '.');
 263     }
 264     chdir ".." || die "Can't cd back to source directory: $!\n";
 265 }
 266 else {
 267     warn "Can't cd to lib to install lib files: $!\n";
 268 }
 269
 270 # Install header files and libraries.
 271 mkpath("$installarchlib/CORE", $verbose, 0777);
 272 my @corefiles;
 273 if ($Is_VMS) {  # We did core file selection during build
 274     my $coredir = "lib/$Config{archname}/$ver/CORE";
 275     $coredir =~ tr/./_/;
 276     map { s|^$coredir/||i; } @corefiles = <$coredir/*.*>;
 277 }
 278 else {
 279     # [als] hard-coded 'libperl' name... not good!
 280     @corefiles = <*.h libperl*.*>;
 281
 282     # AIX needs perl.exp installed as well.
 283     push(@corefiles,'perl.exp') if $^O eq 'aix';
 284     if ($^O eq 'mpeix') {
 285         # MPE needs mpeixish.h installed as well.
 286         mkpath("$installarchlib/CORE/mpeix", $verbose, 0777);
 287         push(@corefiles,'mpeix/mpeixish.h');
 288     }
 289     # If they have built sperl.o...
 290     push(@corefiles,'sperl.o') if -f 'sperl.o';
 291 }
 292 foreach my $file (@corefiles) {
 293     # HP-UX (at least) needs to maintain execute permissions
 294     # on dynamically-loadable libraries. So we do it for all.
 295     if (copy_if_diff($file,"$installarchlib/CORE/$file")) {
 296         if ($file =~ /\.(\Q$so\E|\Q$dlext\E)$/) {
 297             chmod(0555, "$installarchlib/CORE/$file");
 298             strip("-S", "$installarchlib/CORE/$file") if $^O =~ /^(rhapsody|darwin)$/;
 299         } else {
 300             chmod(0444, "$installarchlib/CORE/$file");
 301         }
 302     }
 303 }
 304
 305 # Install main perl executables
 306 # Make links to ordinary names if installbin directory isn't current directory.
 307
 308 if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS) {
 309     safe_unlink("$installbin/$perl$exe_ext", "$installbin/suid$perl$exe_ext");
 310     if ($^O eq 'mpeix') {
 311         # MPE doesn't support hard links, so use a symlink.
 312         # We don't want another cloned copy.
 313         symlink($Config{perlpath}, "$installbin/perl$exe_ext");
 314     } else {
 315         link("$installbin/$perl_verbase$ver$exe_ext",
 316                 "$installbin/$perl$exe_ext");
 317     }
 318     link("$installbin/s$perl_verbase$ver$exe_ext",
 319             "$installbin/suid$perl$exe_ext")
 320       if $d_dosuid;
 321 }
 322
 323 # Offer to install perl in a "standard" location
 324
 325 my $mainperl_is_instperl = 0;
 326
 327 if ($Config{installusrbinperl} && $Config{installusrbinperl} eq 'define' &&
 328     !$versiononly && !$nonono && !$Is_W32 && !$Is_VMS && -t STDIN && -t STDERR
 329         && -w $mainperldir && ! samepath($mainperldir, $installbin)) {
 330     my($usrbinperl)     = "$mainperldir/$perl$exe_ext";
 331     my($instperl)       = "$installbin/$perl$exe_ext";
 332     my($expinstperl)    = "$binexp/$perl$exe_ext";
 333
 334     # First make sure $usrbinperl is not already the same as the perl we
 335     # just installed.
 336     if (-x $usrbinperl) {
 337         # Try to be clever about mainperl being a symbolic link
 338         # to binexp/perl if binexp and installbin are different.
 339         $mainperl_is_instperl =
 340             samepath($usrbinperl, $instperl) ||
 341             samepath($usrbinperl, $expinstperl) ||
 342              (($binexp ne $installbin) &&
 343               (-l $usrbinperl) &&
 344               ((readlink $usrbinperl) eq $expinstperl));
 345     }
 346     if ((! $mainperl_is_instperl) &&
 347         (yn("Many scripts expect perl to be installed as $usrbinperl.\n" .
 348              "Do you wish to have $usrbinperl be the same as\n" .
 349              "$expinstperl? [y] ")))
 350     {
 351         unlink($usrbinperl);
 352         ( $Config{'d_link'} eq 'define' &&
 353           eval { CORE::link $instperl, $usrbinperl } )  ||
 354         eval { symlink $expinstperl, $usrbinperl }      ||
 355         copy($instperl, $usrbinperl);
 356
 357         $mainperl_is_instperl = 1;
 358     }
 359 }
 360
 361 # Make links to ordinary names if installbin directory isn't current directory.
 362
 363 if (!$versiononly && ! samepath($installbin, 'x2p')) {
 364     safe_unlink("$installbin/a2p$exe_ext");
 365     copy("x2p/a2p$exe_ext", "$installbin/a2p$exe_ext");
 366     chmod(0755, "$installbin/a2p$exe_ext");
 367 }
 368
 369 # cppstdin is just a script, but it is architecture-dependent, so
 370 # it can't safely be shared.  Place it in $installbin.
 371 # Note that Configure doesn't build cppstin if it isn't needed, so
 372 # we skip this if cppstdin doesn't exist.
 373 if (! $versiononly && (-f 'cppstdin') && (! samepath($installbin, '.'))) {
 374     safe_unlink("$installbin/cppstdin");
 375     copy("cppstdin", "$installbin/cppstdin");
 376     chmod(0755, "$installbin/cppstdin");
 377 }
 378
 379 if (! $versiononly) {
 380     # Install scripts.
 381
 382     mkpath($installscript, $verbose, 0777);
 383
 384     for (@scripts) {
 385         (my $base = $_) =~ s#.*/##;
 386         copy($_, "$installscript/$base");
 387         chmod(0755, "$installscript/$base");
 388     }
 389
 390     # pstruct should be a link to c2ph
 391     safe_unlink("$installscript/pstruct$scr_ext");
 392     if ($^O eq 'dos' or $Is_VMS or $^O eq 'transit') {
 393         copy("$installscript/c2ph$scr_ext",
 394              "$installscript/pstruct$scr_ext");
 395     } else {
 396         link("$installscript/c2ph$scr_ext",
 397              "$installscript/pstruct$scr_ext");
 398     }
 399 }
 400
 401 # Install pod pages.  Where? I guess in $installprivlib/pod
 402 # ($installprivlib/pods for cygwin).
 403
 404 my $pod = $Is_Cygwin ? 'pods' : 'pod';
 405 if ( !$versiononly || ($installprivlib =~ m/\Q$ver/)) {
 406     mkpath("${installprivlib}/$pod", $verbose, 0777);
 407
 408     # If Perl 5.003's perldiag.pod is there, rename it.
 409     if (open POD, "${installprivlib}/$pod/perldiag.pod") {
 410         read POD, $_, 4000;
 411         close POD;
 412         # Some of Perl 5.003's diagnostic messages ended with periods.
 413         if (/^=.*\.$/m) {
 414             my ($from, $to) = ("${installprivlib}/$pod/perldiag.pod",
 415                                "${installprivlib}/$pod/perldiag-5.003.pod");
 416             print "  rename $from $to";
 417             rename($from, $to)
 418                 or warn "Couldn't rename $from to $to: $!\n"
 419                 unless $nonono;
 420         }
 421     }
 422
 423     for (@pods) {
 424         # $_ is a name like  pod/perl.pod
 425         (my $base = $_) =~ s#.*/##;
 426         copy_if_diff($_, "${installprivlib}/$pod/${base}");
 427     }
 428
 429 }
 430
 431 # Check to make sure there aren't other perls around in installer's
 432 # path.  This is probably UNIX-specific.  Check all absolute directories
 433 # in the path except for where public executables are supposed to live.
 434 # Also skip $mainperl if the user opted to have it be a link to the
 435 # installed perl.
 436
 437 if (!$versiononly && $otherperls) {
 438     my ($path, @path);
 439     my $dirsep = ($Is_OS2 || $Is_W32) ? ';' : ':' ;
 440     ($path = $ENV{"PATH"}) =~ s:\\:/:g ;
 441     @path = split(/$dirsep/, $path);
 442     if ($Is_VMS) {
 443         my $i = 0;
 444         while (exists $ENV{'DCL$PATH' . $i}) {
 445             my $dir = unixpath($ENV{'DCL$PATH' . $i});  $dir =~ s-/$--;
 446             push(@path,$dir);
 447         }
 448     }
 449     my @otherperls;
 450     my %otherperls;
 451     for (@path) {
 452         next unless m,^/,;
 453         # Use &samepath here because some systems have other dirs linked
 454         # to $mainperldir (like SunOS)
 455         next if samepath($_, $binexp);
 456         next if ($mainperl_is_instperl && samepath($_, $mainperldir));
 457         my $otherperl = "$_/$perl$exe_ext";
 458         next if $otherperls{$otherperl}++;
 459         push(@otherperls, $otherperl)
 460             if (-x $otherperl && ! -d $otherperl);
 461     }
 462     if (@otherperls) {
 463         warn "\nWarning: $perl appears in your path in the following " .
 464             "locations beyond where\nwe just installed it:\n";
 465         for (@otherperls) {
 466             warn "    ", $_, "\n";
 467         }
 468         warn "\n";
 469     }
 470
 471 }
 472
 473 $packlist->write() unless $nonono;
 474 print "  Installation complete\n" if $verbose;
 475
 476 exit 0;
 477
 478 ###############################################################################
 479
 480 sub yn {
 481     my($prompt) = @_;
 482     my($answer);
 483     my($default) = $prompt =~ m/\[([yn])\]\s*$/i;
 484     warn $prompt;
 485     chop($answer = <STDIN>);
 486     $answer = $default if $answer =~ m/^\s*$/;
 487     ($answer =~ m/^[yY]/);
 488 }
 489
 490 sub unlink {
 491     my(@names) = @_;
 492     my($cnt) = 0;
 493
 494     return scalar(@names) if $Is_VMS;
 495
 496     foreach my $name (@names) {
 497         next unless -e $name;
 498         chmod 0777, $name if ($Is_OS2 || $Is_W32 || $Is_Cygwin);
 499         print "  unlink $name\n" if $verbose;
 500         ( CORE::unlink($name) and ++$cnt
 501           or warn "Couldn't unlink $name: $!\n" ) unless $nonono;
 502     }
 503     return $cnt;
 504 }
 505
 506 sub safe_unlink {
 507     return if $nonono or $Is_VMS;
 508     my @names = @_;
 509     foreach my $name (@names) {
 510         next unless -e $name;
 511         chmod 0777, $name if ($Is_OS2 || $Is_W32);
 512         print "  unlink $name\n" if $verbose;
 513         next if CORE::unlink($name);
 514         warn "Couldn't unlink $name: $!\n";
 515         if ($! =~ /busy/i) {
 516             print "  mv $name $name.old\n" if $verbose;
 517             safe_rename($name, "$name.old")
 518                 or warn "Couldn't rename $name: $!\n";
 519         }
 520     }
 521 }
 522
 523 sub safe_rename {
 524     my($from,$to) = @_;
 525     if (-f $to and not unlink($to)) {
 526         my($i);
 527         for ($i = 1; $i < 50; $i++) {
 528             last if rename($to, "$to.$i");
 529         }
 530         warn("Cannot rename to `$to.$i': $!"), return 0
 531            if $i >= 50; # Give up!
 532     }
 533     link($from,$to) || return 0;
 534     unlink($from);
 535 }
 536
 537 sub link {
 538     my($from,$to) = @_;
 539     my($success) = 0;
 540
 541     print $verbose ? "  ln $from $to\n" : "  $to\n" unless $silent;
 542     eval {
 543         CORE::link($from, $to)
 544             ? $success++
 545             : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
 546               ? die "AFS"  # okay inside eval {}
 547               : die "Couldn't link $from to $to: $!\n"
 548           unless $nonono;
 549         $packlist->{$to} = { from => $from, type => 'link' };
 550     };
 551     if ($@) {
 552         warn $@;
 553         print $verbose ? "  cp $from $to\n" : "  $to\n" unless $silent;
 554         print "  creating new version of $to\n"
 555                  if $Is_VMS and -e $to and !$silent;
 556         File::Copy::copy($from, $to)
 557             ? $success++
 558             : warn "Couldn't copy $from to $to: $!\n"
 559           unless $nonono;
 560         $packlist->{$to} = { type => 'file' };
 561     }
 562     $success;
 563 }
 564
 565 sub chmod {
 566     my($mode,$name) = @_;
 567
 568     return if ($^O eq 'dos');
 569     printf "  chmod %o %s\n", $mode, $name if $verbose;
 570     CORE::chmod($mode,$name)
 571         || warn sprintf("Couldn't chmod %o %s: $!\n", $mode, $name)
 572       unless $nonono;
 573 }
 574
 575 sub copy {
 576     my($from,$to) = @_;
 577
 578     print $verbose ? "  cp $from $to\n" : "  $to\n" unless $silent;
 579     print "  creating new version of $to\n" if $Is_VMS and -e $to and !$silent;
 580     File::Copy::copy($from, $to)
 581         || warn "Couldn't copy $from to $to: $!\n"
 582       unless $nonono;
 583     $packlist->{$to} = { type => 'file' };
 584 }
 585
 586 sub samepath {
 587     my($p1, $p2) = @_;
 588
 589     return (lc($p1) eq lc($p2)) if $Is_W32;
 590
 591     if ($p1 ne $p2) {
 592         my($dev1, $ino1, $dev2, $ino2);
 593         ($dev1, $ino1) = stat($p1);
 594         ($dev2, $ino2) = stat($p2);
 595         ($dev1 == $dev2 && $ino1 == $ino2);
 596     }
 597     else {
 598         1;
 599     }
 600 }
 601
 602 sub installlib {
 603     my $dir = $File::Find::dir;
 604     $dir =~ s#^\.(?![^/])/?##;
 605     local($depth) = $dir ? "lib/$dir" : "lib";
 606
 607     my $name = $_;
 608
 609     # Ignore RCS and CVS directories.
 610     if (($name eq 'CVS' or $name eq 'RCS') and -d $name) {
 611         $File::Find::prune = 1;
 612         return;
 613     }
 614
 615     # ignore patch backups, RCS files, emacs backup & temp files and the
 616     # .exists files, and .PL files.
 617     return if $name =~ m{\.orig$|~$|^#.+#$|,v$|^\.exists|\.PL$};
 618
 619     $name = "$dir/$name" if $dir ne '';
 620
 621     my $installlib = $installprivlib;
 622     if ($dir =~ /^auto/ ||
 623           ($name =~ /^(.*)\.(?:pm|pod)$/ && $archpms{$1}) ||
 624           ($name =~ /^(.*)\.(?:h|lib)$/i && $Is_W32)
 625        ) {
 626         $installlib = $installarchlib;
 627         return unless $do_installarchlib;
 628     } else {
 629         return unless $do_installprivlib;
 630     }
 631
 632     if (-f $_) {
 633         if (/\.(?:al|ix)$/ && !($dir =~ m[^auto/(.*)$] && $archpms{$1})) {
 634             $installlib = $installprivlib;
 635             #We're installing *.al and *.ix files into $installprivlib,
 636             #but we have to delete old *.al and *.ix files from the 5.000
 637             #distribution:
 638             #This might not work because $archname might have changed.
 639             unlink("$installarchlib/$name");
 640         }
 641         $packlist->{"$installlib/$name"} = { type => 'file' };
 642         if (compare($_, "$installlib/$name") || $nonono) {
 643             unlink("$installlib/$name");
 644             mkpath("$installlib/$dir", $verbose, 0777);
 645             # HP-UX (at least) needs to maintain execute permissions
 646             # on dynamically-loaded libraries.
 647             copy_if_diff($_, "$installlib/$name")
 648                 and chmod($name =~ /\.(so|$dlext)$/o ? 0555 : 0444,
 649                            "$installlib/$name");
 650         }
 651     }
 652 }
 653
 654 # Copy $from to $to, only if $from is different than $to.
 655 # Also preserve modification times for .a libraries.
 656 # On some systems, if you do
 657 #   ranlib libperl.a
 658 #   cp libperl.a /usr/local/lib/perl5/archlib/CORE/libperl.a
 659 # and then try to link against the installed libperl.a, you might
 660 # get an error message to the effect that the symbol table is older
 661 # than the library.
 662 # Return true if copying occurred.
 663
 664 sub copy_if_diff {
 665     my($from,$to)=@_;
 666     return 1 if (($^O eq 'VMS') && (-d $from));
 667     -f $from || warn "$0: $from not found";
 668     $packlist->{$to} = { type => 'file' };
 669     if (compare($from, $to) || $nonono) {
 670         safe_unlink($to);   # In case we don't have write permissions.
 671         if ($nonono) {
 672             $from = $depth . "/" . $from if $depth;
 673         }
 674         copy($from, $to);
 675         # Restore timestamps if it's a .a library or for OS/2.
 676         if (!$nonono && ($Is_OS2 || $to =~ /\.a$/)) {
 677             my ($atime, $mtime) = (stat $from)[8,9];
 678             utime $atime, $mtime, $to;
 679         }
 680         1;
 681     }
 682 }
 683
 684 sub strip
 685 {
 686     my(@args) = @_;
 687
 688     return unless $dostrip;
 689
 690     my @opts;
 691     while (@args && $args[0] =~ /^(-\w+)$/) {
 692         push @opts, shift @args;
 693     }
 694
 695     foreach my $file (@args) {
 696         if (-f $file) {
 697             print "  strip $file\n" if $verbose;
 698             system("strip", @opts, $file);
 699         } else {
 700             print "# file '$file' skipped\n" if $verbose;
 701         }
 702     }
 703 }
 704