xref: /openbsd/gnu/usr.bin/perl/installperl (revision 91f110e0)
1#!./perl -w
2
3BEGIN {
4    require 5.004;
5    chdir '..' if !-d 'lib' and -d '../lib';
6    @INC = 'lib';
7    $ENV{PERL5LIB} = 'lib';
8
9    # This needs to be at BEGIN time, before any use of Config
10    require './install_lib.pl';
11}
12
13use strict;
14use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $Is_Darwin $Is_NetWare
15	    %opts $packlist);
16my ($dostrip, $versiononly, $force,
17    $otherperls, $archname, $nwinstall, $nopods);
18
19BEGIN {
20    if ($Is_VMS) { eval 'use VMS::Filespec;' }
21}
22
23my $scr_ext = ($Is_VMS ? '.Com' : $Is_W32 ? '.bat' : '');
24
25use File::Find;
26use File::Compare;
27use File::Copy ();
28use File::Path ();
29use ExtUtils::Packlist;
30use Cwd;
31
32require './Porting/pod_lib.pl';
33
34if ($Is_NetWare) {
35    $Is_W32 = 0;
36    $scr_ext = '.pl';
37}
38
39# override the ones in the rest of the script
40sub mkpath {
41    File::Path::mkpath(@_) unless $opts{notify};
42}
43
44my $mainperldir = "/usr/bin";
45my $exe_ext = $Config{exe_ext};
46
47# Allow "make install PERLNAME=something_besides_perl":
48my $perl = defined($ENV{PERLNAME}) ? $ENV{PERLNAME} : 'perl';
49
50# This is the base used for versioned names, like "perl5.6.0".
51# It's separate because a common use of $PERLNAME is to install
52# perl as "perl5", if that's used as base for versioned files you
53# get "perl55.6.0".
54my $perl_verbase = defined($ENV{PERLNAME_VERBASE})
55		    ? $ENV{PERLNAME_VERBASE}
56		    : $perl;
57my $dbg = '';
58my $ndbg = '';
59if ( $Is_VMS ) {
60    if ( defined $Config{usevmsdebug} ) {
61        if ( $Config{usevmsdebug} eq 'define' ) {
62            $dbg = 'dbg';
63            $ndbg = 'ndbg';
64        }
65    }
66}
67
68$otherperls = 1;
69# This little hack simplifies making the code after the comment "Fetch some
70# frequently-used items from %Config" warning free. With $opts{destdir} always
71# defined, it's also possible to make the s/\Q$opts{destdir}\E unconditional.
72
73$opts{destdir} = '';
74# Consider refactoring this to use Getopt::Long once Getopt::Long's planned
75# feature is implemented, to distinguish + and - options.
76while (@ARGV) {
77    $opts{notify} = 1 if $ARGV[0] eq '-n';
78    $dostrip = 1 if $ARGV[0] eq '-s';
79    $versiononly = 1 if $ARGV[0] eq '-v';
80    $versiononly = 0 if $ARGV[0] eq '+v';
81    $opts{silent} = 1 if $ARGV[0] eq '-S';
82    $otherperls = 0 if $ARGV[0] eq '-o';
83    $force = 1 if $ARGV[0] eq '-f';
84    $opts{verbose} = 1 if $ARGV[0] eq '-V' || $ARGV [0] eq '-n';
85    $archname = 1 if $ARGV[0] eq '-A';
86    $nwinstall = 1 if $ARGV[0] eq '-netware';
87    $nopods = 1 if $ARGV[0] eq '-p';
88    $opts{destdir} = $1 if $ARGV[0] =~ /^-?-destdir=(.*)$/;
89    if ($ARGV[0] eq '-?' or $ARGV[0] =~ /^-?-h/) {
90	print <<"EOT";
91Usage $0: [switches]
92  -n	    Don't actually run any commands; just print them.
93  -s        Run strip on installed binaries.
94  -v        Only install perl as a binary with the version number in the name.
95            (Override whatever config.sh says)
96  +v        Install perl as "perl" and as a binary with the version number in
97            the name.  (Override whatever config.sh says)
98  -S        Silent mode.
99  -f        Force installation (don't check if same version is there)
100  -o        Skip checking for other copies of perl in your PATH.
101  -V        Verbose mode.
102  -A        Also install perl with the architecture's name in the perl binary's
103            name.
104  -p        Don't install the pod files. [This will break use diagnostics;]
105  -netware  Install correctly on a Netware server.
106  -destdir  Prefix installation directories by this string.
107EOT
108	exit;
109    }
110    shift;
111}
112
113$versiononly = 1 if $Config{versiononly} && !defined $versiononly;
114my (@scripts, @tolink);
115open SCRIPTS, "utils.lst" or die "Can't open utils.lst: $!";
116while (<SCRIPTS>) {
117    next if /^#/;
118    next if /a2p/; # a2p is binary, to be installed separately
119    chomp;
120    if (/(\S*)\s*#\s*link\s*=\s*(\S*)/) {
121	push @scripts, $1;
122	push @tolink, [$1, $2];
123    } else {
124	push @scripts, $_;
125    }
126}
127close SCRIPTS;
128
129if ($scr_ext) { @scripts = map { "$_$scr_ext" } @scripts; }
130
131# Specify here any .pm files that are actually architecture-dependent.
132# (Those included with XS extensions under ext/ are automatically
133# added later.)
134# Now that the default privlib has the full perl version number included,
135# we no longer have to play the trick of sticking version-specific .pm
136# files under the archlib directory.
137my %archpms = (
138    Config => 1,
139    lib => 1,
140    Cwd => 1,
141);
142
143if ($^O eq 'dos') {
144    push(@scripts,'djgpp/fixpmain');
145    $archpms{config} = $archpms{filehand} = 1;
146}
147
148if ((-e "testcompile") && (defined($ENV{'COMPILE'}))) {
149    push(@scripts, map("$_.exe", @scripts));
150}
151
152# Exclude nonxs extensions that are not architecture dependent
153my @nonxs = grep(!/^(Errno|IO\/Compress)$/, split(' ', $Config{'nonxs_ext'}));
154
155my @ext_dirs = qw(cpan dist ext);
156foreach my $ext_dir (@ext_dirs) {
157    find(sub {
158	if (($File::Find::name =~ m{^$ext_dir\b(.*)/([^/]+)\.pm$}) &&
159	    ! grep { (my $dir = $_) =~ s/\//-/g;
160		     $File::Find::name =~ /^$ext_dir\/$dir\// } @nonxs)
161	{
162	    my($path, $modname) = ($1,$2);
163
164	    # Change hyphenated name like Filter-Util-Call to nested
165	    # directory name Filter/Util/Call
166	    $path =~ s{-}{/}g;
167
168	    # strip to optional "/lib", or remove trailing component
169	    $path =~ s{.*/lib\b}{} or $path =~ s{/[^/]*$}{};
170
171	    # strip any leading /
172	    $path =~ s{^/}{};
173
174	    # reconstitute canonical module name
175	    $modname = "$path/$modname" if length $path;
176
177	    # remember it
178	    $archpms{$modname} = 1;
179	}
180    }, $ext_dir);
181}
182
183# print "[$_]\n" for sort keys %archpms;
184
185my $ver = $Config{version};
186my $release = substr($],0,3);   # Not used currently.
187my $patchlevel = substr($],3,2);
188die "Patchlevel of perl ($patchlevel)",
189    "and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n"
190	if $patchlevel != $Config{'PERL_VERSION'};
191
192# Fetch some frequently-used items from %Config
193my $installbin = "$opts{destdir}$Config{installbin}";
194my $installscript = "$opts{destdir}$Config{installscript}";
195my $installprivlib = "$opts{destdir}$Config{installprivlib}";
196my $installarchlib = "$opts{destdir}$Config{installarchlib}";
197my $installsitelib = "$opts{destdir}$Config{installsitelib}";
198my $installsitearch = "$opts{destdir}$Config{installsitearch}";
199my $installman1dir = "none";
200my $man1ext = $Config{man1ext};
201my $libperl = $Config{libperl};
202# Shared library and dynamic loading suffixes.
203my $so = $Config{so};
204my $dlext = $Config{dlext};
205my $dlsrc = $Config{dlsrc};
206if ($^O eq 'os390') {
207    my $pwd;
208    chomp($pwd=`pwd`);
209    my $archlibexp = $Config{archlibexp};
210    my $usedl = $Config{usedl};
211    if ($usedl eq 'define') {
212	`./$^X -pibak -e 's{$pwd\/libperl.x}{$archlibexp/CORE/libperl.x}' lib/Config.pm`;
213    }
214}
215
216if ($nwinstall) {
217    # This is required only if we are installing on a NetWare server
218    $installscript = $Config{installnwscripts};
219    $installprivlib = $Config{installnwlib};
220    $installarchlib = $Config{installnwlib};
221    $installsitelib = $Config{installnwlib};
222}
223
224my $binexp = $Config{binexp};
225
226if ($Is_VMS) {  # Hang in there until File::Spec hits the big time
227    foreach ( \$installbin,     \$installscript,  \$installprivlib,
228	      \$installarchlib, \$installsitelib, \$installsitearch,
229	      \$installman1dir ) {
230	$$_ = unixify($$_);  $$_ =~ s:/$::;
231    }
232}
233
234# Do some quick sanity checks.
235
236   $installbin		|| die "No installbin directory in config.sh\n";
237-d $installbin		|| mkpath($installbin, $opts{verbose}, 0777);
238-d $installbin		|| $opts{notify} || die "$installbin is not a directory\n";
239-w $installbin		|| $opts{notify} || die "$installbin is not writable by you\n"
240	unless $installbin =~ m#^/afs/# || $opts{notify};
241
242if (!$Is_NetWare) {
243if (!$Is_VMS) {
244-x 'perl' . $exe_ext	|| die "perl isn't executable!\n";
245}
246else {
247-x $ndbg . 'perl' . $exe_ext	|| die "${ndbg}perl$exe_ext isn't executable!\n";
248    if ($dbg) {
249        -x $dbg . 'perl' . $exe_ext	|| die "${dbg}perl$exe_ext isn't executable!\n";
250    }
251}
252
253#-f 't/rantests'		|| $Is_W32
254#			|| warn "WARNING: You've never run 'make test' or",
255#				" some tests failed! (Installing anyway.)\n";
256} #if (!$Is_NetWare)
257
258# This will be used to store the packlist
259$packlist = ExtUtils::Packlist->new("$installarchlib/.packlist");
260
261if (($Is_W32 and ! $Is_NetWare) or $Is_Cygwin) {
262    my $perldll;
263
264    if ($Is_Cygwin) {
265	$perldll = $libperl;
266    } else {
267	$perldll = 'perl5'.$Config{patchlevel}.'.'.$dlext;
268    }
269
270    if ($dlsrc ne "dl_none.xs") {
271	-f $perldll || die "No perl DLL built\n";
272    }
273
274    # Install the DLL
275    safe_unlink("$installbin/$perldll");
276    copy("$perldll", "$installbin/$perldll");
277    chmod(0755, "$installbin/$perldll");
278    $packlist->{"$installbin/$perldll"} = { type => 'file' };
279} # if (($Is_W32 and ! $Is_NetWare) or $Is_Cygwin)
280
281# Get the install command and flags from the environment
282my @installcmd = $ENV{"INSTALL"} || "install";
283push(@installcmd, $ENV{"INSTALL_COPY"} || "-c");
284
285# First we install the version-numbered executables.
286
287if ($Is_VMS) {
288    safe_unlink("$installbin/perl_setup.com");
289    copy("perl_setup.com", "$installbin/perl_setup.com");
290    chmod(0755, "$installbin/perl_setup.com");
291    safe_unlink("$installbin/$dbg$perl$exe_ext");
292    copy("$dbg$perl$exe_ext", "$installbin/$dbg$perl$exe_ext");
293    chmod(0755, "$installbin/$dbg$perl$exe_ext");
294    safe_unlink("$installbin/$dbg${perl}shr$exe_ext");
295    copy("$dbg${perl}shr$exe_ext", "$installbin/$dbg${perl}shr$exe_ext");
296    chmod(0755, "$installbin/$dbg${perl}shr$exe_ext");
297    if ($ndbg) {
298        safe_unlink("$installbin/$ndbg$perl$exe_ext");
299        copy("$ndbg$perl$exe_ext", "$installbin/$ndbg$perl$exe_ext");
300        chmod(0755, "$installbin/$ndbg$perl$exe_ext");
301	safe_unlink("$installbin/${dbg}a2p$exe_ext");
302	copy("x2p/${dbg}a2p$exe_ext", "$installbin/${dbg}a2p$exe_ext");
303	chmod(0755, "$installbin/${dbg}a2p$exe_ext");
304    }
305}
306elsif ($^O eq 'mpeix') {
307    # MPE lacks hard links and requires that executables with special
308    # capabilities reside in the MPE namespace.
309    safe_unlink("$installbin/perl$ver$exe_ext", $Config{perlpath});
310    # Install the primary executable into the MPE namespace as perlpath.
311    copy("perl$exe_ext", $Config{perlpath});
312    chmod(0755, $Config{perlpath});
313    # Create a backup copy with the version number.
314    link($Config{perlpath}, "$installbin/perl$ver$exe_ext");
315}
316elsif ($^O ne 'dos') {
317    if (!$Is_NetWare) {
318	install("perl$exe_ext", "$installbin/$perl_verbase$ver$exe_ext",
319	    "0755", $dostrip);
320    }
321    else {
322	# If installing onto a NetWare server
323	if ($nwinstall) {
324	    # Copy perl.nlm, echo.nlm, type.nlm, a2p.nlm & cgi2perl.nlm
325            mkpath($Config{installnwsystem}, $opts{verbose}, 0777);
326	    copy("netware\\".$ENV{'MAKE_TYPE'}."\\perl.nlm", $Config{installnwsystem});
327	    copy("netware\\testnlm\\echo\\echo.nlm", $Config{installnwsystem});
328	    copy("netware\\testnlm\\type\\type.nlm", $Config{installnwsystem});
329	    copy("x2p\\a2p.nlm", $Config{installnwsystem});
330	    chmod(0755, "$Config{installnwsystem}\\perl.nlm");
331            mkpath($Config{installnwlcgi}, $opts{verbose}, 0777);
332	    copy("lib\\auto\\cgi2perl\\cgi2perl.nlm", $Config{installnwlcgi});
333	}
334    } #if (!$Is_NetWare)
335}
336else {
337    safe_unlink("$installbin/$perl.exe");
338    copy("perl.exe", "$installbin/$perl.exe");
339}
340
341# Install library files.
342
343my $do_installarchlib = !samepath($installarchlib, 'lib');
344my $do_installprivlib = !samepath($installprivlib, 'lib');
345my $vershort = ($Is_Cygwin and !$Config{usedevel}) ? substr($ver,0,-2) : $ver;
346$do_installprivlib = 0 if $versiononly && !($installprivlib =~ m/\Q$vershort/);
347
348mkpath($installprivlib, $opts{verbose}, 0777);
349mkpath($installarchlib, $opts{verbose}, 0777);
350mkpath($installsitelib, $opts{verbose}, 0777) if ($installsitelib);
351mkpath($installsitearch, $opts{verbose}, 0777) if ($installsitearch);
352
353if (-d 'lib') {
354    find({no_chdir => 1, wanted => \&installlib}, 'lib')
355        if $do_installarchlib || $do_installprivlib;
356}
357else {
358    warn "Can't install lib files - 'lib/' does not exist";
359}
360
361# Install header files and libraries.
362mkpath("$installarchlib/CORE", $opts{verbose}, 0777);
363my @corefiles;
364if ($Is_VMS) {  # We did core file selection during build
365    my $coredir = "lib/$Config{archname}/$ver/CORE";
366    $coredir =~ tr/./_/;
367    map { s|^$coredir/||i; } @corefiles = <$coredir/*.*>;
368}
369elsif ($Is_Cygwin) { # On Cygwin symlink it to CORE to make Makefile happy
370    @corefiles = <*.h libperl*.* perl*$Config{lib_ext}>;
371    my $coredll = "$installarchlib/CORE/$libperl";
372    safe_unlink($coredll);
373    ( $Config{'d_link'} eq 'define' &&
374      eval {
375          CORE::link("$installbin/$libperl", $coredll);
376          $packlist->{$coredll} = { from => "$installbin/$libperl",
377                                    type => 'link' };
378      }
379    ) ||
380    eval {
381        symlink("$installbin/$libperl", $coredll);
382        $packlist->{$coredll} = { from => "$installbin/$libperl",
383                                  type => 'link' };
384    } ||
385    ( copy("$installbin/$libperl", $coredll) &&
386      push(@corefiles, $coredll)
387    )
388} else {
389    # [als] hard-coded 'libperl' name... not good!
390    #@corefiles = <*.h libperl*.* perl*$Config{lib_ext}>;
391    @corefiles = <*.h *.inc perl*$Config{lib_ext}>;
392    push(@corefiles,<libperl*.*>) unless defined($ENV{"NOLIBINSTALL"});
393
394    # AIX needs perl.exp installed as well.
395    push(@corefiles,'perl.exp') if $^O eq 'aix';
396    if ($^O eq 'mpeix') {
397	# MPE needs mpeixish.h installed as well.
398	mkpath("$installarchlib/CORE/mpeix", $opts{verbose}, 0777);
399	push(@corefiles,'mpeix/mpeixish.h');
400    }
401}
402foreach my $file (@corefiles) {
403    # HP-UX (at least) needs to maintain execute permissions
404    # on dynamically-loadable libraries. So we do it for all.
405    if (copy_if_diff($file,"$installarchlib/CORE/$file")) {
406	if ($file =~ /\.(\Q$so\E|\Q$dlext\E)$/) {
407	    strip("-S", "$installarchlib/CORE/$file") if $^O =~ /^(rhapsody|darwin)$/;
408	    chmod(0555, "$installarchlib/CORE/$file");
409	} else {
410	    chmod(0444, "$installarchlib/CORE/$file");
411	}
412    }
413}
414
415# Install main perl executables
416# Make links to ordinary names if installbin directory isn't current directory.
417
418if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS && ! $Is_NetWare) {
419    safe_unlink("$installbin/$perl$exe_ext", "$installbin/suid$perl$exe_ext");
420    if ($^O eq 'mpeix') {
421	# MPE doesn't support hard links, so use a symlink.
422	# We don't want another cloned copy.
423	symlink($Config{perlpath}, "$installbin/perl$exe_ext");
424    } elsif ($^O eq 'vos') {
425	# VOS doesn't support hard links, so use a symlink.
426	symlink("$installbin/$perl_verbase$ver$exe_ext",
427		"$installbin/$perl$exe_ext");
428    } else {
429	link("$installbin/$perl_verbase$ver$exe_ext",
430		"$installbin/$perl$exe_ext");
431    }
432}
433
434# For development purposes it can be very useful to have multiple perls
435# build for different "architectures" (eg threading or not) simultaneously.
436if ($archname && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS) {
437    my $archperl = "$perl_verbase$ver-$Config{archname}$exe_ext";
438    safe_unlink("$installbin/$archperl");
439    if ($^O eq 'mpeix') {
440	# MPE doesn't support hard links, so use a symlink.
441	# We don't want another cloned copy.
442	symlink($Config{perlpath}, "$installbin/$archperl");
443    } elsif ($^O eq 'vos') {
444	# VOS doesn't support hard links, so use a symlink.
445	symlink("$installbin/$perl_verbase$ver$exe_ext",
446		"$installbin/$archperl");
447    } else {
448	link("$installbin/$perl_verbase$ver$exe_ext", "$installbin/$archperl");
449    }
450}
451
452# Offer to install perl in a "standard" location
453
454my $mainperl_is_instperl = 0;
455
456if ($Config{installusrbinperl} && $Config{installusrbinperl} eq 'define' &&
457    !$versiononly && !$opts{notify} && !$Is_W32 && !$Is_NetWare && !$Is_VMS && -t STDIN && -t STDERR
458	&& -w $mainperldir && ! samepath($mainperldir, $installbin)) {
459    my($usrbinperl)	= "$mainperldir/$perl$exe_ext";
460    my($instperl)	= "$installbin/$perl$exe_ext";
461    my($expinstperl)	= "$binexp/$perl$exe_ext";
462
463    # First make sure $usrbinperl is not already the same as the perl we
464    # just installed.
465    if (-x $usrbinperl) {
466	# Try to be clever about mainperl being a symbolic link
467	# to binexp/perl if binexp and installbin are different.
468	$mainperl_is_instperl =
469	    samepath($usrbinperl, $instperl) ||
470	    samepath($usrbinperl, $expinstperl) ||
471	     (($binexp ne $installbin) &&
472	      (-l $usrbinperl) &&
473	      ((readlink $usrbinperl) eq $expinstperl));
474    }
475    if (! $mainperl_is_instperl) {
476	unlink($usrbinperl);
477	( $Config{'d_link'} eq 'define' &&
478	  eval { CORE::link $instperl, $usrbinperl } )	||
479	eval { symlink $expinstperl, $usrbinperl }	||
480	copy($instperl, $usrbinperl);
481
482	$mainperl_is_instperl = 1;
483    }
484}
485
486# Make links to ordinary names if installbin directory isn't current directory.
487if (!$Is_NetWare && $dbg eq '') {
488    if (! samepath($installbin, 'x2p')) {
489	my $base = 'a2p';
490	$base .= $ver if $versiononly;
491	safe_unlink("$installbin/$base$exe_ext");
492	copy("x2p/a2p$exe_ext", "$installbin/$base$exe_ext");
493	strip("$installbin/$base$exe_ext");
494	chmod(0755, "$installbin/$base$exe_ext");
495    }
496}
497
498# cppstdin is just a script, but it is architecture-dependent, so
499# it can't safely be shared.  Place it in $installbin.
500# Note that Configure doesn't build cppstin if it isn't needed, so
501# we skip this if cppstdin doesn't exist.
502if (! $versiononly && (-f 'cppstdin') && (! samepath($installbin, '.'))) {
503    safe_unlink("$installbin/cppstdin");
504    copy("cppstdin", "$installbin/cppstdin");
505    chmod(0755, "$installbin/cppstdin");
506}
507
508sub script_alias {
509    my ($installscript, $orig, $alias, $scr_ext) = @_;
510
511    safe_unlink("$installscript/$alias$scr_ext");
512    if ($^O eq 'dos' or $Is_VMS or $^O eq 'transit') {
513	copy("$installscript/$orig$scr_ext",
514	     "$installscript/$alias$scr_ext");
515    } elsif ($^O eq 'vos') {
516	symlink("$installscript/$orig$scr_ext",
517		"$installscript/$alias$scr_ext");
518    } else {
519	link("$installscript/$orig$scr_ext",
520	     "$installscript/$alias$scr_ext");
521    }
522}
523
524# Install scripts.
525mkpath($installscript, $opts{verbose}, 0777);
526if ($versiononly) {
527    for (@scripts) {
528	(my $base = $_) =~ s#.*/##;
529	$base .= $ver;
530	copy($_,    "$installscript/$base");
531	chmod(0755, "$installscript/$base");
532    }
533
534    for (@tolink) {
535	my ($from, $to) = map { "$_$ver" } @$_;
536	(my $frbase = $from) =~ s#.*/##;
537	(my $tobase = $to) =~ s#.*/##;
538	script_alias($installscript, $frbase, $tobase, $scr_ext);
539    }
540} else {
541    for (@scripts) {
542	(my $base = $_) =~ s#.*/##;
543	copy($_, "$installscript/$base");
544	chmod(0755, "$installscript/$base");
545    }
546
547    for (@tolink) {
548	my ($from, $to) = @$_;
549	(my $frbase = $from) =~ s#.*/##;
550	(my $tobase = $to) =~ s#.*/##;
551	script_alias($installscript, $frbase, $tobase, $scr_ext);
552    }
553}
554
555# Install pod pages.  Where? I guess in $installprivlib/pod
556# ($installprivlib/pods for cygwin).
557if (!$nopods && (!$versiononly || ($installprivlib =~ m/\Q$vershort/))) {
558    my $pod = ($Is_Cygwin || $Is_Darwin || $Is_VMS || $Is_W32) ? 'pods' : 'pod';
559    mkpath("${installprivlib}/$pod", $opts{verbose}, 0777);
560
561    for (map {$_->[1]} @{get_pod_metadata()->{master}}) {
562	# $_ is a name like  pod/perl.pod
563	(my $base = $_) =~ s#.*/##;
564	copy_if_diff($_, "${installprivlib}/$pod/${base}");
565	chmod(0644, "${installprivlib}/$pod/${base}");
566    }
567
568}
569
570# Check to make sure there aren't other perls around in installer's
571# path.  This is probably UNIX-specific.  Check all absolute directories
572# in the path except for where public executables are supposed to live.
573# Also skip $mainperl if the user opted to have it be a link to the
574# installed perl.
575
576if (!$versiononly && $otherperls) {
577    my ($path, @path);
578    my $dirsep = ($Is_OS2 || $Is_W32 || $Is_NetWare) ? ';' : ':' ;
579    ($path = $ENV{"PATH"}) =~ s:\\:/:g ;
580    @path = split(/$dirsep/, $path);
581    if ($Is_VMS) {
582	my $i = 0;
583	while (exists $ENV{'DCL$PATH' . $i}) {
584	    my $dir = unixpath($ENV{'DCL$PATH' . $i});  $dir =~ s-/$--;
585	    push(@path,$dir);
586	}
587    }
588    my @otherperls;
589    my %otherperls;
590    for (@path) {
591	next unless m,^/,;
592	# Use &samepath here because some systems have other dirs linked
593	# to $mainperldir (like SunOS)
594	next unless -d;
595	next if samepath($_, $binexp);
596	next if samepath($_, cwd());
597	next if ($mainperl_is_instperl && samepath($_, $mainperldir));
598	my $otherperl = "$_/$perl$exe_ext";
599	next if $otherperls{$otherperl}++;
600	push(@otherperls, $otherperl)
601	    if (-x $otherperl && ! -d $otherperl);
602    }
603    if (@otherperls) {
604	warn "\nWarning: $perl appears in your path in the following " .
605	    "locations beyond where\nwe just installed it:\n";
606	for (@otherperls) {
607	    warn "    ", $_, "\n";
608	}
609	warn "\n";
610    }
611
612}
613
614$packlist->write() unless $opts{notify};
615print "  Installation complete\n" if $opts{verbose};
616
617exit 0;
618
619###############################################################################
620
621# If these are needed elsewhere, move them into install_lib.pl rather than
622# copying them.
623
624sub yn {
625    my($prompt) = @_;
626    my($answer);
627    my($default) = $prompt =~ m/\[([yn])\]\s*$/i;
628    print STDERR $prompt;
629    chop($answer = <STDIN>);
630    $answer = $default if $answer =~ m/^\s*$/;
631    ($answer =~ m/^[yY]/);
632}
633
634sub safe_unlink {
635    return if $opts{notify} or $Is_VMS;
636    my @names = @_;
637    foreach my $name (@names) {
638	next unless -e $name;
639	chmod 0777, $name if ($Is_OS2 || $Is_W32 || $Is_NetWare);
640	print "  unlink $name\n" if $opts{verbose};
641	next if CORE::unlink($name);
642	warn "Couldn't unlink $name: $!\n";
643	if ($! =~ /busy/i) {
644	    print "  mv $name $name.old\n" if $opts{verbose};
645	    safe_rename($name, "$name.old")
646		or warn "Couldn't rename $name: $!\n";
647	}
648    }
649}
650
651sub safe_rename {
652    my($from,$to) = @_;
653    if (-f $to and not unlink($to)) {
654	my($i);
655	for ($i = 1; $i < 50; $i++) {
656	    last if rename($to, "$to.$i");
657	}
658	warn("Cannot rename to '$to.$i': $!"), return 0
659	   if $i >= 50;	# Give up!
660    }
661    link($from,$to) || return 0;
662    unlink($from);
663}
664
665sub copy {
666    my($from,$to) = @_;
667
668    my $xto = $to;
669    $xto =~ s/^\Q$opts{destdir}\E//;
670    print $opts{verbose} ? "  cp $from $xto\n" : "  $xto\n"
671	unless $opts{silent};
672    print "  creating new version of $xto\n"
673	if $Is_VMS and -e $to and !$opts{silent};
674    unless ($opts{notify} or File::Copy::copy($from, $to)) {
675	# Might have been that F::C::c can't overwrite the target
676	warn "Couldn't copy $from to $to: $!\n"
677	    unless -f $to and (chmod(0666, $to), unlink $to)
678		   and File::Copy::copy($from, $to);
679    }
680    $packlist->{$xto} = { type => 'file' };
681}
682
683sub install {
684    my($from,$to,$mode,$strip) = @_;
685
686    my $xto = $to;
687    my $cmd = join(' ', @installcmd);
688    $cmd .= " -m $mode" if $mode;
689    $cmd .= " -s" if $strip;
690    $cmd .= " $from $to";
691    $xto =~ s/^\Q$opts{destdir}\E// if $opts{destdir};
692    print $opts{verbose} ? "  install $from $xto\n" : "  $xto\n" unless $opts{silent};
693    system($cmd);
694    warn "Couldn't $cmd\n" if $?;
695    $packlist->{$xto} = { type => 'file' };
696}
697
698sub installlib {
699    my $dir = $File::Find::dir;
700    $dir =~ s!\Alib/?!!;
701
702    m!([^/]+)\z!;
703    my $name = $1;
704
705    # This remains ugly, and in need of refactoring.
706
707    # $name always starts as the leafname
708    # $dir is the directory *within* lib
709    # $name later has $dir pre-pended, to give the relative path in lib/
710    # which is used to create the path in the target directory.
711
712    # $_ was always the filename to use on disk. Adding no_chdir doesn't change
713    # this, as $_ becomes a pathname, and so still works. However, it's not
714    # obvious that $_ is needed later, and hence $_ must not be modified.
715
716    # Also, many of the regex exlusion tests below are now superfluous, as the
717    # files in question are either no longer in blead, or now in ext/, dist/ or
718    # cpan/ and not copied into lib/
719
720    # Ignore version control directories.
721    if ($name =~ /^(?:CVS|RCS|SCCS|\.svn)\z/ and -d $name) {
722	$File::Find::prune = 1;
723	return;
724    }
725
726    # ignore patch backups, RCS files, emacs backup & temp files and the
727    # .exists files, .PL files, and test files.
728    return if $name =~ m{\.orig$|\.rej$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.plc$|\.t$|^test\.pl$|^dbm_filter_util\.pl$|^filter-util\.pl$|^uupacktool\.pl$|^\.gitignore$} ||
729	      $dir  =~ m{/t(?:/|$)};
730    # ignore the cpan script in lib/CPAN/bin, the instmodsh and xsubpp
731    # scripts in lib/ExtUtils, the prove script in lib/Test/Harness,
732    # the corelist script from lib/Module/CoreList/bin and ptar* in
733    # lib/Archive/Tar/bin, the config_data script in lib/Module/Build/scripts
734    # and zipdetails in cpan/IO-Compress/bin
735    # (they're installed later with other utils)
736    return if $name =~ /^(?:cpan|instmodsh|prove|corelist|ptar|cpan2dist|cpanp|cpanp-run-perl|ptardiff|ptargrep|config_data|zipdetails)\z/;
737    # ignore the Makefiles
738    return if $name =~ /^makefile$/i;
739    # ignore the test extensions
740    return if $dir =~ m{\bXS/(?:APItest|Typemap)\b};
741    return if $name =~ m{\b(?:APItest|Typemap)\.pm$};
742    # ignore the build support code
743    return if $name =~ /\bbuildcustomize\.pl$/;
744    # ignore the demo files
745    return if $dir =~ /\b(?:demos?|eg)\b/;
746    # ignore unneeded unicore files
747    if ( $dir =~ /^unicore/ ) {
748      if ( $name =~ /\.txt\z/ ) {
749        # We can ignore most, but not all .txt files
750        return unless $name =~ /\A(?:Blocks|CaseFolding|SpecialCasing|NamedSequences)\.txt\z/;
751      }
752      else {
753        # TestProp only needed during testing
754        return if $name =~ /\ATestProp.pl\z/;
755        # we need version and *.pl files and can skip the rest
756        return unless $name =~ /\A(?:version|\w+\.p[lm])\z/;
757      }
758    }
759
760    # ignore READMEs, MANIFESTs, INSTALL docs, META.ymls and change logs.
761    # Changes.e2x and README.e2x are needed by enc2xs.
762    return if $name =~ m{^(?:README(?:\.\w+)?)$} && $name ne 'README.e2x';
763    return if $name =~ m{^(?:MANIFEST|META\.yml)$};
764    return if $name =~ m{^(?:INSTALL|TODO|BUGS|CREDITS)$}i;
765    return if $name =~ m{^change(?:s|log)(?:\.libnet)?$}i;
766    return if $name =~ m{^(?:SIGNATURE|PAUSE200\d\.pub)$}; # CPAN files
767    return if $name =~ m{^(?:NOTES|PATCHING)$}; # ExtUtils files
768
769    # if using a shared perl library then ignore:
770    # - static library files [of statically linked extensions];
771    # - import library files and export library files (only present on Win32
772    #   anyway?) and empty bootstrap files [of dynamically linked extensions].
773    return if $Config{useshrplib} eq 'true' and
774             ($name =~ /$Config{_a}$/ or $name =~ /\.exp$/ or ($name =~ /\.bs$/ and -z $name));
775
776    $name = "$dir/$name" if $dir ne '';
777
778    # ignore pods that are stand alone documentation from dual life modules.
779    return if /\.pod\z/ && is_duplicate_pod($_);
780
781    return if $name eq 'ExtUtils/XSSymSet.pm' and !$Is_VMS;
782
783    my $installlib = $installprivlib;
784    if ($dir =~ /^auto\// ||
785	  ($name =~ /^(.*)\.(?:pm|pod)$/ && $archpms{$1}) ||
786	  ($name =~ /^(.*)\.(?:h|lib)$/i && ($Is_W32 || $Is_NetWare)) ||
787	  $name=~/^Config_(heavy|git)\.pl\z/
788       ) {
789	$installlib = $installarchlib;
790	return unless $do_installarchlib;
791    } else {
792	return unless $do_installprivlib;
793    }
794
795    if ($Is_NetWare && !$nwinstall && /\.(?:nlp|nlm|bs)$/) {
796        # Don't copy .nlp,.nlm files, doesn't make sense on Windows and also
797        # if copied will give problems when building new extensions.
798        # Has to be copied if we are installing on a NetWare server and
799        # hence the check !$nwinstall
800        return;
801    }
802
803    if (-f $_) {
804	if (/\.(?:al|ix)$/ && !($dir =~ m[^auto/(.*)$])) {
805	    $installlib = $installprivlib;
806	    #We're installing *.al and *.ix files into $installprivlib,
807	    #but we have to delete old *.al and *.ix files from the 5.000
808	    #distribution:
809	    #This might not work because $archname might have changed.
810	    unlink("$installarchlib/$name");
811	}
812	my $xname = "$installlib/$name";
813	$xname =~ s/^\Q$opts{destdir}\E//;
814	$packlist->{$xname} = { type => 'file' };
815	if ($force || compare($_, "$installlib/$name") || $opts{notify}) {
816	    unlink("$installlib/$name");
817	    mkpath("$installlib/$dir", $opts{verbose}, 0777);
818	    # HP-UX (at least) needs to maintain execute permissions
819	    # on dynamically-loaded libraries.
820            if (copy_if_diff($_, "$installlib/$name")) {
821                strip("-S", "$installlib/$name")
822                    if $^O =~ /^(rhapsody|darwin)$/ and /\.(?:so|$dlext|a)$/;
823                chmod(/\.(so|$dlext)$/ ? 0555 : 0444, "$installlib/$name");
824            }
825	}
826    }
827}
828
829# Copy $from to $to, only if $from is different than $to.
830# Also preserve modification times for .a libraries.
831# On some systems, if you do
832#   ranlib libperl.a
833#   cp libperl.a /usr/local/lib/perl5/archlib/CORE/libperl.a
834# and then try to link against the installed libperl.a, you might
835# get an error message to the effect that the symbol table is older
836# than the library.
837# Return true if copying occurred.
838
839sub copy_if_diff {
840    my($from,$to)=@_;
841    return 1 if (($^O eq 'VMS') && (-d $from));
842    my $xto = $to;
843    $xto =~ s/^\Q$opts{destdir}\E//;
844    my $perlpodbadsymlink;
845    if ($from =~ m!^pod/perl[\w-]+\.pod$! &&
846	-l $from &&
847	! -e $from) {
848	# Some Linux implementations have problems traversing over
849	# multiple symlinks (when going over NFS?) and fail to read
850	# the symlink target.  Combine this with the fact that some
851	# of the pod files (the perl$OS.pod) are symlinks (to ../README.$OS),
852	# and you end up with those pods not getting installed.
853	$perlpodbadsymlink = 1;
854    }
855    -f $from || $perlpodbadsymlink || warn "$0: $from not found";
856    $packlist->{$xto} = { type => 'file' };
857    if ($force || compare($from, $to) || $opts{notify}) {
858	safe_unlink($to);   # In case we don't have write permissions.
859	if ($perlpodbadsymlink && $from =~ m!^pod/perl(.+)\.pod$!) {
860	    $from = "README.$1";
861	}
862	copy($from, $to);
863	# Restore timestamps if it's a .a library or for OS/2.
864	if (!$opts{notify} && ($Is_OS2 || $to =~ /\.a$/)) {
865	    my ($atime, $mtime) = (stat $from)[8,9];
866	    utime $atime, $mtime, $to;
867	}
868	1;
869    }
870}
871
872sub strip
873{
874    my(@args) = @_;
875
876    return unless $dostrip;
877
878    my @opts;
879    while (@args && $args[0] =~ /^(-\w+)$/) {
880	push @opts, shift @args;
881    }
882
883    foreach my $file (@args) {
884	if (-f $file) {
885	    if ($opts{verbose}) {
886		print "  strip " . join(' ', @opts);
887		print " " if (@opts);
888		print "$file\n";
889	    }
890	    system("strip", @opts, $file);
891	} else {
892	    print "# file '$file' skipped\n" if $opts{verbose};
893	}
894    }
895}
896
897# Local variables:
898# cperl-indent-level: 4
899# indent-tabs-mode: nil
900# End:
901#
902# ex: set ts=8 sts=4 sw=4 et:
903