home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-src.tgz / tar.out / fsf / perl / installperl < prev    next >
Text File  |  1996-09-28  |  12KB  |  422 lines
  1. #!./perl
  2. BEGIN { @INC=('./lib', '../lib') }
  3. use File::Find;
  4. use File::Path qw(mkpath);
  5. use Config;
  6. use subs qw(unlink rename link chmod);
  7.  
  8. $mainperldir = "/usr/bin";
  9. $exe_ext = $Config{exe_ext};
  10.  
  11. while (@ARGV) {
  12.     $nonono = 1 if $ARGV[0] eq '-n';
  13.     $versiononly = 1 if $ARGV[0] eq '-v';
  14.     shift;
  15. }
  16.  
  17. umask 022;
  18.  
  19. @scripts = qw(cppstdin
  20.         utils/c2ph utils/h2ph utils/h2xs utils/pstruct
  21.         utils/perlbug utils/perldoc
  22.         x2p/s2p x2p/find2perl
  23.         pod/pod2man pod/pod2html pod/pod2latex pod/pod2text);
  24.  
  25. # pod documentation now handled by separate installman script.
  26. # These two are archaic leftovers.
  27. @manpages = qw(x2p/a2p.man x2p/s2p.man);
  28.  
  29. @pods = (<pod/*.pod>);
  30.  
  31. $ver = $];
  32. $release = substr($ver,0,3);   # Not used presently.
  33. $patchlevel = substr($ver,3,2);
  34. die "Patchlevel of perl ($patchlevel)",
  35.     "and patchlevel of config.sh ($Config{'PATCHLEVEL'}) don't match\n"
  36.     if $patchlevel != $Config{'PATCHLEVEL'};
  37.  
  38. # Fetch some frequently-used items from %Config
  39. $installbin = $Config{installbin};
  40. $installscript = $Config{installscript};
  41. $installprivlib = $Config{installprivlib};
  42. $installarchlib = $Config{installarchlib};
  43. $installsitelib = $Config{installsitelib};
  44. $installsitearch = $Config{installsitearch};
  45. $installman1dir = $Config{installman1dir};
  46. $man1ext = $Config{man1ext};
  47. # Did we build libperl as a shared library?
  48. $d_shrplib = $Config{d_shrplib};
  49. $shrpdir = $Config{shrpdir};
  50. # Shared library and dynamic loading suffixes.
  51. $so = $Config{so};
  52. $dlext = $Config{dlext};
  53.  
  54. $d_dosuid = $Config{d_dosuid};
  55. $binexp = $Config{binexp};
  56.  
  57. # Do some quick sanity checks.
  58.  
  59. if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
  60.  
  61.    $installbin        || die "No installbin directory in config.sh\n";
  62. -d $installbin        || mkpath($installbin, 1, 0777);
  63. -d $installbin        || die "$installbin is not a directory\n";
  64. -w $installbin        || die "$installbin is not writable by you\n"
  65.     unless $installbin =~ m#^/afs/# || $nonono;
  66.  
  67. -x 'perl' . $exe_ext    || die "perl isn't executable!\n";
  68. -x 'suidperl' . $exe_ext|| die "suidperl isn't executable!\n" if $d_dosuid;
  69.  
  70. -x 't/TEST'        || warn "WARNING: You've never run 'make test'!!!",
  71.     "  (Installing anyway.)\n";
  72.  
  73. if ($d_shrplib) {
  74.     if (!<libperl*.$so*>) {
  75.     warn "WARNING: Can't find libperl*.$so* to install into $shrpdir.",
  76.         "  (Installing other things anyway.)\n";
  77.     } else {
  78.     mkpath($shrpdir, 1, 0777);
  79.     -w $shrpdir    || $nonono || die "$shrpdir is not writable by you\n";
  80.     &cmd("cp libperl*.$so* $shrpdir");
  81.     }
  82. }
  83.  
  84. # First we install the version-numbered executables.
  85.  
  86. &safe_unlink("$installbin/perl$ver$exe_ext");
  87. &cmd("cp perl$exe_ext $installbin/perl$ver$exe_ext");
  88.  
  89. &safe_unlink("$installbin/sperl$ver$exe_ext");
  90. if ($d_dosuid) {
  91.     &cmd("cp suidperl$exe_ext $installbin/sperl$ver$exe_ext");
  92.     &chmod(04711, "$installbin/sperl$ver$exe_ext");
  93. }
  94.  
  95. exit 0 if $versiononly;
  96.  
  97. # Make links to ordinary names if installbin directory isn't current directory.
  98.  
  99. if (! &samepath($installbin, '.')) {
  100.     &safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext");
  101.     &link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext");
  102.     &link("$installbin/sperl$ver$exe_ext", "$installbin/suidperl$exe_ext") 
  103.       if $d_dosuid;
  104. }
  105.  
  106. if (! &samepath($installbin, 'x2p')) {
  107.     &safe_unlink("$installbin/a2p$exe_ext");
  108.     &cmd("cp x2p/a2p$exe_ext $installbin/a2p$exe_ext");
  109.     &chmod(0755, "$installbin/a2p$exe_ext");
  110. }
  111.  
  112. # Install scripts.
  113.  
  114. mkpath($installscript, 1, 0777);
  115.  
  116. for (@scripts) {
  117.     if (-f $_) {   # cppstdin might not exist on this system.
  118.     &cmd("cp $_ $installscript");
  119.     s#.*/##; &chmod(0755, "$installscript/$_");
  120.     }
  121. }
  122.  
  123. # Install pod pages.  Where? I guess in $installprivlib/pod.
  124. mkpath("${installprivlib}/pod", 1, 0777);
  125. foreach $file (@pods) {
  126.     # $file is a name like  pod/perl.pod
  127.     cp_if_diff($file, "${installprivlib}/${file}");
  128. }
  129.  
  130. # Install old man pages.
  131.  
  132. if ($installman1dir ne '') {
  133.     mkpath($installman1dir, 1, 0777);
  134.  
  135.     if (! &samepath($installman1dir, '.')) {
  136.     for (@manpages) {
  137.         ($new = $_) =~ s/man$/$man1ext/;
  138.         $new =~ s#.*/##;
  139.         print STDERR "  Installing $installman1dir/$new\n";
  140.         next if $nonono;
  141.         open(MI,$_) || warn "Can't open $_: $!\n";
  142.         open(MO,">$installman1dir/$new") || 
  143.             warn "Can't install $installman1dir/$new: $!\n";
  144.         print MO ".ds RP Release $release Patchlevel $patchlevel\n";
  145.         while (<MI>) {
  146.         print MO;
  147.         }
  148.         close MI;
  149.         close MO;
  150.     }
  151.     }
  152. }
  153.  
  154. # Install library files.
  155.  
  156. $do_installarchlib = $do_installprivlib = 0;
  157.     
  158. mkpath($installprivlib, 1, 0777);
  159. mkpath($installarchlib, 1, 0777);
  160. mkpath($installsitelib, 1, 0777) if ($installsitelib);
  161. mkpath($installsitearch, 1, 0777) if ($installsitearch);
  162.  
  163. if (chdir "lib") {
  164.     $do_installarchlib = ! &samepath($installarchlib, '.');
  165.     $do_installprivlib = ! &samepath($installprivlib, '.');
  166.  
  167.     if ($do_installarchlib || $do_installprivlib) {
  168.     find(\&installlib, '.');
  169.     }
  170.     chdir ".." || die "Can't cd back to source directory: $!\n";
  171. }
  172. else {
  173.     warn "Can't cd to lib to install lib files: $!\n";
  174. }
  175.  
  176. # Install header files and libraries.
  177. mkpath("$installarchlib/CORE", 1, 0777);
  178. foreach $file (<*.h libperl*.*>) {
  179.     cp_if_diff($file,"$installarchlib/CORE/$file");
  180.     &chmod(0444,"$installarchlib/CORE/$file");
  181. }
  182. # AIX needs perl.exp installed as well.
  183. cp_if_diff("perl.exp" ,"$installarchlib/CORE/perl.exp") if ($^O eq 'aix');
  184.  
  185. # If they have built sperl.o...
  186. cp_if_diff("sperl.o" ,"$installarchlib/CORE/sperl.o") if (-f 'sperl.o');
  187.  
  188.  
  189. # Offer to install perl in a "standard" location
  190.  
  191. $mainperl_is_instperl = 0;
  192.  
  193. if (-w $mainperldir && ! &samepath($mainperldir, $installbin) && !$nonono) {
  194.     # First make sure $mainperldir/perl is not already the same as
  195.     # the perl we just installed
  196.     if (-x "$mainperldir/perl$exe_ext") {
  197.     # Try to be clever about mainperl being a symbolic link
  198.     # to binexp/perl if binexp and installbin are different.
  199.     $mainperl_is_instperl =
  200.         &samepath("$mainperldir/perl$exe_ext", "$installbin/perl$exe_ext") ||
  201.          (($binexp ne $installbin) &&
  202.           (-l "$mainperldir/perl$exe_ext") &&
  203.           ((readlink "$mainperldir/perl$exe_ext") eq "$binexp/perl$exe_ext"));
  204.     }
  205.     if ((! $mainperl_is_instperl) &&
  206.     (&yn("Many scripts expect perl to be installed as " .
  207.          "$mainperldir/perl.\n" . 
  208.          "Do you wish to have $mainperldir/perl be the same as\n" .
  209.          "$binexp/perl? [y] ")))
  210.     {    
  211.     unlink("$mainperldir/perl$exe_ext");
  212.     eval 'link("$installbin/perl$exe_ext", "$mainperldir/perl$exe_ext")' ||
  213.     eval 'symlink("$binexp/perl$exe_ext", "$mainperldir/perl$exe_ext")' ||
  214.     &cmd("cp $installbin/perl$exe_ext $mainperldir$exe_ext");
  215.     $mainperl_is_instperl = 1;
  216.     }
  217. }
  218.  
  219. # Check to make sure there aren't other perls around in installer's
  220. # path.  This is probably UNIX-specific.  Check all absolute directories
  221. # in the path except for where public executables are supposed to live.
  222. # Also skip $mainperl if the user opted to have it be a link to the
  223. # installed perl.
  224.  
  225. $dirsep = ($^O eq 'os2') ? ';' : ':' ;
  226. ($path = $ENV{"PATH"}) =~ s:\\:/:g ;
  227. @path = split(/$dirsep/, $path);
  228. @otherperls = ();
  229. for (@path) {
  230.     next unless m,^/,;
  231.     next if ($_ eq $binexp);
  232.     # Use &samepath here because some systems have other dirs linked
  233.     # to $mainperldir (like SunOS)
  234.     next if ($mainperl_is_instperl && &samepath($_, $mainperldir));
  235.     push(@otherperls, "$_/perl$exe_ext")
  236.       if (-x "$_/perl$exe_ext" && ! -d "$_/perl$exe_ext");
  237. }
  238. if (@otherperls) {
  239.     print STDERR "\nWarning: perl appears in your path in the following " .
  240.     "locations beyond where\nwe just installed it:\n";
  241.     for (@otherperls) {
  242.     print STDERR "    ", $_, "\n";
  243.     }
  244.     print STDERR "\n";
  245. }
  246.  
  247. print STDERR "  Installation complete\n";
  248.  
  249. exit 0;
  250.  
  251. ###############################################################################
  252.  
  253. sub yn {
  254.     local($prompt) = @_;
  255.     local($answer);
  256.     local($default) = $prompt =~ m/\[([yn])\]\s*$/i;
  257.     print STDERR $prompt;
  258.     chop($answer = <STDIN>);
  259.     $answer = $default if $answer =~ m/^\s*$/;
  260.     ($answer =~ m/^[yY]/);
  261. }
  262.  
  263. sub unlink {
  264.     local(@names) = @_;
  265.     my($cnt) = 0;
  266.  
  267.     foreach $name (@names) {
  268.     next unless -e $name;
  269.     chmod 0777, $name if $^O eq 'os2';
  270.     print STDERR "  unlink $name\n";
  271.     ( CORE::unlink($name) and ++$cnt 
  272.       or warn "Couldn't unlink $name: $!\n" ) unless $nonono;
  273.     }
  274.     return $cnt;
  275. }
  276.  
  277. sub safe_unlink {
  278.     local(@names) = @_;
  279.  
  280.     foreach $name (@names) {
  281.     next unless -e $name;
  282.     next if $nonono;
  283.     chmod 0777, $name if $^O eq 'os2';
  284.     print STDERR "  unlink $name\n";
  285.     next if CORE::unlink($name);
  286.     warn "Couldn't unlink $name: $!\n";
  287.     if ($! =~ /busy/i) {
  288.         print STDERR "  mv $name $name.old\n";
  289.         &rename($name, "$name.old") || warn "Couldn't rename $name: $!\n";
  290.     }
  291.     }
  292. }
  293.  
  294. sub cmd {
  295.     local($cmd) = @_;
  296.     print STDERR "  $cmd\n";
  297.     unless ($nonono) {
  298.     system $cmd;
  299.     warn "Command failed!!!\n" if $?;
  300.     }
  301. }
  302.  
  303. sub rename {
  304.     local($from,$to) = @_;
  305.     if (-f $to and not unlink($to)) {
  306.     my($i);
  307.     for ($i = 1; $i < 50; $i++) {
  308.         last if CORE::rename($to, "$to.$i");
  309.     }
  310.     warn("Cannot rename to `$to.$i': $!"), return 0 
  311.        if $i >= 50;    # Give up!
  312.     }
  313.     link($from,$to) || return 0;
  314.     unlink($from);
  315. }
  316.  
  317. sub link {
  318.     local($from,$to) = @_;
  319.  
  320.     print STDERR "  ln $from $to\n";
  321.     eval {
  322.       CORE::link($from,$to) || warn "Couldn't link $from to $to: $!\n" unless $nonono;
  323.     };
  324.     if ($@) {
  325.       system( $cp, $from, $to )
  326.     && warn "Couldn't copy $from to $to: $!\n" unless $nonono;
  327.     }
  328. }
  329.  
  330. sub chmod {
  331.     local($mode,$name) = @_;
  332.  
  333.     printf STDERR "  chmod %o %s\n", $mode, $name;
  334.     CORE::chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n",$mode,$name)
  335.     unless $nonono;
  336. }
  337.  
  338. sub samepath {
  339.     local($p1, $p2) = @_;
  340.     local($dev1, $ino1, $dev2, $ino2);
  341.  
  342.     if ($p1 ne $p2) {
  343.     ($dev1, $ino1) = stat($p1);
  344.     ($dev2, $ino2) = stat($p2);
  345.     ($dev1 == $dev2 && $ino1 == $ino2);
  346.     }
  347.     else {
  348.     1;
  349.     }
  350. }
  351.  
  352. sub installlib {
  353.     my $dir = $File::Find::dir;
  354.     $dir =~ s#^\.(?![^/])/?##;
  355.  
  356.     my $name = $_;
  357.     
  358.     # ignore patch backups and the .exists files.
  359.     return if $name =~ m{\.orig$|~$|^\.exists};
  360.  
  361.     $name = "$dir/$name" if $dir ne '';
  362.  
  363.     my $installlib = $installprivlib;
  364.     if ((substr($dir, 0, 4) eq 'auto') || ($name eq 'Config.pm')) {
  365.         $installlib = $installarchlib;
  366.     return unless $do_installarchlib;
  367.     } else {
  368.     return unless $do_installprivlib;
  369.     }
  370.  
  371.     if (-f $_) {
  372.     if (/\.al$/ || /\.ix$/) {
  373.         $installlib = $installprivlib;
  374.         #We're installing *.al and *.ix files into $installprivlib,
  375.         #but we have to delete old *.al and *.ix files from the 5.000
  376.         #distribution:
  377.         #This might not work because $archname might have changed.
  378.         &unlink("$installarchlib/$name");
  379.     }
  380.     system "cmp", "-s", $_, "$installlib/$name";
  381.     if ($?) {
  382.         &unlink("$installlib/$name");
  383.         mkpath("$installlib/$dir", 1, 0777);
  384.         cp_if_diff($_, "$installlib/$name");
  385.         # HP-UX (at least) needs to maintain execute permissions
  386.         # on dynamically-loaded libraries.
  387.         if ($name =~ /\.(so|$dlext)$/o) {
  388.         &chmod(0555, "$installlib/$name");
  389.         }
  390.         else {
  391.         &chmod(0444, "$installlib/$name");
  392.         }
  393.     }
  394.     } elsif (-d $_) {
  395.     mkpath("$installlib/$name", 1, 0777);
  396.     }
  397. }
  398.  
  399. # Copy $from to $to, only if $from is different than $to.
  400. # Also preserve modification times for .a libraries.
  401. # On some systems, if you do
  402. #   ranlib libperl.a
  403. #   cp libperl.a /usr/local/lib/perl5/archlib/CORE/libperl.a
  404. # and then try to link against the installed libperl.a, you might
  405. # get an error message to the effect that the symbol table is older
  406. # than the library.
  407. sub cp_if_diff {
  408.     my($from,$to)=@_;
  409.     -f $from || die "$0: $from not found";
  410.     system "cmp", "-s", $from, $to;
  411.     if ($?) {
  412.     my ($atime, $mtime);
  413.     unlink($to);   # In case we don't have write permissions.
  414.     cmd("cp $from $to");
  415.     # Restore timestamps if it's a .a library.
  416.     if ($to =~ /\.a$/) {
  417.         ($atime, $mtime) = (stat $from)[8,9];
  418.         utime $atime, $mtime, $to;
  419.     }
  420.     }
  421. }
  422.