installperl revision 1410:1b2e7ae0aee9
113546Sjulian#
213546Sjulian# This is a version of the 5.8.4 installperl script that has been modified to
313546Sjulian# work correctly as part of the ON build process.  The changes are as follows:
413546Sjulian#    * 'use filetest' added so the build works across mismatched NFSv4 domains
513546Sjulian#    * umask set to 022
613546Sjulian#    * install locations modified to be relative to $ROOT
713546Sjulian#    * check for 'make test' being run before install removed
813546Sjulian#    * executables installed with mode 0555
913546Sjulian#    * executables only overwritten if different from last build
1013546Sjulian#    * check for other versions of perl in $PATH removed
1113546Sjulian#    * .packlist entries cleaned of $ROOT prefix
1213546Sjulian#    * SCCS directories and .tstamp files ignored on install
1313546Sjulian#    * The contents of the additional contrib_bin directory are installed
1413546Sjulian#
1513546Sjulian
1613546SjulianBEGIN {
1713546Sjulian    require 5.004;
1813546Sjulian    chdir '..' if !-d 'lib' and -d '../lib';
1913546Sjulian    @INC = 'lib';
2013546Sjulian    $ENV{PERL5LIB} = 'lib';
2113546Sjulian}
2213546Sjulian
2313546Sjulianuse strict;
2413546Sjulianuse filetest qw(access);
2513546Sjulianmy ($Is_VMS, $Is_W32, $Is_OS2, $Is_Cygwin, $Is_Darwin,
2613546Sjulian    $nonono, $dostrip, $versiononly, $silent, $verbose, $force,
2713546Sjulian    $otherperls, $archname, $Is_NetWare, $nwinstall, $nopods);
2813546Sjulianuse vars qw /$depth/;
2913546Sjulian
3013546SjulianBEGIN {
3113546Sjulian    $Is_VMS = $^O eq 'VMS';
3213546Sjulian    $Is_W32 = $^O eq 'MSWin32';
3313546Sjulian    $Is_OS2 = $^O eq 'os2';
3413546Sjulian    $Is_Cygwin = $^O eq 'cygwin';
3513546Sjulian    $Is_Darwin = $^O eq 'darwin';
3613546Sjulian    if ($Is_VMS) { eval 'use VMS::Filespec;' }
3713546Sjulian}
3813546Sjulian
3931985Salexmy $scr_ext = ($Is_VMS ? '.Com' : $Is_W32 ? '.bat' : '');
4013546Sjulian
4113546Sjulianuse File::Find;
4213546Sjulianuse File::Compare;
4313546Sjulianuse File::Copy ();
4413546Sjulianuse File::Path ();
4513546Sjulianuse ExtUtils::Packlist;
4635509Sjbuse Config;
4713546Sjulianuse subs qw(unlink link chmod);
4831402Salex
4935509Sjbif ($Config{d_umask}) {
5013546Sjulian    umask(022); # umasks like 077 aren't that useful for installations
5113546Sjulian}
5213546Sjulian
5313546Sjulian$Is_NetWare = $Config{osname} eq 'NetWare';
5413546Sjulianif ($Is_NetWare) {
5513546Sjulian    $Is_W32 = 0;
5613546Sjulian    $scr_ext = '.pl';
5713546Sjulian}
5822315Sjulian
5913546Sjulian# override the ones in the rest of the script
6035509Sjbsub mkpath {
6113546Sjulian    File::Path::mkpath(@_) unless $nonono;
6231985Salex}
6313546Sjulian
6413546Sjulianmy $mainperldir = "/usr/bin";
6513546Sjulianmy $exe_ext = $Config{exe_ext};
6613546Sjulian
6713546Sjulian# Allow ``make install PERLNAME=something_besides_perl'':
68my $perl = defined($ENV{PERLNAME}) ? $ENV{PERLNAME} : 'perl';
69
70# This is the base used for versioned names, like "perl5.6.0".
71# It's separate because a common use of $PERLNAME is to install
72# perl as "perl5", if that's used as base for versioned files you
73# get "perl55.6.0".
74my $perl_verbase = defined($ENV{PERLNAME_VERBASE})
75		    ? $ENV{PERLNAME_VERBASE}
76		    : $perl;
77my $dbg = '';
78my $ndbg = '';
79if ( $Is_VMS ) {
80    if ( defined $Config{usevmsdebug} ) {
81        if ( $Config{usevmsdebug} eq 'define' ) {
82            $dbg = 'dbg';
83            $ndbg = 'ndbg';
84        }
85    }
86}
87
88$otherperls = 1;
89my $destdir = '';
90while (@ARGV) {
91    $nonono = 1 if $ARGV[0] eq '-n';
92    $dostrip = 1 if $ARGV[0] eq '-s';
93    $versiononly = 1 if $ARGV[0] eq '-v';
94    $versiononly = 0 if $ARGV[0] eq '+v';
95    $silent = 1 if $ARGV[0] eq '-S';
96    $otherperls = 0 if $ARGV[0] eq '-o';
97    $force = 1 if $ARGV[0] eq '-f';
98    $verbose = 1 if $ARGV[0] eq '-V' || $ARGV [0] eq '-n';
99    $archname = 1 if $ARGV[0] eq '-A';
100    $nwinstall = 1 if $ARGV[0] eq '-netware';
101    $nopods = 1 if $ARGV[0] eq '-p';
102    $destdir = $1 if $ARGV[0] =~ /^-?-destdir=(.*)$/;
103    if ($ARGV[0] eq '-?' or $ARGV[0] =~ /^-?-h/) {
104	print <<"EOT";
105Usage $0: [switches]
106  -n	    Don't actually run any commands; just print them.
107  -s        Run strip on installed binaries.
108  -v        Only install perl as a binary with the version number in the name.
109            (Override whatever config.sh says)
110  +v        Install perl as "perl" and as a binary with the version number in
111            the name.  (Override whatever config.sh says)
112  -S        Silent mode.
113  -f        Force installation (don't check if same version is there)
114  -o        Skip checking for other copies of perl in your PATH.
115  -V        Verbose mode.
116  -A        Also install perl with the architecture's name in the perl binary's
117            name.
118  -p        Don't install the pod files. [This will break use diagnostics;]
119  -netware  Install correctly on a Netware server.
120  -destdir  Prefix installation directories by this string.
121EOT
122	exit;
123    }
124    shift;
125}
126
127$versiononly = 1 if $Config{versiononly} && !defined $versiononly;
128my (@scripts, @tolink);
129open SCRIPTS, "utils.lst" or die "Can't open utils.lst: $!";
130while (<SCRIPTS>) {
131    next if /^#/;
132    s/\s*#\s*pod\s*=.*//; # install script regardless of pod location
133    next if /a2p/; # a2p is binary, to be installed separately
134    chomp;
135    if (/(\S*)\s*#\s*link\s*=\s*(\S*)/) {
136	push @scripts, $1;
137	push @tolink, [$1, $2];
138    } else {
139	push @scripts, $_;
140    }
141}
142close SCRIPTS;
143
144# Added for ON - install the scripts (if any) from contrib_bin.
145my $dh;
146if (opendir($dh, 'contrib_bin')) {
147	push(@scripts,
148	    map("contrib_bin/$_", grep($_ !~ /^\./, readdir($dh))));
149	closedir($dh);
150}
151
152if ($scr_ext) { @scripts = map { "$_$scr_ext" } @scripts; }
153
154my @pods = $nopods ? () : (<pod/*.pod>, 'x2p/a2p.pod');
155
156# Specify here any .pm files that are actually architecture-dependent.
157# (Those included with XS extensions under ext/ are automatically
158# added later.)
159# Now that the default privlib has the full perl version number included,
160# we no longer have to play the trick of sticking version-specific .pm
161# files under the archlib directory.
162my %archpms = (
163    Config => 1,
164    lib => 1,
165    Cwd => 1,
166);
167
168if ($^O eq 'dos') {
169    push(@scripts,'djgpp/fixpmain');
170    $archpms{config} = $archpms{filehand} = 1;
171}
172
173if ((-e "testcompile") && (defined($ENV{'COMPILE'}))) {
174    push(@scripts, map("$_.exe", @scripts));
175}
176
177find(sub {
178    if ("$File::Find::dir/$_" =~ m{^ext\b(.*)/([^/]+)\.pm$}) {
179	my($path, $modname) = ($1,$2);
180
181	# strip trailing component first
182	$path =~ s{/[^/]*$}{};
183
184	# strip optional "/lib";
185	$path =~ s{/lib\b}{};
186
187	# strip any leading /
188	$path =~ s{^/}{};
189
190	# reconstitute canonical module name
191	$modname = "$path/$modname" if length $path;
192
193	# remember it
194	$archpms{$modname} = 1;
195    }
196}, 'ext');
197
198# print "[$_]\n" for sort keys %archpms;
199
200my $ver = $Config{version};
201my $release = substr($],0,3);   # Not used currently.
202my $patchlevel = substr($],3,2);
203die "Patchlevel of perl ($patchlevel)",
204    "and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n"
205	if $patchlevel != $Config{'PERL_VERSION'};
206
207# Fetch some frequently-used items from %Config
208my $installbin = "$destdir$Config{installbin}";
209my $installscript = "$destdir$Config{installscript}";
210my $installprivlib = "$destdir$Config{installprivlib}";
211my $installarchlib = "$destdir$Config{installarchlib}";
212my $installsitelib = "$destdir$Config{installsitelib}";
213my $installsitearch = "$destdir$Config{installsitearch}";
214my $installman1dir = "$destdir$Config{installman1dir}";
215my $man1ext = $Config{man1ext};
216my $libperl = "$destdir$Config{libperl}";
217# Shared library and dynamic loading suffixes.
218my $so = $Config{so};
219my $dlext = $Config{dlext};
220my $dlsrc = $Config{dlsrc};
221if ($^O eq 'os390') {
222    my $pwd;
223    chomp($pwd=`pwd`);
224    my $archlibexp = $Config{archlibexp};
225    my $usedl = $Config{usedl};
226    if ($usedl eq 'define') {
227	`./$^X -pibak -e 's{$pwd\/libperl.x}{$archlibexp/CORE/libperl.x}' lib/Config.pm`;
228    }
229}
230
231if ($nwinstall) {
232    # This is required only if we are installing on a NetWare server
233    $installscript = $Config{installnwscripts};
234    $installprivlib = $Config{installnwlib};
235    $installarchlib = $Config{installnwlib};
236    $installsitelib = $Config{installnwlib};
237}
238
239my $d_dosuid = $Config{d_dosuid};
240my $binexp = $Config{binexp};
241
242if ($Is_VMS) {  # Hang in there until File::Spec hits the big time
243    foreach ( \$installbin,     \$installscript,  \$installprivlib,
244	      \$installarchlib, \$installsitelib, \$installsitearch,
245	      \$installman1dir ) {
246	$$_ = unixify($$_);  $$_ =~ s:/$::;
247    }
248}
249
250# Do some quick sanity checks.
251
252if (!$nonono && $d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
253
254   $installbin		|| die "No installbin directory in config.sh\n";
255-d $installbin		|| mkpath($installbin, $verbose, 0777);
256-d $installbin		|| $nonono || die "$installbin is not a directory\n";
257-w $installbin		|| $nonono || die "$installbin is not writable by you\n"
258	unless $installbin =~ m#^/afs/# || $nonono;
259
260if (!$Is_NetWare) {
261if (!$Is_VMS) {
262-x 'perl' . $exe_ext	|| die "perl isn't executable!\n";
263}
264else {
265-x $ndbg . 'perl' . $exe_ext	|| die "${ndbg}perl$exe_ext isn't executable!\n";
266    if ($dbg) {
267        -x $dbg . 'perl' . $exe_ext	|| die "${dbg}perl$exe_ext isn't executable!\n";
268    }
269}
270-x 'suidperl' . $exe_ext|| die "suidperl isn't executable!\n" if $d_dosuid;
271
272# Removed for ON
273#-f 't/rantests'		|| $Is_W32
274#			|| warn "WARNING: You've never run 'make test' or",
275#				" some tests failed! (Installing anyway.)\n";
276} #if (!$Is_NetWare)
277
278if (($Is_W32 and ! $Is_NetWare) or $Is_Cygwin) {
279    my $perldll;
280
281    if ($Is_Cygwin) {
282	$perldll = $libperl;
283	my $v_e_r_s = $ver; $v_e_r_s =~ tr/./_/;
284	$perldll =~ s/(\..*)?$/$v_e_r_s.$dlext/;
285	$perldll =~ s/^lib/cyg/;
286	if ($Config{useshrplib} eq 'true') {
287	    # install ld2 and perlld as well
288	    foreach ('ld2', 'perlld') {
289		safe_unlink("$installbin/$_");
290		copy("$_", "$installbin/$_");
291		chmod(0755, "$installbin/$_");
292	    };
293	    open (LD2, ">$installbin/ld2");
294	    print LD2 <<SHELL;
295#!/bin/sh
296#
297# ld wrapper, passes all args to perlld;
298#
299for trythis in $installbin/perl
300do
301  if [ -x \$trythis ]
302  then
303    \$trythis $installbin/perlld "\$\@"
304    exit \$?
305  fi
306done
307# hard luck!
308echo I see no perl executable around there
309echo perl is required to build dynamic libraries
310echo look if the path to perl in /bin/ld2 is correct
311exit 1
312SHELL
313	    close LD2;
314	    chmod(0755, "$installbin/ld2");
315	};
316    } else {
317	$perldll = 'perl58.' . $dlext;
318    }
319
320    if ($dlsrc ne "dl_none.xs") {
321	-f $perldll || die "No perl DLL built\n";
322    }
323
324    # Install the DLL
325    safe_unlink("$installbin/$perldll");
326    copy("$perldll", "$installbin/$perldll");
327    chmod(0755, "$installbin/$perldll");
328} # if (($Is_W32 and ! $Is_NetWare) or $Is_Cygwin)
329
330# This will be used to store the packlist
331my $packlist = ExtUtils::Packlist->new("$installarchlib/.packlist");
332
333# First we install the version-numbered executables.
334
335if ($Is_VMS) {
336    safe_unlink("$installbin/perl_setup.com");
337    copy("perl_setup.com", "$installbin/perl_setup.com");
338    chmod(0755, "$installbin/perl_setup.com");
339    safe_unlink("$installbin/$dbg$perl$exe_ext");
340    copy("$dbg$perl$exe_ext", "$installbin/$dbg$perl$exe_ext");
341    chmod(0755, "$installbin/$dbg$perl$exe_ext");
342    safe_unlink("$installbin/$dbg${perl}shr$exe_ext");
343    copy("$dbg${perl}shr$exe_ext", "$installbin/$dbg${perl}shr$exe_ext");
344    chmod(0755, "$installbin/$dbg${perl}shr$exe_ext");
345    if ($ndbg) {
346        safe_unlink("$installbin/$ndbg$perl$exe_ext");
347        copy("$ndbg$perl$exe_ext", "$installbin/$ndbg$perl$exe_ext");
348        chmod(0755, "$installbin/$ndbg$perl$exe_ext");
349	safe_unlink("$installbin/${dbg}a2p$exe_ext");
350	copy("x2p/${dbg}a2p$exe_ext", "$installbin/${dbg}a2p$exe_ext");
351	chmod(0755, "$installbin/${dbg}a2p$exe_ext");
352    }
353}
354elsif ($^O eq 'mpeix') {
355    # MPE lacks hard links and requires that executables with special
356    # capabilities reside in the MPE namespace.
357    safe_unlink("$installbin/perl$ver$exe_ext", $Config{perlpath});
358    # Install the primary executable into the MPE namespace as perlpath.
359    copy("perl$exe_ext", $Config{perlpath});
360    chmod(0755, $Config{perlpath});
361    # Create a backup copy with the version number.
362    link($Config{perlpath}, "$installbin/perl$ver$exe_ext");
363}
364elsif ($^O ne 'dos') {
365    if (!$Is_NetWare) {
366	if (copy_if_diff("perl$exe_ext",
367	    "$installbin/$perl_verbase$ver$exe_ext")) {
368	    strip("$installbin/$perl_verbase$ver$exe_ext");
369	    chmod(0555, "$installbin/$perl_verbase$ver$exe_ext");
370	}
371    }
372    else {
373	# If installing onto a NetWare server
374	if ($nwinstall) {
375	    # Copy perl.nlm, echo.nlm, type.nlm, a2p.nlm & cgi2perl.nlm
376	    mkpath($Config{installnwsystem}, 1, 0777);
377	    copy("netware\\".$ENV{'MAKE_TYPE'}."\\perl.nlm", $Config{installnwsystem});
378	    copy("netware\\testnlm\\echo\\echo.nlm", $Config{installnwsystem});
379	    copy("netware\\testnlm\\type\\type.nlm", $Config{installnwsystem});
380	    copy("x2p\\a2p.nlm", $Config{installnwsystem});
381	    chmod(0755, "$Config{installnwsystem}\\perl.nlm");
382	    mkpath($Config{installnwlcgi}, 1, 0777);
383	    copy("lib\\auto\\cgi2perl\\cgi2perl.nlm", $Config{installnwlcgi});
384	}
385    } #if (!$Is_NetWare)
386}
387else {
388    safe_unlink("$installbin/$perl.exe");
389    copy("perl.exe", "$installbin/$perl.exe");
390}
391
392safe_unlink("$installbin/s$perl_verbase$ver$exe_ext");
393if ($d_dosuid) {
394    copy("suidperl$exe_ext", "$installbin/s$perl_verbase$ver$exe_ext");
395    chmod(04711, "$installbin/s$perl_verbase$ver$exe_ext");
396}
397
398# Install library files.
399
400my ($do_installarchlib, $do_installprivlib) = (0, 0);
401
402mkpath($installprivlib, $verbose, 0777);
403mkpath($installarchlib, $verbose, 0777);
404mkpath($installsitelib, $verbose, 0777) if ($installsitelib);
405mkpath($installsitearch, $verbose, 0777) if ($installsitearch);
406
407if (chdir "lib") {
408    $do_installarchlib = ! samepath($installarchlib, '.');
409    $do_installprivlib = ! samepath($installprivlib, '.');
410    $do_installprivlib = 0 if $versiononly && !($installprivlib =~ m/\Q$ver/);
411
412    if ($do_installarchlib || $do_installprivlib) {
413	find(\&installlib, '.');
414    }
415    chdir ".." || die "Can't cd back to source directory: $!\n";
416}
417else {
418    warn "Can't cd to lib to install lib files: $!\n";
419}
420
421# Install header files and libraries.
422mkpath("$installarchlib/CORE", $verbose, 0777);
423my @corefiles;
424if ($Is_VMS) {  # We did core file selection during build
425    my $coredir = "lib/$Config{archname}/$ver/CORE";
426    $coredir =~ tr/./_/;
427    map { s|^$coredir/||i; } @corefiles = <$coredir/*.*>;
428}
429else {
430    # [als] hard-coded 'libperl' name... not good!
431    @corefiles = <*.h *.inc libperl*.* perl*$Config{lib_ext}>;
432
433    # AIX needs perl.exp installed as well.
434    push(@corefiles,'perl.exp') if $^O eq 'aix';
435    if ($^O eq 'mpeix') {
436	# MPE needs mpeixish.h installed as well.
437	mkpath("$installarchlib/CORE/mpeix", $verbose, 0777);
438	push(@corefiles,'mpeix/mpeixish.h');
439    }
440    # If they have built sperl.o...
441    push(@corefiles,'sperl.o') if -f 'sperl.o';
442}
443foreach my $file (@corefiles) {
444    # HP-UX (at least) needs to maintain execute permissions
445    # on dynamically-loadable libraries. So we do it for all.
446    if (copy_if_diff($file,"$installarchlib/CORE/$file")) {
447	if ($file =~ /\.(\Q$so\E|\Q$dlext\E)$/) {
448	    strip("-S", "$installarchlib/CORE/$file") if $^O =~ /^(rhapsody|darwin)$/;
449	    chmod(0555, "$installarchlib/CORE/$file");
450	} else {
451	    chmod(0444, "$installarchlib/CORE/$file");
452	}
453    }
454}
455
456# Switch in the 5.005-threads versions of he threadsafe queue and semaphore
457# modules if so needed.
458if ($Config{use5005threads}) {
459    for my $m (qw(Queue Semaphore)) {
460	my $t = "$installprivlib/Thread/$m.pm";
461	unlink $t;
462	copy("ext/Thread/$m.pmx", $t);
463	chmod(0444, $t);
464    }
465}
466
467# Install main perl executables
468# Make links to ordinary names if installbin directory isn't current directory.
469
470if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS && ! $Is_NetWare) {
471    safe_unlink("$installbin/$perl$exe_ext", "$installbin/suid$perl$exe_ext");
472    if ($^O eq 'mpeix') {
473	# MPE doesn't support hard links, so use a symlink.
474	# We don't want another cloned copy.
475	symlink($Config{perlpath}, "$installbin/perl$exe_ext");
476    } elsif ($^O eq 'vos') {
477	# VOS doesn't support hard links, so use a symlink.
478	symlink("$installbin/$perl_verbase$ver$exe_ext",
479		"$installbin/$perl$exe_ext");
480    } else {
481	link("$installbin/$perl_verbase$ver$exe_ext",
482		"$installbin/$perl$exe_ext");
483    }
484    link("$installbin/$perl_verbase$ver$exe_ext",
485	    "$installbin/suid$perl$exe_ext")
486      if $d_dosuid;
487}
488
489# For development purposes it can be very useful to have multiple perls
490# build for different "architectures" (eg threading or not) simultaneously.
491if ($archname && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS) {
492    my $archperl = "$perl_verbase$ver-$Config{archname}$exe_ext";
493    safe_unlink("$installbin/$archperl");
494    if ($^O eq 'mpeix') {
495	# MPE doesn't support hard links, so use a symlink.
496	# We don't want another cloned copy.
497	symlink($Config{perlpath}, "$installbin/$archperl");
498    } elsif ($^O eq 'vos') {
499	# VOS doesn't support hard links, so use a symlink.
500	symlink("$installbin/$perl_verbase$ver$exe_ext",
501		"$installbin/$archperl");
502    } else {
503	link("$installbin/$perl_verbase$ver$exe_ext", "$installbin/$archperl");
504    }
505}
506
507# Offer to install perl in a "standard" location
508
509my $mainperl_is_instperl = 0;
510
511if ($Config{installusrbinperl} && $Config{installusrbinperl} eq 'define' &&
512    !$versiononly && !$nonono && !$Is_W32 && !$Is_NetWare && !$Is_VMS && -t STDIN && -t STDERR
513	&& -w $mainperldir && ! samepath($mainperldir, $installbin)) {
514    my($usrbinperl)	= "$mainperldir/$perl$exe_ext";
515    my($instperl)	= "$installbin/$perl$exe_ext";
516    my($expinstperl)	= "$binexp/$perl$exe_ext";
517
518    # First make sure $usrbinperl is not already the same as the perl we
519    # just installed.
520    if (-x $usrbinperl) {
521	# Try to be clever about mainperl being a symbolic link
522	# to binexp/perl if binexp and installbin are different.
523	$mainperl_is_instperl =
524	    samepath($usrbinperl, $instperl) ||
525	    samepath($usrbinperl, $expinstperl) ||
526	     (($binexp ne $installbin) &&
527	      (-l $usrbinperl) &&
528	      ((readlink $usrbinperl) eq $expinstperl));
529    }
530    if (! $mainperl_is_instperl) {
531	unlink($usrbinperl);
532	( $Config{'d_link'} eq 'define' &&
533	  eval { CORE::link $instperl, $usrbinperl } )	||
534	eval { symlink $expinstperl, $usrbinperl }	||
535	copy($instperl, $usrbinperl);
536
537	$mainperl_is_instperl = 1;
538    }
539}
540
541# Make links to ordinary names if installbin directory isn't current directory.
542if (!$Is_NetWare && $dbg eq '') {
543    if (! samepath($installbin, 'x2p')) {
544	my $base = 'a2p';
545	$base .= $ver if $versiononly;
546	copy_if_diff("x2p/a2p$exe_ext", "$installbin/$base$exe_ext");
547	strip("$installbin/$base$exe_ext");
548	chmod(0555, "$installbin/$base$exe_ext");
549    }
550}
551
552# cppstdin is just a script, but it is architecture-dependent, so
553# it can't safely be shared.  Place it in $installbin.
554# Note that Configure doesn't build cppstin if it isn't needed, so
555# we skip this if cppstdin doesn't exist.
556if (! $versiononly && (-f 'cppstdin') && (! samepath($installbin, '.'))) {
557    safe_unlink("$installbin/cppstdin");
558    copy("cppstdin", "$installbin/cppstdin");
559    chmod(0555, "$installbin/cppstdin");
560}
561
562sub script_alias {
563    my ($installscript, $orig, $alias, $scr_ext) = @_;
564
565    safe_unlink("$installscript/$alias$scr_ext");
566    if ($^O eq 'dos' or $Is_VMS or $^O eq 'transit') {
567	copy("$installscript/$orig$scr_ext",
568	     "$installscript/$alias$scr_ext");
569    } elsif ($^O eq 'vos') {
570	symlink("$installscript/$orig$scr_ext",
571		"$installscript/$alias$scr_ext");
572    } else {
573	link("$installscript/$orig$scr_ext",
574	     "$installscript/$alias$scr_ext");
575    }
576}
577
578# Install scripts.
579mkpath($installscript, $verbose, 0777);
580if ($versiononly) {
581    for (@scripts) {
582	(my $base = $_) =~ s#.*/##;
583	$base .= $ver;
584	if (copy_if_diff($_,    "$installscript/$base")) {
585	    chmod(0555, "$installscript/$base");
586	}
587    }
588
589    for (@tolink) {
590	my ($from, $to) = map { "$_$ver" } @$_;
591	(my $frbase = $from) =~ s#.*/##;
592	(my $tobase = $to) =~ s#.*/##;
593	script_alias($installscript, $frbase, $tobase, $scr_ext);
594    }
595} else {
596    for (@scripts) {
597	(my $base = $_) =~ s#.*/##;
598	copy_if_diff($_, "$installscript/$base");
599	chmod(0555, "$installscript/$base");
600    }
601
602    for (@tolink) {
603	my ($from, $to) = @$_;
604	(my $frbase = $from) =~ s#.*/##;
605	(my $tobase = $to) =~ s#.*/##;
606	script_alias($installscript, $frbase, $tobase, $scr_ext);
607    }
608}
609
610# Install pod pages.  Where? I guess in $installprivlib/pod
611# ($installprivlib/pods for cygwin).
612
613my $pod = ($Is_Cygwin || $Is_Darwin) ? 'pods' : 'pod';
614if ( !$versiononly || ($installprivlib =~ m/\Q$ver/)) {
615    mkpath("${installprivlib}/$pod", $verbose, 0777);
616
617    # If Perl 5.003's perldiag.pod is there, rename it.
618    if (open POD, "${installprivlib}/$pod/perldiag.pod") {
619	read POD, $_, 4000;
620	close POD;
621	# Some of Perl 5.003's diagnostic messages ended with periods.
622	if (/^=.*\.$/m) {
623	    my ($from, $to) = ("${installprivlib}/$pod/perldiag.pod",
624			       "${installprivlib}/$pod/perldiag-5.003.pod");
625	    print "  rename $from $to";
626	    rename($from, $to)
627		or warn "Couldn't rename $from to $to: $!\n"
628		unless $nonono;
629	}
630    }
631
632    for (@pods) {
633	# $_ is a name like  pod/perl.pod
634	(my $base = $_) =~ s#.*/##;
635	if (copy_if_diff($_, "${installprivlib}/$pod/${base}")) {
636	    chmod(0444, "${installprivlib}/$pod/${base}");
637	}
638    }
639
640}
641
642# Check to make sure there aren't other perls around in installer's
643# path.  This is probably UNIX-specific.  Check all absolute directories
644# in the path except for where public executables are supposed to live.
645# Also skip $mainperl if the user opted to have it be a link to the
646# installed perl.
647
648# Note: Removed for ON.
649
650#if (!$versiononly && $otherperls) {
651#    my ($path, @path);
652#    my $dirsep = ($Is_OS2 || $Is_W32 || $Is_NetWare) ? ';' : ':' ;
653#    ($path = $ENV{"PATH"}) =~ s:\\:/:g ;
654#    @path = split(/$dirsep/, $path);
655#    if ($Is_VMS) {
656#	my $i = 0;
657#	while (exists $ENV{'DCL$PATH' . $i}) {
658#	    my $dir = unixpath($ENV{'DCL$PATH' . $i});  $dir =~ s-/$--;
659#	    push(@path,$dir);
660#	}
661#    }
662#    my @otherperls;
663#    my %otherperls;
664#    for (@path) {
665#	next unless m,^/,;
666#	# Use &samepath here because some systems have other dirs linked
667#	# to $mainperldir (like SunOS)
668#	next if samepath($_, $binexp);
669#	next if ($mainperl_is_instperl && samepath($_, $mainperldir));
670#	my $otherperl = "$_/$perl$exe_ext";
671#	next if $otherperls{$otherperl}++;
672#	push(@otherperls, $otherperl)
673#	    if (-x $otherperl && ! -d $otherperl);
674#    }
675#    if (@otherperls) {
676#	warn "\nWarning: $perl appears in your path in the following " .
677#	    "locations beyond where\nwe just installed it:\n";
678#	for (@otherperls) {
679#	    warn "    ", $_, "\n";
680#	}
681#	warn "\n";
682#    }
683#}
684
685# Added for ON - remove $ROOT prefix from the packlist entries.
686my $pat = qr{^$destdir};
687while (my ($k, $v) = each(%{$packlist})) {
688	delete($packlist->{$k});
689	$k =~ s/$pat//;
690	if ($v->{type} eq 'link') {
691		my $l = delete($v->{from});
692		$l =~ s/$pat//;
693		$v->{from} = $l;
694	}
695	$packlist->{$k} = $v;
696}
697if (! $nonono) {
698    $packlist->write("$installarchlib/.packlist.tmp");
699    if (copy_if_diff("$installarchlib/.packlist.tmp",
700    "$installarchlib/.packlist")) {
701        chmod(0444, "$installarchlib/.packlist");
702    }
703    safe_unlink("$installarchlib/.packlist.tmp");
704}
705
706print "  Installation complete\n" if $verbose;
707
708exit 0;
709
710###############################################################################
711
712sub yn {
713    my($prompt) = @_;
714    my($answer);
715    my($default) = $prompt =~ m/\[([yn])\]\s*$/i;
716    print STDERR $prompt;
717    chop($answer = <STDIN>);
718    $answer = $default if $answer =~ m/^\s*$/;
719    ($answer =~ m/^[yY]/);
720}
721
722sub unlink {
723    my(@names) = @_;
724    my($cnt) = 0;
725
726    return scalar(@names) if $Is_VMS;
727
728    foreach my $name (@names) {
729	next unless -e $name;
730	chmod 0777, $name if ($Is_OS2 || $Is_W32 || $Is_Cygwin || $Is_NetWare);
731	print "  unlink $name\n" if $verbose;
732	( CORE::unlink($name) and ++$cnt
733	  or warn "Couldn't unlink $name: $!\n" ) unless $nonono;
734    }
735    return $cnt;
736}
737
738sub safe_unlink {
739    return if $nonono or $Is_VMS;
740    my @names = @_;
741    foreach my $name (@names) {
742	next unless -e $name;
743	chmod 0777, $name if ($Is_OS2 || $Is_W32 || $Is_NetWare);
744	print "  unlink $name\n" if $verbose;
745	next if CORE::unlink($name);
746	warn "Couldn't unlink $name: $!\n";
747	if ($! =~ /busy/i) {
748	    print "  mv $name $name.old\n" if $verbose;
749	    safe_rename($name, "$name.old")
750		or warn "Couldn't rename $name: $!\n";
751	}
752    }
753}
754
755sub safe_rename {
756    my($from,$to) = @_;
757    if (-f $to and not unlink($to)) {
758	my($i);
759	for ($i = 1; $i < 50; $i++) {
760	    last if rename($to, "$to.$i");
761	}
762	warn("Cannot rename to `$to.$i': $!"), return 0
763	   if $i >= 50;	# Give up!
764    }
765    link($from,$to) || return 0;
766    unlink($from);
767}
768
769sub link {
770    my($from,$to) = @_;
771    my($success) = 0;
772
773    my $xfrom = $from;
774    $xfrom =~ s/^\Q$destdir\E// if $destdir;
775    my $xto = $to;
776    $xto =~ s/^\Q$destdir\E// if $destdir;
777    print $verbose ? "  ln $xfrom $xto\n" : "  $xto\n" unless $silent;
778    eval {
779	CORE::link($from, $to)
780	    ? $success++
781	    : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
782	      ? die "AFS"  # okay inside eval {}
783	      : die "Couldn't link $from to $to: $!\n"
784	  unless $nonono;
785	$packlist->{$xto} = { from => $xfrom, type => 'link' };
786    };
787    if ($@) {
788	warn "Replacing link() with File::Copy::copy(): $@";
789	print $verbose ? "  cp $from $xto\n" : "  $xto\n" unless $silent;
790	print "  creating new version of $xto\n"
791		 if $Is_VMS and -e $to and !$silent;
792	unless ($nonono or File::Copy::copy($from, $to) and ++$success) {
793	    # Might have been that F::C::c can't overwrite the target
794	    warn "Couldn't copy $from to $to: $!\n"
795		unless -f $to and (chmod(0666, $to), unlink $to)
796			and File::Copy::copy($from, $to) and ++$success;
797	}
798	$packlist->{$xto} = { type => 'file' };
799    }
800    $success;
801}
802
803sub chmod {
804    my($mode,$name) = @_;
805
806    return if ($^O eq 'dos');
807    printf "  chmod %o %s\n", $mode, $name if $verbose;
808    CORE::chmod($mode,$name)
809	|| warn sprintf("Couldn't chmod %o %s: $!\n", $mode, $name)
810      unless $nonono;
811}
812
813sub copy {
814    my($from,$to) = @_;
815
816    my $xto = $to;
817    $xto =~ s/^\Q$destdir\E// if $destdir;
818    print $verbose ? "  cp $from $xto\n" : "  $xto\n" unless $silent;
819    print "  creating new version of $xto\n" if $Is_VMS and -e $to and !$silent;
820    unless ($nonono or File::Copy::copy($from, $to)) {
821	# Might have been that F::C::c can't overwrite the target
822	warn "Couldn't copy $from to $to: $!\n"
823	    unless -f $to and (chmod(0666, $to), unlink $to)
824		   and File::Copy::copy($from, $to);
825    }
826    $packlist->{$xto} = { type => 'file' };
827}
828
829sub samepath {
830    my($p1, $p2) = @_;
831
832    return (lc($p1) eq lc($p2)) if ($Is_W32 || $Is_NetWare);
833
834    if ($p1 ne $p2) {
835	my($dev1, $ino1, $dev2, $ino2);
836	($dev1, $ino1) = stat($p1);
837	($dev2, $ino2) = stat($p2);
838	($dev1 == $dev2 && $ino1 == $ino2);
839    }
840    else {
841	1;
842    }
843}
844
845sub installlib {
846    my $dir = $File::Find::dir;
847    $dir =~ s#^\.(?![^/])/?##;
848    local($depth) = $dir ? "lib/$dir" : "lib";
849
850    my $name = $_;
851
852    # Ignore version control directories and ON artifacts.
853    if (($name =~ /^(?:CVS|RCS|SCCS|\.svn)\z/ and -d $name)
854        or ($name eq '.tstamp' and -f $name)) {
855	$File::Find::prune = 1;
856	return;
857    }
858
859    # ignore patch backups, RCS files, emacs backup & temp files and the
860    # .exists files, .PL files, and test files.
861    return if $name =~ m{\.orig$|\.rej$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.plc$|\.t$|^test\.pl$} ||
862	      $dir  =~ m{/t(?:/|$)};
863
864    # XXX xsubpp back out of the list. prove now integrated. Out of order, so
865    # p4 will conflict on the next update to the following lines:
866
867    # ignore the cpan script in lib/CPAN/bin, the instmodsh and xsubpp
868    # scripts in lib/ExtUtils, and the prove script in lib/Test/Harness
869    # (they're installed later with other utils)
870    return if $name =~ /^(?:cpan|instmodsh|prove)\z/;
871
872    # ignore the Makefiles
873    return if $name =~ /^makefile$/i;
874    # ignore the test extensions
875    return if $dir =~ m{ext/XS/(?:APItest|Typemap)/};
876
877    $name = "$dir/$name" if $dir ne '';
878
879    my $installlib = $installprivlib;
880    if ($dir =~ /^auto/ ||
881	  ($name =~ /^(.*)\.(?:pm|pod)$/ && $archpms{$1}) ||
882	  ($name =~ /^(.*)\.(?:h|lib)$/i && ($Is_W32 || $Is_NetWare))
883       ) {
884	$installlib = $installarchlib;
885	return unless $do_installarchlib;
886    } else {
887	return unless $do_installprivlib;
888    }
889
890    if (-f $_) {
891	if (/\.(?:al|ix)$/ && !($dir =~ m[^auto/(.*)$] && $archpms{$1})) {
892	    $installlib = $installprivlib;
893	    #We're installing *.al and *.ix files into $installprivlib,
894	    #but we have to delete old *.al and *.ix files from the 5.000
895	    #distribution:
896	    #This might not work because $archname might have changed.
897	    unlink("$installarchlib/$name");
898	}
899	my $xname = "$installlib/$name";
900	$xname =~ s/^\Q$destdir\E// if $destdir;
901	$packlist->{$xname} = { type => 'file' };
902	if ($force || compare($_, "$installlib/$name") || $nonono) {
903	    unlink("$installlib/$name");
904	    mkpath("$installlib/$dir", $verbose, 0777);
905	    # HP-UX (at least) needs to maintain execute permissions
906	    # on dynamically-loaded libraries.
907	    if ($Is_NetWare && !$nwinstall) {
908		# Don't copy .nlp,.nlm files, doesn't make sense on Windows and also
909		# if copied will give problems when building new extensions.
910		# Has to be copied if we are installing on a NetWare server and hence
911		# the check !$nwinstall
912		if (!(/\.(?:nlp|nlm|bs)$/)) {
913		    copy_if_diff($_, "$installlib/$name")
914			and chmod($name =~ /\.(so|$dlext)$/o ? 0555 : 0444,
915				  "$installlib/$name");
916		}
917	   } else {
918		if (copy_if_diff($_, "$installlib/$name")) {
919		    if ($name =~ /\.(so|$dlext)$/o) {
920			strip("-S", "$installlib/$name") if $^O =~ /^(rhapsody|darwin)$/;
921			chmod(0555, "$installlib/$name");
922		    } else {
923			strip("-S", "$installlib/$name")
924			    if ($name =~ /\.a$/o and $^O =~ /^(rhapsody|darwin)$/);
925			chmod(0444, "$installlib/$name");
926		    }
927		}
928	    } #if ($Is_NetWare)
929	}
930    }
931}
932
933# Copy $from to $to, only if $from is different than $to.
934# Also preserve modification times for .a libraries.
935# On some systems, if you do
936#   ranlib libperl.a
937#   cp libperl.a /usr/local/lib/perl5/archlib/CORE/libperl.a
938# and then try to link against the installed libperl.a, you might
939# get an error message to the effect that the symbol table is older
940# than the library.
941# Return true if copying occurred.
942
943sub copy_if_diff {
944    my($from,$to)=@_;
945    return 1 if (($^O eq 'VMS') && (-d $from));
946    my $xto = $to;
947    $xto =~ s/^\Q$destdir\E// if $destdir;
948    my $perlpodbadsymlink;
949    if ($from =~ m!^pod/perl[\w-]+\.pod$! &&
950	-l $from &&
951	! -e $from) {
952	# Some Linux implementations have problems traversing over
953	# multiple symlinks (when going over NFS?) and fail to read
954	# the symlink target.  Combine this with the fact that some
955	# of the pod files (the perl$OS.pod) are symlinks (to ../README.$OS),
956	# and you end up with those pods not getting installed.
957	$perlpodbadsymlink = 1;
958    }
959    -f $from || $perlpodbadsymlink || warn "$0: $from not found";
960    $packlist->{$xto} = { type => 'file' };
961    if ($force || compare($from, $to) || $nonono) {
962	safe_unlink($to);   # In case we don't have write permissions.
963	if ($nonono) {
964	    $from = $depth . "/" . $from if $depth;
965	}
966	if ($perlpodbadsymlink && $from =~ m!^pod/perl(.+)\.pod$!) {
967	    $from = "README.$1";
968	}
969	copy($from, $to);
970	# Restore timestamps if it's a .a library or for OS/2.
971	if (!$nonono && ($Is_OS2 || $to =~ /\.a$/)) {
972	    my ($atime, $mtime) = (stat $from)[8,9];
973	    utime $atime, $mtime, $to;
974	}
975	1;
976    }
977}
978
979sub strip
980{
981    my(@args) = @_;
982
983    return unless $dostrip;
984
985    my @opts;
986    while (@args && $args[0] =~ /^(-\w+)$/) {
987	push @opts, shift @args;
988    }
989
990    foreach my $file (@args) {
991	if (-f $file) {
992	    if ($verbose) {
993		print "  strip " . join(' ', @opts);
994		print " " if (@opts);
995		print "$file\n";
996	    }
997	    system("strip", @opts, $file);
998	} else {
999	    print "# file '$file' skipped\n" if $verbose;
1000	}
1001    }
1002}
1003