This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Split out S_refcounted_he_new_common() from
[perl5.git] / installperl
index 9eaad73..b89990b 100755 (executable)
@@ -2,11 +2,36 @@
 
 BEGIN {
     require 5.004;
-    chdir '..' if !-d 'lib' and -d '..\lib';
+    chdir '..' if !-d 'lib' and -d '../lib';
     @INC = 'lib';
     $ENV{PERL5LIB} = 'lib';
 }
 
+BEGIN {
+    use Config;
+    if ($Config{userelocatableinc}) {
+       # This might be a considered a hack. Need to get information about the
+       # configuration from Config.pm *before* Config.pm expands any .../
+       # prefixes.
+       #
+       # So we set $^X to pretend that we're the already installed perl, so
+       # Config.pm doesits ... expansion off that location.
+
+       my $location = $Config{initialinstalllocation};
+       die <<'OS' unless defined $location;
+$Config{initialinstalllocation} is not defined - can't install a relocatable
+perl without this.
+OS
+       $^X = "$location/perl";
+       # And then remove all trace of ever having loaded Config.pm, so that
+       # it will reload with the revised $^X
+       undef %Config::;
+       delete $INC{"Config.pm"};
+       delete $INC{"Config_heavy.pl"};
+       # You never saw us. We weren't here.
+    }
+}
+
 use strict;
 my ($Is_VMS, $Is_W32, $Is_OS2, $Is_Cygwin, $Is_Darwin,
     $nonono, $dostrip, $versiononly, $silent, $verbose, $force,
@@ -29,6 +54,7 @@ use File::Compare;
 use File::Copy ();
 use File::Path ();
 use ExtUtils::Packlist;
+use Cwd;
 use Config;
 use subs qw(unlink link chmod);
 
@@ -60,8 +86,19 @@ my $perl = defined($ENV{PERLNAME}) ? $ENV{PERLNAME} : 'perl';
 my $perl_verbase = defined($ENV{PERLNAME_VERBASE})
                    ? $ENV{PERLNAME_VERBASE}
                    : $perl;
+my $dbg = '';
+my $ndbg = '';
+if ( $Is_VMS ) {
+    if ( defined $Config{usevmsdebug} ) {
+        if ( $Config{usevmsdebug} eq 'define' ) {
+            $dbg = 'dbg';
+            $ndbg = 'ndbg';
+        }
+    }
+}
 
 $otherperls = 1;
+my $destdir = '';
 while (@ARGV) {
     $nonono = 1 if $ARGV[0] eq '-n';
     $dostrip = 1 if $ARGV[0] eq '-s';
@@ -74,6 +111,7 @@ while (@ARGV) {
     $archname = 1 if $ARGV[0] eq '-A';
     $nwinstall = 1 if $ARGV[0] eq '-netware';
     $nopods = 1 if $ARGV[0] eq '-p';
+    $destdir = $1 if $ARGV[0] =~ /^-?-destdir=(.*)$/;
     if ($ARGV[0] eq '-?' or $ARGV[0] =~ /^-?-h/) {
        print <<"EOT";
 Usage $0: [switches]
@@ -91,6 +129,7 @@ Usage $0: [switches]
             name.
   -p        Don't install the pod files. [This will break use diagnostics;]
   -netware  Install correctly on a Netware server.
+  -destdir  Prefix installation directories by this string.
 EOT
        exit;
     }
@@ -102,7 +141,8 @@ my (@scripts, @tolink);
 open SCRIPTS, "utils.lst" or die "Can't open utils.lst: $!";
 while (<SCRIPTS>) {
     next if /^#/;
-    next if /#\s*pod\s*=/; # The pods are provided separately
+    s/\s*#\s*pod\s*=.*//; # install script regardless of pod location
+    next if /a2p/; # a2p is binary, to be installed separately
     chomp;
     if (/(\S*)\s*#\s*link\s*=\s*(\S*)/) {
        push @scripts, $1;
@@ -115,7 +155,7 @@ close SCRIPTS;
 
 if ($scr_ext) { @scripts = map { "$_$scr_ext" } @scripts; }
 
-my @pods = $nopods ? () : (<pod/*.pod>);
+my @pods = $nopods ? () : (<pod/*.pod>, 'x2p/a2p.pod');
 
 # Specify here any .pm files that are actually architecture-dependent.
 # (Those included with XS extensions under ext/ are automatically
@@ -142,11 +182,8 @@ find(sub {
     if ("$File::Find::dir/$_" =~ m{^ext\b(.*)/([^/]+)\.pm$}) {
        my($path, $modname) = ($1,$2);
 
-       # strip trailing component first
-       $path =~ s{/[^/]*$}{};
-
-       # strip optional "/lib";
-       $path =~ s{/lib\b}{};
+       # strip to optional "/lib", or remove trailing component
+       $path =~ s{.*/lib\b}{} or $path =~ s{/[^/]*$}{};
 
        # strip any leading /
        $path =~ s{^/}{};
@@ -169,13 +206,13 @@ die "Patchlevel of perl ($patchlevel)",
        if $patchlevel != $Config{'PERL_VERSION'};
 
 # Fetch some frequently-used items from %Config
-my $installbin = $Config{installbin};
-my $installscript = $Config{installscript};
-my $installprivlib = $Config{installprivlib};
-my $installarchlib = $Config{installarchlib};
-my $installsitelib = $Config{installsitelib};
-my $installsitearch = $Config{installsitearch};
-my $installman1dir = $Config{installman1dir};
+my $installbin = "$destdir$Config{installbin}";
+my $installscript = "$destdir$Config{installscript}";
+my $installprivlib = "$destdir$Config{installprivlib}";
+my $installarchlib = "$destdir$Config{installarchlib}";
+my $installsitelib = "$destdir$Config{installsitelib}";
+my $installsitearch = "$destdir$Config{installsitearch}";
+my $installman1dir = "$destdir$Config{installman1dir}";
 my $man1ext = $Config{man1ext};
 my $libperl = $Config{libperl};
 # Shared library and dynamic loading suffixes.
@@ -222,7 +259,15 @@ if (!$nonono && $d_dosuid && $>) { die "You must run as root to install suidperl
        unless $installbin =~ m#^/afs/# || $nonono;
 
 if (!$Is_NetWare) {
+if (!$Is_VMS) {
 -x 'perl' . $exe_ext   || die "perl isn't executable!\n";
+}
+else {
+-x $ndbg . 'perl' . $exe_ext   || die "${ndbg}perl$exe_ext isn't executable!\n";
+    if ($dbg) {
+        -x $dbg . 'perl' . $exe_ext    || die "${dbg}perl$exe_ext isn't executable!\n";
+    }
+}
 -x 'suidperl' . $exe_ext|| die "suidperl isn't executable!\n" if $d_dosuid;
 
 -f 't/rantests'                || $Is_W32
@@ -230,46 +275,19 @@ if (!$Is_NetWare) {
                                " some tests failed! (Installing anyway.)\n";
 } #if (!$Is_NetWare)
 
+# This will be used to store the packlist
+my $packlist = ExtUtils::Packlist->new("$installarchlib/.packlist");
+
 if (($Is_W32 and ! $Is_NetWare) or $Is_Cygwin) {
     my $perldll;
 
     if ($Is_Cygwin) {
        $perldll = $libperl;
-       my $v_e_r_s = $ver; $v_e_r_s =~ tr/./_/;
+       my $v_e_r_s = substr($ver,0,-2); $v_e_r_s =~ tr/./_/;
        $perldll =~ s/(\..*)?$/$v_e_r_s.$dlext/;
        $perldll =~ s/^lib/cyg/;
-       if ($Config{useshrplib} eq 'true') {
-           # install ld2 and perlld as well
-           foreach ('ld2', 'perlld') {
-               safe_unlink("$installbin/$_");
-               copy("$_", "$installbin/$_");
-               chmod(0755, "$installbin/$_");
-           };
-           open (LD2, ">$installbin/ld2");
-           print LD2 <<SHELL;
-#!/bin/sh
-#
-# ld wrapper, passes all args to perlld;
-#
-for trythis in $installbin/perl
-do
-  if [ -x \$trythis ]
-  then
-    \$trythis $installbin/perlld "\$\@"
-    exit \$?
-  fi
-done
-# hard luck!
-echo I see no perl executable around there
-echo perl is required to build dynamic libraries
-echo look if the path to perl in /bin/ld2 is correct
-exit 1
-SHELL
-           close LD2;
-           chmod(0755, "$installbin/ld2");
-       };
     } else {
-       $perldll = 'perl59.' . $dlext;
+       $perldll = 'perl511.' . $dlext;
     }
 
     if ($dlsrc ne "dl_none.xs") {
@@ -280,20 +298,29 @@ SHELL
     safe_unlink("$installbin/$perldll");
     copy("$perldll", "$installbin/$perldll");
     chmod(0755, "$installbin/$perldll");
+    $packlist->{"$installbin/$perldll"} = { type => 'file' };
 } # if (($Is_W32 and ! $Is_NetWare) or $Is_Cygwin)
 
-# This will be used to store the packlist
-my $packlist = ExtUtils::Packlist->new("$installarchlib/.packlist");
-
 # First we install the version-numbered executables.
 
 if ($Is_VMS) {
-    safe_unlink("$installbin/$perl$exe_ext");
-    copy("perl$exe_ext", "$installbin/$perl$exe_ext");
-    chmod(0755, "$installbin/$perl$exe_ext");
-    safe_unlink("$installbin/${perl}shr$exe_ext");
-    copy("perlshr$exe_ext", "$installbin/${perl}shr$exe_ext");
-    chmod(0755, "$installbin/${perl}shr$exe_ext");
+    safe_unlink("$installbin/perl_setup.com");
+    copy("perl_setup.com", "$installbin/perl_setup.com");
+    chmod(0755, "$installbin/perl_setup.com");
+    safe_unlink("$installbin/$dbg$perl$exe_ext");
+    copy("$dbg$perl$exe_ext", "$installbin/$dbg$perl$exe_ext");
+    chmod(0755, "$installbin/$dbg$perl$exe_ext");
+    safe_unlink("$installbin/$dbg${perl}shr$exe_ext");
+    copy("$dbg${perl}shr$exe_ext", "$installbin/$dbg${perl}shr$exe_ext");
+    chmod(0755, "$installbin/$dbg${perl}shr$exe_ext");
+    if ($ndbg) {
+        safe_unlink("$installbin/$ndbg$perl$exe_ext");
+        copy("$ndbg$perl$exe_ext", "$installbin/$ndbg$perl$exe_ext");
+        chmod(0755, "$installbin/$ndbg$perl$exe_ext");
+       safe_unlink("$installbin/${dbg}a2p$exe_ext");
+       copy("x2p/${dbg}a2p$exe_ext", "$installbin/${dbg}a2p$exe_ext");
+       chmod(0755, "$installbin/${dbg}a2p$exe_ext");
+    }
 }
 elsif ($^O eq 'mpeix') {
     # MPE lacks hard links and requires that executables with special
@@ -341,6 +368,7 @@ if ($d_dosuid) {
 # Install library files.
 
 my ($do_installarchlib, $do_installprivlib) = (0, 0);
+my $vershort = $Is_Cygwin ? substr($ver,0,-2) : $ver;
 
 mkpath($installprivlib, $verbose, 0777);
 mkpath($installarchlib, $verbose, 0777);
@@ -350,7 +378,7 @@ mkpath($installsitearch, $verbose, 0777) if ($installsitearch);
 if (chdir "lib") {
     $do_installarchlib = ! samepath($installarchlib, '.');
     $do_installprivlib = ! samepath($installprivlib, '.');
-    $do_installprivlib = 0 if $versiononly && !($installprivlib =~ m/\Q$ver/);
+    $do_installprivlib = 0 if $versiononly && !($installprivlib =~ m/\Q$vershort/);
 
     if ($do_installarchlib || $do_installprivlib) {
        find(\&installlib, '.');
@@ -371,7 +399,7 @@ if ($Is_VMS) {  # We did core file selection during build
 }
 else {
     # [als] hard-coded 'libperl' name... not good!
-    @corefiles = <*.h libperl*.*>;
+    @corefiles = <*.h libperl*.* perl*$Config{lib_ext}>;
 
     # AIX needs perl.exp installed as well.
     push(@corefiles,'perl.exp') if $^O eq 'aix';
@@ -413,7 +441,7 @@ if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VM
        link("$installbin/$perl_verbase$ver$exe_ext",
                "$installbin/$perl$exe_ext");
     }
-    link("$installbin/s$perl_verbase$ver$exe_ext",
+    link("$installbin/$perl_verbase$ver$exe_ext",
            "$installbin/suid$perl$exe_ext")
       if $d_dosuid;
 }
@@ -471,7 +499,7 @@ if ($Config{installusrbinperl} && $Config{installusrbinperl} eq 'define' &&
 }
 
 # Make links to ordinary names if installbin directory isn't current directory.
-if (!$Is_NetWare) {
+if (!$Is_NetWare && $dbg eq '') {
     if (! samepath($installbin, 'x2p')) {
        my $base = 'a2p';
        $base .= $ver if $versiononly;
@@ -542,8 +570,8 @@ if ($versiononly) {
 # Install pod pages.  Where? I guess in $installprivlib/pod
 # ($installprivlib/pods for cygwin).
 
-my $pod = ($Is_Cygwin || $Is_Darwin) ? 'pods' : 'pod';
-if ( !$versiononly || ($installprivlib =~ m/\Q$ver/)) {
+my $pod = ($Is_Cygwin || $Is_Darwin || $Is_VMS || $Is_W32) ? 'pods' : 'pod';
+if ( !$versiononly || ($installprivlib =~ m/\Q$vershort/)) {
     mkpath("${installprivlib}/$pod", $verbose, 0777);
 
     # If Perl 5.003's perldiag.pod is there, rename it.
@@ -594,6 +622,7 @@ if (!$versiononly && $otherperls) {
        # Use &samepath here because some systems have other dirs linked
        # to $mainperldir (like SunOS)
        next if samepath($_, $binexp);
+       next if samepath($_, cwd());
        next if ($mainperl_is_instperl && samepath($_, $mainperldir));
        my $otherperl = "$_/$perl$exe_ext";
        next if $otherperls{$otherperl}++;
@@ -679,7 +708,11 @@ sub link {
     my($from,$to) = @_;
     my($success) = 0;
 
-    print $verbose ? "  ln $from $to\n" : "  $to\n" unless $silent;
+    my $xfrom = $from;
+    $xfrom =~ s/^\Q$destdir\E// if $destdir;
+    my $xto = $to;
+    $xto =~ s/^\Q$destdir\E// if $destdir;
+    print $verbose ? "  ln $xfrom $xto\n" : "  $xto\n" unless $silent;
     eval {
        CORE::link($from, $to)
            ? $success++
@@ -687,18 +720,20 @@ sub link {
              ? die "AFS"  # okay inside eval {}
              : die "Couldn't link $from to $to: $!\n"
          unless $nonono;
-       $packlist->{$to} = { from => $from, type => 'link' };
+       $packlist->{$xto} = { from => $xfrom, type => 'link' };
     };
     if ($@) {
-       warn $@;
-       print $verbose ? "  cp $from $to\n" : "  $to\n" unless $silent;
-       print "  creating new version of $to\n"
+       warn "Replacing link() with File::Copy::copy(): $@";
+       print $verbose ? "  cp $from $xto\n" : "  $xto\n" unless $silent;
+       print "  creating new version of $xto\n"
                 if $Is_VMS and -e $to and !$silent;
-       File::Copy::copy($from, $to)
-           ? $success++
-           : warn "Couldn't copy $from to $to: $!\n"
-         unless $nonono;
-       $packlist->{$to} = { type => 'file' };
+       unless ($nonono or File::Copy::copy($from, $to) and ++$success) {
+           # Might have been that F::C::c can't overwrite the target
+           warn "Couldn't copy $from to $to: $!\n"
+               unless -f $to and (chmod(0666, $to), unlink $to)
+                       and File::Copy::copy($from, $to) and ++$success;
+       }
+       $packlist->{$xto} = { type => 'file' };
     }
     $success;
 }
@@ -716,12 +751,17 @@ sub chmod {
 sub copy {
     my($from,$to) = @_;
 
-    print $verbose ? "  cp $from $to\n" : "  $to\n" unless $silent;
-    print "  creating new version of $to\n" if $Is_VMS and -e $to and !$silent;
-    File::Copy::copy($from, $to)
-       || warn "Couldn't copy $from to $to: $!\n"
-      unless $nonono;
-    $packlist->{$to} = { type => 'file' };
+    my $xto = $to;
+    $xto =~ s/^\Q$destdir\E// if $destdir;
+    print $verbose ? "  cp $from $xto\n" : "  $xto\n" unless $silent;
+    print "  creating new version of $xto\n" if $Is_VMS and -e $to and !$silent;
+    unless ($nonono or File::Copy::copy($from, $to)) {
+       # Might have been that F::C::c can't overwrite the target
+       warn "Couldn't copy $from to $to: $!\n"
+           unless -f $to and (chmod(0666, $to), unlink $to)
+                  and File::Copy::copy($from, $to);
+    }
+    $packlist->{$xto} = { type => 'file' };
 }
 
 sub samepath {
@@ -748,26 +788,52 @@ sub installlib {
     my $name = $_;
 
     # Ignore version control directories.
-    if (($name eq 'CVS' or $name eq 'RCS' or $name eq '.svn') and -d $name) {
+    if ($name =~ /^(?:CVS|RCS|SCCS|\.svn)\z/ and -d $name) {
        $File::Find::prune = 1;
        return;
     }
 
     # ignore patch backups, RCS files, emacs backup & temp files and the
     # .exists files, .PL files, and test files.
-    return if $name =~ m{\.orig$|\.rej$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.t$|^test\.pl$} ||
+    return if $name =~ m{\.orig$|\.rej$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.plc$|\.t$|^test\.pl$|^dbm_filter_util.pl$} ||
              $dir  =~ m{/t(?:/|$)};
-    # ignore the cpan script in lib/CPAN/bin (installed later with other utils)
-    return if $name eq 'cpan';
+    # ignore the cpan script in lib/CPAN/bin, the instmodsh and xsubpp
+    # scripts in lib/ExtUtils, the prove script in lib/Test/Harness,
+    # the corelist script from lib/Module/CoreList/bin and ptar* in
+    # lib/Archive/Tar/bin, the config_data script in lib/Module/Build/scripts
+    # (they're installed later with other utils)
+    return if $name =~ /^(?:cpan|instmodsh|prove|corelist|ptar|cpan2dist|cpanp|cpanp-run-perl|ptardiff|config_data)\z/;
+    # ignore the Makefiles
+    return if $name =~ /^makefile$/i;
     # ignore the test extensions
-    return if $dir =~ m{ext/XS/(?:APItest|Typemap)/};
+    return if $dir =~ m{\bXS/(?:APItest|Typemap)\b};
+    return if $name =~ m{\b(?:APItest|Typemap)\.pm$};
+    # ignore the demo files
+    return if $dir =~ /\b(?:demos?|eg)\b/;
+
+    # ignore READMEs, MANIFESTs, INSTALL docs, META.ymls and change logs.
+    # Changes.e2x and README.e2x are needed by enc2xs.
+    return if $name =~ m{^(?:README(?:\.\w+)?)$} && $name ne 'README.e2x';
+    return if $name =~ m{^(?:MANIFEST|META\.yml)$};
+    return if $name =~ m{^(?:INSTALL|TODO|BUGS|CREDITS)$}i;
+    return if $name =~ m{^change(?:s|log)(?:\.libnet)?$}i;
+    return if $name =~ m{^(?:SIGNATURE|PAUSE200\d\.pub)$}; # CPAN files
+    return if $name =~ m{^(?:NOTES|PATCHING)$}; # ExtUtils files
+
+    # if using a shared perl library then ignore:
+    # - static library files [of statically linked extensions];
+    # - import library files and export library files (only present on Win32
+    #   anyway?) and empty bootstrap files [of dynamically linked extensions].
+    return if $Config{useshrplib} eq 'true' and
+             ($name =~ /$Config{_a}$/ or $name =~ /\.exp$/ or ($name =~ /\.bs$/ and -z $name));
 
     $name = "$dir/$name" if $dir ne '';
 
     my $installlib = $installprivlib;
     if ($dir =~ /^auto/ ||
          ($name =~ /^(.*)\.(?:pm|pod)$/ && $archpms{$1}) ||
-         ($name =~ /^(.*)\.(?:h|lib)$/i && ($Is_W32 || $Is_NetWare))
+         ($name =~ /^(.*)\.(?:h|lib)$/i && ($Is_W32 || $Is_NetWare)) ||
+         $name eq 'Config_heavy.pl'
        ) {
        $installlib = $installarchlib;
        return unless $do_installarchlib;
@@ -776,7 +842,7 @@ sub installlib {
     }
 
     if (-f $_) {
-       if (/\.(?:al|ix)$/ && !($dir =~ m[^auto/(.*)$] && $archpms{$1})) {
+       if (/\.(?:al|ix)$/ && !($dir =~ m[^auto/(.*)$])) {
            $installlib = $installprivlib;
            #We're installing *.al and *.ix files into $installprivlib,
            #but we have to delete old *.al and *.ix files from the 5.000
@@ -784,7 +850,9 @@ sub installlib {
            #This might not work because $archname might have changed.
            unlink("$installarchlib/$name");
        }
-       $packlist->{"$installlib/$name"} = { type => 'file' };
+       my $xname = "$installlib/$name";
+       $xname =~ s/^\Q$destdir\E// if $destdir;
+       $packlist->{$xname} = { type => 'file' };
        if ($force || compare($_, "$installlib/$name") || $nonono) {
            unlink("$installlib/$name");
            mkpath("$installlib/$dir", $verbose, 0777);
@@ -829,6 +897,8 @@ sub installlib {
 sub copy_if_diff {
     my($from,$to)=@_;
     return 1 if (($^O eq 'VMS') && (-d $from));
+    my $xto = $to;
+    $xto =~ s/^\Q$destdir\E// if $destdir;
     my $perlpodbadsymlink;
     if ($from =~ m!^pod/perl[\w-]+\.pod$! &&
        -l $from &&
@@ -841,7 +911,7 @@ sub copy_if_diff {
        $perlpodbadsymlink = 1;
     }
     -f $from || $perlpodbadsymlink || warn "$0: $from not found";
-    $packlist->{$to} = { type => 'file' };
+    $packlist->{$xto} = { type => 'file' };
     if ($force || compare($from, $to) || $nonono) {
        safe_unlink($to);   # In case we don't have write permissions.
        if ($nonono) {