From: Perl 5 Porters Date: Thu, 7 Mar 1996 23:01:52 +0000 (+0000) Subject: perl 5.002_01: lib/ExtUtils/Install.pm X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=08ad6bd51aa9b43c749f6480d48228711f60a48e;p=p5sagit%2Fp5-mst-13.2.git perl 5.002_01: lib/ExtUtils/Install.pm Update to MakeMaker 5.26, including VMS support and $^O. Change over to SelfLoader, to avoid AutoLoader tricks during main build --- diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm index 84641c0..46b09d5 100644 --- a/lib/ExtUtils/Install.pm +++ b/lib/ExtUtils/Install.pm @@ -1,46 +1,64 @@ package ExtUtils::Install; -require Exporter; +use Exporter; +use SelfLoader; +use Carp (); + @ISA = ('Exporter'); -@EXPORT = ('install','uninstall'); - -use Carp; -use Cwd qw(cwd); -use ExtUtils::MakeMaker; # to implement a MY class -use File::Basename qw(dirname); -use File::Copy qw(copy); -use File::Find qw(find); -use File::Path qw(mkpath); +@EXPORT = ('install','uninstall','pm_to_blib'); +$Is_VMS = $^O eq 'VMS'; + +#use vars qw( @EXPORT @ISA $Is_VMS ); #use strict; +1; + +sub ExtUtils::Install::install; +sub ExtUtils::Install::uninstall; +sub ExtUtils::Install::pm_to_blib; +sub ExtUtils::Install::my_cmp; + +__DATA__ + sub install { my($hash,$verbose,$nonono) = @_; $verbose ||= 0; $nonono ||= 0; + + use Cwd qw(cwd); + use ExtUtils::MakeMaker; # to implement a MY class + use File::Basename qw(dirname); + use File::Copy qw(copy); + use File::Find qw(find); + use File::Path qw(mkpath); + # require "auto/ExtUtils/Install/my_cmp.al"; # Hairy, but for the first + # time use we are in a different directory when autoload happens, so + # the relativ path to ./blib is ill. + my(%hash) = %$hash; - my(%pack, %write,$dir); + my(%pack, %write, $dir); local(*DIR, *P); for (qw/read write/) { $pack{$_}=$hash{$_}; delete $hash{$_}; } - my($blibdir); - foreach $blibdir (sort keys %hash) { + my($source_dir_or_file); + foreach $source_dir_or_file (sort keys %hash) { #Check if there are files, and if yes, look if the corresponding #target directory is writable for us - opendir DIR, $blibdir or next; + opendir DIR, $source_dir_or_file or next; while ($_ = readdir DIR) { next if $_ eq "." || $_ eq ".." || $_ eq ".exists"; - if (-w $hash{$blibdir} || mkpath($hash{$blibdir})) { + if (-w $hash{$source_dir_or_file} || mkpath($hash{$source_dir_or_file})) { last; } else { - croak("You do not have permissions to install into $hash{$blibdir}"); + Carp::croak("You do not have permissions to install into $hash{$source_dir_or_file}"); } } closedir DIR; } if (-f $pack{"read"}) { - open P, $pack{"read"} or die "Couldn't read $pack{'read'}"; + open P, $pack{"read"} or Carp::croak("Couldn't read $pack{'read'}"); # Remember what you found while (

) { chomp; @@ -49,13 +67,11 @@ sub install { close P; } my $cwd = cwd(); - my $umask = umask 0; + my $umask = umask 0 unless $Is_VMS; # This silly reference is just here to be able to call MY->catdir # without a warning (Waiting for a proper path/directory module, - # Charles!) The catdir and catfile calls leave us with a lot of - # paths containing ././, but I don't want to use regexes on paths - # anymore to delete them :-) + # Charles!) my $MY = {}; bless $MY, 'MY'; my($source); @@ -77,38 +93,22 @@ sub install { if ( -f $targetfile && -s _ == $size) { # We have a good chance, we can skip this one - local(*F,*T); - open F, $_ or croak("Couldn't open $_: $!"); - open T, $targetfile or croak("Couldn't open $targetfile: $!"); - my($fr, $tr, $fbuf,$tbuf,$size); - $size = 1024; - # print "Reading $_\n"; - while ( $fr = read(F,$fbuf,$size)) { - unless ( - $tr = read(T,$tbuf,$size) and - $tbuf eq $fbuf - ){ - # print "diff "; - $diff++; - last; - } - # print "$fr/$tr "; - } - # print "\n"; - close F; - close T; + $diff = my_cmp($_,$targetfile); } else { print "$_ differs\n" if $verbose>1; $diff++; } if ($diff){ - mkpath($targetdir,0,0755) unless $nonono; - print "mkpath($targetdir,0,0755)\n" if $verbose>1; - unlink $targetfile if -f $targetfile; + if (-f $targetfile){ + unlink $targetfile or Carp::croak("Couldn't unlink $targetfile"); + } else { + mkpath($targetdir,0,0755) unless $nonono; + print "mkpath($targetdir,0,0755)\n" if $verbose>1; + } copy($_,$targetfile) unless $nonono; print "Installing $targetfile\n" if $verbose; - utime($atime,$mtime,$targetfile) unless $nonono>1; + utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1; print "utime($atime,$mtime,$targetfile)\n" if $verbose>1; chmod $mode, $targetfile; print "chmod($mode, $targetfile)\n" if $verbose>1; @@ -119,14 +119,14 @@ sub install { $write{$targetfile}++; }, "."); - chdir($cwd) or croak("Couldn't chdir...."); + chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!"); } - umask $umask; + umask $umask unless $Is_VMS; if ($pack{'write'}) { $dir = dirname($pack{'write'}); mkpath($dir,0,0755); print "Writing $pack{'write'}\n"; - open P, ">$pack{'write'}" or croak("Couldn't write $pack{'write'}: $!"); + open P, ">$pack{'write'}" or Carp::croak("Couldn't write $pack{'write'}: $!"); for (sort keys %write) { print P "$_\n"; } @@ -134,18 +134,74 @@ sub install { } } +sub my_cmp { + my($one,$two) = @_; + local(*F,*T); + my $diff = 0; + open T, $two or return 1; + open F, $one or Carp::croak("Couldn't open $one: $!"); + my($fr, $tr, $fbuf, $tbuf, $size); + $size = 1024; + # print "Reading $one\n"; + while ( $fr = read(F,$fbuf,$size)) { + unless ( + $tr = read(T,$tbuf,$size) and + $tbuf eq $fbuf + ){ + # print "diff "; + $diff++; + last; + } + # print "$fr/$tr "; + } + # print "\n"; + close F; + close T; + $diff; +} + sub uninstall { my($fil,$verbose,$nonono) = @_; die "no packlist file found: $fil" unless -f $fil; local *P; - open P, $fil or croak("uninstall: Could not read packlist file $fil: $!"); + open P, $fil or Carp::croak("uninstall: Could not read packlist file $fil: $!"); while (

) { chomp; print "unlink $_\n" if $verbose; - unlink($_) || carp("Couldn't unlink $_") unless $nonono; + unlink($_) || Carp::carp("Couldn't unlink $_") unless $nonono; } print "unlink $fil\n" if $verbose; - unlink($fil) || carp("Couldn't unlink $fil") unless $nonono; + unlink($fil) || Carp::carp("Couldn't unlink $fil") unless $nonono; +} + +sub pm_to_blib { + my($fromto,$autodir) = @_; + + use File::Basename qw(dirname); + use File::Copy qw(copy); + use File::Path qw(mkpath); + use AutoSplit; + + my $umask = umask 0022 unless $Is_VMS; + mkpath($autodir,0,0755); + foreach (keys %$fromto) { + next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_; + unless (my_cmp($_,$fromto->{$_})){ + print "Skip $fromto->{$_} (unchanged)\n"; + next; + } + if (-f $fromto->{$_}){ + unlink $fromto->{$_} or Carp::carp("Couldn't unlink $fromto->{$_}"); + } else { + mkpath(dirname($fromto->{$_}),0,0755); + } + copy($_,$fromto->{$_}); + chmod((stat)[2],$fromto->{$_}); + print "cp $_ $fromto->{$_}\n"; + next unless /\.pm$/; + autosplit($fromto->{$_},$autodir); + } + umask $umask unless $Is_VMS; } 1; @@ -164,9 +220,11 @@ B B +B + =head1 DESCRIPTION -Both functions, install() and uninstall() are specific to the way +Both install() and uninstall() are specific to the way ExtUtils::MakeMaker handles the installation and deinstallation of perl modules. They are not designed as general purpose tools. @@ -189,11 +247,10 @@ uninstall() takes as first argument a file containing filenames to be unlinked. The second argument is a verbose switch, the third is a no-don't-really-do-it-now switch. -=cut - -#=head1 NOTES - -#=head1 BUGS +pm_to_blib() takes a hashref as the first argument and copies all keys +of the hash to the corresponding values efficiently. Filenames with +the extension pm are autosplit. Second argument is the autosplit +directory. -#=head1 AUTHORS +=cut