installperl revision 1.1
1#!./perl 2BEGIN { @INC=('./lib', '../lib') } 3use File::Find; 4use File::Path qw(mkpath); 5use Config; 6use subs qw(unlink rename link chmod); 7 8$mainperldir = "/usr/bin"; 9$exe_ext = $Config{exe_ext}; 10 11while (@ARGV) { 12 $nonono = 1 if $ARGV[0] eq '-n'; 13 $versiononly = 1 if $ARGV[0] eq '-v'; 14 shift; 15} 16 17umask 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); 34die "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 59if ($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 73if ($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"); 90if ($d_dosuid) { 91 &cmd("cp suidperl$exe_ext $installbin/sperl$ver$exe_ext"); 92 &chmod(04711, "$installbin/sperl$ver$exe_ext"); 93} 94 95exit 0 if $versiononly; 96 97# Make links to ordinary names if installbin directory isn't current directory. 98 99if (! &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 106if (! &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 114mkpath($installscript, 1, 0777); 115 116for (@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. 124mkpath("${installprivlib}/pod", 1, 0777); 125foreach $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 132if ($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 158mkpath($installprivlib, 1, 0777); 159mkpath($installarchlib, 1, 0777); 160mkpath($installsitelib, 1, 0777) if ($installsitelib); 161mkpath($installsitearch, 1, 0777) if ($installsitearch); 162 163if (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} 172else { 173 warn "Can't cd to lib to install lib files: $!\n"; 174} 175 176# Install header files and libraries. 177mkpath("$installarchlib/CORE", 1, 0777); 178foreach $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. 183cp_if_diff("perl.exp" ,"$installarchlib/CORE/perl.exp") if ($^O eq 'aix'); 184 185# If they have built sperl.o... 186cp_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 193if (-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 = (); 229for (@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} 238if (@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 247print STDERR " Installation complete\n"; 248 249exit 0; 250 251############################################################################### 252 253sub 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 263sub 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 277sub 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 294sub cmd { 295 local($cmd) = @_; 296 print STDERR " $cmd\n"; 297 unless ($nonono) { 298 system $cmd; 299 warn "Command failed!!!\n" if $?; 300 } 301} 302 303sub 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 317sub 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 330sub 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 338sub 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 352sub 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. 407sub 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