[prev in list] [next in list] [prev in thread] [next in thread]
List: perl5-changes
Subject: Change 31645: Update ExtUtils::Install, EU::Installed and EU::Packlist to the latest CPAN version 1.
From: Yves Orton <demerphq () gmail ! com>
Date: 2007-07-20 23:00:03
Message-ID: 20070720230003.69389215CA6 () mx ! activestate ! com
[Download RAW message or body]
Change 31645 by demerphq@demerphq-fresh on 2007/07/20 22:46:47
Update ExtUtils::Install, EU::Installed and EU::Packlist to the latest CPAN version \
1.43
Affected files ...
... //depot/perl/lib/ExtUtils/Install.pm#53 edit
... //depot/perl/lib/ExtUtils/Installed.pm#25 edit
... //depot/perl/lib/ExtUtils/Packlist.pm#17 edit
... //depot/perl/lib/ExtUtils/t/Installed.t#17 edit
Differences ...
==== //depot/perl/lib/ExtUtils/Install.pm#53 (text) ====
Index: perl/lib/ExtUtils/Install.pm
--- perl/lib/ExtUtils/Install.pm#52~31298~ 2007-05-29 00:25:22.000000000 -0700
+++ perl/lib/ExtUtils/Install.pm 2007-07-20 15:46:47.000000000 -0700
@@ -3,7 +3,7 @@
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 @@
# 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 @@
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 @@
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.
-
- #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.
+ #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.
- 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 @@
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 : "");
- }
+ 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;
+
- # Record the full pathname.
- $packlist->{$targetfile}++;
+ $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;
+ }
- # File::Find can get confused if you chdir in here.
- _chdir($save_cwd);
+ if ( defined $inc_uninstall ) {
+ inc_uninstall($sourcefile,$ffd, $verbose,
+ $nonono,
+ $realtarget ne $targetfile ? $realtarget : "");
+ }
- # File::Find seems to always be Unixy except on MacPerl :(
- }, $Is_MacPerl ? $Curdir : '.' ); #END SUB -- XXX OS-SPECIFIC
- _chdir($cwd);
+ # 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 @@
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 @@
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 @@
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 @@
# 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 @@
? $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 @@
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 @@
_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);
}
}
==== //depot/perl/lib/ExtUtils/Installed.pm#25 (text) ====
Index: perl/lib/ExtUtils/Installed.pm
--- perl/lib/ExtUtils/Installed.pm#24~28463~ 2006-07-02 09:31:10.000000000 -0700
+++ perl/lib/ExtUtils/Installed.pm 2007-07-20 15:46:47.000000000 -0700
@@ -16,7 +16,7 @@
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_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 @@
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 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 @@
# 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 @@
$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 @@
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 @@
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 @@
=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<ExtUtils::Packlist> module.
+
+If the named parameter C<config_override> 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<inc_override> 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<extra_libs> can be used to specify B<additional> 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</my/lib/path> is not in PERL5LIB.
=item modules()
==== //depot/perl/lib/ExtUtils/Packlist.pm#17 (text) ====
Index: perl/lib/ExtUtils/Packlist.pm
--- perl/lib/ExtUtils/Packlist.pm#16~28463~ 2006-07-02 09:31:10.000000000 -0700
+++ perl/lib/ExtUtils/Packlist.pm 2007-07-20 15:46:47.000000000 -0700
@@ -5,7 +5,7 @@
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 @@
$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);
}
==== //depot/perl/lib/ExtUtils/t/Installed.t#17 (text) ====
Index: perl/lib/ExtUtils/t/Installed.t
--- perl/lib/ExtUtils/t/Installed.t#16~27983~ 2006-04-27 11:06:12.000000000 -0700
+++ perl/lib/ExtUtils/t/Installed.t 2007-07-20 15:46:47.000000000 -0700
@@ -21,7 +21,7 @@
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 @@
# 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 @@
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 @@
'... 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',
End of Patch.
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic