use IPC::Cmd qw[can_run run];
use File::Find qw[find];
use Params::Check qw[check];
+use File::Basename qw[dirname];
use Module::Load::Conditional qw[can_load check_install];
$Params::Check::VERBOSE = 1;
Undefined if you didn't specify a separate format to install through.
-=item prereqs
+=item prereqs | requires
A hashref of prereqs this distribution was found to have. Will look
something like this:
Might be undefined if the distribution didn't have any prerequisites.
+=item configure_requires
+
+Like prereqs, but these are necessary to be installed before the
+build process can even begin.
+
=item signature
Flag indicating, if a signature check was done, whether it was OK or
=head1 METHODS
-=head2 $self = CPANPLUS::Module::new( OPTIONS )
+=head2 $self = CPANPLUS::Module->new( OPTIONS )
This method returns a C<CPANPLUS::Module> object. Normal users
should never call this method directly, but instead use the
$acc->mk_accessors( qw[ installer_type dist_cpan dist prereqs
signature extract fetch readme uninstall
created installed prepared checksums files
- checksum_ok checksum_value _fetch_from] );
+ checksum_ok checksum_value _fetch_from
+ configure_requires
+ ] );
+
+ ### create an alias from 'requires' to 'prereqs', so it's more in
+ ### line with 'configure_requires';
+ $acc->mk_aliases( requires => 'prereqs' );
$self->_status( $acc );
return 1;
}
-=head2 $mod->package_name
+=head2 $mod->package_name( [$package_string] )
Returns the name of the package a module is in. For C<Acme::Bleach>
that might be C<Acme-Bleach>.
-=head2 $mod->package_version
+=head2 $mod->package_version( [$package_string] )
Returns the version of the package a module is in. For a module
in the package C<Acme-Bleach-1.1.tar.gz> this would be C<1.1>.
-=head2 $mod->package_extension
+=head2 $mod->package_extension( [$package_string] )
Returns the suffix added by the compression method of a package a
certain module is in. For a module in C<Acme-Bleach-1.1.tar.gz>, this
actually a bundle. Bundles are identified as modules whose name starts
with C<Bundle::>.
+=head2 $mod->is_autobundle;
+
+Returns a boolean indicating if the module you are looking at, is
+actually an autobundle as generated by C<< $cb->autobundle >>.
+
=head2 $mod->is_third_party
Returns a boolean indicating whether the package is a known third-party
no strict 'refs';
*$name = sub {
my $self = shift;
- my @res = $self->parent->_split_package_string(
- package => $self->package
- );
+ my $val = shift || $self->package;
+ my @res = $self->parent->_split_package_string( package => $val );
### return the corresponding index from the result
return $res[$index] if @res;
my $self = shift;
my $ver = shift || $];
+ ### allow it to be called as a package function as well like:
+ ### CPANPLUS::Module::module_is_supplied_with_perl_core('Config')
+ ### so that we can check the status of modules that aren't released
+ ### to CPAN, but are part of the core.
+ my $name = ref $self ? $self->module : $self;
+
### check Module::CoreList to see if it's a core package
require Module::CoreList;
- my $core = $Module::CoreList::version{ $ver }->{ $self->module };
+
+ ### Address #41157: Module::module_is_supplied_with_perl_core()
+ ### broken for perl 5.10: Module::CoreList's version key for the
+ ### hash has a different number of trailing zero than $] aka
+ ### $PERL_VERSION.
+ my $core = $Module::CoreList::version{ 0+$ver }->{ $name };
return $core;
}
### make sure Bundle-Foo also gets flagged as bundle
sub is_bundle {
- return shift->module =~ /^bundle(?:-|::)/i ? 1 : 0;
+ my $self = shift;
+
+ ### cpan'd bundle
+ return 1 if $self->module =~ /^bundle(?:-|::)/i;
+
+ ### autobundle
+ return 1 if $self->is_autobundle;
+
+ ### neither
+ return;
+ }
+
+ ### full path to a generated autobundle
+ sub is_autobundle {
+ my $self = shift;
+ my $conf = $self->parent->configure_object;
+ my $prefix = $conf->_get_build('autobundle_prefix');
+
+ return 1 if $self->module eq $prefix;
+ return;
}
sub is_third_party {
=cut
-sub clone {
- my $self = shift;
-
- ### clone the object ###
- my %data;
- for my $acc ( grep !/status/, __PACKAGE__->accessors() ) {
- $data{$acc} = $self->$acc();
+{ ### accessors dont change during run time, so only compute once
+ my @acc = grep !/status/, __PACKAGE__->accessors();
+
+ sub clone {
+ my $self = shift;
+
+ ### clone the object ###
+ my %data = map { $_ => $self->$_ } @acc;
+
+ my $obj = CPANPLUS::Module::Fake->new( %data );
+
+ return $obj;
}
-
- my $obj = CPANPLUS::Module::Fake->new( %data );
-
- return $obj;
}
=pod
$self->module) );
return;
}
-
+
+ ### can't extract these, so just use the basedir for the file
+ if( $self->is_autobundle ) {
+
+ ### this is expected to be set after an extract call
+ $self->get_installer_type;
+
+ return $self->status->extract( dirname( $self->status->fetch ) );
+ }
+
return $cb->_extract( @_, module => $self );
}
my $conf = $cb->configure_object;
my %hash = @_;
- my $prefer_makefile;
+ my ($prefer_makefile,$verbose);
my $tmpl = {
prefer_makefile => { default => $conf->get_conf('prefer_makefile'),
- store => \$prefer_makefile, allow => BOOLEANS },
+ store => \$prefer_makefile, allow => BOOLEANS },
+ verbose => { default => $conf->get_conf('verbose'),
+ store => \$verbose },
};
check( $tmpl, \%hash ) or return;
- my $extract = $self->status->extract();
- unless( $extract ) {
- error(loc("Cannot determine installer type of unextracted module '%1'",
- $self->module));
- return;
- }
-
-
- ### check if it's a makemaker or a module::build type dist ###
- my $found_build = -e BUILD_PL->( $extract );
- my $found_makefile = -e MAKEFILE_PL->( $extract );
-
my $type;
- $type = INSTALLER_BUILD if !$prefer_makefile && $found_build;
- $type = INSTALLER_BUILD if $found_build && !$found_makefile;
- $type = INSTALLER_MM if $prefer_makefile && $found_makefile;
- $type = INSTALLER_MM if $found_makefile && !$found_build;
+
+ ### autobundles use their own installer, so return that
+ if( $self->is_autobundle ) {
+ $type = INSTALLER_AUTOBUNDLE;
+
+ } else {
+ my $extract = $self->status->extract();
+ unless( $extract ) {
+ error(loc(
+ "Cannot determine installer type of unextracted module '%1'",
+ $self->module
+ ));
+ return;
+ }
+
+ ### check if it's a makemaker or a module::build type dist ###
+ my $found_build = -e BUILD_PL->( $extract );
+ my $found_makefile = -e MAKEFILE_PL->( $extract );
+
+ $type = INSTALLER_BUILD if !$prefer_makefile && $found_build;
+ $type = INSTALLER_BUILD if $found_build && !$found_makefile;
+ $type = INSTALLER_MM if $prefer_makefile && $found_makefile;
+ $type = INSTALLER_MM if $found_makefile && !$found_build;
+ }
### ok, so it's a 'build' installer, but you don't /have/ module build
- if( $type eq INSTALLER_BUILD and (
- not grep { $_ eq INSTALLER_BUILD } CPANPLUS::Dist->dist_types )
+ if( $type eq INSTALLER_BUILD and
+ not CPANPLUS::Dist->has_dist_type( INSTALLER_BUILD )
) {
- error( loc( "This module requires '%1' and '%2' to be installed, ".
- "but you don't have it! Will fall back to ".
- "'%3', but might not be able to install!",
- 'Module::Build', INSTALLER_BUILD, INSTALLER_MM ) );
- $type = INSTALLER_MM;
+
+ ### XXX this is for recording purposes only. We *have* to install
+ ### these before even creating a dist object, or we'll get an error
+ ### saying 'no such dist type';
+ my $href = $self->status->configure_requires || {};
+ my $deps = { INSTALLER_BUILD, 0, %$href };
+
+ $self->status->configure_requires( $deps );
+
+ msg(loc("This module requires '%1' and '%2' to be installed first. ".
+ "Adding these modules to your prerequisites list",
+ 'Module::Build', INSTALLER_BUILD
+ ), $verbose );
+
### ok, actually we found neither ###
} elsif ( !$type ) {
### we need the info
$self->get_installer_type unless $self->status->installer_type;
-
my($type,$args,$target);
my $tmpl = {
format => { default => $conf->get_conf('dist_type') ||
check( $tmpl, \%hash ) or return;
- my $dist = CPANPLUS::Dist->new(
- format => $type,
- module => $self
- ) or return;
+ ### ok, check for $type. Do we have it?
+ unless( CPANPLUS::Dist->has_dist_type( $type ) ) {
+
+ ### ok, we don't have it. Is it C::D::Build? if so we can install the
+ ### whole thing now
+ ### XXX we _could_ do this for any type we dont have actually...
+ if( $type eq INSTALLER_BUILD ) {
+ msg(loc("Bootstrapping installer '%1'", $type));
+
+ ### don't propagate the format, it's the one we're trying to
+ ### bootstrap, so it'll be an infinite loop if we do
+
+ $cb->module_tree( $type )->install( target => $target, %$args ) or
+ do {
+ error(loc("Could not bootstrap installer '%1' -- ".
+ "can not continue", $type));
+ return;
+ };
+
+ ### re-scan for available modules now
+ CPANPLUS::Dist->rescan_dist_types;
+
+ unless( CPANPLUS::Dist->has_dist_type( $type ) ) {
+ error(loc("Newly installed installer type '%1' should be ".
+ "available, but is not! -- aborting", $type));
+ return;
+ } else {
+ msg(loc("Installer '%1' succesfully bootstrapped", $type));
+ }
+
+ ### some other plugin you dont have. Abort
+ } else {
+ error(loc("Installer type '%1' not found. Please verify your ".
+ "installation -- aborting", $type ));
+ return;
+ }
+ }
+
+ my $dist = $type->new( module => $self ) or return;
my $dist_cpan = $type eq $self->status->installer_type
? $dist
- : CPANPLUS::Dist->new(
- format => $self->status->installer_type,
- module => $self,
- );
+ : $self->status->installer_type->new( module => $self );
### store the dists
$self->status->dist_cpan( $dist_cpan );
return;
}
- my $dir;
- unless( $dir = $self->status->extract ) {
- error( loc("Don't know where '%1' was extracted to", $self->module ) );
- return;
- }
-
my @files;
- find( {
- wanted => sub { push @files, File::Spec->rel2abs($_) if /\.pm/i; },
- no_chdir => 1,
- }, $dir );
+
+ ### autobundles are special files generated by CPANPLUS. If we can
+ ### read the file, we can determine the prereqs
+ if( $self->is_autobundle ) {
+ my $where;
+ unless( $where = $self->status->fetch ) {
+ error(loc("Don't know where '%1' was fetched to", $self->package));
+ return;
+ }
+
+ push @files, $where
+
+ ### regular bundle::* upload
+ } else {
+ my $dir;
+ unless( $dir = $self->status->extract ) {
+ error(loc("Don't know where '%1' was extracted to", $self->module));
+ return;
+ }
+
+ find( {
+ wanted => sub { push @files, File::Spec->rel2abs($_) if /\.pm/i },
+ no_chdir => 1,
+ }, $dir );
+ }
my $prereqs = {}; my @list; my $seen = {};
for my $file ( @files ) {
$file,$!)), next );
my $flag;
- while(<$fh>) {
+ while( local $_ = <$fh> ) {
### quick hack to read past the header of the file ###
last if $flag && m|^=head|i;
if ($flag && /^(?!=)(\S+)\s*(\S+)?/) {
my $module = $1;
- my $version = $2 || '0';
+ my $version = $cb->_version_to_number( version => $2 );
my $obj = $cb->module_tree($module);
return;
}
- my $in;
- { local $/; $in = <$fh> };
+ my $in = do{ local $/; <$fh> };
$fh->close;
return $self->status->readme( $in );
Returns the location of the currently installed file of this module,
if any.
+=head2 $dir = $self->installed_dir()
+
+Returns the directory (or more accurately, the C<@INC> handle) from
+which this module was loaded, if any.
+
=head2 $bool = $self->is_uptodate([version => VERSION_NUMBER])
Returns a boolean indicating if this module is uptodate or not.
{ my $map = { # hashkey, alternate rv
installed_version => ['version', 0 ],
installed_file => ['file', ''],
+ installed_dir => ['dir', ''],
is_uptodate => ['uptodate', 0 ],
};
for my $dir ( sort @$dirs ) {
local *DIR;
- open DIR, $dir or next;
+ opendir DIR, $dir or next;
my @count = readdir(DIR);
close DIR;
# unless $^O eq 'MSWin32';
#}
- my @cmd = ($^X, "-ermdir+q[$dir]");
+ my @cmd = ($^X, "-e", "rmdir q[$dir]");
unshift @cmd, $sudo if $sudo;
my $buffer;
verbose => $verbose,
);
- my $inst;
- unless( $inst = ExtUtils::Installed->new() ) {
+ ### search in your regular @INC, and anything you added to your config.
+ ### this lets EU::Installed find .packlists that are *not* in the standard
+ ### compiled in @INC path. Requires EU::I 1.42 or up. this addresses #33438
+ ### make sure the archname path is also added, as that's where the .packlist
+ ### files are written
+ my @libs;
+ for my $lib ( @{ $conf->get_conf('lib') } ) {
+ require Config;
+
+ ### figure out what an MM prefix expands to. Basically, it's the
+ ### site install target from %Config, ie: /opt/lib/perl5/site_perl/5.8.8
+ ### minus the site wide prefix, ie: /opt
+ ### this lets users add the dir they have set as their EU::MM PREFIX
+ ### to our 'lib' config and it Just Works
+ ### XXX is this the right thing to do?
+ push @libs, do {
+ my $site = $Config::Config{sitelib};
+ my $prefix = quotemeta $Config::Config{prefix};
+
+ ### strip the prefix from the site dir
+ $site =~ s/^$prefix//;
+
+ File::Spec->catdir( $lib, $site ),
+ File::Spec->catdir( $lib, $site, $Config::Config{'archname'} );
+ };
+
+ ### the arch specific dir, ie:
+ ### /opt/lib/perl5/site_perl/5.8.8/darwin-2level
+ push @libs, File::Spec->catdir( $lib, $Config::Config{'archname'} );
+
+ ### and just the standard dir
+ push @libs, $lib;
+ }
+
+ my $inst;
+ unless( $inst = ExtUtils::Installed->new( extra_libs => \@libs ) ) {
error( loc("Could not create an '%1' object", 'ExtUtils::Installed' ) );
### in case it's being used directly... ###
=head2 $bool = $self->add_to_includepath;
Adds the current modules path to C<@INC> and C<$PERL5LIB>. This allows
-you to add the module from it's build dir to your path.
+you to add the module from its build dir to your path.
-You can reset C<@INC> and C<$PERL5LIB> to it's original state when you
+You can reset C<@INC> and C<$PERL5LIB> to its original state when you
started the program, by calling:
$self->parent->flush('lib');
projects / p5sagit/p5-mst-13.2.git / blobdiff