From: Yves Orton Date: Fri, 20 Jul 2007 22:46:47 +0000 (+0000) Subject: Update ExtUtils::Install, EU::Installed and EU::Packlist to the latest CPAN version... X-Git-Tag: accepted/trunk/20130322.191538~14837 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=060fb22c412095419d8820020a11c811dd6a7dfd;p=platform%2Fupstream%2Fperl.git Update ExtUtils::Install, EU::Installed and EU::Packlist to the latest CPAN version 1.43 p4raw-id: //depot/perl@31645 --- diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm index 41f1ca0..8ac42d6 100644 --- a/lib/ExtUtils/Install.pm +++ b/lib/ExtUtils/Install.pm @@ -3,7 +3,7 @@ use 5.00503; use strict; use vars qw(@ISA @EXPORT $VERSION $MUST_REBOOT %Config); -$VERSION = '1.41_01'; +$VERSION = '1.43'; $VERSION = eval $VERSION; use AutoSplit; @@ -259,7 +259,7 @@ sub _unlink_or_rename { #XXX OS-SPECIFIC # not the end of the world. The other cases are more serious # and need to be fatal. _move_file_at_boot( $tmp, [], $installing ); - return $file; + return $file; } elsif ( $installing ) { _warnonce("Rename failed: $!. Scheduling '$tmp'\nfor". " installation as '$file' at reboot.\n"); @@ -431,11 +431,12 @@ sub _can_write_dir { return unless defined $dir and length $dir; - my @dirs=File::Spec->splitdir(File::Spec->rel2abs($dir)); + my ($vol, $dirs, $file) = File::Spec->splitpath(File::Spec->rel2abs($dir),1); + my @dirs = File::Spec->splitdir($dirs); my $path=''; my @make; while (@dirs) { - $dir=File::Spec->catdir(@dirs); + $dir = File::Spec->catdir($vol,@dirs); next if ( $dir eq $path ); if ( ! -e $dir ) { unshift @make,$dir; @@ -559,61 +560,53 @@ sub install { #XXX OS-SPECIFIC local(*DIR); for (qw/read write/) { - $pack{$_}=$from_to{$_}; - delete $from_to{$_}; - } - my($source_dir_or_file); - my (%fs_type); - foreach $source_dir_or_file (sort keys %from_to) { - #Check if there are files, and if yes, look if the corresponding - #target directory is writable for us - opendir DIR, $source_dir_or_file or next; - for (readdir DIR) { - next if $_ eq $Curdir || $_ eq $Updir || $_ eq ".exists"; - my $targetdir = install_rooted_dir($from_to{$source_dir_or_file}); - _mkpath( $targetdir, 0, 0755, $verbose, $nonono ); - } - closedir DIR; + $pack{$_}=$from_to{$_}; + delete $from_to{$_}; } my $tmpfile = install_rooted_file($pack{"read"}); $packlist->read($tmpfile) if (-f $tmpfile); my $cwd = cwd(); - + my @found_files; + my %check_dirs; + MOD_INSTALL: foreach my $source (sort keys %from_to) { - #copy the tree to the target directory without altering - #timestamp and permission and remember for the .packlist - #file. The packlist file contains the absolute paths of the - #install locations. AFS users may call this a bug. We'll have - #to reconsider how to add the means to satisfy AFS users also. + #copy the tree to the target directory without altering + #timestamp and permission and remember for the .packlist + #file. The packlist file contains the absolute paths of the + #install locations. AFS users may call this a bug. We'll have + #to reconsider how to add the means to satisfy AFS users also. - #October 1997: we want to install .pm files into archlib if - #there are any files in arch. So we depend on having ./blib/arch - #hardcoded here. + #October 1997: we want to install .pm files into archlib if + #there are any files in arch. So we depend on having ./blib/arch + #hardcoded here. - my $targetroot = install_rooted_dir($from_to{$source}); + my $targetroot = install_rooted_dir($from_to{$source}); my $blib_lib = File::Spec->catdir('blib', 'lib'); my $blib_arch = File::Spec->catdir('blib', 'arch'); - if ($source eq $blib_lib and - exists $from_to{$blib_arch} and - directory_not_empty($blib_arch) - ){ - $targetroot = install_rooted_dir($from_to{$blib_arch}); + if ($source eq $blib_lib and + exists $from_to{$blib_arch} and + directory_not_empty($blib_arch) + ){ + $targetroot = install_rooted_dir($from_to{$blib_arch}); print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n"; - } + } next unless -d $source; _chdir($source); + # 5.5.3's File::Find missing no_chdir option + # XXX OS-SPECIFIC + # File::Find seems to always be Unixy except on MacPerl :( + my $current_directory= $Is_MacPerl ? $Curdir : '.'; + find(sub { + my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9]; - find(sub { - my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9]; - - return if !-f _; + return if !-f _; my $origfile = $_; - return if $origfile eq ".exists"; - my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir); - my $targetfile = File::Spec->catfile($targetdir, $origfile); + return if $origfile eq ".exists"; + my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir); + my $targetfile = File::Spec->catfile($targetdir, $origfile); my $sourcedir = File::Spec->catdir($source, $File::Find::dir); my $sourcefile = File::Spec->catfile($sourcedir, $origfile); @@ -621,69 +614,81 @@ sub install { #XXX OS-SPECIFIC if ( $sourcefile=~/$pat/ ) { print "Skipping $targetfile (filtered)\n" if $verbose>1; - return; - } - } - - # 5.5.3's File::Find missing no_chdir option. - my $save_cwd = _chdir($cwd); # in case the target is relative - - my $diff = 0; - if ( -f $targetfile && -s _ == $size) { - # We have a good chance, we can skip this one - $diff = compare($sourcefile, $targetfile); - } else { - $diff++; - } - print "$sourcefile differs\n" if $diff && $verbose>1; - my $realtarget= $targetfile; - if ($diff) { - if (-f $targetfile) { - print "_unlink_or_rename($targetfile)\n" if $verbose>1; - $targetfile= _unlink_or_rename( $targetfile, 'tryhard', 'install' ) - unless $nonono; - } elsif ( ! -d $targetdir ) { - _mkpath( $targetdir, 0, 0755, $verbose, $nonono ); - } - print "Installing $targetfile\n"; - _copy( $sourcefile, $targetfile, $verbose, $nonono, ); - #XXX OS-SPECIFIC - print "utime($atime,$mtime,$targetfile)\n" if $verbose>1; - utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1; - - - $mode = 0444 | ( $mode & 0111 ? 0111 : 0 ); - $mode = $mode | 0222 - if $realtarget ne $targetfile; - _chmod( $mode, $targetfile, $verbose ); - - - } else { - print "Skipping $targetfile (unchanged)\n" if $verbose; - } - - if ( defined $inc_uninstall ) { - inc_uninstall($sourcefile,$File::Find::dir,$verbose, - $inc_uninstall ? 0 : 1, - $realtarget ne $targetfile ? $realtarget : ""); - } - - # Record the full pathname. - $packlist->{$targetfile}++; - - # File::Find can get confused if you chdir in here. - _chdir($save_cwd); + return; + } + } + # we have to do this for back compat with old File::Finds + # and because the target is relative + my $save_cwd = _chdir($cwd); + my $diff = 0; + if ( -f $targetfile && -s _ == $size) { + # We have a good chance, we can skip this one + $diff = compare($sourcefile, $targetfile); + } else { + $diff++; + } + $check_dirs{$targetdir}++ + unless -w $targetfile; + + push @found_files, + [ $diff, $File::Find::dir, $origfile, + $mode, $size, $atime, $mtime, + $targetdir, $targetfile, $sourcedir, $sourcefile, + + ]; + #restore the original directory we were in when File::Find + #called us so that it doesnt get horribly confused. + _chdir($save_cwd); + }, $current_directory ); + _chdir($cwd); + } + + foreach my $targetdir (sort keys %check_dirs) { + _mkpath( $targetdir, 0, 0755, $verbose, $nonono ); + } + foreach my $found (@found_files) { + my ($diff, $ffd, $origfile, $mode, $size, $atime, $mtime, + $targetdir, $targetfile, $sourcedir, $sourcefile)= @$found; + + my $realtarget= $targetfile; + if ($diff) { + if (-f $targetfile) { + print "_unlink_or_rename($targetfile)\n" if $verbose>1; + $targetfile= _unlink_or_rename( $targetfile, 'tryhard', 'install' ) + unless $nonono; + } elsif ( ! -d $targetdir ) { + _mkpath( $targetdir, 0, 0755, $verbose, $nonono ); + } + print "Installing $targetfile\n"; + _copy( $sourcefile, $targetfile, $verbose, $nonono, ); + #XXX OS-SPECIFIC + print "utime($atime,$mtime,$targetfile)\n" if $verbose>1; + utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1; - # File::Find seems to always be Unixy except on MacPerl :( - }, $Is_MacPerl ? $Curdir : '.' ); #END SUB -- XXX OS-SPECIFIC - _chdir($cwd); + + $mode = 0444 | ( $mode & 0111 ? 0111 : 0 ); + $mode = $mode | 0222 + if $realtarget ne $targetfile; + _chmod( $mode, $targetfile, $verbose ); + } else { + print "Skipping $targetfile (unchanged)\n" if $verbose; + } + + if ( defined $inc_uninstall ) { + inc_uninstall($sourcefile,$ffd, $verbose, + $nonono, + $realtarget ne $targetfile ? $realtarget : ""); + } + + # Record the full pathname. + $packlist->{$targetfile}++; } if ($pack{'write'}) { - $dir = install_rooted_dir(dirname($pack{'write'})); - _mkpath( $dir, 0, 0755, $verbose, $nonono ); - print "Writing $pack{'write'}\n"; - $packlist->write(install_rooted_file($pack{'write'})) unless $nonono; + $dir = install_rooted_dir(dirname($pack{'write'})); + _mkpath( $dir, 0, 0755, $verbose, $nonono ); + print "Writing $pack{'write'}\n"; + $packlist->write(install_rooted_file($pack{'write'})) unless $nonono; } _do_cleanup($verbose); @@ -731,18 +736,18 @@ is defined. sub install_rooted_file { if (defined $INSTALL_ROOT) { - File::Spec->catfile($INSTALL_ROOT, $_[0]); + File::Spec->catfile($INSTALL_ROOT, $_[0]); } else { - $_[0]; + $_[0]; } } sub install_rooted_dir { if (defined $INSTALL_ROOT) { - File::Spec->catdir($INSTALL_ROOT, $_[0]); + File::Spec->catdir($INSTALL_ROOT, $_[0]); } else { - $_[0]; + $_[0]; } } @@ -780,11 +785,11 @@ sub directory_not_empty ($) { my($dir) = @_; my $files = 0; find(sub { - return if $_ eq ".exists"; - if (-f) { - $File::Find::prune++; - $files = 1; - } + return if $_ eq ".exists"; + if (-f) { + $File::Find::prune++; + $files = 1; + } }, $dir); return $files; } @@ -822,17 +827,17 @@ sub install_default { my $INST_MAN1DIR = File::Spec->catdir($Curdir,'blib','man1'); my $INST_MAN3DIR = File::Spec->catdir($Curdir,'blib','man3'); install({ - read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist", - write => "$Config{installsitearch}/auto/$FULLEXT/.packlist", - $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ? - $Config{installsitearch} : - $Config{installsitelib}, - $INST_ARCHLIB => $Config{installsitearch}, - $INST_BIN => $Config{installbin} , - $INST_SCRIPT => $Config{installscript}, - $INST_MAN1DIR => $Config{installman1dir}, - $INST_MAN3DIR => $Config{installman3dir}, - },1,0,0); + read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist", + write => "$Config{installsitearch}/auto/$FULLEXT/.packlist", + $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ? + $Config{installsitearch} : + $Config{installsitelib}, + $INST_ARCHLIB => $Config{installsitearch}, + $INST_BIN => $Config{installbin} , + $INST_SCRIPT => $Config{installscript}, + $INST_MAN1DIR => $Config{installman1dir}, + $INST_MAN3DIR => $Config{installman3dir}, + },1,0,0); } @@ -862,9 +867,9 @@ sub uninstall { # require $my_req; # Hairy, but for the first my ($packlist) = ExtUtils::Packlist->new($fil); foreach (sort(keys(%$packlist))) { - chomp; - print "unlink $_\n" if $verbose; - forceunlink($_,'tryhard') unless $nonono; + chomp; + print "unlink $_\n" if $verbose; + forceunlink($_,'tryhard') unless $nonono; } print "unlink $fil\n" if $verbose; forceunlink($fil, 'tryhard') unless $nonono; @@ -894,42 +899,42 @@ sub inc_uninstall { ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || ''; foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp - privlibexp - sitearchexp - sitelibexp)}) { - my $canonpath = File::Spec->canonpath($dir); - next if $canonpath eq $Curdir; - next if $seen_dir{$canonpath}++; - my $targetfile = File::Spec->catfile($canonpath,$libdir,$file); - next unless -f $targetfile; - - # The reason why we compare file's contents is, that we cannot - # know, which is the file we just installed (AFS). So we leave - # an identical file in place - my $diff = 0; - if ( -f $targetfile && -s _ == -s $filepath) { - # We have a good chance, we can skip this one - $diff = compare($filepath,$targetfile); - } else { - $diff++; - } + privlibexp + sitearchexp + sitelibexp)}) { + my $canonpath = File::Spec->canonpath($dir); + next if $canonpath eq $Curdir; + next if $seen_dir{$canonpath}++; + my $targetfile = File::Spec->catfile($canonpath,$libdir,$file); + next unless -f $targetfile; + + # The reason why we compare file's contents is, that we cannot + # know, which is the file we just installed (AFS). So we leave + # an identical file in place + my $diff = 0; + if ( -f $targetfile && -s _ == -s $filepath) { + # We have a good chance, we can skip this one + $diff = compare($filepath,$targetfile); + } else { + $diff++; + } print "#$file and $targetfile differ\n" if $diff && $verbose > 1; - next if !$diff or $targetfile eq $ignore; - if ($nonono) { - if ($verbose) { - $Inc_uninstall_warn_handler ||= ExtUtils::Install::Warn->new(); - $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier. - $Inc_uninstall_warn_handler->add( + next if !$diff or $targetfile eq $ignore; + if ($nonono) { + if ($verbose) { + $Inc_uninstall_warn_handler ||= ExtUtils::Install::Warn->new(); + $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier. + $Inc_uninstall_warn_handler->add( File::Spec->catfile($libdir, $file), $targetfile ); - } - # if not verbose, we just say nothing - } else { - print "Unlinking $targetfile (shadowing?)\n"; - forceunlink($targetfile,'tryhard'); - } + } + # if not verbose, we just say nothing + } else { + print "Unlinking $targetfile (shadowing?)\n" if $verbose; + forceunlink($targetfile,'tryhard'); + } } } @@ -951,7 +956,7 @@ sub run_filter { my $buf; my $sz = 1024; while (my $len = sysread(SRC, $buf, $sz)) { - syswrite(CMD, $buf, $len); + syswrite(CMD, $buf, $len); } close SRC; close CMD or die "Filter command '$cmd' failed for $src"; @@ -981,41 +986,41 @@ sub pm_to_blib { _mkpath($autodir,0,0755); while(my($from, $to) = each %$fromto) { - if( -f $to && -s $from == -s $to && -M $to < -M $from ) { + if( -f $to && -s $from == -s $to && -M $to < -M $from ) { print "Skip $to (unchanged)\n"; next; } - # When a pm_filter is defined, we need to pre-process the source first - # to determine whether it has changed or not. Therefore, only perform - # the comparison check when there's no filter to be ran. - # -- RAM, 03/01/2001 + # When a pm_filter is defined, we need to pre-process the source first + # to determine whether it has changed or not. Therefore, only perform + # the comparison check when there's no filter to be ran. + # -- RAM, 03/01/2001 - my $need_filtering = defined $pm_filter && length $pm_filter && + my $need_filtering = defined $pm_filter && length $pm_filter && $from =~ /\.pm$/; - if (!$need_filtering && 0 == compare($from,$to)) { - print "Skip $to (unchanged)\n"; - next; - } - if (-f $to){ - # we wont try hard here. its too likely to mess things up. - forceunlink($to); - } else { - _mkpath(dirname($to),0,0755); - } - if ($need_filtering) { - run_filter($pm_filter, $from, $to); - print "$pm_filter <$from >$to\n"; - } else { - _copy( $from, $to ); - print "cp $from $to\n"; - } - my($mode,$atime,$mtime) = (stat $from)[2,8,9]; - utime($atime,$mtime+$Is_VMS,$to); - _chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to); - next unless $from =~ /\.pm$/; - _autosplit($to,$autodir); + if (!$need_filtering && 0 == compare($from,$to)) { + print "Skip $to (unchanged)\n"; + next; + } + if (-f $to){ + # we wont try hard here. its too likely to mess things up. + forceunlink($to); + } else { + _mkpath(dirname($to),0,0755); + } + if ($need_filtering) { + run_filter($pm_filter, $from, $to); + print "$pm_filter <$from >$to\n"; + } else { + _copy( $from, $to ); + print "cp $from $to\n"; + } + my($mode,$atime,$mtime) = (stat $from)[2,8,9]; + utime($atime,$mtime+$Is_VMS,$to); + _chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to); + next unless $from =~ /\.pm$/; + _autosplit($to,$autodir); } } diff --git a/lib/ExtUtils/Installed.pm b/lib/ExtUtils/Installed.pm index e8f9f3a..8e65139 100644 --- a/lib/ExtUtils/Installed.pm +++ b/lib/ExtUtils/Installed.pm @@ -16,7 +16,7 @@ my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/); require VMS::Filespec if $Is_VMS; use vars qw($VERSION); -$VERSION = '1.41'; +$VERSION = '1.43'; $VERSION = eval $VERSION; sub _is_prefix { @@ -44,8 +44,9 @@ sub _is_prefix { sub _is_doc { my ($self, $path) = @_; - my $man1dir = $Config{man1direxp}; - my $man3dir = $Config{man3direxp}; + + my $man1dir = $self->{':private:'}{Config}{man1direxp}; + my $man3dir = $self->{':private:'}{Config}{man3direxp}; return(($man1dir && $self->_is_prefix($path, $man1dir)) || ($man3dir && $self->_is_prefix($path, $man3dir)) @@ -59,7 +60,7 @@ sub _is_type { return($self->_is_doc($path)) if $type eq "doc"; if ($type eq "prog") { - return($self->_is_prefix($path, $Config{prefix} || $Config{prefixexp}) + return($self->_is_prefix($path, $self->{':private:'}{Config}{prefix} || $self->{':private:'}{Config}{prefixexp}) && !($self->_is_doc($path)) ? 1 : 0); @@ -78,28 +79,67 @@ sub _is_under { } sub new { - my ($class) = @_; + my ($class) = shift(@_); $class = ref($class) || $class; - my $self = {}; - my $archlib = $Config{archlibexp}; - my $sitearch = $Config{sitearchexp}; + my %args = @_; + my $self = {}; + + if ($args{config_override}) { + eval { + $self->{':private:'}{Config} = { %{$args{config_override}} }; + } or Carp::croak( + "The 'config_override' parameter must be a hash reference." + ); + } + else { + $self->{':private:'}{Config} = \%Config; + } + + for my $tuple ([inc_override => INC => [ @INC ] ], + [ extra_libs => EXTRA => [] ]) + { + my ($arg,$key,$val)=@$tuple; + if ( $args{$arg} ) { + eval { + $self->{':private:'}{$key} = [ @{$args{$arg}} ]; + } or Carp::croak( + "The '$arg' parameter must be an array reference." + ); + } + elsif ($val) { + $self->{':private:'}{$key} = $val; + } + } + { + my %dupe; + @{$self->{':private:'}{INC}} = grep { -e $_ && !$dupe{$_}++ } + @{$self->{':private:'}{INC}}, @{$self->{':private:'}{EXTRA}}; + } + my $perl5lib = defined $ENV{PERL5LIB} ? $ENV{PERL5LIB} : ""; + + my @dirs = ( $self->{':private:'}{Config}{archlibexp}, + $self->{':private:'}{Config}{sitearchexp}, + split(/\Q$Config{path_sep}\E/, $perl5lib), + @{$self->{':private:'}{EXTRA}}, + ); + # File::Find does not know how to deal with VMS filepaths. if( $Is_VMS ) { - $archlib = VMS::Filespec::unixify($archlib); - $sitearch = VMS::Filespec::unixify($sitearch); + $_ = VMS::Filespec::unixify($_) + for @dirs; } if ($DOSISH) { - $archlib =~ s|\\|/|g; - $sitearch =~ s|\\|/|g; + s|\\|/|g for @dirs; } - + my $archlib = $dirs[0]; + # Read the core packlist $self->{Perl}{packlist} = ExtUtils::Packlist->new( File::Spec->catfile($archlib, '.packlist') ); - $self->{Perl}{version} = $Config{version}; + $self->{Perl}{version} = $self->{':private:'}{Config}{version}; # Read the module packlists my $sub = sub { @@ -108,20 +148,26 @@ sub new { # Hack of the leading bits of the paths & convert to a module name my $module = $File::Find::name; - - $module =~ s!\Q$archlib\E/?auto/(.*)/.packlist!$1!s or - $module =~ s!\Q$sitearch\E/?auto/(.*)/.packlist!$1!s; + my $found; + for (@dirs) { + $found = $module =~ s!\Q$_\E/?auto/(.*)/.packlist!$1!s + and last; + } + unless ($found) { + # warn "Woah! \$_=$_\n\$module=$module\n\$File::Find::dir=$File::Find::dir\n", + # join ("\n",@dirs); + return; + } my $modfile = "$module.pm"; $module =~ s!/!::!g; # Find the top-level module file in @INC $self->{$module}{version} = ''; - foreach my $dir (@INC) { + foreach my $dir (@{$self->{':private:'}{INC}}) { my $p = File::Spec->catfile($dir, $modfile); if (-r $p) { $module = _module_name($p, $module) if $Is_VMS; - require ExtUtils::MM; $self->{$module}{version} = MM->parse_version($p); last; } @@ -131,8 +177,9 @@ sub new { $self->{$module}{packlist} = ExtUtils::Packlist->new($File::Find::name); }; - - my(@dirs) = grep { -e } ($archlib, $sitearch); + my %dupe; + @dirs= grep { -e $_ && !$dupe{$_}++ } @dirs; + $self->{':private:'}{LIBDIRS} = \@dirs; find($sub, @dirs) if @dirs; return(bless($self, $class)); @@ -172,7 +219,9 @@ sub modules { my ($self) = @_; # Bug/feature of sort in scalar context requires this. - return wantarray ? sort keys %$self : keys %$self; + return wantarray + ? sort grep { not /^:private:$/ } keys %$self + : grep { not /^:private:$/ } keys %$self; } sub files { @@ -269,7 +318,8 @@ information from the .packlist files. The new() function searches for all the installed .packlists on the system, and stores their contents. The .packlists can be queried with the functions -described below. +described below. Where it searches by default is determined by the settings found +in C<%Config::Config>, and what the value is of the PERL5LIB environment variable. =head1 FUNCTIONS @@ -277,8 +327,35 @@ described below. =item new() -This takes no parameters, and searches for all the installed .packlists on the -system. The packlists are read using the ExtUtils::packlist module. +This takes optional named parameters. Without parameters, this +searches for all the installed .packlists on the system using +information from C<%Config::Config> and the default module search +paths C<@INC>. The packlists are read using the +L module. + +If the named parameter C is specified, +it should be a reference to a hash which contains all information +usually found in C<%Config::Config>. For example, you can obtain +the configuration information for a separate perl installation and +pass that in. + + my $yoda_cfg = get_fake_config('yoda'); + my $yoda_inst = ExtUtils::Installed->new(config_override=>$yoda_cfg); + +Similarly, the parameter C may be a reference to an +array which is used in place of the default module search paths +from C<@INC>. + + use Config; + my @dirs = split(/\Q$Config{path_sep}\E/, $ENV{PERL5LIB}); + my $p5libs = ExtUtils::Installed->new(inc_override=>\@dirs); + +The parameter c can be used to specify B paths to +search for installed modules. For instance + + my $installed = ExtUtils::Installed->new(extra_libs=>["/my/lib/path"]); + +This should only be necessary if C is not in PERL5LIB. =item modules() diff --git a/lib/ExtUtils/Packlist.pm b/lib/ExtUtils/Packlist.pm index 5965bbc..04f267a 100644 --- a/lib/ExtUtils/Packlist.pm +++ b/lib/ExtUtils/Packlist.pm @@ -5,7 +5,7 @@ use strict; use Carp qw(); use Config; use vars qw($VERSION $Relocations); -$VERSION = '1.41'; +$VERSION = '1.43'; $VERSION = eval $VERSION; # Used for generating filehandle globs. IO::File might not be available! @@ -131,17 +131,17 @@ while (defined($line = <$fh>)) $data = { map { split('=', $_) } split(' ', $2)}; if ($Config{userelocatableinc} && $data->{relocate_as}) - { + { require File::Spec; require Cwd; my ($vol, $dir) = File::Spec->splitpath($packfile); my $newpath = File::Spec->catpath($vol, $dir, $data->{relocate_as}); $key = Cwd::realpath($newpath); - } } + } $key =~ s!/\./!/!g; # Some .packlists have spurious '/./' bits in the paths - $self->{data}->{$key} = $data; - } + $self->{data}->{$key} = $data; + } close($fh); } diff --git a/lib/ExtUtils/t/Installed.t b/lib/ExtUtils/t/Installed.t index c18e8b0..f820ef4 100644 --- a/lib/ExtUtils/t/Installed.t +++ b/lib/ExtUtils/t/Installed.t @@ -21,7 +21,7 @@ use File::Path; use File::Basename; use File::Spec; -use Test::More tests => 46; +use Test::More tests => 63; BEGIN { use_ok( 'ExtUtils::Installed' ) } @@ -30,6 +30,10 @@ my $mandirs = !!$Config{man1direxp} + !!$Config{man3direxp}; # saves having to qualify package name for class methods my $ei = bless( {}, 'ExtUtils::Installed' ); +# Make sure meta info is available +$ei->{':private:'}{Config} = \%Config; +$ei->{':private:'}{INC} = \@INC; + # _is_prefix ok( $ei->_is_prefix('foo/bar', 'foo'), '_is_prefix() should match valid path prefix' ); @@ -100,10 +104,10 @@ FAKE close FAKEMOD; +my $fake_mod_dir = File::Spec->catdir(cwd(), 'auto', 'FakeMod'); { # avoid warning and death by localizing glob local *ExtUtils::Installed::Config; - my $fake_mod_dir = File::Spec->catdir(cwd(), 'auto', 'FakeMod'); %ExtUtils::Installed::Config = ( %Config, archlibexp => cwd(), @@ -125,6 +129,73 @@ close FAKEMOD; '... should find version in modules' ); } +# Now try this using PERL5LIB +{ + local $ENV{PERL5LIB} = join $Config{path_sep}, $fake_mod_dir; + local *ExtUtils::Installed::Config; + %ExtUtils::Installed::Config = ( + %Config, + archlibexp => cwd(), + sitearchexp => cwd(), + ); + + my $realei = ExtUtils::Installed->new(); + isa_ok( $realei, 'ExtUtils::Installed' ); + isa_ok( $realei->{Perl}{packlist}, 'ExtUtils::Packlist' ); + is( $realei->{Perl}{version}, $Config{version}, + 'new() should set Perl version from %Config' ); + + ok( exists $realei->{FakeMod}, + 'new() should find modules with .packlists using PERL5LIB' + ); + isa_ok( $realei->{FakeMod}{packlist}, 'ExtUtils::Packlist' ); + is( $realei->{FakeMod}{version}, '1.1.1', + '... should find version in modules' ); +} + +# Do the same thing as the last block, but with overrides for +# %Config and @INC. +{ + my $config_override = { %Config::Config }; + $config_override->{archlibexp} = cwd(); + $config_override->{sitearchexp} = $fake_mod_dir; + $config_override->{version} = 'fake_test_version'; + + my @inc_override = (@INC, $fake_mod_dir); + + my $realei = ExtUtils::Installed->new( + 'config_override' => $config_override, + 'inc_override' => \@inc_override, + ); + isa_ok( $realei, 'ExtUtils::Installed' ); + isa_ok( $realei->{Perl}{packlist}, 'ExtUtils::Packlist' ); + is( $realei->{Perl}{version}, 'fake_test_version', + 'new(config_override => HASH) overrides %Config' ); + + ok( exists $realei->{FakeMod}, 'new() with overrides should find modules with .packlists'); + isa_ok( $realei->{FakeMod}{packlist}, 'ExtUtils::Packlist' ); + is( $realei->{FakeMod}{version}, '1.1.1', + '... should find version in modules' ); +} + +# Check if extra_libs works. +{ + my $realei = ExtUtils::Installed->new( + 'extra_libs' => [ cwd() ], + ); + isa_ok( $realei, 'ExtUtils::Installed' ); + isa_ok( $realei->{Perl}{packlist}, 'ExtUtils::Packlist' ); + ok( exists $realei->{FakeMod}, + 'new() with extra_libs should find modules with .packlists'); + + #{ use Data::Dumper; local $realei->{':private:'}{Config}; + # warn Dumper($realei); } + + isa_ok( $realei->{FakeMod}{packlist}, 'ExtUtils::Packlist' ); + is( $realei->{FakeMod}{version}, '1.1.1', + '... should find version in modules' ); +} + # modules $ei->{$_} = 1 for qw( abc def ghi ); is( join(' ', $ei->modules()), 'abc def ghi',