In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/4320851cd57948e3e528ddb2ea5adc8e2d873271?hp=1f55bb435760d6f0cd87d3d9fd23b3c51253b43e>
- Log ----------------------------------------------------------------- commit 4320851cd57948e3e528ddb2ea5adc8e2d873271 Merge: 1f55bb4 0664757 Author: Nicholas Clark <[email protected]> Date: Tue Jul 23 14:36:03 2013 +0200 Merge the install_lib.pl/installman/installperl refactoring into blead. commit 06647572b041d2b9ee3087793f7d56668840eefa Author: Nicholas Clark <[email protected]> Date: Sun Jul 14 11:44:20 2013 +0200 install_lib.pl's samepath() should not warn if $p1 does not exist. If $p1 is a non-existent path, then the two paths can't be the same, so samepath() should promptly return false. M install_lib.pl commit f4df373def033480516a6b0b9bd76e0182ce0024 Author: Nicholas Clark <[email protected]> Date: Sun Jul 14 11:12:17 2013 +0200 In install_lib.pl, no need to Config->import for the relocatableinc setup. require Config; within the BEGIN block instead of using it outside it to save creating one implicit BEGIN block, and running its import twice. Remove the require 5.004; as the require of Config will fail if running with anything other than the version about to be installed. Note in installperl and installman that install_lib.pl imports Config. M install_lib.pl M installman M installperl commit a01f566143b97d5d074775e31bd511a83044cab6 Author: Nicholas Clark <[email protected]> Date: Sat Jul 13 20:50:44 2013 +0200 Move the wrapper for File::Path::mkpath() to install_lib.pl installperl and installman call File::Path::mkpath with identical arguments and options, so move the repeated code into a single place. M install_lib.pl M installman M installperl commit 4c4326140484b090df4dd2ed7165e669991744cc Author: Nicholas Clark <[email protected]> Date: Sat Jul 13 18:33:53 2013 +0200 Move {safe_,}rename() from install{man,perl} into install_lib.pl installman's rename() was identical to installperl's safe_rename() in all but name (and whitespace), so de-duplicate by moving the code to install_lib.pl M install_lib.pl M installman M installperl ----------------------------------------------------------------------- Summary of changes: install_lib.pl | 44 +++++++++++++++++++++++++++++++------------- installman | 22 +++++----------------- installperl | 40 ++++++++++------------------------------ 3 files changed, 46 insertions(+), 60 deletions(-) diff --git a/install_lib.pl b/install_lib.pl index 308af70..aa9945a 100644 --- a/install_lib.pl +++ b/install_lib.pl @@ -7,10 +7,11 @@ 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); +require File::Path; -use Config; BEGIN { - if ($Config{userelocatableinc}) { + require Config; + if ($Config::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. @@ -18,7 +19,7 @@ BEGIN { # So we set $^X to pretend that we're the already installed perl, so # Config.pm does its ... expansion off that location. - my $location = $Config{initialinstalllocation}; + my $location = $Config::Config{initialinstalllocation}; die <<'OS' unless defined $location; $Config{initialinstalllocation} is not defined - can't install a relocatable perl without this. @@ -33,8 +34,8 @@ OS # You never saw us. We weren't here. require Config; - Config->import; } + Config->import; } if ($Config{d_umask}) { @@ -110,21 +111,38 @@ sub chmod { 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; + return 1 + if $p1 eq $p2; + + my ($dev1, $ino1) = stat $p1; + return 0 + unless defined $dev1; + my ($dev2, $ino2) = stat $p2; + + return $dev1 == $dev2 && $ino1 == $ino2; +} + +sub safe_rename { + my($from,$to) = @_; + if (-f $to and not unlink($to)) { + my($i); + for ($i = 1; $i < 50; $i++) { + last if rename($to, "$to.$i"); + } + warn("Cannot rename to '$to.$i': $!"), return 0 + if $i >= 50; # Give up! } + link($from,$to) || return 0; + unlink($from); +} + +sub mkpath { + File::Path::mkpath(shift , $opts{verbose}, 0777) unless $opts{notify}; } 1; diff --git a/installman b/installman index 4f9d469..3f83909 100755 --- a/installman +++ b/installman @@ -1,14 +1,16 @@ #!./perl -w + BEGIN { @INC = qw(lib); # This needs to be at BEGIN time, before any use of Config + # install_lib itself loads and imports Config into main:: require './install_lib.pl'; } + use strict; use Getopt::Long; -require File::Path; use ExtUtils::Packlist; use Pod::Man; use vars qw(%opts $packlist); @@ -119,7 +121,7 @@ sub pod2man { } } - File::Path::mkpath($mandir, $opts{verbose}, 0777) unless $opts{notify}; + mkpath($mandir); foreach my $manpage (sort keys %$modpods) { my $mod = $modpods->{$manpage}; @@ -159,7 +161,7 @@ sub pod2man { print " $xmanpage\n" unless $opts{silent}; if (!$opts{notify} && $parser->parse_from_file($mod, $tmp)) { if (-s $tmp) { - if (rename($tmp, $manpage)) { + if (safe_rename($tmp, $manpage)) { $packlist->{$xmanpage} = { type => 'file' }; next; } @@ -172,20 +174,6 @@ sub pod2man { $packlist->write() unless $opts{notify}; print " Installation complete\n" if $opts{verbose}; -sub rename { - my($from,$to) = @_; - if (-f $to and not unlink($to)) { - my($i); - for ($i = 1; $i < 50; $i++) { - last if CORE::rename($to, "$to.$i"); - } - warn("Cannot rename to '$to.$i': $!"), return 0 - if $i >= 50; # Give up! - } - link($from,$to) || return 0; - unlink($from); -} - # Local variables: # cperl-indent-level: 4 # indent-tabs-mode: nil diff --git a/installperl b/installperl index 9cf7d7b..427786f 100755 --- a/installperl +++ b/installperl @@ -1,12 +1,12 @@ #!./perl -w BEGIN { - require 5.004; chdir '..' if !-d 'lib' and -d '../lib'; @INC = 'lib'; $ENV{PERL5LIB} = 'lib'; # This needs to be at BEGIN time, before any use of Config + # install_lib itself loads and imports Config into main:: require './install_lib.pl'; } @@ -24,7 +24,6 @@ my $scr_ext = ($Is_VMS ? '.Com' : $Is_W32 ? '.bat' : ''); use File::Find; use File::Compare; use File::Copy (); -use File::Path (); use ExtUtils::Packlist; use Cwd; # nogetopt_compat to disable treating +v as meaning -v @@ -37,11 +36,6 @@ if ($Is_NetWare) { $scr_ext = '.pl'; } -# override the ones in the rest of the script -sub mkpath { - File::Path::mkpath(@_) unless $opts{notify}; -} - my $mainperldir = "/usr/bin"; my $exe_ext = $Config{exe_ext}; @@ -237,7 +231,7 @@ if ($Is_VMS) { # Hang in there until File::Spec hits the big time # Do some quick sanity checks. $installbin || die "No installbin directory in config.sh\n"; --d $installbin || mkpath($installbin, $opts{verbose}, 0777); +-d $installbin || mkpath($installbin); -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}; @@ -313,13 +307,13 @@ elsif ($^O ne 'dos') { # If installing onto a NetWare server if ($opts{netware}) { # Copy perl.nlm, echo.nlm, type.nlm, a2p.nlm & cgi2perl.nlm - mkpath($Config{installnwsystem}, $opts{verbose}, 0777); + mkpath($Config{installnwsystem}); copy("netware\\".$ENV{'MAKE_TYPE'}."\\perl.nlm", $Config{installnwsystem}); copy("netware\\testnlm\\echo\\echo.nlm", $Config{installnwsystem}); copy("netware\\testnlm\\type\\type.nlm", $Config{installnwsystem}); copy("x2p\\a2p.nlm", $Config{installnwsystem}); chmod(0755, "$Config{installnwsystem}\\perl.nlm"); - mkpath($Config{installnwlcgi}, $opts{verbose}, 0777); + mkpath($Config{installnwlcgi}); copy("lib\\auto\\cgi2perl\\cgi2perl.nlm", $Config{installnwlcgi}); } } #if (!$Is_NetWare) @@ -336,8 +330,8 @@ my $do_installprivlib = !samepath($installprivlib, 'lib'); my $vershort = ($Is_Cygwin and !$Config{usedevel}) ? substr($ver,0,-2) : $ver; $do_installprivlib = 0 if $versiononly && !($installprivlib =~ m/\Q$vershort/); -mkpath($installprivlib, $opts{verbose}, 0777); -mkpath($installarchlib, $opts{verbose}, 0777); +mkpath($installprivlib); +mkpath($installarchlib); mkpath($installsitelib, $opts{verbose}, 0777) if ($installsitelib); mkpath($installsitearch, $opts{verbose}, 0777) if ($installsitearch); @@ -350,7 +344,7 @@ else { } # Install header files and libraries. -mkpath("$installarchlib/CORE", $opts{verbose}, 0777); +mkpath("$installarchlib/CORE"); my @corefiles; if ($Is_VMS) { # We did core file selection during build my $coredir = "lib/$Config{archname}/$ver/CORE"; @@ -499,7 +493,7 @@ sub script_alias { } # Install scripts. -mkpath($installscript, $opts{verbose}, 0777); +mkpath($installscript); if ($versiononly) { for (@scripts) { (my $base = $_) =~ s#.*/##; @@ -533,7 +527,7 @@ if ($versiononly) { # ($installprivlib/pods for cygwin). if (!$opts{nopods} && (!$versiononly || ($installprivlib =~ m/\Q$vershort/))) { my $pod = ($Is_Cygwin || $Is_Darwin || $Is_VMS || $Is_W32) ? 'pods' : 'pod'; - mkpath("${installprivlib}/$pod", $opts{verbose}, 0777); + mkpath("${installprivlib}/$pod"); for (map {$_->[1]} @{get_pod_metadata()->{master}}) { # $_ is a name like pod/perl.pod @@ -625,20 +619,6 @@ sub safe_unlink { } } -sub safe_rename { - my($from,$to) = @_; - if (-f $to and not unlink($to)) { - my($i); - for ($i = 1; $i < 50; $i++) { - last if rename($to, "$to.$i"); - } - warn("Cannot rename to '$to.$i': $!"), return 0 - if $i >= 50; # Give up! - } - link($from,$to) || return 0; - unlink($from); -} - sub copy { my($from,$to) = @_; @@ -768,7 +748,7 @@ sub installlib { $packlist->{$xname} = { type => 'file' }; if ($opts{force} || compare($_, "$installlib/$name") || $opts{notify}) { unlink("$installlib/$name"); - mkpath("$installlib/$dir", $opts{verbose}, 0777); + mkpath("$installlib/$dir"); # HP-UX (at least) needs to maintain execute permissions # on dynamically-loaded libraries. if (copy_if_diff($_, "$installlib/$name")) { -- Perl5 Master Repository
