X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FExtUtils%2FInstalled.pm;h=8e6513998bb2fb3413c04c7abc7a758d1ba265b8;hb=3e15aad56068d2dfe80836fe1f37f2b0000476ee;hp=d1faaa2a271c82e359cb97c8852a247c5a6da7e2;hpb=b308eaac984433b634f42b8721523057190cf20c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/ExtUtils/Installed.pm b/lib/ExtUtils/Installed.pm index d1faaa2..8e65139 100644 --- a/lib/ExtUtils/Installed.pm +++ b/lib/ExtUtils/Installed.pm @@ -16,7 +16,8 @@ my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/); require VMS::Filespec if $Is_VMS; use vars qw($VERSION); -$VERSION = '0.08_01'; +$VERSION = '1.43'; +$VERSION = eval $VERSION; sub _is_prefix { my ($self, $path, $prefix) = @_; @@ -41,16 +42,17 @@ sub _is_prefix { return(0); } -sub _is_doc { +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)) ? 1 : 0) } - + sub _is_type { my ($self, $path, $type) = @_; return 1 if $type eq "all"; @@ -58,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); @@ -77,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 { @@ -107,31 +148,38 @@ 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; } } # Read the .packlist - $self->{$module}{packlist} = + $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)); @@ -171,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 { @@ -186,7 +236,7 @@ sub files { my (@files); foreach my $file (keys(%{$self->{$module}{packlist}})) { push(@files, $file) - if ($self->_is_type($file, $type) && + if ($self->_is_type($file, $type) && $self->_is_under($file, @under)); } return(@files); @@ -268,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 @@ -276,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()