From: Yves Orton Date: Sun, 19 Jul 2009 20:40:14 +0000 (+0200) Subject: bring up to date with ExtUtils-Install v1.52_02 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dcd43ceb79239badc074c6ea85ad8a41aa131326;p=p5sagit%2Fp5-mst-13.2.git bring up to date with ExtUtils-Install v1.52_02 --- diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm index c8aa0b3..464b769 100644 --- a/lib/ExtUtils/Install.pm +++ b/lib/ExtUtils/Install.pm @@ -42,7 +42,7 @@ ExtUtils::Install - install files from here to there =cut -$VERSION = '1.52_01'; +$VERSION = '1.52_02'; $VERSION = eval $VERSION; =pod @@ -158,10 +158,11 @@ sub _chmod($$;$) { my ( $mode, $item, $verbose )=@_; $verbose ||= 0; if (chmod $mode, $item) { - print "chmod($mode, $item)\n" if $verbose > 1; + printf "chmod(0%o, %s)\n",$mode, $item if $verbose > 1; } else { my $err="$!"; - _warnonce "WARNING: Failed chmod($mode, $item): $err\n" + _warnonce sprintf "WARNING: Failed chmod(0%o, %s): %s\n", + $mode, $item, $err if -e $item; } } diff --git a/lib/ExtUtils/Installed.pm b/lib/ExtUtils/Installed.pm index 727a01d..9cb1fc1 100644 --- a/lib/ExtUtils/Installed.pm +++ b/lib/ExtUtils/Installed.pm @@ -2,6 +2,7 @@ package ExtUtils::Installed; use 5.00503; use strict; +#use warnings; # XXX requires 5.6 use Carp qw(); use ExtUtils::Packlist; use ExtUtils::MakeMaker; @@ -16,7 +17,7 @@ my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/); require VMS::Filespec if $Is_VMS; use vars qw($VERSION); -$VERSION = '1.43_1'; +$VERSION = '1.999_001'; $VERSION = eval $VERSION; sub _is_prefix { @@ -57,12 +58,10 @@ sub _is_type { return 1 if $type eq "all"; return($self->_is_doc($path)) if $type eq "doc"; - + my $conf= $self->{':private:'}{Config}; if ($type eq "prog") { - return($self->_is_prefix($path, $self->{':private:'}{Config}{prefix} || $self->{':private:'}{Config}{prefixexp}) - && - !($self->_is_doc($path)) - ? 1 : 0); + return($self->_is_prefix($path, $conf->{prefix} || $conf->{prefixexp}) + && !($self->_is_doc($path)) ? 1 : 0); } return(0); } @@ -77,13 +76,63 @@ sub _is_under { return(0); } +sub _fix_dirs { + my ($self, @dirs)= @_; + # File::Find does not know how to deal with VMS filepaths. + if( $Is_VMS ) { + $_ = VMS::Filespec::unixify($_) + for @dirs; + } + + if ($DOSISH) { + s|\\|/|g for @dirs; + } + return wantarray ? @dirs : $dirs[0]; +} + +sub _make_entry { + my ($self, $module, $packlist_file, $modfile)= @_; + + my $data= { + module => $module, + packlist => scalar(ExtUtils::Packlist->new($packlist_file)), + packlist_file => $packlist_file, + }; + + if (!$modfile) { + $data->{version} = $self->{':private:'}{Config}{version}; + } else { + $data->{modfile} = $modfile; + # Find the top-level module file in @INC + $data->{version} = ''; + foreach my $dir (@{$self->{':private:'}{INC}}) { + my $p = File::Spec->catfile($dir, $modfile); + if (-r $p) { + $module = _module_name($p, $module) if $Is_VMS; + + $data->{version} = MM->parse_version($p); + $data->{version_from} = $p; + $data->{packlist_valid} = exists $data->{packlist}{$p}; + last; + } + } + } + $self->{$module}= $data; +} + +our $INSTALLED; sub new { my ($class) = shift(@_); $class = ref($class) || $class; my %args = @_; - my $self = {}; + return $INSTALLED if $INSTALLED and ($args{default_get} || $args{default}); + + my $self = bless {}, $class; + + $INSTALLED= $self if $args{default_set} || $args{default}; + if ($args{config_override}) { eval { @@ -95,9 +144,9 @@ sub new { else { $self->{':private:'}{Config} = \%Config; } - + for my $tuple ([inc_override => INC => [ @INC ] ], - [ extra_libs => EXTRA => [] ]) + [ extra_libs => EXTRA => [] ]) { my ($arg,$key,$val)=@$tuple; if ( $args{$arg} ) { @@ -113,33 +162,17 @@ sub new { } { 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 ) { - $_ = VMS::Filespec::unixify($_) - for @dirs; + @{$self->{':private:'}{LIBDIRS}} = grep { -e $_ && !$dupe{$_}++ } + @{$self->{':private:'}{EXTRA}}, @{$self->{':private:'}{INC}}; } - if ($DOSISH) { - s|\\|/|g for @dirs; - } - my $archlib = $dirs[0]; - + my @dirs= $self->_fix_dirs(@{$self->{':private:'}{LIBDIRS}}); + # Read the core packlist - $self->{Perl}{packlist} = - ExtUtils::Packlist->new( File::Spec->catfile($archlib, '.packlist') ); - $self->{Perl}{version} = $self->{':private:'}{Config}{version}; + my $archlib = $self->_fix_dirs($self->{':private:'}{Config}{archlibexp}); + $self->_make_entry("Perl",File::Spec->catfile($archlib, '.packlist')); + my $root; # Read the module packlists my $sub = sub { # Only process module .packlists @@ -147,41 +180,26 @@ sub new { # Hack of the leading bits of the paths & convert to a module name my $module = $File::Find::name; - my $found; - for (@dirs) { - $found = $module =~ s!\Q$_\E/?auto/(.*)/.packlist!$1!s - and last; - } - unless ($found) { + my $found = $module =~ s!^.*?/auto/(.*)/.packlist!$1!s + or do { # 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 (@{$self->{':private:'}{INC}}) { - my $p = File::Spec->catfile($dir, $modfile); - if (-r $p) { - $module = _module_name($p, $module) if $Is_VMS; - - $self->{$module}{version} = MM->parse_version($p); - last; - } - } - - # Read the .packlist - $self->{$module}{packlist} = - ExtUtils::Packlist->new($File::Find::name); + return if $self->{$module}; #shadowing? + $self->_make_entry($module,$File::Find::name,$modfile); }; - my %dupe; - @dirs= grep { -e $_ && !$dupe{$_}++ } @dirs; - $self->{':private:'}{LIBDIRS} = \@dirs; - find($sub, @dirs) if @dirs; + while (@dirs) { + $root= shift @dirs; + next if !-d $root; + find($sub,$root); + } - return(bless($self, $class)); + return $self; } # VMS's non-case preserving file-system means the package name can't @@ -212,10 +230,9 @@ sub _module_name { return $module; } - - sub modules { my ($self) = @_; + $self= $self->new(default=>1) if !ref $self; # Bug/feature of sort in scalar context requires this. return wantarray @@ -225,6 +242,7 @@ sub modules { sub files { my ($self, $module, $type, @under) = @_; + $self= $self->new(default=>1) if !ref $self; # Validate arguments Carp::croak("$module is not installed") if (! exists($self->{$module})); @@ -243,6 +261,7 @@ sub files { sub directories { my ($self, $module, $type, @under) = @_; + $self= $self->new(default=>1) if !ref $self; my (%dirs); foreach my $file ($self->files($module, $type, @under)) { $dirs{dirname($file)}++; @@ -252,6 +271,7 @@ sub directories { sub directory_tree { my ($self, $module, $type, @under) = @_; + $self= $self->new(default=>1) if !ref $self; my (%dirs); foreach my $dir ($self->directories($module, $type, @under)) { $dirs{$dir}++; @@ -268,22 +288,33 @@ sub directory_tree { sub validate { my ($self, $module, $remove) = @_; + $self= $self->new(default=>1) if !ref $self; Carp::croak("$module is not installed") if (! exists($self->{$module})); return($self->{$module}{packlist}->validate($remove)); } sub packlist { my ($self, $module) = @_; + $self= $self->new(default=>1) if !ref $self; Carp::croak("$module is not installed") if (! exists($self->{$module})); return($self->{$module}{packlist}); } sub version { my ($self, $module) = @_; + $self= $self->new(default=>1) if !ref $self; Carp::croak("$module is not installed") if (! exists($self->{$module})); return($self->{$module}{version}); } +sub debug_dump { + my ($self, $module) = @_; + $self= $self->new(default=>1) if !ref $self; + local $self->{":private:"}{Config}; + require Data::Dumper; + print Data::Dumper->new([$self])->Sortkeys(1)->Indent(1)->Dump(); +} + 1; @@ -320,7 +351,13 @@ stores their contents. The .packlists can be queried with the functions 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 +=head1 METHODS + +Unless specified otherwise all method can be called as class methods, or as object +methods. If called as class methods then the "default" object will be used, and if +necessary created using the current processes %Config and @INC. See the +'default' option to new() for details. + =over 4 @@ -343,19 +380,30 @@ pass that in. 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>. +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 +B: You probably do not want to use these options alone, almost always +you will want to set both together. + +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. +Finally there is the 'default', and the related 'default_get' and 'default_set' +options. These options control the "default" object which is provided by the +class interface to the methods. Setting C to true tells the constructor +to return the default object if it is defined. Setting C to true tells +the constructor to make the default object the constructed object. Setting the +C option is like setting both to true. This is used primarily internally +and probably isn't interesting to any real user. + =item modules() This returns a list of the names of all the installed modules. The perl 'core'