Change 33954 by [EMAIL PROTECTED] on 2008/05/31 00:29:21
Integrate:
[ 33859]
$nonono => $opts{notify}
$verbose => $opts{verbose}
$silent => $opts{silent}
to align the code with forked code in installman
[ 33860]
Converge some changes from installperl into installman. I have a
suspicion that installman is only run on *nix and OS/2, not Win32 or
VMS. Specifically
sub unlink - return scalar(@names) if $Is_VMS # from change 854
sub link - change warn to die # from change 4774
sub samepath - case insensitive name comparison # from change 311
(in the ansiperl branch, merged via the win32 branch)
[ 33861]
Change 33859 missed $destdir => $opts{destdir}
[ 33862]
Merge common code from installperl and installman into install_lib.pl
[ 33863]
A couple more installman tidy ups.
[ 33864]
Add -w, tweak some comments.
Affected files ...
... //depot/maint-5.10/perl/MANIFEST#29 integrate
... //depot/maint-5.10/perl/install_lib.pl#1 branch
... //depot/maint-5.10/perl/installman#2 integrate
... //depot/maint-5.10/perl/installperl#5 integrate
... //depot/maint-5.10/perl/pod/perltodo.pod#11 integrate
Differences ...
==== //depot/maint-5.10/perl/MANIFEST#29 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#28~33945~ 2008-05-28 13:51:40.000000000 -0700
+++ perl/MANIFEST 2008-05-30 17:29:21.000000000 -0700
@@ -1395,6 +1395,7 @@
hv.h Hash value header
INSTALL Detailed installation instructions
installhtml Perl script to install html files for pods
+install_lib.pl functions shared between install* scripts
installman Perl script to install man pages for pods
installperl Perl script to do "make install" dirty work
INTERN.h Included before domestic .h files
==== //depot/maint-5.10/perl/install_lib.pl#1 (text) ====
Index: perl/install_lib.pl
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/install_lib.pl 2008-05-30 17:29:21.000000000 -0700
@@ -0,0 +1,129 @@
+#!perl
+
+# Initialisation code and subroutines shared between installperl and installman
+# Probably installhtml needs to join the club.
+
+use strict;
+use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $Is_Darwin $Is_NetWare
+ %opts $packlist);
+use subs qw(unlink link chmod);
+
+use Config;
+BEGIN {
+ 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.
+
+ require Config;
+ Config->import;
+ }
+}
+
+if ($Config{d_umask}) {
+ umask(022); # umasks like 077 aren't that useful for installations
+}
+
+$Is_VMS = $^O eq 'VMS';
+$Is_W32 = $^O eq 'MSWin32';
+$Is_OS2 = $^O eq 'os2';
+$Is_Cygwin = $^O eq 'cygwin';
+$Is_Darwin = $^O eq 'darwin';
+$Is_NetWare = $Config{osname} eq 'NetWare';
+
+sub unlink {
+ my(@names) = @_;
+ my($cnt) = 0;
+
+ return scalar(@names) if $Is_VMS;
+
+ foreach my $name (@names) {
+ next unless -e $name;
+ chmod 0777, $name if ($Is_OS2 || $Is_W32 || $Is_Cygwin || $Is_NetWare);
+ print " unlink $name\n" if $opts{verbose};
+ ( CORE::unlink($name) and ++$cnt
+ or warn "Couldn't unlink $name: $!\n" ) unless $opts{notify};
+ }
+ return $cnt;
+}
+
+sub link {
+ my($from,$to) = @_;
+ my($success) = 0;
+
+ my $xfrom = $from;
+ $xfrom =~ s/^\Q$opts{destdir}\E// if $opts{destdir};
+ my $xto = $to;
+ $xto =~ s/^\Q$opts{destdir}\E// if $opts{destdir};
+ print $opts{verbose} ? " ln $xfrom $xto\n" : " $xto\n"
+ unless $opts{silent};
+ eval {
+ CORE::link($from, $to)
+ ? $success++
+ : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
+ ? die "AFS" # okay inside eval {}
+ : die "Couldn't link $from to $to: $!\n"
+ unless $opts{notify};
+ $packlist->{$xto} = { from => $xfrom, type => 'link' };
+ };
+ if ($@) {
+ warn "Replacing link() with File::Copy::copy(): $@";
+ print $opts{verbose} ? " cp $from $xto\n" : " $xto\n"
+ unless $opts{silent};
+ print " creating new version of $xto\n"
+ if $Is_VMS and -e $to and !$opts{silent};
+ unless ($opts{notify} 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;
+}
+
+sub chmod {
+ my($mode,$name) = @_;
+
+ return if ($^O eq 'dos');
+ printf " chmod %o %s\n", $mode, $name if $opts{verbose};
+ CORE::chmod($mode,$name)
+ || warn sprintf("Couldn't chmod %o %s: $!\n", $mode, $name)
+ unless $opts{notify};
+}
+
+
+sub samepath {
+ my($p1, $p2) = @_;
+
+ return (lc($p1) eq lc($p2)) if ($Is_W32 || $Is_NetWare);
+
+ if ($p1 ne $p2) {
+ my($dev1, $ino1, $dev2, $ino2);
+ ($dev1, $ino1) = stat($p1);
+ ($dev2, $ino2) = stat($p2);
+ ($dev1 == $dev2 && $ino1 == $ino2);
+ }
+ else {
+ 1;
+ }
+}
+
+1;
==== //depot/maint-5.10/perl/installman#2 (xtext) ====
Index: perl/installman
--- perl/installman#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/installman 2008-05-30 17:29:21.000000000 -0700
@@ -1,50 +1,23 @@
#!./perl -w
-BEGIN { @INC = qw(lib) }
-use strict;
-
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.
- }
+ @INC = qw(lib);
+
+ # This needs to be at BEGIN time, before any use of Config
+ require './install_lib.pl';
}
+use strict;
-use Config;
use Getopt::Long;
use File::Find;
use File::Copy;
use File::Path qw(mkpath);
use ExtUtils::Packlist;
use Pod::Man;
-use subs qw(unlink chmod rename link);
-use vars qw($packlist);
-
-if ($Config{d_umask}) {
- umask(022); # umasks like 077 aren't that useful for installations
-}
+use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $Is_Darwin $Is_NetWare
+ %opts $packlist);
$ENV{SHELL} = 'sh' if $^O eq 'os2';
-my $ver = $Config{version}; # Not used presently.
-my $release = substr($],0,3); # Not used presently.
my $patchlevel = substr($],3,2);
die "Patchlevel of perl ($patchlevel)",
"and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n"
@@ -64,7 +37,6 @@
--verbose (or -V) report all progress.
--silent (or -S) be silent. Only report errors.\n";
-my %opts;
GetOptions( \%opts,
qw( man1dir=s man1ext=s man3dir=s man3ext=s batchlimit=i
destdir:s notify n help silent S verbose V))
@@ -72,14 +44,10 @@
die $usage if $opts{help};
$opts{destdir} //= '';
-$opts{man1dir} = "$opts{destdir}$Config{'installman1dir'}"
- unless defined($opts{man1dir});
-$opts{man1ext} = $Config{'man1ext'}
- unless defined($opts{man1ext});
-$opts{man3dir} = "$opts{destdir}$Config{'installman3dir'}"
- unless defined($opts{man3dir});
-$opts{man3ext} = $Config{'man3ext'}
- unless defined($opts{man3ext});
+foreach my $pre (qw(man1 man3)) {
+ $opts{"${pre}dir"} //= $opts{destdir} . $Config{"install${pre}dir"};
+ $opts{"${pre}ext"} //= $Config{"${pre}ext"};
+}
$opts{silent} ||= $opts{S};
$opts{notify} ||= $opts{n};
$opts{verbose} ||= $opts{V} || $opts{notify};
@@ -234,45 +202,6 @@
exit 0;
-###############################################################################
-# Utility subroutines from installperl
-
-sub unlink {
- my(@names) = @_;
- my $cnt = 0;
-
- foreach my $name (@names) {
- next unless -e $name;
- chmod 0777, $name if $^O eq 'os2';
- print " unlink $name\n" if $opts{verbose};
- ( CORE::unlink($name) and ++$cnt
- or warn "Couldn't unlink $name: $!\n" ) unless $opts{notify};
- }
- return $cnt;
-}
-
-sub link {
- my($from,$to) = @_;
- my($success) = 0;
-
- print " ln $from $to\n" if $opts{verbose};
- eval {
- CORE::link($from, $to)
- ? $success++
- : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
- ? die "AFS" # okay inside eval {}
- : warn "Couldn't link $from to $to: $!\n"
- unless $opts{notify};
- };
- if ($@) {
- File::Copy::copy($from, $to)
- ? $success++
- : warn "Couldn't copy $from to $to: $!\n"
- unless $opts{notify};
- }
- $success;
-}
-
sub rename {
my($from,$to) = @_;
if (-f $to and not unlink($to)) {
@@ -286,25 +215,3 @@
link($from,$to) || return 0;
unlink($from);
}
-
-sub chmod {
- my($mode,$name) = @_;
-
- printf " chmod %o %s\n", $mode, $name if $opts{verbose};
- CORE::chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s:
$!\n",$mode,$name)
- unless $opts{notify};
-}
-
-sub samepath {
- my($p1, $p2) = @_;
- my($dev1, $ino1, $dev2, $ino2);
-
- if ($p1 ne $p2) {
- ($dev1, $ino1) = stat($p1);
- ($dev2, $ino2) = stat($p2);
- ($dev1 == $dev2 && $ino1 == $ino2);
- }
- else {
- 1;
- }
-}
==== //depot/maint-5.10/perl/installperl#5 (xtext) ====
Index: perl/installperl
--- perl/installperl#4~33619~ 2008-03-31 14:36:46.000000000 -0700
+++ perl/installperl 2008-05-30 17:29:21.000000000 -0700
@@ -1,49 +1,25 @@
-#!./perl
+#!./perl -w
BEGIN {
require 5.004;
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.
- }
+ # This needs to be at BEGIN time, before any use of Config
+ require './install_lib.pl';
}
use strict;
-my ($Is_VMS, $Is_W32, $Is_OS2, $Is_Cygwin, $Is_Darwin,
- $nonono, $dostrip, $versiononly, $silent, $verbose, $force,
- $otherperls, $archname, $Is_NetWare, $nwinstall, $nopods);
+use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $Is_Darwin $Is_NetWare
+ %opts $packlist);
+my ($dostrip, $versiononly, $force,
+ $otherperls, $archname, $nwinstall, $nopods);
+# Not sure how easy it would be to refactor to remove the need for local $depth
+# below
use vars qw /$depth/;
BEGIN {
- $Is_VMS = $^O eq 'VMS';
- $Is_W32 = $^O eq 'MSWin32';
- $Is_OS2 = $^O eq 'os2';
- $Is_Cygwin = $^O eq 'cygwin';
- $Is_Darwin = $^O eq 'darwin';
if ($Is_VMS) { eval 'use VMS::Filespec;' }
}
@@ -55,14 +31,7 @@
use File::Path ();
use ExtUtils::Packlist;
use Cwd;
-use Config;
-use subs qw(unlink link chmod);
-if ($Config{d_umask}) {
- umask(022); # umasks like 077 aren't that useful for installations
-}
-
-$Is_NetWare = $Config{osname} eq 'NetWare';
if ($Is_NetWare) {
$Is_W32 = 0;
$scr_ext = '.pl';
@@ -70,13 +39,13 @@
# override the ones in the rest of the script
sub mkpath {
- File::Path::mkpath(@_) unless $nonono;
+ File::Path::mkpath(@_) unless $opts{notify};
}
my $mainperldir = "/usr/bin";
my $exe_ext = $Config{exe_ext};
-# Allow ``make install PERLNAME=something_besides_perl'':
+# Allow "make install PERLNAME=something_besides_perl":
my $perl = defined($ENV{PERLNAME}) ? $ENV{PERLNAME} : 'perl';
# This is the base used for versioned names, like "perl5.6.0".
@@ -98,20 +67,21 @@
}
$otherperls = 1;
-my $destdir = '';
+# Consider refactoring this to use Getopt::Long once Getopt::Long's planned
+# feature is implemented, to distinguish + and - options.
while (@ARGV) {
- $nonono = 1 if $ARGV[0] eq '-n';
+ $opts{notify} = 1 if $ARGV[0] eq '-n';
$dostrip = 1 if $ARGV[0] eq '-s';
$versiononly = 1 if $ARGV[0] eq '-v';
$versiononly = 0 if $ARGV[0] eq '+v';
- $silent = 1 if $ARGV[0] eq '-S';
+ $opts{silent} = 1 if $ARGV[0] eq '-S';
$otherperls = 0 if $ARGV[0] eq '-o';
$force = 1 if $ARGV[0] eq '-f';
- $verbose = 1 if $ARGV[0] eq '-V' || $ARGV [0] eq '-n';
+ $opts{verbose} = 1 if $ARGV[0] eq '-V' || $ARGV [0] eq '-n';
$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=(.*)$/;
+ $opts{destdir} = $1 if $ARGV[0] =~ /^-?-destdir=(.*)$/;
if ($ARGV[0] eq '-?' or $ARGV[0] =~ /^-?-h/) {
print <<"EOT";
Usage $0: [switches]
@@ -206,13 +176,13 @@
if $patchlevel != $Config{'PERL_VERSION'};
# Fetch some frequently-used items from %Config
-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 $installbin = "$opts{destdir}$Config{installbin}";
+my $installscript = "$opts{destdir}$Config{installscript}";
+my $installprivlib = "$opts{destdir}$Config{installprivlib}";
+my $installarchlib = "$opts{destdir}$Config{installarchlib}";
+my $installsitelib = "$opts{destdir}$Config{installsitelib}";
+my $installsitearch = "$opts{destdir}$Config{installsitearch}";
+my $installman1dir = "$opts{destdir}$Config{installman1dir}";
my $man1ext = $Config{man1ext};
my $libperl = $Config{libperl};
# Shared library and dynamic loading suffixes.
@@ -250,13 +220,13 @@
# Do some quick sanity checks.
-if (!$nonono && $d_dosuid && $>) { die "You must run as root to install
suidperl\n"; }
+if (!$opts{notify} && $d_dosuid && $>) { die "You must run as root to install
suidperl\n"; }
$installbin || die "No installbin directory in config.sh\n";
--d $installbin || mkpath($installbin, $verbose, 0777);
--d $installbin || $nonono || die "$installbin is not a directory\n";
--w $installbin || $nonono || die "$installbin is not writable by you\n"
- unless $installbin =~ m#^/afs/# || $nonono;
+-d $installbin || mkpath($installbin, $opts{verbose}, 0777);
+-d $installbin || $opts{notify} || die "$installbin is not a
directory\n";
+-w $installbin || $opts{notify} || die "$installbin is not writable by
you\n"
+ unless $installbin =~ m#^/afs/# || $opts{notify};
if (!$Is_NetWare) {
if (!$Is_VMS) {
@@ -276,7 +246,7 @@
} #if (!$Is_NetWare)
# This will be used to store the packlist
-my $packlist = ExtUtils::Packlist->new("$installarchlib/.packlist");
+$packlist = ExtUtils::Packlist->new("$installarchlib/.packlist");
if (($Is_W32 and ! $Is_NetWare) or $Is_Cygwin) {
my $perldll;
@@ -370,10 +340,10 @@
my ($do_installarchlib, $do_installprivlib) = (0, 0);
my $vershort = $Is_Cygwin ? substr($ver,0,-2) : $ver;
-mkpath($installprivlib, $verbose, 0777);
-mkpath($installarchlib, $verbose, 0777);
-mkpath($installsitelib, $verbose, 0777) if ($installsitelib);
-mkpath($installsitearch, $verbose, 0777) if ($installsitearch);
+mkpath($installprivlib, $opts{verbose}, 0777);
+mkpath($installarchlib, $opts{verbose}, 0777);
+mkpath($installsitelib, $opts{verbose}, 0777) if ($installsitelib);
+mkpath($installsitearch, $opts{verbose}, 0777) if ($installsitearch);
if (chdir "lib") {
$do_installarchlib = ! samepath($installarchlib, '.');
@@ -390,7 +360,7 @@
}
# Install header files and libraries.
-mkpath("$installarchlib/CORE", $verbose, 0777);
+mkpath("$installarchlib/CORE", $opts{verbose}, 0777);
my @corefiles;
if ($Is_VMS) { # We did core file selection during build
my $coredir = "lib/$Config{archname}/$ver/CORE";
@@ -405,7 +375,7 @@
push(@corefiles,'perl.exp') if $^O eq 'aix';
if ($^O eq 'mpeix') {
# MPE needs mpeixish.h installed as well.
- mkpath("$installarchlib/CORE/mpeix", $verbose, 0777);
+ mkpath("$installarchlib/CORE/mpeix", $opts{verbose}, 0777);
push(@corefiles,'mpeix/mpeixish.h');
}
# If they have built sperl.o...
@@ -469,7 +439,7 @@
my $mainperl_is_instperl = 0;
if ($Config{installusrbinperl} && $Config{installusrbinperl} eq 'define' &&
- !$versiononly && !$nonono && !$Is_W32 && !$Is_NetWare && !$Is_VMS && -t
STDIN && -t STDERR
+ !$versiononly && !$opts{notify} && !$Is_W32 && !$Is_NetWare && !$Is_VMS &&
-t STDIN && -t STDERR
&& -w $mainperldir && ! samepath($mainperldir, $installbin)) {
my($usrbinperl) = "$mainperldir/$perl$exe_ext";
my($instperl) = "$installbin/$perl$exe_ext";
@@ -537,7 +507,7 @@
}
# Install scripts.
-mkpath($installscript, $verbose, 0777);
+mkpath($installscript, $opts{verbose}, 0777);
if ($versiononly) {
for (@scripts) {
(my $base = $_) =~ s#.*/##;
@@ -572,7 +542,7 @@
my $pod = ($Is_Cygwin || $Is_Darwin || $Is_VMS || $Is_W32) ? 'pods' : 'pod';
if ( !$versiononly || ($installprivlib =~ m/\Q$vershort/)) {
- mkpath("${installprivlib}/$pod", $verbose, 0777);
+ mkpath("${installprivlib}/$pod", $opts{verbose}, 0777);
# If Perl 5.003's perldiag.pod is there, rename it.
if (open POD, "${installprivlib}/$pod/perldiag.pod") {
@@ -585,7 +555,7 @@
print " rename $from $to";
rename($from, $to)
or warn "Couldn't rename $from to $to: $!\n"
- unless $nonono;
+ unless $opts{notify};
}
}
@@ -640,13 +610,16 @@
}
-$packlist->write() unless $nonono;
-print " Installation complete\n" if $verbose;
+$packlist->write() unless $opts{notify};
+print " Installation complete\n" if $opts{verbose};
exit 0;
###############################################################################
+# If these are needed elsewhere, move them into install_lib.pl rather than
+# copying them.
+
sub yn {
my($prompt) = @_;
my($answer);
@@ -657,33 +630,17 @@
($answer =~ m/^[yY]/);
}
-sub unlink {
- my(@names) = @_;
- my($cnt) = 0;
-
- return scalar(@names) if $Is_VMS;
-
- foreach my $name (@names) {
- next unless -e $name;
- chmod 0777, $name if ($Is_OS2 || $Is_W32 || $Is_Cygwin || $Is_NetWare);
- print " unlink $name\n" if $verbose;
- ( CORE::unlink($name) and ++$cnt
- or warn "Couldn't unlink $name: $!\n" ) unless $nonono;
- }
- return $cnt;
-}
-
sub safe_unlink {
- return if $nonono or $Is_VMS;
+ return if $opts{notify} or $Is_VMS;
my @names = @_;
foreach my $name (@names) {
next unless -e $name;
chmod 0777, $name if ($Is_OS2 || $Is_W32 || $Is_NetWare);
- print " unlink $name\n" if $verbose;
+ print " unlink $name\n" if $opts{verbose};
next if CORE::unlink($name);
warn "Couldn't unlink $name: $!\n";
if ($! =~ /busy/i) {
- print " mv $name $name.old\n" if $verbose;
+ print " mv $name $name.old\n" if $opts{verbose};
safe_rename($name, "$name.old")
or warn "Couldn't rename $name: $!\n";
}
@@ -704,58 +661,16 @@
unlink($from);
}
-sub link {
- my($from,$to) = @_;
- my($success) = 0;
-
- 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++
- : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
- ? die "AFS" # okay inside eval {}
- : die "Couldn't link $from to $to: $!\n"
- unless $nonono;
- $packlist->{$xto} = { from => $xfrom, type => 'link' };
- };
- if ($@) {
- 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;
- 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;
-}
-
-sub chmod {
- my($mode,$name) = @_;
-
- return if ($^O eq 'dos');
- printf " chmod %o %s\n", $mode, $name if $verbose;
- CORE::chmod($mode,$name)
- || warn sprintf("Couldn't chmod %o %s: $!\n", $mode, $name)
- unless $nonono;
-}
-
sub copy {
my($from,$to) = @_;
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)) {
+ $xto =~ s/^\Q$opts{destdir}\E// if $opts{destdir};
+ print $opts{verbose} ? " cp $from $xto\n" : " $xto\n"
+ unless $opts{silent};
+ print " creating new version of $xto\n"
+ if $Is_VMS and -e $to and !$opts{silent};
+ unless ($opts{notify} 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)
@@ -764,22 +679,6 @@
$packlist->{$xto} = { type => 'file' };
}
-sub samepath {
- my($p1, $p2) = @_;
-
- return (lc($p1) eq lc($p2)) if ($Is_W32 || $Is_NetWare);
-
- if ($p1 ne $p2) {
- my($dev1, $ino1, $dev2, $ino2);
- ($dev1, $ino1) = stat($p1);
- ($dev2, $ino2) = stat($p2);
- ($dev1 == $dev2 && $ino1 == $ino2);
- }
- else {
- 1;
- }
-}
-
sub installlib {
my $dir = $File::Find::dir;
$dir =~ s#^\.(?![^/])/?##;
@@ -851,11 +750,11 @@
unlink("$installarchlib/$name");
}
my $xname = "$installlib/$name";
- $xname =~ s/^\Q$destdir\E// if $destdir;
+ $xname =~ s/^\Q$opts{destdir}\E// if $opts{destdir};
$packlist->{$xname} = { type => 'file' };
- if ($force || compare($_, "$installlib/$name") || $nonono) {
+ if ($force || compare($_, "$installlib/$name") || $opts{notify}) {
unlink("$installlib/$name");
- mkpath("$installlib/$dir", $verbose, 0777);
+ mkpath("$installlib/$dir", $opts{verbose}, 0777);
# HP-UX (at least) needs to maintain execute permissions
# on dynamically-loaded libraries.
if ($Is_NetWare && !$nwinstall) {
@@ -898,7 +797,7 @@
my($from,$to)[EMAIL PROTECTED];
return 1 if (($^O eq 'VMS') && (-d $from));
my $xto = $to;
- $xto =~ s/^\Q$destdir\E// if $destdir;
+ $xto =~ s/^\Q$opts{destdir}\E// if $opts{destdir};
my $perlpodbadsymlink;
if ($from =~ m!^pod/perl[\w-]+\.pod$! &&
-l $from &&
@@ -912,9 +811,9 @@
}
-f $from || $perlpodbadsymlink || warn "$0: $from not found";
$packlist->{$xto} = { type => 'file' };
- if ($force || compare($from, $to) || $nonono) {
+ if ($force || compare($from, $to) || $opts{notify}) {
safe_unlink($to); # In case we don't have write permissions.
- if ($nonono) {
+ if ($opts{notify}) {
$from = $depth . "/" . $from if $depth;
}
if ($perlpodbadsymlink && $from =~ m!^pod/perl(.+)\.pod$!) {
@@ -922,7 +821,7 @@
}
copy($from, $to);
# Restore timestamps if it's a .a library or for OS/2.
- if (!$nonono && ($Is_OS2 || $to =~ /\.a$/)) {
+ if (!$opts{notify} && ($Is_OS2 || $to =~ /\.a$/)) {
my ($atime, $mtime) = (stat $from)[8,9];
utime $atime, $mtime, $to;
}
@@ -943,14 +842,14 @@
foreach my $file (@args) {
if (-f $file) {
- if ($verbose) {
+ if ($opts{verbose}) {
print " strip " . join(' ', @opts);
print " " if (@opts);
print "$file\n";
}
system("strip", @opts, $file);
} else {
- print "# file '$file' skipped\n" if $verbose;
+ print "# file '$file' skipped\n" if $opts{verbose};
}
}
}
==== //depot/maint-5.10/perl/pod/perltodo.pod#11 (text) ====
Index: perl/pod/perltodo.pod
--- perl/pod/perltodo.pod#10~33884~ 2008-05-20 08:07:58.000000000 -0700
+++ perl/pod/perltodo.pod 2008-05-30 17:29:21.000000000 -0700
@@ -30,15 +30,6 @@
into a file, change it to build an C<%Is> hash and require it. Maybe just put
it into F<test.pl>. Throw in the handy tainting subroutines.
-=head2 merge common code in installperl and installman
-
-There are some common subroutines and a common C<BEGIN> block in F<installperl>
-and F<installman>. These should probably be merged. It would also be good to
-check for duplication in all the utility scripts supplied in the source
-tarball. It might be good to move them all to a subdirectory, but this would
-require careful checking to find all places that call them, and change those
-correctly.
-
=head2 common test code for timed bail out
Write portable self destruct code for tests to stop them burning CPU in
End of Patch.
