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 File::Find;
  11 use File::Compare;
  12 use File::Copy ();
  13 use File::Path ();
  14 use ExtUtils::Packlist;
  15 use Config;
  16 use subs qw(unlink link chmod);
  17 use vars qw($packlist);
  18
  19 # override the ones in the rest of the script
  20 sub mkpath {
  21     File::Path::mkpath(@_) unless $nonono;
  22 }
  23
  24 $mainperldir = "/usr/bin";
  25 $exe_ext = $Config{exe_ext};
  26
  27 while (@ARGV) {
  28     $nonono = 1 if $ARGV[0] eq '-n';
  29     $versiononly = 1 if $ARGV[0] eq '-v';
  30     shift;
  31 }
  32
  33 umask 022;
  34
  35 @scripts = qw(  utils/c2ph utils/h2ph utils/h2xs
  36                 utils/perlbug utils/perldoc utils/pl2pm utils/splain
  37                 x2p/s2p x2p/find2perl
  38                 pod/pod2man pod/pod2html pod/pod2latex pod/pod2text);
  39
  40 @pods = (<pod/*.pod>);
  41
  42 %archpms = (Config => 1, FileHandle => 1, overload => 1);
  43
  44 if ($^O eq 'dos') {
  45     push(@scripts,'djgpp/fixpmain');
  46     $archpms{config} = $archpms{filehand} = 1;
  47 }
  48
  49 find(sub {
  50         if ("$File::Find::dir/$_" =~ m{^ext/[^/]+/(.*)\.pm$}) {
  51             (my $pm = $1) =~ s{^lib/}{};
  52             $archpms{$pm} = 1;
  53         }
  54     }, 'ext');
  55
  56 $ver = $];
  57 $release = substr($ver,0,3);   # Not used presently.
  58 $patchlevel = substr($ver,3,2);
  59 die "Patchlevel of perl ($patchlevel)",
  60     "and patchlevel of config.sh ($Config{'PATCHLEVEL'}) don't match\n"
  61         if $patchlevel != $Config{'PATCHLEVEL'};
  62
  63 # Fetch some frequently-used items from %Config
  64 $installbin = $Config{installbin};
  65 $installscript = $Config{installscript};
  66 $installprivlib = $Config{installprivlib};
  67 $installarchlib = $Config{installarchlib};
  68 $installsitelib = $Config{installsitelib};
  69 $installsitearch = $Config{installsitearch};
  70 $installman1dir = $Config{installman1dir};
  71 $man1ext = $Config{man1ext};
  72 $libperl = $Config{libperl};
  73 # Shared library and dynamic loading suffixes.
  74 $so = $Config{so};
  75 $dlext = $Config{dlext};
  76
  77 $d_dosuid = $Config{d_dosuid};
  78 $binexp = $Config{binexp};
  79
  80 # Do some quick sanity checks.
  81
  82 if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
  83
  84    $installbin          || die "No installbin directory in config.sh\n";
  85 -d $installbin          || mkpath($installbin, 1, 0777);
  86 -d $installbin          || $nonono || die "$installbin is not a directory\n";
  87 -w $installbin          || $nonono || die "$installbin is not writable by you\n"
  88         unless $installbin =~ m#^/afs/# || $nonono;
  89
  90 -x 'perl' . $exe_ext    || die "perl isn't executable!\n";
  91 -x 'suidperl' . $exe_ext|| die "suidperl isn't executable!\n" if $d_dosuid;
  92
  93 -x 't/TEST'             || $^O eq 'MSWin32'
  94                         || warn "WARNING: You've never run 'make test'!!!",
  95                                 "  (Installing anyway.)\n";
  96
  97 if ($^O eq 'MSWin32') {
  98
  99 -f 'perl.' . $dlext || die "No perl DLL built\n";
 100
 101 # Install the DLL
 102
 103 safe_unlink("$installbin/perl.$dlext");
 104 copy("perl.$dlext", "$installbin/perl.$dlext");
 105 chmod(0755, "$installbin/perl.$dlext");
 106 }
 107
 108 # This will be used to store the packlist
 109 $packlist = ExtUtils::Packlist->new("$installarchlib/.packlist");
 110
 111 # First we install the version-numbered executables.
 112
 113 if ($^O ne 'dos') {
 114     safe_unlink("$installbin/perl$ver$exe_ext");
 115     copy("perl$exe_ext", "$installbin/perl$ver$exe_ext");
 116     chmod(0755, "$installbin/perl$ver$exe_ext");
 117 } else {
 118     safe_unlink("$installbin/perl.exe");
 119     copy("perl.exe", "$installbin/perl.exe");
 120 }
 121
 122 safe_unlink("$installbin/sperl$ver$exe_ext");
 123 if ($d_dosuid) {
 124     copy("suidperl$exe_ext", "$installbin/sperl$ver$exe_ext");
 125     chmod(04711, "$installbin/sperl$ver$exe_ext");
 126 }
 127
 128 # Install library files.
 129
 130 $do_installarchlib = $do_installprivlib = 0;
 131
 132 mkpath($installprivlib, 1, 0777);
 133 mkpath($installarchlib, 1, 0777);
 134 mkpath($installsitelib, 1, 0777) if ($installsitelib);
 135 mkpath($installsitearch, 1, 0777) if ($installsitearch);
 136
 137 if (chdir "lib") {
 138     $do_installarchlib = ! samepath($installarchlib, '.');
 139     $do_installprivlib = ! samepath($installprivlib, '.');
 140     $do_installprivlib = 0 if $versiononly && !($installprivlib =~ m/\Q$]/);
 141
 142     if ($do_installarchlib || $do_installprivlib) {
 143         find(\&installlib, '.');
 144     }
 145     chdir ".." || die "Can't cd back to source directory: $!\n";
 146 }
 147 else {
 148     warn "Can't cd to lib to install lib files: $!\n";
 149 }
 150
 151 # Install header files and libraries.
 152 mkpath("$installarchlib/CORE", 1, 0777);
 153 @corefiles = <*.h libperl*.*>;
 154 # AIX needs perl.exp installed as well.
 155 push(@corefiles,'perl.exp') if $^O eq 'aix';
 156 # If they have built sperl.o...
 157 push(@corefiles,'sperl.o') if -f 'sperl.o';
 158 foreach $file (@corefiles) {
 159     # HP-UX (at least) needs to maintain execute permissions
 160     # on dynamically-loadable libraries. So we do it for all.
 161     copy_if_diff($file,"$installarchlib/CORE/$file")
 162         and chmod($file =~ /\.(so|\Q$dlext\E)$/ ? 0555 : 0444,
 163                    "$installarchlib/CORE/$file");
 164 }
 165
 166 # Install main perl executables
 167 # Make links to ordinary names if installbin directory isn't current directory.
 168
 169 if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos')) {
 170     safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext");
 171     link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext");
 172     link("$installbin/sperl$ver$exe_ext", "$installbin/suidperl$exe_ext")
 173       if $d_dosuid;
 174 }
 175
 176 # Offer to install perl in a "standard" location
 177
 178 $mainperl_is_instperl = 0;
 179
 180 if (!$versiononly && !$nonono && $^O ne 'MSWin32' && -t STDIN && -t STDERR
 181         && -w $mainperldir && ! samepath($mainperldir, $installbin)) {
 182     local($usrbinperl)  = "$mainperldir/perl$exe_ext";
 183     local($instperl)    = "$installbin/perl$exe_ext";
 184     local($expinstperl) = "$binexp/perl$exe_ext";
 185
 186     # First make sure $usrbinperl is not already the same as the perl we
 187     # just installed.
 188     if (-x $usrbinperl) {
 189         # Try to be clever about mainperl being a symbolic link
 190         # to binexp/perl if binexp and installbin are different.
 191         $mainperl_is_instperl =
 192             samepath($usrbinperl, $instperl) ||
 193             samepath($usrbinperl, $expinstperl) ||
 194              (($binexp ne $installbin) &&
 195               (-l $usrbinperl) &&
 196               ((readlink $usrbinperl) eq $expinstperl));
 197     }
 198     if ((! $mainperl_is_instperl) &&
 199         (yn("Many scripts expect perl to be installed as $usrbinperl.\n" .
 200              "Do you wish to have $usrbinperl be the same as\n" .
 201              "$expinstperl? [y] ")))
 202     {
 203         unlink($usrbinperl);
 204         eval { CORE::link $instperl, $usrbinperl } ||
 205             eval { symlink $expinstperl, $usrbinperl } ||
 206                 copy($instperl, $usrbinperl);
 207         $mainperl_is_instperl = 1;
 208     }
 209 }
 210
 211 # Make links to ordinary names if installbin directory isn't current directory.
 212
 213 if (!$versiononly && ! samepath($installbin, 'x2p')) {
 214     safe_unlink("$installbin/a2p$exe_ext");
 215     copy("x2p/a2p$exe_ext", "$installbin/a2p$exe_ext");
 216     chmod(0755, "$installbin/a2p$exe_ext");
 217 }
 218
 219 # cppstdin is just a script, but it is architecture-dependent, so
 220 # it can't safely be shared.  Place it in $installbin.
 221 # Note that Configure doesn't build cppstin if it isn't needed, so
 222 # we skip this if cppstdin doesn't exist.
 223 if (! $versiononly && (-f 'cppstdin') && (! samepath($installbin, '.'))) {
 224     safe_unlink("$installbin/cppstdin");
 225     copy("cppstdin", "$installbin/cppstdin");
 226     chmod(0755, "$installbin/cppstdin");
 227 }
 228
 229 # Install scripts.
 230
 231 mkpath($installscript, 1, 0777);
 232
 233 if (! $versiononly) {
 234     for (@scripts) {
 235         (my $base = $_) =~ s#.*/##;
 236         copy($_, "$installscript/$base");
 237         chmod(0755, "$installscript/$base");
 238     }
 239 }
 240
 241 # pstruct should be a link to c2ph
 242
 243 if (! $versiononly) {
 244     safe_unlink("$installscript/pstruct");
 245     if ($^O eq 'dos') {
 246         copy("$installscript/c2ph","$installscript/pstruct");
 247     } else {
 248         link("$installscript/c2ph","$installscript/pstruct");
 249     }
 250 }
 251
 252 # Install pod pages.  Where? I guess in $installprivlib/pod.
 253
 254 if (! $versiononly || !($installprivlib =~ m/\Q$]/)) {
 255     mkpath("${installprivlib}/pod", 1, 0777);
 256
 257     # If Perl 5.003's perldiag.pod is there, rename it.
 258     if (open POD, "${installprivlib}/pod/perldiag.pod") {
 259         read POD, $_, 4000;
 260         close POD;
 261         # Some of Perl 5.003's diagnostic messages ended with periods.
 262         if (/^=.*\.$/m) {
 263             my ($from, $to) = ("${installprivlib}/pod/perldiag.pod",
 264                                "${installprivlib}/pod/perldiag-5.003.pod");
 265             print STDERR "  rename $from $to";
 266             rename($from, $to)
 267                 or warn "Couldn't rename $from to $to: $!\n"
 268                 unless $nonono;
 269         }
 270     }
 271
 272     foreach $file (@pods) {
 273         # $file is a name like  pod/perl.pod
 274         copy_if_diff($file, "${installprivlib}/${file}");
 275     }
 276
 277     # Link perldiag.pod into archlib
 278     my ($from, $to) = ("${installprivlib}/pod/perldiag.pod",
 279                        "${installarchlib}/pod/perldiag.pod");
 280     $packlist->{$to} = { from => $from, type => 'link' };
 281     if (compare($from, $to) || $nonono) {
 282         mkpath("${installarchlib}/pod", 1, 0777);
 283         unlink($to);
 284         link($from, $to) if ($^O ne 'dos');
 285     }
 286 }
 287
 288 # Check to make sure there aren't other perls around in installer's
 289 # path.  This is probably UNIX-specific.  Check all absolute directories
 290 # in the path except for where public executables are supposed to live.
 291 # Also skip $mainperl if the user opted to have it be a link to the
 292 # installed perl.
 293
 294 if (!$versiononly) {
 295
 296     $dirsep = ($^O eq 'os2' || $^O eq 'MSWin32') ? ';' : ':' ;
 297     ($path = $ENV{"PATH"}) =~ s:\\:/:g ;
 298     @path = split(/$dirsep/, $path);
 299     @otherperls = ();
 300     for (@path) {
 301         next unless m,^/,;
 302         # Use &samepath here because some systems have other dirs linked
 303         # to $mainperldir (like SunOS)
 304         next if samepath($_, $binexp);
 305         next if ($mainperl_is_instperl && samepath($_, $mainperldir));
 306         push(@otherperls, "$_/perl$exe_ext")
 307             if (-x "$_/perl$exe_ext" && ! -d "$_/perl$exe_ext");
 308     }
 309     if (@otherperls) {
 310         print STDERR "\nWarning: perl appears in your path in the following " .
 311             "locations beyond where\nwe just installed it:\n";
 312         for (@otherperls) {
 313             print STDERR "    ", $_, "\n";
 314         }
 315         print STDERR "\n";
 316     }
 317
 318 }
 319
 320 $packlist->write() unless $nono;
 321 print STDERR "  Installation complete\n";
 322
 323 exit 0;
 324
 325 ###############################################################################
 326
 327 sub yn {
 328     local($prompt) = @_;
 329     local($answer);
 330     local($default) = $prompt =~ m/\[([yn])\]\s*$/i;
 331     print STDERR $prompt;
 332     chop($answer = <STDIN>);
 333     $answer = $default if $answer =~ m/^\s*$/;
 334     ($answer =~ m/^[yY]/);
 335 }
 336
 337 sub unlink {
 338     local(@names) = @_;
 339     my($cnt) = 0;
 340
 341     foreach $name (@names) {
 342         next unless -e $name;
 343         chmod 0777, $name if ($^O eq 'os2' || $^O eq 'MSWin32');
 344         print STDERR "  unlink $name\n";
 345         ( CORE::unlink($name) and ++$cnt
 346           or warn "Couldn't unlink $name: $!\n" ) unless $nonono;
 347     }
 348     return $cnt;
 349 }
 350
 351 sub safe_unlink {
 352     return if $nonono;
 353     local @names = @_;
 354     foreach $name (@names) {
 355         next unless -e $name;
 356         chmod 0777, $name if ($^O eq 'os2' || $^O eq 'MSWin32');
 357         print STDERR "  unlink $name\n";
 358         next if CORE::unlink($name);
 359         warn "Couldn't unlink $name: $!\n";
 360         if ($! =~ /busy/i) {
 361             print STDERR "  mv $name $name.old\n";
 362             safe_rename($name, "$name.old")
 363                 or warn "Couldn't rename $name: $!\n";
 364         }
 365     }
 366 }
 367
 368 sub safe_rename {
 369     local($from,$to) = @_;
 370     if (-f $to and not unlink($to)) {
 371         my($i);
 372         for ($i = 1; $i < 50; $i++) {
 373             last if rename($to, "$to.$i");
 374         }
 375         warn("Cannot rename to `$to.$i': $!"), return 0
 376            if $i >= 50; # Give up!
 377     }
 378     link($from,$to) || return 0;
 379     unlink($from);
 380 }
 381
 382 sub link {
 383     my($from,$to) = @_;
 384     my($success) = 0;
 385
 386     print STDERR "  ln $from $to\n";
 387     eval {
 388         CORE::link($from, $to)
 389             ? $success++
 390             : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
 391               ? die "AFS"  # okay inside eval {}
 392               : warn "Couldn't link $from to $to: $!\n"
 393           unless $nonono;
 394         $packlist->{$to} = { from => $from, type => 'link' };
 395     };
 396     if ($@) {
 397         File::Copy::copy($from, $to)
 398             ? $success++
 399             : warn "Couldn't copy $from to $to: $!\n"
 400           unless $nonono;
 401         $packlist->{$to} = { type => 'file' };
 402     }
 403     $success;
 404 }
 405
 406 sub chmod {
 407     local($mode,$name) = @_;
 408
 409     return if ($^O eq 'dos');
 410     printf STDERR "  chmod %o %s\n", $mode, $name;
 411     CORE::chmod($mode,$name)
 412         || warn sprintf("Couldn't chmod %o %s: $!\n", $mode, $name)
 413       unless $nonono;
 414 }
 415
 416 sub copy {
 417     my($from,$to) = @_;
 418
 419     print STDERR "  cp $from $to\n";
 420     File::Copy::copy($from, $to)
 421         || warn "Couldn't copy $from to $to: $!\n"
 422       unless $nonono;
 423     $packlist->{$to} = { type => 'file' };
 424 }
 425
 426 sub samepath {
 427     local($p1, $p2) = @_;
 428
 429     return (lc($p1) eq lc($p2)) if ($^O eq 'MSWin32');
 430
 431     if ($p1 ne $p2) {
 432         local($dev1, $ino1, $dev2, $ino2);
 433         ($dev1, $ino1) = stat($p1);
 434         ($dev2, $ino2) = stat($p2);
 435         ($dev1 == $dev2 && $ino1 == $ino2);
 436     }
 437     else {
 438         1;
 439     }
 440 }
 441
 442 sub installlib {
 443     my $dir = $File::Find::dir;
 444     $dir =~ s#^\.(?![^/])/?##;
 445     local($depth) = $dir ? "lib/$dir" : "lib";
 446
 447     my $name = $_;
 448
 449     if ($name eq 'CVS' && -d $name) {
 450         $File::Find::prune = 1;
 451         return;
 452     }
 453
 454     # ignore patch backups and the .exists files.
 455     return if $name =~ m{\.orig$|~$|^\.exists};
 456
 457     $name = "$dir/$name" if $dir ne '';
 458
 459     my $installlib = $installprivlib;
 460     if ($dir =~ /^auto/ ||
 461           ($name =~ /^(.*)\.(?:pm|pod)$/ && $archpms{$1}) ||
 462           ($name =~ /^(.*)\.(?:h|lib)$/i && $^O eq 'MSWin32')
 463        ) {
 464         $installlib = $installarchlib;
 465         return unless $do_installarchlib;
 466     } else {
 467         return unless $do_installprivlib;
 468     }
 469
 470     if (-f $_) {
 471         if (/\.(?:al|ix)$/ && !($dir =~ m[^auto/(.*)$] && $archpms{$1})) {
 472             $installlib = $installprivlib;
 473             #We're installing *.al and *.ix files into $installprivlib,
 474             #but we have to delete old *.al and *.ix files from the 5.000
 475             #distribution:
 476             #This might not work because $archname might have changed.
 477             unlink("$installarchlib/$name");
 478         }
 479         $packlist->{"$installlib/$name"} = { type => 'file' };
 480         if (compare($_, "$installlib/$name") || $nonono) {
 481             unlink("$installlib/$name");
 482             mkpath("$installlib/$dir", 1, 0777);
 483             # HP-UX (at least) needs to maintain execute permissions
 484             # on dynamically-loaded libraries.
 485             copy_if_diff($_, "$installlib/$name")
 486                 and chmod($name =~ /\.(so|$dlext)$/o ? 0555 : 0444,
 487                            "$installlib/$name");
 488         }
 489     } elsif (-d $_) {
 490         mkpath("$installlib/$name", 1, 0777);
 491     }
 492 }
 493
 494 # Copy $from to $to, only if $from is different than $to.
 495 # Also preserve modification times for .a libraries.
 496 # On some systems, if you do
 497 #   ranlib libperl.a
 498 #   cp libperl.a /usr/local/lib/perl5/archlib/CORE/libperl.a
 499 # and then try to link against the installed libperl.a, you might
 500 # get an error message to the effect that the symbol table is older
 501 # than the library.
 502 # Return true if copying occurred.
 503
 504 sub copy_if_diff {
 505     my($from,$to)=@_;
 506     -f $from || die "$0: $from not found";
 507     $packlist->{$to} = { type => 'file' };
 508     if (compare($from, $to) || $nonono) {
 509         safe_unlink($to);   # In case we don't have write permissions.
 510         if ($nonono) {
 511             $from = $depth . "/" . $from if $depth;
 512         }
 513         copy($from, $to);
 514         # Restore timestamps if it's a .a library or for OS/2.
 515         if (!$nonono && ($^O eq 'os2' || $to =~ /\.a$/)) {
 516             my ($atime, $mtime) = (stat $from)[8,9];
 517             utime $atime, $mtime, $to;
 518         }
 519         1;
 520     }
 521 }