| 1 | #!./perl | 
|---|
| 2 |  | 
|---|
| 3 | BEGIN { | 
|---|
| 4 | require 5.004; | 
|---|
| 5 | chdir '..' if !-d 'lib' and -d '../lib'; | 
|---|
| 6 | @INC = 'lib'; | 
|---|
| 7 | $ENV{PERL5LIB} = 'lib'; | 
|---|
| 8 | } | 
|---|
| 9 |  | 
|---|
| 10 | use strict; | 
|---|
| 11 | my ($Is_VMS, $Is_W32, $Is_OS2, $Is_Cygwin, $Is_Darwin, | 
|---|
| 12 | $nonono, $dostrip, $versiononly, $silent, $verbose, $force, | 
|---|
| 13 | $otherperls, $archname, $Is_NetWare, $nwinstall, $nopods); | 
|---|
| 14 | use vars qw /$depth/; | 
|---|
| 15 |  | 
|---|
| 16 | BEGIN { | 
|---|
| 17 | $Is_VMS = $^O eq 'VMS'; | 
|---|
| 18 | $Is_W32 = $^O eq 'MSWin32'; | 
|---|
| 19 | $Is_OS2 = $^O eq 'os2'; | 
|---|
| 20 | $Is_Cygwin = $^O eq 'cygwin'; | 
|---|
| 21 | $Is_Darwin = $^O eq 'darwin'; | 
|---|
| 22 | if ($Is_VMS) { eval 'use VMS::Filespec;' } | 
|---|
| 23 | } | 
|---|
| 24 |  | 
|---|
| 25 | my $scr_ext = ($Is_VMS ? '.Com' : $Is_W32 ? '.bat' : ''); | 
|---|
| 26 |  | 
|---|
| 27 | use File::Find; | 
|---|
| 28 | use File::Compare; | 
|---|
| 29 | use File::Copy (); | 
|---|
| 30 | use File::Path (); | 
|---|
| 31 | use ExtUtils::Packlist; | 
|---|
| 32 | use Config; | 
|---|
| 33 | use subs qw(unlink link chmod); | 
|---|
| 34 |  | 
|---|
| 35 | if ($Config{d_umask}) { | 
|---|
| 36 | umask(022); # umasks like 077 aren't that useful for installations | 
|---|
| 37 | } | 
|---|
| 38 |  | 
|---|
| 39 | $Is_NetWare = $Config{osname} eq 'NetWare'; | 
|---|
| 40 | if ($Is_NetWare) { | 
|---|
| 41 | $Is_W32 = 0; | 
|---|
| 42 | $scr_ext = '.pl'; | 
|---|
| 43 | } | 
|---|
| 44 |  | 
|---|
| 45 | # override the ones in the rest of the script | 
|---|
| 46 | sub mkpath { | 
|---|
| 47 | File::Path::mkpath(@_) unless $nonono; | 
|---|
| 48 | } | 
|---|
| 49 |  | 
|---|
| 50 | my $mainperldir = "/usr/bin"; | 
|---|
| 51 | my $exe_ext = $Config{exe_ext}; | 
|---|
| 52 |  | 
|---|
| 53 | # Allow ``make install PERLNAME=something_besides_perl'': | 
|---|
| 54 | my $perl = defined($ENV{PERLNAME}) ? $ENV{PERLNAME} : 'perl'; | 
|---|
| 55 |  | 
|---|
| 56 | # This is the base used for versioned names, like "perl5.6.0". | 
|---|
| 57 | # It's separate because a common use of $PERLNAME is to install | 
|---|
| 58 | # perl as "perl5", if that's used as base for versioned files you | 
|---|
| 59 | # get "perl55.6.0". | 
|---|
| 60 | my $perl_verbase = defined($ENV{PERLNAME_VERBASE}) | 
|---|
| 61 | ? $ENV{PERLNAME_VERBASE} | 
|---|
| 62 | : $perl; | 
|---|
| 63 | my $dbg = ''; | 
|---|
| 64 | my $ndbg = ''; | 
|---|
| 65 | if ( $Is_VMS ) { | 
|---|
| 66 | if ( defined $Config{usevmsdebug} ) { | 
|---|
| 67 | if ( $Config{usevmsdebug} eq 'define' ) { | 
|---|
| 68 | $dbg = 'dbg'; | 
|---|
| 69 | $ndbg = 'ndbg'; | 
|---|
| 70 | } | 
|---|
| 71 | } | 
|---|
| 72 | } | 
|---|
| 73 |  | 
|---|
| 74 | $otherperls = 1; | 
|---|
| 75 | my $destdir = ''; | 
|---|
| 76 | while (@ARGV) { | 
|---|
| 77 | $nonono = 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 | $silent = 1 if $ARGV[0] eq '-S'; | 
|---|
| 82 | $otherperls = 0 if $ARGV[0] eq '-o'; | 
|---|
| 83 | $force = 1 if $ARGV[0] eq '-f'; | 
|---|
| 84 | $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 | $destdir = $1 if $ARGV[0] =~ /^-?-destdir=(.*)$/; | 
|---|
| 89 | if ($ARGV[0] eq '-?' or $ARGV[0] =~ /^-?-h/) { | 
|---|
| 90 | print <<"EOT"; | 
|---|
| 91 | Usage $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. | 
|---|
| 107 | EOT | 
|---|
| 108 | exit; | 
|---|
| 109 | } | 
|---|
| 110 | shift; | 
|---|
| 111 | } | 
|---|
| 112 |  | 
|---|
| 113 | $versiononly = 1 if $Config{versiononly} && !defined $versiononly; | 
|---|
| 114 | my (@scripts, @tolink); | 
|---|
| 115 | open SCRIPTS, "utils.lst" or die "Can't open utils.lst: $!"; | 
|---|
| 116 | while (<SCRIPTS>) { | 
|---|
| 117 | next if /^#/; | 
|---|
| 118 | s/\s*#\s*pod\s*=.*//; # install script regardless of pod location | 
|---|
| 119 | next if /a2p/; # a2p is binary, to be installed separately | 
|---|
| 120 | chomp; | 
|---|
| 121 | if (/(\S*)\s*#\s*link\s*=\s*(\S*)/) { | 
|---|
| 122 | push @scripts, $1; | 
|---|
| 123 | push @tolink, [$1, $2]; | 
|---|
| 124 | } else { | 
|---|
| 125 | push @scripts, $_; | 
|---|
| 126 | } | 
|---|
| 127 | } | 
|---|
| 128 | close SCRIPTS; | 
|---|
| 129 |  | 
|---|
| 130 | if ($scr_ext) { @scripts = map { "$_$scr_ext" } @scripts; } | 
|---|
| 131 |  | 
|---|
| 132 | my @pods = $nopods ? () : (<pod/*.pod>, 'x2p/a2p.pod'); | 
|---|
| 133 |  | 
|---|
| 134 | # Specify here any .pm files that are actually architecture-dependent. | 
|---|
| 135 | # (Those included with XS extensions under ext/ are automatically | 
|---|
| 136 | # added later.) | 
|---|
| 137 | # Now that the default privlib has the full perl version number included, | 
|---|
| 138 | # we no longer have to play the trick of sticking version-specific .pm | 
|---|
| 139 | # files under the archlib directory. | 
|---|
| 140 | my %archpms = ( | 
|---|
| 141 | Config => 1, | 
|---|
| 142 | lib => 1, | 
|---|
| 143 | Cwd => 1, | 
|---|
| 144 | ); | 
|---|
| 145 |  | 
|---|
| 146 | if ($^O eq 'dos') { | 
|---|
| 147 | push(@scripts,'djgpp/fixpmain'); | 
|---|
| 148 | $archpms{config} = $archpms{filehand} = 1; | 
|---|
| 149 | } | 
|---|
| 150 |  | 
|---|
| 151 | if ((-e "testcompile") && (defined($ENV{'COMPILE'}))) { | 
|---|
| 152 | push(@scripts, map("$_.exe", @scripts)); | 
|---|
| 153 | } | 
|---|
| 154 |  | 
|---|
| 155 | find(sub { | 
|---|
| 156 | if ("$File::Find::dir/$_" =~ m{^ext\b(.*)/([^/]+)\.pm$}) { | 
|---|
| 157 | my($path, $modname) = ($1,$2); | 
|---|
| 158 |  | 
|---|
| 159 | # strip trailing component first | 
|---|
| 160 | $path =~ s{/[^/]*$}{}; | 
|---|
| 161 |  | 
|---|
| 162 | # strip optional "/lib"; | 
|---|
| 163 | $path =~ s{/lib\b}{}; | 
|---|
| 164 |  | 
|---|
| 165 | # strip any leading / | 
|---|
| 166 | $path =~ s{^/}{}; | 
|---|
| 167 |  | 
|---|
| 168 | # reconstitute canonical module name | 
|---|
| 169 | $modname = "$path/$modname" if length $path; | 
|---|
| 170 |  | 
|---|
| 171 | # remember it | 
|---|
| 172 | $archpms{$modname} = 1; | 
|---|
| 173 | } | 
|---|
| 174 | }, 'ext'); | 
|---|
| 175 |  | 
|---|
| 176 | # print "[$_]\n" for sort keys %archpms; | 
|---|
| 177 |  | 
|---|
| 178 | my $ver = $Config{version}; | 
|---|
| 179 | my $release = substr($],0,3);   # Not used currently. | 
|---|
| 180 | my $patchlevel = substr($],3,2); | 
|---|
| 181 | die "Patchlevel of perl ($patchlevel)", | 
|---|
| 182 | "and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n" | 
|---|
| 183 | if $patchlevel != $Config{'PERL_VERSION'}; | 
|---|
| 184 |  | 
|---|
| 185 | my %MyConfig; | 
|---|
| 186 | $MyConfig{'installbin'}      = $Config{'installbin'}; | 
|---|
| 187 | $MyConfig{'installscript'}   = $Config{'installscript'}; | 
|---|
| 188 | $MyConfig{'installarchlib'}  = $Config{'installarchlib'}; | 
|---|
| 189 | $MyConfig{'installsitelib'}  = $Config{'installsitelib'}; | 
|---|
| 190 | $MyConfig{'installsitearch'} = $Config{'installsitearch'}; | 
|---|
| 191 | $MyConfig{'installprivlib'}  = $Config{'installprivlib'}; | 
|---|
| 192 | $MyConfig{'installman1dir'}  = $Config{'installman1dir'}; | 
|---|
| 193 | $MyConfig{'installman3dir'}  = $Config{'installman3dir'}; | 
|---|
| 194 | if ($^O eq 'os2' && "$destdir" ne '') { | 
|---|
| 195 | # Drop the /@unixroot bit if not installing to the unixroot. | 
|---|
| 196 | my $unixroot = '/@unixroot'; | 
|---|
| 197 | $MyConfig{'installbin'}      =~ s/^$unixroot//; | 
|---|
| 198 | $MyConfig{'installscript'}   =~ s/^$unixroot//; | 
|---|
| 199 | $MyConfig{'installarchlib'}  =~ s/^$unixroot//; | 
|---|
| 200 | $MyConfig{'installsitelib'}  =~ s/^$unixroot//; | 
|---|
| 201 | $MyConfig{'installsitearch'} =~ s/^$unixroot//; | 
|---|
| 202 | $MyConfig{'installprivlib'}  =~ s/^$unixroot//; | 
|---|
| 203 | $MyConfig{'installman1dir'}  =~ s/^$unixroot//; | 
|---|
| 204 | $MyConfig{'installman3dir'}  =~ s/^$unixroot//; | 
|---|
| 205 | #$Config{'archlibexp'}      =~ s/^$unixroot//; | 
|---|
| 206 | #$Config{'privlibexp'}      =~ s/^$unixroot//; | 
|---|
| 207 | #$Config{'scriptdir'}       =~ s/^$unixroot//; | 
|---|
| 208 | #$Config{'sitearchexp'}     =~ s/^$unixroot//; | 
|---|
| 209 | #$Config{'sitelibexp'}      =~ s/^$unixroot//; | 
|---|
| 210 | } | 
|---|
| 211 |  | 
|---|
| 212 | # Fetch some frequently-used items from %Config | 
|---|
| 213 | my $installbin = "$destdir$MyConfig{installbin}"; | 
|---|
| 214 | my $installscript = "$destdir$MyConfig{installscript}"; | 
|---|
| 215 | my $installprivlib = "$destdir$MyConfig{installprivlib}"; | 
|---|
| 216 | my $installarchlib = "$destdir$MyConfig{installarchlib}"; | 
|---|
| 217 | my $installsitelib = "$destdir$MyConfig{installsitelib}"; | 
|---|
| 218 | my $installsitearch = "$destdir$MyConfig{installsitearch}"; | 
|---|
| 219 | my $installman1dir = "$destdir$MyConfig{installman1dir}"; | 
|---|
| 220 | my $man1ext = $Config{man1ext}; | 
|---|
| 221 | my $libperl = $Config{libperl}; | 
|---|
| 222 | # Shared library and dynamic loading suffixes. | 
|---|
| 223 | my $so = $Config{so}; | 
|---|
| 224 | my $dlext = $Config{dlext}; | 
|---|
| 225 | my $dlsrc = $Config{dlsrc}; | 
|---|
| 226 | if ($^O eq 'os390') { | 
|---|
| 227 | my $pwd; | 
|---|
| 228 | chomp($pwd=`pwd`); | 
|---|
| 229 | my $archlibexp = $Config{archlibexp}; | 
|---|
| 230 | my $usedl = $Config{usedl}; | 
|---|
| 231 | if ($usedl eq 'define') { | 
|---|
| 232 | `./$^X -pibak -e 's{$pwd\/libperl.x}{$archlibexp/CORE/libperl.x}' lib/Config.pm`; | 
|---|
| 233 | } | 
|---|
| 234 | } | 
|---|
| 235 |  | 
|---|
| 236 | if ($nwinstall) { | 
|---|
| 237 | # This is required only if we are installing on a NetWare server | 
|---|
| 238 | $installscript = $Config{installnwscripts}; | 
|---|
| 239 | $installprivlib = $Config{installnwlib}; | 
|---|
| 240 | $installarchlib = $Config{installnwlib}; | 
|---|
| 241 | $installsitelib = $Config{installnwlib}; | 
|---|
| 242 | } | 
|---|
| 243 |  | 
|---|
| 244 | my $d_dosuid = $Config{d_dosuid}; | 
|---|
| 245 | my $binexp = $Config{binexp}; | 
|---|
| 246 |  | 
|---|
| 247 | if ($Is_VMS) {  # Hang in there until File::Spec hits the big time | 
|---|
| 248 | foreach ( \$installbin,     \$installscript,  \$installprivlib, | 
|---|
| 249 | \$installarchlib, \$installsitelib, \$installsitearch, | 
|---|
| 250 | \$installman1dir ) { | 
|---|
| 251 | $$_ = unixify($$_);  $$_ =~ s:/$::; | 
|---|
| 252 | } | 
|---|
| 253 | } | 
|---|
| 254 |  | 
|---|
| 255 | # Do some quick sanity checks. | 
|---|
| 256 |  | 
|---|
| 257 | if (!$nonono && $d_dosuid && $>) { die "You must run as root to install suidperl\n"; } | 
|---|
| 258 |  | 
|---|
| 259 | $installbin          || die "No installbin directory in config.sh\n"; | 
|---|
| 260 | -d $installbin          || mkpath($installbin, $verbose, 0777); | 
|---|
| 261 | -d $installbin          || $nonono || die "$installbin is not a directory\n"; | 
|---|
| 262 | -w $installbin          || $nonono || die "$installbin is not writable by you\n" | 
|---|
| 263 | unless $installbin =~ m#^/afs/# || $nonono; | 
|---|
| 264 |  | 
|---|
| 265 | if (!$Is_NetWare) { | 
|---|
| 266 | if (!$Is_VMS) { | 
|---|
| 267 | -x 'perl' . $exe_ext    || die "perl isn't executable!\n"; | 
|---|
| 268 | } | 
|---|
| 269 | else { | 
|---|
| 270 | -x $ndbg . 'perl' . $exe_ext    || die "${ndbg}perl$exe_ext isn't executable!\n"; | 
|---|
| 271 | if ($dbg) { | 
|---|
| 272 | -x $dbg . 'perl' . $exe_ext     || die "${dbg}perl$exe_ext isn't executable!\n"; | 
|---|
| 273 | } | 
|---|
| 274 | } | 
|---|
| 275 | -x 'suidperl' . $exe_ext|| die "suidperl isn't executable!\n" if $d_dosuid; | 
|---|
| 276 |  | 
|---|
| 277 | -f 't/rantests'         || $Is_W32 | 
|---|
| 278 | || warn "WARNING: You've never run 'make test' or", | 
|---|
| 279 | " some tests failed! (Installing anyway.)\n"; | 
|---|
| 280 | } #if (!$Is_NetWare) | 
|---|
| 281 |  | 
|---|
| 282 | # This will be used to store the packlist | 
|---|
| 283 | my $packlist = ExtUtils::Packlist->new("$installarchlib/.packlist"); | 
|---|
| 284 |  | 
|---|
| 285 | if (($Is_W32 and ! $Is_NetWare) or $Is_Cygwin) { | 
|---|
| 286 | my $perldll; | 
|---|
| 287 |  | 
|---|
| 288 | if ($Is_Cygwin) { | 
|---|
| 289 | $perldll = $libperl; | 
|---|
| 290 | my $v_e_r_s = $ver; $v_e_r_s =~ tr/./_/; | 
|---|
| 291 | $perldll =~ s/(\..*)?$/$v_e_r_s.$dlext/; | 
|---|
| 292 | $perldll =~ s/^lib/cyg/; | 
|---|
| 293 | if ($Config{useshrplib} eq 'true') { | 
|---|
| 294 | # install ld2 and perlld as well | 
|---|
| 295 | foreach ('ld2', 'perlld') { | 
|---|
| 296 | safe_unlink("$installbin/$_"); | 
|---|
| 297 | copy("$_", "$installbin/$_"); | 
|---|
| 298 | chmod(0755, "$installbin/$_"); | 
|---|
| 299 | $packlist->{"$installbin/$_"} = { type => 'file' }; | 
|---|
| 300 | }; | 
|---|
| 301 | open (LD2, ">$installbin/ld2"); | 
|---|
| 302 | print LD2 <<SHELL; | 
|---|
| 303 | #!/bin/sh | 
|---|
| 304 | # | 
|---|
| 305 | # ld wrapper, passes all args to perlld; | 
|---|
| 306 | # | 
|---|
| 307 | for trythis in $installbin/perl | 
|---|
| 308 | do | 
|---|
| 309 | if [ -x \$trythis ] | 
|---|
| 310 | then | 
|---|
| 311 | \$trythis $installbin/perlld "\$\@" | 
|---|
| 312 | exit \$? | 
|---|
| 313 | fi | 
|---|
| 314 | done | 
|---|
| 315 | # hard luck! | 
|---|
| 316 | echo I see no perl executable around there | 
|---|
| 317 | echo perl is required to build dynamic libraries | 
|---|
| 318 | echo look if the path to perl in /bin/ld2 is correct | 
|---|
| 319 | exit 1 | 
|---|
| 320 | SHELL | 
|---|
| 321 | close LD2; | 
|---|
| 322 | chmod(0755, "$installbin/ld2"); | 
|---|
| 323 | }; | 
|---|
| 324 | } else { | 
|---|
| 325 | $perldll = 'perl58.' . $dlext; | 
|---|
| 326 | } | 
|---|
| 327 |  | 
|---|
| 328 | if ($dlsrc ne "dl_none.xs") { | 
|---|
| 329 | -f $perldll || die "No perl DLL built\n"; | 
|---|
| 330 | } | 
|---|
| 331 |  | 
|---|
| 332 | # Install the DLL | 
|---|
| 333 | safe_unlink("$installbin/$perldll"); | 
|---|
| 334 | copy("$perldll", "$installbin/$perldll"); | 
|---|
| 335 | chmod(0755, "$installbin/$perldll"); | 
|---|
| 336 | $packlist->{"$installbin/$perldll"} = { type => 'file' }; | 
|---|
| 337 | } # if (($Is_W32 and ! $Is_NetWare) or $Is_Cygwin) | 
|---|
| 338 | elsif ($^O eq 'os2') { | 
|---|
| 339 | # Install the DLL | 
|---|
| 340 | my $perldll = `cat imp_version | tr -d '\r\n'`; | 
|---|
| 341 | if ($perldll ne '') { | 
|---|
| 342 | $perldll .= ".dll"; | 
|---|
| 343 | } else { | 
|---|
| 344 | print "warning: imp_version is missing..."; | 
|---|
| 345 | my @perldllfiles; | 
|---|
| 346 | @perldllfiles = <perl*.dll>; | 
|---|
| 347 | $perldll = pop @perldllfiles; | 
|---|
| 348 | die 'error: cannot find the perl dll!' if $perldll eq ''; | 
|---|
| 349 | } | 
|---|
| 350 |  | 
|---|
| 351 | safe_unlink("$installbin/../lib/$perldll"); | 
|---|
| 352 | copy("$perldll", "$installbin/../lib/$perldll"); | 
|---|
| 353 | chmod(0644, "$installbin/../lib/$perldll"); | 
|---|
| 354 | $packlist->{"$installbin/../lib/$perldll"} = { type => 'file' }; | 
|---|
| 355 | } | 
|---|
| 356 |  | 
|---|
| 357 | # First we install the version-numbered executables. | 
|---|
| 358 |  | 
|---|
| 359 | if ($Is_VMS) { | 
|---|
| 360 | safe_unlink("$installbin/perl_setup.com"); | 
|---|
| 361 | copy("perl_setup.com", "$installbin/perl_setup.com"); | 
|---|
| 362 | chmod(0755, "$installbin/perl_setup.com"); | 
|---|
| 363 | safe_unlink("$installbin/$dbg$perl$exe_ext"); | 
|---|
| 364 | copy("$dbg$perl$exe_ext", "$installbin/$dbg$perl$exe_ext"); | 
|---|
| 365 | chmod(0755, "$installbin/$dbg$perl$exe_ext"); | 
|---|
| 366 | safe_unlink("$installbin/$dbg${perl}shr$exe_ext"); | 
|---|
| 367 | copy("$dbg${perl}shr$exe_ext", "$installbin/$dbg${perl}shr$exe_ext"); | 
|---|
| 368 | chmod(0755, "$installbin/$dbg${perl}shr$exe_ext"); | 
|---|
| 369 | if ($ndbg) { | 
|---|
| 370 | safe_unlink("$installbin/$ndbg$perl$exe_ext"); | 
|---|
| 371 | copy("$ndbg$perl$exe_ext", "$installbin/$ndbg$perl$exe_ext"); | 
|---|
| 372 | chmod(0755, "$installbin/$ndbg$perl$exe_ext"); | 
|---|
| 373 | safe_unlink("$installbin/${dbg}a2p$exe_ext"); | 
|---|
| 374 | copy("x2p/${dbg}a2p$exe_ext", "$installbin/${dbg}a2p$exe_ext"); | 
|---|
| 375 | chmod(0755, "$installbin/${dbg}a2p$exe_ext"); | 
|---|
| 376 | } | 
|---|
| 377 | } | 
|---|
| 378 | elsif ($^O eq 'mpeix') { | 
|---|
| 379 | # MPE lacks hard links and requires that executables with special | 
|---|
| 380 | # capabilities reside in the MPE namespace. | 
|---|
| 381 | safe_unlink("$installbin/perl$ver$exe_ext", $Config{perlpath}); | 
|---|
| 382 | # Install the primary executable into the MPE namespace as perlpath. | 
|---|
| 383 | copy("perl$exe_ext", $Config{perlpath}); | 
|---|
| 384 | chmod(0755, $Config{perlpath}); | 
|---|
| 385 | # Create a backup copy with the version number. | 
|---|
| 386 | link($Config{perlpath}, "$installbin/perl$ver$exe_ext"); | 
|---|
| 387 | } | 
|---|
| 388 | elsif ($^O ne 'dos') { | 
|---|
| 389 | if (!$Is_NetWare) { | 
|---|
| 390 | safe_unlink("$installbin/$perl_verbase$ver$exe_ext"); | 
|---|
| 391 | copy("perl$exe_ext", "$installbin/$perl_verbase$ver$exe_ext"); | 
|---|
| 392 | strip("$installbin/$perl_verbase$ver$exe_ext"); | 
|---|
| 393 | chmod(0755, "$installbin/$perl_verbase$ver$exe_ext"); | 
|---|
| 394 | } | 
|---|
| 395 | else { | 
|---|
| 396 | # If installing onto a NetWare server | 
|---|
| 397 | if ($nwinstall) { | 
|---|
| 398 | # Copy perl.nlm, echo.nlm, type.nlm, a2p.nlm & cgi2perl.nlm | 
|---|
| 399 | mkpath($Config{installnwsystem}, 1, 0777); | 
|---|
| 400 | copy("netware\\".$ENV{'MAKE_TYPE'}."\\perl.nlm", $Config{installnwsystem}); | 
|---|
| 401 | copy("netware\\testnlm\\echo\\echo.nlm", $Config{installnwsystem}); | 
|---|
| 402 | copy("netware\\testnlm\\type\\type.nlm", $Config{installnwsystem}); | 
|---|
| 403 | copy("x2p\\a2p.nlm", $Config{installnwsystem}); | 
|---|
| 404 | chmod(0755, "$Config{installnwsystem}\\perl.nlm"); | 
|---|
| 405 | mkpath($Config{installnwlcgi}, 1, 0777); | 
|---|
| 406 | copy("lib\\auto\\cgi2perl\\cgi2perl.nlm", $Config{installnwlcgi}); | 
|---|
| 407 | } | 
|---|
| 408 | } #if (!$Is_NetWare) | 
|---|
| 409 | } | 
|---|
| 410 | else { | 
|---|
| 411 | safe_unlink("$installbin/$perl.exe"); | 
|---|
| 412 | copy("perl.exe", "$installbin/$perl.exe"); | 
|---|
| 413 | } | 
|---|
| 414 |  | 
|---|
| 415 | safe_unlink("$installbin/s$perl_verbase$ver$exe_ext"); | 
|---|
| 416 | if ($d_dosuid) { | 
|---|
| 417 | copy("suidperl$exe_ext", "$installbin/s$perl_verbase$ver$exe_ext"); | 
|---|
| 418 | chmod(04711, "$installbin/s$perl_verbase$ver$exe_ext"); | 
|---|
| 419 | } | 
|---|
| 420 |  | 
|---|
| 421 | # Install library files. | 
|---|
| 422 |  | 
|---|
| 423 | my ($do_installarchlib, $do_installprivlib) = (0, 0); | 
|---|
| 424 |  | 
|---|
| 425 | mkpath($installprivlib, $verbose, 0777); | 
|---|
| 426 | mkpath($installarchlib, $verbose, 0777); | 
|---|
| 427 | mkpath($installsitelib, $verbose, 0777) if ($installsitelib); | 
|---|
| 428 | mkpath($installsitearch, $verbose, 0777) if ($installsitearch); | 
|---|
| 429 |  | 
|---|
| 430 | if (chdir "lib") { | 
|---|
| 431 | $do_installarchlib = ! samepath($installarchlib, '.'); | 
|---|
| 432 | $do_installprivlib = ! samepath($installprivlib, '.'); | 
|---|
| 433 | $do_installprivlib = 0 if $versiononly && !($installprivlib =~ m/\Q$ver/); | 
|---|
| 434 |  | 
|---|
| 435 | if ($do_installarchlib || $do_installprivlib) { | 
|---|
| 436 | find(\&installlib, '.'); | 
|---|
| 437 | } | 
|---|
| 438 | chdir ".." || die "Can't cd back to source directory: $!\n"; | 
|---|
| 439 | } | 
|---|
| 440 | else { | 
|---|
| 441 | warn "Can't cd to lib to install lib files: $!\n"; | 
|---|
| 442 | } | 
|---|
| 443 |  | 
|---|
| 444 | # Install header files and libraries. | 
|---|
| 445 | mkpath("$installarchlib/CORE", $verbose, 0777); | 
|---|
| 446 | my @corefiles; | 
|---|
| 447 | if ($Is_VMS) {  # We did core file selection during build | 
|---|
| 448 | my $coredir = "lib/$Config{archname}/$ver/CORE"; | 
|---|
| 449 | $coredir =~ tr/./_/; | 
|---|
| 450 | map { s|^$coredir/||i; } @corefiles = <$coredir/*.*>; | 
|---|
| 451 | } | 
|---|
| 452 | else { | 
|---|
| 453 | # [als] hard-coded 'libperl' name... not good! | 
|---|
| 454 | @corefiles = <*.h *.inc libperl*.* perl*$Config{lib_ext}>; | 
|---|
| 455 |  | 
|---|
| 456 | # AIX needs perl.exp installed as well. | 
|---|
| 457 | push(@corefiles,'perl.exp') if $^O eq 'aix'; | 
|---|
| 458 | if ($^O eq 'mpeix') { | 
|---|
| 459 | # MPE needs mpeixish.h installed as well. | 
|---|
| 460 | mkpath("$installarchlib/CORE/mpeix", $verbose, 0777); | 
|---|
| 461 | push(@corefiles,'mpeix/mpeixish.h'); | 
|---|
| 462 | } | 
|---|
| 463 | # If they have built sperl.o... | 
|---|
| 464 | push(@corefiles,'sperl.o') if -f 'sperl.o'; | 
|---|
| 465 | } | 
|---|
| 466 | foreach my $file (@corefiles) { | 
|---|
| 467 | # HP-UX (at least) needs to maintain execute permissions | 
|---|
| 468 | # on dynamically-loadable libraries. So we do it for all. | 
|---|
| 469 | if (copy_if_diff($file,"$installarchlib/CORE/$file")) { | 
|---|
| 470 | if ($file =~ /\.(\Q$so\E|\Q$dlext\E)$/) { | 
|---|
| 471 | strip("-S", "$installarchlib/CORE/$file") if $^O =~ /^(rhapsody|darwin)$/; | 
|---|
| 472 | chmod(0555, "$installarchlib/CORE/$file"); | 
|---|
| 473 | } else { | 
|---|
| 474 | chmod(0444, "$installarchlib/CORE/$file"); | 
|---|
| 475 | } | 
|---|
| 476 | } | 
|---|
| 477 | } | 
|---|
| 478 |  | 
|---|
| 479 | # Switch in the 5.005-threads versions of he threadsafe queue and semaphore | 
|---|
| 480 | # modules if so needed. | 
|---|
| 481 | if ($Config{use5005threads}) { | 
|---|
| 482 | for my $m (qw(Queue Semaphore)) { | 
|---|
| 483 | my $t = "$installprivlib/Thread/$m.pm"; | 
|---|
| 484 | unlink $t; | 
|---|
| 485 | copy("ext/Thread/$m.pmx", $t); | 
|---|
| 486 | chmod(0444, $t); | 
|---|
| 487 | } | 
|---|
| 488 | } | 
|---|
| 489 |  | 
|---|
| 490 | # Install main perl executables | 
|---|
| 491 | # Make links to ordinary names if installbin directory isn't current directory. | 
|---|
| 492 |  | 
|---|
| 493 | if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS && ! $Is_NetWare) { | 
|---|
| 494 | safe_unlink("$installbin/$perl$exe_ext", "$installbin/suid$perl$exe_ext"); | 
|---|
| 495 | if ($^O eq 'mpeix') { | 
|---|
| 496 | # MPE doesn't support hard links, so use a symlink. | 
|---|
| 497 | # We don't want another cloned copy. | 
|---|
| 498 | symlink($Config{perlpath}, "$installbin/perl$exe_ext"); | 
|---|
| 499 | } elsif ($^O eq 'vos') { | 
|---|
| 500 | # VOS doesn't support hard links, so use a symlink. | 
|---|
| 501 | symlink("$installbin/$perl_verbase$ver$exe_ext", | 
|---|
| 502 | "$installbin/$perl$exe_ext"); | 
|---|
| 503 | } else { | 
|---|
| 504 | link("$installbin/$perl_verbase$ver$exe_ext", | 
|---|
| 505 | "$installbin/$perl$exe_ext"); | 
|---|
| 506 | } | 
|---|
| 507 | link("$installbin/$perl_verbase$ver$exe_ext", | 
|---|
| 508 | "$installbin/suid$perl$exe_ext") | 
|---|
| 509 | if $d_dosuid; | 
|---|
| 510 | } | 
|---|
| 511 |  | 
|---|
| 512 | # For development purposes it can be very useful to have multiple perls | 
|---|
| 513 | # build for different "architectures" (eg threading or not) simultaneously. | 
|---|
| 514 | if ($archname && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS) { | 
|---|
| 515 | my $archperl = "$perl_verbase$ver-$Config{archname}$exe_ext"; | 
|---|
| 516 | safe_unlink("$installbin/$archperl"); | 
|---|
| 517 | if ($^O eq 'mpeix') { | 
|---|
| 518 | # MPE doesn't support hard links, so use a symlink. | 
|---|
| 519 | # We don't want another cloned copy. | 
|---|
| 520 | symlink($Config{perlpath}, "$installbin/$archperl"); | 
|---|
| 521 | } elsif ($^O eq 'vos') { | 
|---|
| 522 | # VOS doesn't support hard links, so use a symlink. | 
|---|
| 523 | symlink("$installbin/$perl_verbase$ver$exe_ext", | 
|---|
| 524 | "$installbin/$archperl"); | 
|---|
| 525 | } else { | 
|---|
| 526 | link("$installbin/$perl_verbase$ver$exe_ext", "$installbin/$archperl"); | 
|---|
| 527 | } | 
|---|
| 528 | } | 
|---|
| 529 |  | 
|---|
| 530 | # Offer to install perl in a "standard" location | 
|---|
| 531 |  | 
|---|
| 532 | my $mainperl_is_instperl = 0; | 
|---|
| 533 |  | 
|---|
| 534 | if ($Config{installusrbinperl} && $Config{installusrbinperl} eq 'define' && | 
|---|
| 535 | !$versiononly && !$nonono && !$Is_W32 && !$Is_NetWare && !$Is_VMS && -t STDIN && -t STDERR | 
|---|
| 536 | && -w $mainperldir && ! samepath($mainperldir, $installbin)) { | 
|---|
| 537 | my($usrbinperl)     = "$mainperldir/$perl$exe_ext"; | 
|---|
| 538 | my($instperl)       = "$installbin/$perl$exe_ext"; | 
|---|
| 539 | my($expinstperl)    = "$binexp/$perl$exe_ext"; | 
|---|
| 540 |  | 
|---|
| 541 | # First make sure $usrbinperl is not already the same as the perl we | 
|---|
| 542 | # just installed. | 
|---|
| 543 | if (-x $usrbinperl) { | 
|---|
| 544 | # Try to be clever about mainperl being a symbolic link | 
|---|
| 545 | # to binexp/perl if binexp and installbin are different. | 
|---|
| 546 | $mainperl_is_instperl = | 
|---|
| 547 | samepath($usrbinperl, $instperl) || | 
|---|
| 548 | samepath($usrbinperl, $expinstperl) || | 
|---|
| 549 | (($binexp ne $installbin) && | 
|---|
| 550 | (-l $usrbinperl) && | 
|---|
| 551 | ((readlink $usrbinperl) eq $expinstperl)); | 
|---|
| 552 | } | 
|---|
| 553 | if (! $mainperl_is_instperl) { | 
|---|
| 554 | unlink($usrbinperl); | 
|---|
| 555 | ( $Config{'d_link'} eq 'define' && | 
|---|
| 556 | eval { CORE::link $instperl, $usrbinperl } )  || | 
|---|
| 557 | eval { symlink $expinstperl, $usrbinperl }      || | 
|---|
| 558 | copy($instperl, $usrbinperl); | 
|---|
| 559 |  | 
|---|
| 560 | $mainperl_is_instperl = 1; | 
|---|
| 561 | } | 
|---|
| 562 | } | 
|---|
| 563 |  | 
|---|
| 564 | # Make links to ordinary names if installbin directory isn't current directory. | 
|---|
| 565 | if (!$Is_NetWare && $dbg eq '') { | 
|---|
| 566 | if (! samepath($installbin, 'x2p')) { | 
|---|
| 567 | my $base = 'a2p'; | 
|---|
| 568 | $base .= $ver if $versiononly; | 
|---|
| 569 | safe_unlink("$installbin/$base$exe_ext"); | 
|---|
| 570 | copy("x2p/a2p$exe_ext", "$installbin/$base$exe_ext"); | 
|---|
| 571 | strip("$installbin/$base$exe_ext"); | 
|---|
| 572 | chmod(0755, "$installbin/$base$exe_ext"); | 
|---|
| 573 | } | 
|---|
| 574 | } | 
|---|
| 575 |  | 
|---|
| 576 | # cppstdin is just a script, but it is architecture-dependent, so | 
|---|
| 577 | # it can't safely be shared.  Place it in $installbin. | 
|---|
| 578 | # Note that Configure doesn't build cppstin if it isn't needed, so | 
|---|
| 579 | # we skip this if cppstdin doesn't exist. | 
|---|
| 580 | if (! $versiononly && (-f 'cppstdin') && (! samepath($installbin, '.'))) { | 
|---|
| 581 | safe_unlink("$installbin/cppstdin"); | 
|---|
| 582 | copy("cppstdin", "$installbin/cppstdin"); | 
|---|
| 583 | chmod(0755, "$installbin/cppstdin"); | 
|---|
| 584 | } | 
|---|
| 585 |  | 
|---|
| 586 | sub script_alias { | 
|---|
| 587 | my ($installscript, $orig, $alias, $scr_ext) = @_; | 
|---|
| 588 |  | 
|---|
| 589 | safe_unlink("$installscript/$alias$scr_ext"); | 
|---|
| 590 | if ($^O eq 'dos' or $Is_VMS or $^O eq 'transit') { | 
|---|
| 591 | copy("$installscript/$orig$scr_ext", | 
|---|
| 592 | "$installscript/$alias$scr_ext"); | 
|---|
| 593 | } elsif ($^O eq 'vos') { | 
|---|
| 594 | symlink("$installscript/$orig$scr_ext", | 
|---|
| 595 | "$installscript/$alias$scr_ext"); | 
|---|
| 596 | } else { | 
|---|
| 597 | link("$installscript/$orig$scr_ext", | 
|---|
| 598 | "$installscript/$alias$scr_ext"); | 
|---|
| 599 | } | 
|---|
| 600 | } | 
|---|
| 601 |  | 
|---|
| 602 | # Install scripts. | 
|---|
| 603 | mkpath($installscript, $verbose, 0777); | 
|---|
| 604 | if ($versiononly) { | 
|---|
| 605 | for (@scripts) { | 
|---|
| 606 | (my $base = $_) =~ s#.*/##; | 
|---|
| 607 | $base .= $ver; | 
|---|
| 608 | copy($_,    "$installscript/$base"); | 
|---|
| 609 | chmod(0755, "$installscript/$base"); | 
|---|
| 610 | } | 
|---|
| 611 |  | 
|---|
| 612 | for (@tolink) { | 
|---|
| 613 | my ($from, $to) = map { "$_$ver" } @$_; | 
|---|
| 614 | (my $frbase = $from) =~ s#.*/##; | 
|---|
| 615 | (my $tobase = $to) =~ s#.*/##; | 
|---|
| 616 | script_alias($installscript, $frbase, $tobase, $scr_ext); | 
|---|
| 617 | } | 
|---|
| 618 | } else { | 
|---|
| 619 | for (@scripts) { | 
|---|
| 620 | (my $base = $_) =~ s#.*/##; | 
|---|
| 621 | copy($_, "$installscript/$base"); | 
|---|
| 622 | chmod(0755, "$installscript/$base"); | 
|---|
| 623 | } | 
|---|
| 624 |  | 
|---|
| 625 | for (@tolink) { | 
|---|
| 626 | my ($from, $to) = @$_; | 
|---|
| 627 | (my $frbase = $from) =~ s#.*/##; | 
|---|
| 628 | (my $tobase = $to) =~ s#.*/##; | 
|---|
| 629 | script_alias($installscript, $frbase, $tobase, $scr_ext); | 
|---|
| 630 | } | 
|---|
| 631 | } | 
|---|
| 632 |  | 
|---|
| 633 | # Install pod pages.  Where? I guess in $installprivlib/pod | 
|---|
| 634 | # ($installprivlib/pods for cygwin). | 
|---|
| 635 |  | 
|---|
| 636 | my $pod = ($Is_Cygwin || $Is_Darwin || $Is_VMS) ? 'pods' : 'pod'; | 
|---|
| 637 | if ( !$versiononly || ($installprivlib =~ m/\Q$ver/)) { | 
|---|
| 638 | mkpath("${installprivlib}/$pod", $verbose, 0777); | 
|---|
| 639 |  | 
|---|
| 640 | # If Perl 5.003's perldiag.pod is there, rename it. | 
|---|
| 641 | if (open POD, "${installprivlib}/$pod/perldiag.pod") { | 
|---|
| 642 | read POD, $_, 4000; | 
|---|
| 643 | close POD; | 
|---|
| 644 | # Some of Perl 5.003's diagnostic messages ended with periods. | 
|---|
| 645 | if (/^=.*\.$/m) { | 
|---|
| 646 | my ($from, $to) = ("${installprivlib}/$pod/perldiag.pod", | 
|---|
| 647 | "${installprivlib}/$pod/perldiag-5.003.pod"); | 
|---|
| 648 | print "  rename $from $to"; | 
|---|
| 649 | rename($from, $to) | 
|---|
| 650 | or warn "Couldn't rename $from to $to: $!\n" | 
|---|
| 651 | unless $nonono; | 
|---|
| 652 | } | 
|---|
| 653 | } | 
|---|
| 654 |  | 
|---|
| 655 | for (@pods) { | 
|---|
| 656 | # $_ is a name like  pod/perl.pod | 
|---|
| 657 | (my $base = $_) =~ s#.*/##; | 
|---|
| 658 | copy_if_diff($_, "${installprivlib}/$pod/${base}"); | 
|---|
| 659 | } | 
|---|
| 660 |  | 
|---|
| 661 | } | 
|---|
| 662 |  | 
|---|
| 663 | # Check to make sure there aren't other perls around in installer's | 
|---|
| 664 | # path.  This is probably UNIX-specific.  Check all absolute directories | 
|---|
| 665 | # in the path except for where public executables are supposed to live. | 
|---|
| 666 | # Also skip $mainperl if the user opted to have it be a link to the | 
|---|
| 667 | # installed perl. | 
|---|
| 668 |  | 
|---|
| 669 | if (!$versiononly && $otherperls) { | 
|---|
| 670 | my ($path, @path); | 
|---|
| 671 | my $dirsep = ($Is_OS2 || $Is_W32 || $Is_NetWare) ? ';' : ':' ; | 
|---|
| 672 | ($path = $ENV{"PATH"}) =~ s:\\:/:g ; | 
|---|
| 673 | @path = split(/$dirsep/, $path); | 
|---|
| 674 | if ($Is_VMS) { | 
|---|
| 675 | my $i = 0; | 
|---|
| 676 | while (exists $ENV{'DCL$PATH' . $i}) { | 
|---|
| 677 | my $dir = unixpath($ENV{'DCL$PATH' . $i});  $dir =~ s-/$--; | 
|---|
| 678 | push(@path,$dir); | 
|---|
| 679 | } | 
|---|
| 680 | } | 
|---|
| 681 | my @otherperls; | 
|---|
| 682 | my %otherperls; | 
|---|
| 683 | for (@path) { | 
|---|
| 684 | next unless m,^/,; | 
|---|
| 685 | # Use &samepath here because some systems have other dirs linked | 
|---|
| 686 | # to $mainperldir (like SunOS) | 
|---|
| 687 | next if samepath($_, $binexp); | 
|---|
| 688 | next if ($mainperl_is_instperl && samepath($_, $mainperldir)); | 
|---|
| 689 | my $otherperl = "$_/$perl$exe_ext"; | 
|---|
| 690 | next if $otherperls{$otherperl}++; | 
|---|
| 691 | push(@otherperls, $otherperl) | 
|---|
| 692 | if (-x $otherperl && ! -d $otherperl); | 
|---|
| 693 | } | 
|---|
| 694 | if (@otherperls) { | 
|---|
| 695 | warn "\nWarning: $perl appears in your path in the following " . | 
|---|
| 696 | "locations beyond where\nwe just installed it:\n"; | 
|---|
| 697 | for (@otherperls) { | 
|---|
| 698 | warn "    ", $_, "\n"; | 
|---|
| 699 | } | 
|---|
| 700 | warn "\n"; | 
|---|
| 701 | } | 
|---|
| 702 |  | 
|---|
| 703 | } | 
|---|
| 704 |  | 
|---|
| 705 | $packlist->write() unless $nonono; | 
|---|
| 706 | print "  Installation complete\n" if $verbose; | 
|---|
| 707 |  | 
|---|
| 708 | exit 0; | 
|---|
| 709 |  | 
|---|
| 710 | ############################################################################### | 
|---|
| 711 |  | 
|---|
| 712 | sub 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 |  | 
|---|
| 722 | sub 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 |  | 
|---|
| 738 | sub 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 |  | 
|---|
| 755 | sub 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 |  | 
|---|
| 769 | sub 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 |  | 
|---|
| 803 | sub 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 |  | 
|---|
| 813 | sub 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 |  | 
|---|
| 829 | sub 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 |  | 
|---|
| 845 | sub 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. | 
|---|
| 853 | if ($name =~ /^(?:CVS|RCS|SCCS|\.svn)\z/ and -d $name) { | 
|---|
| 854 | $File::Find::prune = 1; | 
|---|
| 855 | return; | 
|---|
| 856 | } | 
|---|
| 857 |  | 
|---|
| 858 | # ignore patch backups, RCS files, emacs backup & temp files and the | 
|---|
| 859 | # .exists files, .PL files, and test files. | 
|---|
| 860 | return if $name =~ m{\.orig$|\.rej$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.plc$|\.t$|^test\.pl$} || | 
|---|
| 861 | $dir  =~ m{/t(?:/|$)}; | 
|---|
| 862 |  | 
|---|
| 863 | # XXX xsubpp back out of the list. prove now integrated. Out of order, so | 
|---|
| 864 | # p4 will conflict on the next update to the following lines: | 
|---|
| 865 |  | 
|---|
| 866 | # ignore the cpan script in lib/CPAN/bin, the instmodsh and xsubpp | 
|---|
| 867 | # scripts in lib/ExtUtils, and the prove script in lib/Test/Harness | 
|---|
| 868 | # (they're installed later with other utils) | 
|---|
| 869 | return if $name =~ /^(?:cpan|instmodsh|prove)\z/; | 
|---|
| 870 |  | 
|---|
| 871 | # ignore the Makefiles | 
|---|
| 872 | return if $name =~ /^makefile$/i; | 
|---|
| 873 | # ignore the test extensions | 
|---|
| 874 | return if $dir =~ m{ext/XS/(?:APItest|Typemap)/}; | 
|---|
| 875 | # ignore the demo files | 
|---|
| 876 | return if $dir =~ /\bdemos?\b/; | 
|---|
| 877 |  | 
|---|
| 878 | # ignore READMEs, MANIFESTs, INSTALL docs, META.ymls and change logs. | 
|---|
| 879 | # Changes.e2x and README.e2x are needed by enc2xs. | 
|---|
| 880 | return if $name =~ m{^(?:README(?:\.\w+)?|MANIFEST|META\.yml|INSTALL)$} && $name ne 'README.e2x'; | 
|---|
| 881 | return if $name =~ m{^(?:TODO|BUGS|CREDITS)$}i; | 
|---|
| 882 | return if $name =~ m{^change(?:s|log)(?:\.libnet)?$}i; | 
|---|
| 883 |  | 
|---|
| 884 | $name = "$dir/$name" if $dir ne ''; | 
|---|
| 885 |  | 
|---|
| 886 | my $installlib = $installprivlib; | 
|---|
| 887 | if ($dir =~ /^auto/ || | 
|---|
| 888 | ($name =~ /^(.*)\.(?:pm|pod)$/ && $archpms{$1}) || | 
|---|
| 889 | ($name =~ /^(.*)\.(?:h|lib)$/i && ($Is_W32 || $Is_NetWare)) || | 
|---|
| 890 | $name eq 'Config_heavy.pl' | 
|---|
| 891 | ) { | 
|---|
| 892 | $installlib = $installarchlib; | 
|---|
| 893 | return unless $do_installarchlib; | 
|---|
| 894 | } else { | 
|---|
| 895 | return unless $do_installprivlib; | 
|---|
| 896 | } | 
|---|
| 897 |  | 
|---|
| 898 | if (-f $_) { | 
|---|
| 899 | if (/\.(?:al|ix)$/ && !($dir =~ m[^auto/(.*)$] && $archpms{$1})) { | 
|---|
| 900 | $installlib = $installprivlib; | 
|---|
| 901 | #We're installing *.al and *.ix files into $installprivlib, | 
|---|
| 902 | #but we have to delete old *.al and *.ix files from the 5.000 | 
|---|
| 903 | #distribution: | 
|---|
| 904 | #This might not work because $archname might have changed. | 
|---|
| 905 | unlink("$installarchlib/$name"); | 
|---|
| 906 | } | 
|---|
| 907 | my $xname = "$installlib/$name"; | 
|---|
| 908 | $xname =~ s/^\Q$destdir\E// if $destdir; | 
|---|
| 909 | $packlist->{$xname} = { type => 'file' }; | 
|---|
| 910 | if ($force || compare($_, "$installlib/$name") || $nonono) { | 
|---|
| 911 | unlink("$installlib/$name"); | 
|---|
| 912 | mkpath("$installlib/$dir", $verbose, 0777); | 
|---|
| 913 | # HP-UX (at least) needs to maintain execute permissions | 
|---|
| 914 | # on dynamically-loaded libraries. | 
|---|
| 915 | if ($Is_NetWare && !$nwinstall) { | 
|---|
| 916 | # Don't copy .nlp,.nlm files, doesn't make sense on Windows and also | 
|---|
| 917 | # if copied will give problems when building new extensions. | 
|---|
| 918 | # Has to be copied if we are installing on a NetWare server and hence | 
|---|
| 919 | # the check !$nwinstall | 
|---|
| 920 | if (!(/\.(?:nlp|nlm|bs)$/)) { | 
|---|
| 921 | copy_if_diff($_, "$installlib/$name") | 
|---|
| 922 | and chmod($name =~ /\.(so|$dlext)$/o ? 0555 : 0444, | 
|---|
| 923 | "$installlib/$name"); | 
|---|
| 924 | } | 
|---|
| 925 | } else { | 
|---|
| 926 | if (copy_if_diff($_, "$installlib/$name")) { | 
|---|
| 927 | if ($name =~ /\.(so|$dlext)$/o) { | 
|---|
| 928 | strip("-S", "$installlib/$name") if $^O =~ /^(rhapsody|darwin)$/; | 
|---|
| 929 | chmod(0555, "$installlib/$name"); | 
|---|
| 930 | } else { | 
|---|
| 931 | strip("-S", "$installlib/$name") | 
|---|
| 932 | if ($name =~ /\.a$/o and $^O =~ /^(rhapsody|darwin)$/); | 
|---|
| 933 | chmod(0444, "$installlib/$name"); | 
|---|
| 934 | } | 
|---|
| 935 | } | 
|---|
| 936 | } #if ($Is_NetWare) | 
|---|
| 937 | } | 
|---|
| 938 | } | 
|---|
| 939 | } | 
|---|
| 940 |  | 
|---|
| 941 | # Copy $from to $to, only if $from is different than $to. | 
|---|
| 942 | # Also preserve modification times for .a libraries. | 
|---|
| 943 | # On some systems, if you do | 
|---|
| 944 | #   ranlib libperl.a | 
|---|
| 945 | #   cp libperl.a /usr/local/lib/perl5/archlib/CORE/libperl.a | 
|---|
| 946 | # and then try to link against the installed libperl.a, you might | 
|---|
| 947 | # get an error message to the effect that the symbol table is older | 
|---|
| 948 | # than the library. | 
|---|
| 949 | # Return true if copying occurred. | 
|---|
| 950 |  | 
|---|
| 951 | sub copy_if_diff { | 
|---|
| 952 | my($from,$to)=@_; | 
|---|
| 953 | return 1 if (($^O eq 'VMS') && (-d $from)); | 
|---|
| 954 | my $xto = $to; | 
|---|
| 955 | $xto =~ s/^\Q$destdir\E// if $destdir; | 
|---|
| 956 | my $perlpodbadsymlink; | 
|---|
| 957 | if ($from =~ m!^pod/perl[\w-]+\.pod$! && | 
|---|
| 958 | -l $from && | 
|---|
| 959 | ! -e $from) { | 
|---|
| 960 | # Some Linux implementations have problems traversing over | 
|---|
| 961 | # multiple symlinks (when going over NFS?) and fail to read | 
|---|
| 962 | # the symlink target.  Combine this with the fact that some | 
|---|
| 963 | # of the pod files (the perl$OS.pod) are symlinks (to ../README.$OS), | 
|---|
| 964 | # and you end up with those pods not getting installed. | 
|---|
| 965 | $perlpodbadsymlink = 1; | 
|---|
| 966 | } | 
|---|
| 967 | -f $from || $perlpodbadsymlink || warn "$0: $from not found"; | 
|---|
| 968 | $packlist->{$xto} = { type => 'file' }; | 
|---|
| 969 | if ($force || compare($from, $to) || $nonono) { | 
|---|
| 970 | safe_unlink($to);   # In case we don't have write permissions. | 
|---|
| 971 | if ($nonono) { | 
|---|
| 972 | $from = $depth . "/" . $from if $depth; | 
|---|
| 973 | } | 
|---|
| 974 | if ($perlpodbadsymlink && $from =~ m!^pod/perl(.+)\.pod$!) { | 
|---|
| 975 | $from = "README.$1"; | 
|---|
| 976 | } | 
|---|
| 977 | copy($from, $to); | 
|---|
| 978 | # Restore timestamps if it's a .a library or for OS/2. | 
|---|
| 979 | if (!$nonono && ($Is_OS2 || $to =~ /\.a$/)) { | 
|---|
| 980 | my ($atime, $mtime) = (stat $from)[8,9]; | 
|---|
| 981 | utime $atime, $mtime, $to; | 
|---|
| 982 | } | 
|---|
| 983 | 1; | 
|---|
| 984 | } | 
|---|
| 985 | } | 
|---|
| 986 |  | 
|---|
| 987 | sub strip | 
|---|
| 988 | { | 
|---|
| 989 | my(@args) = @_; | 
|---|
| 990 |  | 
|---|
| 991 | return unless $dostrip; | 
|---|
| 992 |  | 
|---|
| 993 | my @opts; | 
|---|
| 994 | while (@args && $args[0] =~ /^(-\w+)$/) { | 
|---|
| 995 | push @opts, shift @args; | 
|---|
| 996 | } | 
|---|
| 997 |  | 
|---|
| 998 | foreach my $file (@args) { | 
|---|
| 999 | if (-f $file) { | 
|---|
| 1000 | if ($verbose) { | 
|---|
| 1001 | print "  strip " . join(' ', @opts); | 
|---|
| 1002 | print " " if (@opts); | 
|---|
| 1003 | print "$file\n"; | 
|---|
| 1004 | } | 
|---|
| 1005 | system("strip", @opts, $file); | 
|---|
| 1006 | } else { | 
|---|
| 1007 | print "# file '$file' skipped\n" if $verbose; | 
|---|
| 1008 | } | 
|---|
| 1009 | } | 
|---|
| 1010 | } | 
|---|