Update ExtUtils::Install, EU::Installed and EU::Packlist to the latest CPAN version 1.43

p4raw-id: //depot/perl@31645

4 files changed, 369 insertions, 216 deletions

diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm
index 41f1ca0965..8ac42d6b62 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 e8f9f3a180..8e6513998b 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<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()
 
diff --git a/lib/ExtUtils/Packlist.pm b/lib/ExtUtils/Packlist.pm
index 5965bbcfb6..04f267a0a3 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 c18e8b049f..f820ef49c6 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',