diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | install_lib.pl | 129 | ||||
| -rwxr-xr-x | installman | 115 | ||||
| -rwxr-xr-x | installperl | 128 | ||||
| -rw-r--r-- | pod/perltodo.pod | 9 |
5 files changed, 147 insertions, 235 deletions
@@ -1406,6 +1406,7 @@ hv.c Hash value code 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 diff --git a/install_lib.pl b/install_lib.pl new file mode 100644 index 0000000000..7eeae1d33c --- /dev/null +++ b/install_lib.pl @@ -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; diff --git a/installman b/installman index 9778029304..9c3f873969 100755 --- a/installman +++ b/installman @@ -1,55 +1,20 @@ #!./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); -use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $Is_Darwin $Is_NetWare); - -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;' } -} - -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'; @@ -74,7 +39,6 @@ my $usage = --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)) @@ -244,47 +208,6 @@ print " Installation complete\n" if $opts{verbose}; exit 0; -############################################################################### -# Utility subroutines from installperl - -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 $^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 {} - : die "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)) { @@ -298,27 +221,3 @@ sub rename { 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); - - return (lc($p1) eq lc($p2)) if ($Is_W32 || $Is_NetWare); - - if ($p1 ne $p2) { - ($dev1, $ino1) = stat($p1); - ($dev2, $ino2) = stat($p2); - ($dev1 == $dev2 && $ino1 == $ino2); - } - else { - 1; - } -} diff --git a/installperl b/installperl index 03ff495041..54e657826f 100755 --- a/installperl +++ b/installperl @@ -5,45 +5,19 @@ BEGIN { 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 the use Config; below. + require './install_lib.pl'; } use strict; -my ($Is_VMS, $Is_W32, $Is_OS2, $Is_Cygwin, $Is_Darwin, - %opts, $dostrip, $versiononly, $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); 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 +29,7 @@ use File::Copy (); 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'; @@ -275,7 +242,7 @@ else { } #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; @@ -646,6 +613,9 @@ exit 0; ############################################################################### +# If these are needed elsewhere, move them into install_lib.pl rather than +# copying them. + sub yn { my($prompt) = @_; my($answer); @@ -656,22 +626,6 @@ sub yn { ($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 $opts{verbose}; - ( CORE::unlink($name) and ++$cnt - or warn "Couldn't unlink $name: $!\n" ) unless $opts{notify}; - } - return $cnt; -} - sub safe_unlink { return if $opts{notify} or $Is_VMS; my @names = @_; @@ -703,52 +657,6 @@ sub safe_rename { unlink($from); } -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 copy { my($from,$to) = @_; @@ -767,22 +675,6 @@ sub copy { $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#^\.(?![^/])/?##; diff --git a/pod/perltodo.pod b/pod/perltodo.pod index d856c4f634..40159610d3 100644 --- a/pod/perltodo.pod +++ b/pod/perltodo.pod @@ -30,15 +30,6 @@ some variation on the big block of C<$Is_Foo> checks. We can safely put this 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 |