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