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