X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=installperl;h=346e8351aad5270746082fb3a1aec85a81646063;hb=d1bf51ddeaafef1b94a1f5c011bdefbb8ebf5604;hp=73da720ece25d78f206292d1bfc627788269e0e4;hpb=ecfc54246c2a6f42dc95b17a964a6048192067d2;p=p5sagit%2Fp5-mst-13.2.git diff --git a/installperl b/installperl index 73da720..346e835 100755 --- a/installperl +++ b/installperl @@ -1,9 +1,18 @@ #!./perl BEGIN { @INC=('./lib', '../lib') } - use File::Find; +use File::Path (); +use Config; +use subs qw(unlink rename link chmod); + +# override the ones in the rest of the script +sub mkpath +{ + File::Path::mkpath(@_) unless $nonono; +} $mainperldir = "/usr/bin"; +$exe_ext = $Config{exe_ext}; while (@ARGV) { $nonono = 1 if $ARGV[0] eq '-n'; @@ -13,61 +22,66 @@ while (@ARGV) { umask 022; -@scripts = ('cppstdin', 'c2ph', 'pstruct', 'x2p/s2p', 'x2p/find2perl'); -@manpages = (, 'x2p/a2p.man', 'x2p/s2p.man'); +@scripts = qw( utils/c2ph utils/h2ph utils/h2xs utils/pstruct + utils/perlbug utils/perldoc + x2p/s2p x2p/find2perl + pod/pod2man pod/pod2html pod/pod2latex pod/pod2text); -# Read in the config file. +# pod documentation now handled by separate installman script. +# These two are archaic leftovers. +@manpages = qw(x2p/a2p.man x2p/s2p.man); -open(CONFIG, "config.sh") || die "You haven't run Configure yet!\n"; -while () { - if (s/^(\w+=)/\$$1/) { - $accum =~ s/'undef'/undef/g; - eval $accum; - $accum = ''; - } - $accum .= $_; -} -close CONFIG; +@pods = (); -$ver = sprintf("%5.3f", $] + 0); -$release = substr($ver,0,3); +$ver = $]; +$release = substr($ver,0,3); # Not used presently. $patchlevel = substr($ver,3,2); +die "Patchlevel of perl ($patchlevel)", + "and patchlevel of config.sh ($Config{'PATCHLEVEL'}) don't match\n" + if $patchlevel != $Config{'PATCHLEVEL'}; + +# Fetch some frequently-used items from %Config +$installbin = $Config{installbin}; +$installscript = $Config{installscript}; +$installprivlib = $Config{installprivlib}; +$installarchlib = $Config{installarchlib}; +$installsitelib = $Config{installsitelib}; +$installsitearch = $Config{installsitearch}; +$installman1dir = $Config{installman1dir}; +$man1ext = $Config{man1ext}; +$libperl = $Config{libperl}; +# Shared library and dynamic loading suffixes. +$so = $Config{so}; +$dlext = $Config{dlext}; + +$d_dosuid = $Config{d_dosuid}; +$binexp = $Config{binexp}; # Do some quick sanity checks. if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; } $installbin || die "No installbin directory in config.sh\n"; --d $installbin || die "$installbin is not a directory\n"; --w $installbin || die "$installbin is not writable by you\n" +-d $installbin || mkpath($installbin, 1, 0777); +-d $installbin || $nonono || die "$installbin is not a directory\n"; +-w $installbin || $nonono || die "$installbin is not writable by you\n" unless $installbin =~ m#^/afs/# || $nonono; --x 'perl' || die "perl isn't executable!\n"; --x 'suidperl' || die "suidperl isn't executable!\n" if $d_dosuid; +-x 'perl' . $exe_ext || die "perl isn't executable!\n"; +-x 'suidperl' . $exe_ext|| die "suidperl isn't executable!\n" if $d_dosuid; -x 't/TEST' || warn "WARNING: You've never run 'make test'!!!", " (Installing anyway.)\n"; -if ($d_shrplib) { - if (!) { - warn "WARNING: Can't find libperl*.$so* to install into $shrpdir.", - " (Installing other things anyway.)\n"; - } else { - &makedir($shrpdir); - -w $shrpdir || die "$shrpdir is not writable by you\n"; - &cmd("cp libperl*.$so* $shrpdir"); - } -} - # First we install the version-numbered executables. -&unlink("$installbin/perl$ver"); -&cmd("cp perl $installbin/perl$ver"); +&safe_unlink("$installbin/perl$ver$exe_ext"); +&cmd("cp perl$exe_ext $installbin/perl$ver$exe_ext"); -&unlink("$installbin/sperl$ver"); +&safe_unlink("$installbin/sperl$ver$exe_ext"); if ($d_dosuid) { - &cmd("cp suidperl $installbin/sperl$ver"); - &chmod(04711, "$installbin/sperl$ver"); + &cmd("cp suidperl$exe_ext $installbin/sperl$ver$exe_ext"); + &chmod(04711, "$installbin/sperl$ver$exe_ext"); } exit 0 if $versiononly; @@ -75,41 +89,58 @@ exit 0 if $versiononly; # Make links to ordinary names if installbin directory isn't current directory. if (! &samepath($installbin, '.')) { - &unlink("$installbin/perl", "$installbin/suidperl"); - &link("$installbin/perl$ver", "$installbin/perl"); - &link("$installbin/sperl$ver", "$installbin/suidperl") if $d_dosuid; + &safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext"); + &link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext"); + &link("$installbin/sperl$ver$exe_ext", "$installbin/suidperl$exe_ext") + if $d_dosuid; } if (! &samepath($installbin, 'x2p')) { - &unlink("$installbin/a2p"); - &cmd("cp x2p/a2p $installbin/a2p"); - &chmod(0755, "$installbin/a2p"); + &safe_unlink("$installbin/a2p$exe_ext"); + &cmd("cp x2p/a2p$exe_ext $installbin/a2p$exe_ext"); + &chmod(0755, "$installbin/a2p$exe_ext"); +} + +# cppstdin is just a script, but it is architecture-dependent, so +# it can't safely be shared. Place it in $installbin. +# Note that Configure doesn't build cppstin if it isn't needed, so +# we skip this if cppstdin doesn't exist. +if ((-f cppstdin) && (! &samepath($installbin, '.'))) { + &safe_unlink("$installbin/cppstdin"); + &cmd("cp cppstdin $installbin/cppstdin"); + &chmod(0755, "$installbin/cppstdin"); } # Install scripts. -&makedir($installscript); +mkpath($installscript, 1, 0777); for (@scripts) { - if (-f $_) { # cppstdin might not exist on this system. - &cmd("cp $_ $installscript"); - s#.*/##; &chmod(0755, "$installscript/$_"); - } + &cmd("cp $_ $installscript"); + s#.*/##; &chmod(0755, "$installscript/$_"); +} + +# Install pod pages. Where? I guess in $installprivlib/pod. +mkpath("${installprivlib}/pod", 1, 0777); +foreach $file (@pods) { + # $file is a name like pod/perl.pod + cp_if_diff($file, "${installprivlib}/${file}"); } -# Install man pages. +# Install old man pages. -if ($installmansrc ne '') { - &makedir($installmansrc); +if ($installman1dir ne '') { + mkpath($installman1dir, 1, 0777); - if (! &samepath($installmansrc, '.')) { + if (! &samepath($installman1dir, '.')) { for (@manpages) { - ($new = $_) =~ s/man$/$manext/; + ($new = $_) =~ s/man$/$man1ext/; $new =~ s#.*/##; - print STDERR " Installing $installmansrc/$new\n"; + print STDERR " Installing $installman1dir/$new\n"; next if $nonono; open(MI,$_) || warn "Can't open $_: $!\n"; - open(MO,">$installmansrc/$new") || warn "Can't install $installmansrc/$new: $!\n"; + open(MO,">$installman1dir/$new") || + warn "Can't install $installman1dir/$new: $!\n"; print MO ".ds RP Release $release Patchlevel $patchlevel\n"; while () { print MO; @@ -124,8 +155,11 @@ if ($installmansrc ne '') { $do_installarchlib = $do_installprivlib = 0; -&makedir($installprivlib); -&makedir($installarchlib); +mkpath($installprivlib, 1, 0777); +mkpath($installarchlib, 1, 0777); +mkpath($installsitelib, 1, 0777) if ($installsitelib); +mkpath($installsitearch, 1, 0777) if ($installsitearch); + if (chdir "lib") { $do_installarchlib = ! &samepath($installarchlib, '.'); $do_installprivlib = ! &samepath($installprivlib, '.'); @@ -139,10 +173,16 @@ else { warn "Can't cd to lib to install lib files: $!\n"; } -# Install header files -makedir("$installarchlib/CORE"); -foreach $file (<*.h libperl*.a>) { +# Install header files and libraries. +mkpath("$installarchlib/CORE", 1, 0777); +@corefiles = <*.h libperl*.*>; +# AIX needs perl.exp installed as well. +push(@corefiles,'perl.exp') if $^O eq 'aix'; +# If they have built sperl.o... +push(@corefiles,'sperl.o') if -f 'sperl.o'; +foreach $file (@corefiles) { cp_if_diff($file,"$installarchlib/CORE/$file"); + &chmod($file =~ /^libperl/ ? 0555 : 0444,"$installarchlib/CORE/$file"); } # Offer to install perl in a "standard" location @@ -152,14 +192,14 @@ $mainperl_is_instperl = 0; if (-w $mainperldir && ! &samepath($mainperldir, $installbin) && !$nonono) { # First make sure $mainperldir/perl is not already the same as # the perl we just installed - if (-x "$mainperldir/perl") { + if (-x "$mainperldir/perl$exe_ext") { # Try to be clever about mainperl being a symbolic link # to binexp/perl if binexp and installbin are different. $mainperl_is_instperl = - &samepath("$mainperldir/perl", "$installbin/perl") || + &samepath("$mainperldir/perl$exe_ext", "$installbin/perl$exe_ext") || (($binexp ne $installbin) && - (-l "$mainperldir/perl") && - ((readlink "$mainperldir/perl") eq "$binexp/perl")); + (-l "$mainperldir/perl$exe_ext") && + ((readlink "$mainperldir/perl$exe_ext") eq "$binexp/perl$exe_ext")); } if ((! $mainperl_is_instperl) && (&yn("Many scripts expect perl to be installed as " . @@ -167,10 +207,10 @@ if (-w $mainperldir && ! &samepath($mainperldir, $installbin) && !$nonono) { "Do you wish to have $mainperldir/perl be the same as\n" . "$binexp/perl? [y] "))) { - unlink("$mainperldir/perl"); - eval 'link("$installbin/perl", "$mainperldir/perl")' || - eval 'symlink("$binexp/perl", "$mainperldir/perl")' || - &cmd("cp $installbin/perl $mainperldir"); + unlink("$mainperldir/perl$exe_ext"); + CORE::link("$installbin/perl$exe_ext", "$mainperldir/perl$exe_ext") || + symlink("$binexp/perl$exe_ext", "$mainperldir/perl$exe_ext") || + cmd("cp $installbin/perl$exe_ext $mainperldir$exe_ext"); $mainperl_is_instperl = 1; } } @@ -181,7 +221,9 @@ if (-w $mainperldir && ! &samepath($mainperldir, $installbin) && !$nonono) { # Also skip $mainperl if the user opted to have it be a link to the # installed perl. -@path = split(/:/, $ENV{"PATH"}); +$dirsep = ($^O eq 'os2') ? ';' : ':' ; +($path = $ENV{"PATH"}) =~ s:\\:/:g ; +@path = split(/$dirsep/, $path); @otherperls = (); for (@path) { next unless m,^/,; @@ -189,7 +231,8 @@ for (@path) { # Use &samepath here because some systems have other dirs linked # to $mainperldir (like SunOS) next if ($mainperl_is_instperl && &samepath($_, $mainperldir)); - push(@otherperls, "$_/perl") if (-x "$_/perl" && ! -d "$_/perl"); + push(@otherperls, "$_/perl$exe_ext") + if (-x "$_/perl$exe_ext" && ! -d "$_/perl$exe_ext"); } if (@otherperls) { print STDERR "\nWarning: perl appears in your path in the following " . @@ -218,11 +261,32 @@ sub yn { sub unlink { local(@names) = @_; + my($cnt) = 0; + + foreach $name (@names) { + next unless -e $name; + chmod 0777, $name if $^O eq 'os2'; + print STDERR " unlink $name\n"; + ( CORE::unlink($name) and ++$cnt + or warn "Couldn't unlink $name: $!\n" ) unless $nonono; + } + return $cnt; +} + +sub safe_unlink { + local(@names) = @_; foreach $name (@names) { next unless -e $name; + next if $nonono; + chmod 0777, $name if $^O eq 'os2'; print STDERR " unlink $name\n"; - unlink($name) || warn "Couldn't unlink $name: $!\n" unless $nonono; + next if CORE::unlink($name); + warn "Couldn't unlink $name: $!\n"; + if ($! =~ /busy/i) { + print STDERR " mv $name $name.old\n"; + &rename($name, "$name.old") || warn "Couldn't rename $name: $!\n"; + } } } @@ -235,39 +299,48 @@ sub cmd { } } -sub link { +sub rename { local($from,$to) = @_; + if (-f $to and not unlink($to)) { + my($i); + for ($i = 1; $i < 50; $i++) { + last if CORE::rename($to, "$to.$i"); + } + warn("Cannot rename to `$to.$i': $!"), return 0 + if $i >= 50; # Give up! + } + link($from,$to) || return 0; + unlink($from); +} + +sub link { + my($from,$to) = @_; + my($success) = 0; print STDERR " ln $from $to\n"; - link($from,$to) || warn "Couldn't link $from to $to: $!\n" unless $nonono; + eval { + CORE::link($from,$to) ? $success++ : warn "Couldn't link $from to $to: $!\n" unless $nonono; + }; + if ($@) { + system( $cp, $from, $to )==0 ? $success++ : + warn "Couldn't copy $from to $to: $!\n" unless $nonono; + } + $success; } sub chmod { local($mode,$name) = @_; printf STDERR " chmod %o %s\n", $mode, $name; - chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n",$mode,$name) + CORE::chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n",$mode,$name) unless $nonono; } -sub makedir { - local($dir) = @_; - unless (-d $dir) { - local($shortdir) = $dir; - - $shortdir =~ s#(.*)/.*#$1#; - &makedir($shortdir); - - print STDERR " mkdir $dir\n"; - mkdir($dir, 0777) || warn "Couldn't create $dir: $!\n" unless $nonono; - } -} - sub samepath { local($p1, $p2) = @_; local($dev1, $ino1, $dev2, $ino2); - if ($p1 ne p2) { + if ($p1 ne $p2) { ($dev1, $ino1) = stat($p1); ($dev2, $ino2) = stat($p2); ($dev1 == $dev2 && $ino1 == $ino2); @@ -280,8 +353,13 @@ sub samepath { sub installlib { my $dir = $File::Find::dir; $dir =~ s#^\.(?![^/])/?##; + local($depth) = $dir ? "lib/$dir" : "lib"; my $name = $_; + + # ignore patch backups and the .exists files. + return if $name =~ m{\.orig$|~$|^\.exists}; + $name = "$dir/$name" if $dir ne ''; my $installlib = $installprivlib; @@ -298,25 +376,51 @@ sub installlib { #We're installing *.al and *.ix files into $installprivlib, #but we have to delete old *.al and *.ix files from the 5.000 #distribution: + #This might not work because $archname might have changed. &unlink("$installarchlib/$name"); } system "cmp", "-s", $_, "$installlib/$name"; - if ($?) { + if ($? || $nonono) { &unlink("$installlib/$name"); - &makedir("$installlib/$dir"); - &cmd("cp $_ $installlib/$dir"); - &chmod(0644, "$installlib/$name"); + mkpath("$installlib/$dir", 1, 0777); + cp_if_diff($_, "$installlib/$name"); + # HP-UX (at least) needs to maintain execute permissions + # on dynamically-loaded libraries. + if ($name =~ /\.(so|$dlext)$/o) { + &chmod(0555, "$installlib/$name"); + } + else { + &chmod(0444, "$installlib/$name"); + } } } elsif (-d $_) { - &makedir("$installlib/$name"); + mkpath("$installlib/$name", 1, 0777); } } +# Copy $from to $to, only if $from is different than $to. +# Also preserve modification times for .a libraries. +# On some systems, if you do +# ranlib libperl.a +# cp libperl.a /usr/local/lib/perl5/archlib/CORE/libperl.a +# and then try to link against the installed libperl.a, you might +# get an error message to the effect that the symbol table is older +# than the library. sub cp_if_diff { my($from,$to)=@_; -f $from || die "$0: $from not found"; system "cmp", "-s", $from, $to; - if ($?) { + if ($? || $nonono) { + my ($atime, $mtime); + unlink($to); # In case we don't have write permissions. + if ($nonono) { + $from = $depth . "/" . $from if $depth; + } cmd("cp $from $to"); + # Restore timestamps if it's a .a library. + if ($to =~ /\.a$/) { + ($atime, $mtime) = (stat $from)[8,9]; + utime $atime, $mtime, $to; + } } }