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