849 lines
26 KiB
Perl
849 lines
26 KiB
Perl
package CPANPLUS::Dist;
|
|
|
|
use strict;
|
|
|
|
use CPANPLUS::Error;
|
|
use CPANPLUS::Internals::Constants;
|
|
|
|
use Cwd ();
|
|
use Object::Accessor;
|
|
use Parse::CPAN::Meta;
|
|
|
|
use IPC::Cmd qw[run];
|
|
use Params::Check qw[check];
|
|
use Module::Load::Conditional qw[can_load check_install];
|
|
use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
|
|
|
|
use vars qw[$VERSION];
|
|
$VERSION = "0.9910";
|
|
|
|
use base 'Object::Accessor';
|
|
|
|
local $Params::Check::VERBOSE = 1;
|
|
|
|
=pod
|
|
|
|
=head1 NAME
|
|
|
|
CPANPLUS::Dist - base class for plugins
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
my $dist = CPANPLUS::Dist::YOUR_DIST_TYPE_HERE->new(
|
|
module => $modobj,
|
|
);
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
C<CPANPLUS::Dist> is a base class for C<CPANPLUS::Dist::MM>
|
|
and C<CPANPLUS::Dist::Build>. Developers of other C<CPANPLUS::Dist::*>
|
|
plugins should look at C<CPANPLUS::Dist::Base>.
|
|
|
|
=head1 ACCESSORS
|
|
|
|
=over 4
|
|
|
|
=item parent()
|
|
|
|
Returns the C<CPANPLUS::Module> object that parented this object.
|
|
|
|
=item status()
|
|
|
|
Returns the C<Object::Accessor> object that keeps the status for
|
|
this module.
|
|
|
|
=back
|
|
|
|
=head1 STATUS ACCESSORS
|
|
|
|
All accessors can be accessed as follows:
|
|
$deb->status->ACCESSOR
|
|
|
|
=over 4
|
|
|
|
=item created()
|
|
|
|
Boolean indicating whether the dist was created successfully.
|
|
Explicitly set to C<0> when failed, so a value of C<undef> may be
|
|
interpreted as C<not yet attempted>.
|
|
|
|
=item installed()
|
|
|
|
Boolean indicating whether the dist was installed successfully.
|
|
Explicitly set to C<0> when failed, so a value of C<undef> may be
|
|
interpreted as C<not yet attempted>.
|
|
|
|
=item uninstalled()
|
|
|
|
Boolean indicating whether the dist was uninstalled successfully.
|
|
Explicitly set to C<0> when failed, so a value of C<undef> may be
|
|
interpreted as C<not yet attempted>.
|
|
|
|
=item dist()
|
|
|
|
The location of the final distribution. This may be a file or
|
|
directory, depending on how your distribution plug in of choice
|
|
works. This will be set upon a successful create.
|
|
|
|
=cut
|
|
|
|
=back
|
|
|
|
=head2 $dist = CPANPLUS::Dist::YOUR_DIST_TYPE_HERE->new( module => MODOBJ );
|
|
|
|
Create a new C<CPANPLUS::Dist::YOUR_DIST_TYPE_HERE> object based on the
|
|
provided C<MODOBJ>.
|
|
|
|
*** DEPRECATED ***
|
|
The optional argument C<format> is used to indicate what type of dist
|
|
you would like to create (like C<CPANPLUS::Dist::MM> or
|
|
C<CPANPLUS::Dist::Build> and so on ).
|
|
|
|
C<< CPANPLUS::Dist->new >> is exclusively meant as a method to be
|
|
inherited by C<CPANPLUS::Dist::MM|Build>.
|
|
|
|
Returns a C<CPANPLUS::Dist::YOUR_DIST_TYPE_HERE> object on success
|
|
and false on failure.
|
|
|
|
=cut
|
|
|
|
sub new {
|
|
my $self = shift;
|
|
my $class = ref $self || $self;
|
|
my %hash = @_;
|
|
|
|
### first verify we got a module object ###
|
|
my( $mod, $format );
|
|
my $tmpl = {
|
|
module => { required => 1, allow => IS_MODOBJ, store => \$mod },
|
|
### for backwards compatibility
|
|
format => { default => $class, store => \$format,
|
|
allow => [ __PACKAGE__->dist_types ],
|
|
},
|
|
};
|
|
check( $tmpl, \%hash ) or return;
|
|
|
|
unless( can_load( modules => { $format => '0.0' }, verbose => 1 ) ) {
|
|
error(loc("'%1' not found -- you need '%2' version '%3' or higher ".
|
|
"to detect plugins", $format, 'Module::Pluggable','2.4'));
|
|
return;
|
|
}
|
|
|
|
### get an empty o::a object for this class
|
|
my $obj = $format->SUPER::new;
|
|
|
|
$obj->mk_accessors( qw[parent status] );
|
|
|
|
### set the parent
|
|
$obj->parent( $mod );
|
|
|
|
### create a status object ###
|
|
{ my $acc = Object::Accessor->new;
|
|
$obj->status($acc);
|
|
|
|
### add minimum supported accessors
|
|
$acc->mk_accessors( qw[prepared created installed uninstalled
|
|
distdir dist _metadata] );
|
|
}
|
|
|
|
### get the conf object ###
|
|
my $conf = $mod->parent->configure_object();
|
|
|
|
### check if the format is available in this environment ###
|
|
if( $conf->_get_build('sanity_check') and not $obj->format_available ) {
|
|
error( loc( "Format '%1' is not available", $format) );
|
|
return;
|
|
}
|
|
|
|
### now initialize it or admit failure
|
|
unless( $obj->init ) {
|
|
error(loc("Dist initialization of '%1' failed for '%2'",
|
|
$format, $mod->module));
|
|
return;
|
|
}
|
|
|
|
### return the object
|
|
return $obj;
|
|
}
|
|
|
|
=head2 @dists = CPANPLUS::Dist->dist_types;
|
|
|
|
Returns a list of the CPANPLUS::Dist::* classes available
|
|
|
|
=cut
|
|
|
|
### returns a list of dist_types we support
|
|
### will get overridden by Module::Pluggable if loaded
|
|
### XXX add support for 'plugin' dir in config as well
|
|
{ my $Loaded;
|
|
my @Dists = (INSTALLER_MM);
|
|
my @Ignore = ();
|
|
|
|
### backdoor method to add more dist types
|
|
sub _add_dist_types { my $self = shift; push @Dists, @_ };
|
|
|
|
### backdoor method to exclude dist types
|
|
sub _ignore_dist_types { my $self = shift; push @Ignore, @_ };
|
|
sub _reset_dist_ignore { @Ignore = () };
|
|
|
|
### locally add the plugins dir to @INC, so we can find extra plugins
|
|
#local @INC = @INC, File::Spec->catdir(
|
|
# $conf->get_conf('base'),
|
|
# $conf->_get_build('plugins') );
|
|
|
|
### load any possible plugins
|
|
sub dist_types {
|
|
|
|
if ( !$Loaded++ and check_install( module => 'Module::Pluggable',
|
|
version => '2.4')
|
|
) {
|
|
require Module::Pluggable;
|
|
|
|
my $only_re = __PACKAGE__ . '::\w+$';
|
|
my %except = map { $_ => 1 }
|
|
INSTALLER_SAMPLE,
|
|
INSTALLER_BASE;
|
|
|
|
Module::Pluggable->import(
|
|
sub_name => '_dist_types',
|
|
search_path => __PACKAGE__,
|
|
only => qr/$only_re/,
|
|
require => 1,
|
|
except => [ keys %except ]
|
|
);
|
|
my %ignore = map { $_ => $_ } @Ignore;
|
|
|
|
push @Dists, grep { not $ignore{$_} and not $except{$_} }
|
|
__PACKAGE__->_dist_types;
|
|
}
|
|
|
|
return @Dists;
|
|
}
|
|
|
|
=head2 $bool = CPANPLUS::Dist->rescan_dist_types;
|
|
|
|
Rescans C<@INC> for available dist types. Useful if you've installed new
|
|
C<CPANPLUS::Dist::*> classes and want to make them available to the
|
|
current process.
|
|
|
|
=cut
|
|
|
|
sub rescan_dist_types {
|
|
my $dist = shift;
|
|
$Loaded = 0; # reset the flag;
|
|
return $dist->dist_types;
|
|
}
|
|
}
|
|
|
|
=head2 $bool = CPANPLUS::Dist->has_dist_type( $type )
|
|
|
|
Returns true if distribution type C<$type> is loaded/supported.
|
|
|
|
=cut
|
|
|
|
sub has_dist_type {
|
|
my $dist = shift;
|
|
my $type = shift or return;
|
|
|
|
return scalar grep { $_ eq $type } CPANPLUS::Dist->dist_types;
|
|
}
|
|
|
|
=head2 $bool = $dist->prereq_satisfied( modobj => $modobj, version => $version_spec )
|
|
|
|
Returns true if this prereq is satisfied. Returns false if it's not.
|
|
Also issues an error if it seems "unsatisfiable," i.e. if it can't be
|
|
found on CPAN or the latest CPAN version doesn't satisfy it.
|
|
|
|
=cut
|
|
|
|
sub prereq_satisfied {
|
|
my $dist = shift;
|
|
my $cb = $dist->parent->parent;
|
|
my %hash = @_;
|
|
|
|
my($mod,$ver);
|
|
my $tmpl = {
|
|
version => { required => 1, store => \$ver },
|
|
modobj => { required => 1, store => \$mod, allow => IS_MODOBJ },
|
|
};
|
|
|
|
check( $tmpl, \%hash ) or return;
|
|
|
|
return 1 if $mod->is_uptodate( version => $ver );
|
|
|
|
if ( $cb->_vcmp( $ver, $mod->version ) > 0 ) {
|
|
|
|
error(loc(
|
|
"This distribution depends on %1, but the latest version".
|
|
" of %2 on CPAN (%3) doesn't satisfy the specific version".
|
|
" dependency (%4). You may have to resolve this dependency ".
|
|
"manually.",
|
|
$mod->module, $mod->module, $mod->version, $ver ));
|
|
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
=head2 $configure_requires = $dist->find_configure_requires( [file => /path/to/META.yml] )
|
|
|
|
Reads the configure_requires for this distribution from the META.yml or META.json
|
|
file in the root directory and returns a hashref with module names
|
|
and versions required.
|
|
|
|
=cut
|
|
|
|
sub find_configure_requires {
|
|
my $self = shift;
|
|
my $mod = $self->parent;
|
|
my %hash = @_;
|
|
|
|
my ($meta);
|
|
my $href = {};
|
|
|
|
my $tmpl = {
|
|
file => { store => \$meta },
|
|
};
|
|
|
|
$self->_stash_metadata(); # Okay hacks.
|
|
|
|
check( $tmpl, \%hash ) or return;
|
|
|
|
my $meth = 'configure_requires';
|
|
|
|
{
|
|
|
|
### the prereqs as we have them now
|
|
my @args = (
|
|
defaults => $mod->status->$meth || {},
|
|
);
|
|
|
|
my @possibles = do { defined $mod->status->extract
|
|
? ( META_JSON->( $mod->status->extract ),
|
|
META_YML->( $mod->status->extract ) )
|
|
: ()
|
|
};
|
|
|
|
unshift @possibles, $meta if $meta;
|
|
|
|
META: foreach my $mfile ( grep { -e } @possibles ) {
|
|
push @args, ( file => $mfile );
|
|
if ( $mfile =~ /\.json/ ) {
|
|
$href = $self->_prereqs_from_meta_json( @args, keys => [ 'configure' ] );
|
|
}
|
|
else {
|
|
$href = $self->_prereqs_from_meta_file( @args, keys => [ $meth ] );
|
|
}
|
|
last META;
|
|
}
|
|
|
|
}
|
|
|
|
### and store it in the module
|
|
$mod->status->$meth( $href );
|
|
|
|
return { %$href };
|
|
}
|
|
|
|
sub find_mymeta_requires {
|
|
my $self = shift;
|
|
my $mod = $self->parent;
|
|
my %hash = @_;
|
|
|
|
my ($meta);
|
|
my $href = {};
|
|
|
|
my $tmpl = {
|
|
file => { store => \$meta },
|
|
};
|
|
|
|
check( $tmpl, \%hash ) or return;
|
|
|
|
my $meth = 'prereqs';
|
|
|
|
{
|
|
|
|
### the prereqs as we have them now
|
|
my @args = (
|
|
defaults => $mod->status->$meth || {},
|
|
);
|
|
|
|
my @possibles = do { defined $mod->status->extract
|
|
? ( MYMETA_JSON->( $mod->status->extract ),
|
|
MYMETA_YML->( $mod->status->extract ) )
|
|
: ()
|
|
};
|
|
|
|
unshift @possibles, $meta if $meta;
|
|
|
|
META: foreach my $mfile ( grep { -e } @possibles ) {
|
|
push @args, ( file => $mfile );
|
|
if ( $mfile =~ /\.json/ ) {
|
|
$href = $self->_prereqs_from_meta_json( @args,
|
|
keys => [ qw|build test runtime| ] );
|
|
}
|
|
else {
|
|
$href = $self->_prereqs_from_meta_file( @args,
|
|
keys => [ qw|build_requires requires| ] );
|
|
}
|
|
last META;
|
|
}
|
|
|
|
}
|
|
|
|
### and store it in the module
|
|
$mod->status->$meth( $href );
|
|
|
|
return { %$href };
|
|
}
|
|
|
|
sub _prereqs_from_meta_file {
|
|
my $self = shift;
|
|
my $mod = $self->parent;
|
|
my %hash = @_;
|
|
|
|
my( $meta, $defaults, $keys );
|
|
my $tmpl = { ### check if we have an extract path. if not, we
|
|
### get 'undef value' warnings from file::spec
|
|
file => { default => do { defined $mod->status->extract
|
|
? META_YML->( $mod->status->extract )
|
|
: '' },
|
|
store => \$meta,
|
|
},
|
|
defaults => { required => 1, default => {}, strict_type => 1,
|
|
store => \$defaults },
|
|
keys => { required => 1, default => [], strict_type => 1,
|
|
store => \$keys },
|
|
};
|
|
|
|
check( $tmpl, \%hash ) or return;
|
|
|
|
### if there's a meta file, we read it;
|
|
if( -e $meta ) {
|
|
|
|
### Parse::CPAN::Meta uses exceptions for errors
|
|
### hash returned in list context!!!
|
|
|
|
local $ENV{PERL_YAML_BACKEND};
|
|
|
|
my ($doc) = eval { Parse::CPAN::Meta::LoadFile( $meta ) };
|
|
|
|
unless( $doc ) {
|
|
error(loc( "Could not read %1: '%2'", $meta, $@ ));
|
|
return $defaults;
|
|
}
|
|
|
|
### read the keys now, make sure not to throw
|
|
### away anything that was already added
|
|
for my $key ( @$keys ) {
|
|
$defaults = {
|
|
%$defaults,
|
|
%{ $doc->{$key} },
|
|
} if $doc->{ $key };
|
|
}
|
|
}
|
|
|
|
### and return a copy
|
|
return \%{ $defaults };
|
|
}
|
|
|
|
sub _prereqs_from_meta_json {
|
|
my $self = shift;
|
|
my $mod = $self->parent;
|
|
my %hash = @_;
|
|
|
|
my( $meta, $defaults, $keys );
|
|
my $tmpl = { ### check if we have an extract path. if not, we
|
|
### get 'undef value' warnings from file::spec
|
|
file => { default => do { defined $mod->status->extract
|
|
? META_JSON->( $mod->status->extract )
|
|
: '' },
|
|
store => \$meta,
|
|
},
|
|
defaults => { required => 1, default => {}, strict_type => 1,
|
|
store => \$defaults },
|
|
keys => { required => 1, default => [], strict_type => 1,
|
|
store => \$keys },
|
|
};
|
|
|
|
check( $tmpl, \%hash ) or return;
|
|
|
|
### if there's a meta file, we read it;
|
|
if( -e $meta ) {
|
|
|
|
### Parse::CPAN::Meta uses exceptions for errors
|
|
### hash returned in list context!!!
|
|
|
|
local $ENV{PERL_JSON_BACKEND};
|
|
|
|
my ($doc) = eval { Parse::CPAN::Meta->load_file( $meta ) };
|
|
|
|
unless( $doc ) {
|
|
error(loc( "Could not read %1: '%2'", $meta, $@ ));
|
|
return $defaults;
|
|
}
|
|
|
|
### read the keys now, make sure not to throw
|
|
### away anything that was already added
|
|
#for my $key ( @$keys ) {
|
|
# $defaults = {
|
|
# %$defaults,
|
|
# %{ $doc->{$key} },
|
|
# } if $doc->{ $key };
|
|
#}
|
|
my $prereqs = $doc->{prereqs} || {};
|
|
for my $key ( @$keys ) {
|
|
$defaults = {
|
|
%$defaults,
|
|
%{ $prereqs->{$key}->{requires} },
|
|
} if $prereqs->{ $key }->{requires};
|
|
}
|
|
}
|
|
|
|
### and return a copy
|
|
return \%{ $defaults };
|
|
}
|
|
|
|
sub _stash_metadata {
|
|
my $self = shift;
|
|
my $mod = $self->parent;
|
|
|
|
my @possibles = do { defined $mod->status->extract
|
|
? ( META_JSON->( $mod->status->extract ),
|
|
META_YML->( $mod->status->extract ) )
|
|
: ()
|
|
};
|
|
|
|
$self->mk_accessors( qw[_metadata] );
|
|
$self->status->_metadata( {} );
|
|
|
|
META: foreach my $mfile ( grep { -e } @possibles ) {
|
|
if ( $mfile =~ /\.json/ ) {
|
|
local $ENV{PERL_JSON_BACKEND};
|
|
my ($doc) = eval { Parse::CPAN::Meta->load_file( $mfile ) };
|
|
unless( $doc ) {
|
|
error(loc( "Could not read %1: '%2'", $mfile, $@ ));
|
|
return;
|
|
}
|
|
$self->status->_metadata( $doc );
|
|
return $doc;
|
|
}
|
|
else {
|
|
local $ENV{PERL_YAML_BACKEND};
|
|
my ($doc) = eval { Parse::CPAN::Meta->load_file( $mfile ) };
|
|
unless( $doc ) {
|
|
error(loc( "Could not read %1: '%2'", $mfile, $@ ));
|
|
return;
|
|
}
|
|
$self->status->_metadata( $doc );
|
|
return $doc;
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
|
|
|
|
=head2 $bool = $dist->_resolve_prereqs( ... )
|
|
|
|
Makes sure prerequisites are resolved
|
|
|
|
format The dist class to use to make the prereqs
|
|
(ie. CPANPLUS::Dist::MM)
|
|
|
|
prereqs Hash of the prerequisite modules and their versions
|
|
|
|
target What to do with the prereqs.
|
|
create => Just build them
|
|
install => Install them
|
|
ignore => Ignore them
|
|
|
|
prereq_build If true, always build the prereqs even if already
|
|
resolved
|
|
|
|
verbose Be verbose
|
|
|
|
force Force the prereq to be built, even if already resolved
|
|
|
|
=cut
|
|
|
|
sub _resolve_prereqs {
|
|
my $dist = shift;
|
|
my $self = $dist->parent;
|
|
my $cb = $self->parent;
|
|
my $conf = $cb->configure_object;
|
|
my %hash = @_;
|
|
|
|
my ($prereqs, $format, $verbose, $target, $force, $prereq_build,$tolerant);
|
|
my $tmpl = {
|
|
### XXX perhaps this should not be required, since it may not be
|
|
### packaged, just installed...
|
|
### Let it be empty as well -- that means the $modobj->install
|
|
### routine will figure it out, which is fine if we didn't have any
|
|
### very specific wishes (it will even detect the favourite
|
|
### dist_type).
|
|
format => { required => 1, store => \$format,
|
|
allow => ['',__PACKAGE__->dist_types], },
|
|
prereqs => { required => 1, default => { },
|
|
strict_type => 1, store => \$prereqs },
|
|
verbose => { default => $conf->get_conf('verbose'),
|
|
store => \$verbose },
|
|
force => { default => $conf->get_conf('force'),
|
|
store => \$force },
|
|
### make sure allow matches with $mod->install's list
|
|
target => { default => '', store => \$target,
|
|
allow => ['',qw[create ignore install]] },
|
|
prereq_build => { default => 0, store => \$prereq_build },
|
|
tolerant => { default => $conf->get_conf('allow_unknown_prereqs'),
|
|
store => \$tolerant },
|
|
};
|
|
|
|
check( $tmpl, \%hash ) or return;
|
|
|
|
### so there are no prereqs? then don't even bother
|
|
return 1 unless keys %$prereqs;
|
|
|
|
### Make sure we wound up where we started.
|
|
my $original_wd = Cwd::cwd;
|
|
|
|
### so you didn't provide an explicit target.
|
|
### maybe your config can tell us what to do.
|
|
$target ||= {
|
|
PREREQ_ASK, TARGET_INSTALL, # we'll bail out if the user says no
|
|
PREREQ_BUILD, TARGET_CREATE,
|
|
PREREQ_IGNORE, TARGET_IGNORE,
|
|
PREREQ_INSTALL, TARGET_INSTALL,
|
|
}->{ $conf->get_conf('prereqs') } || '';
|
|
|
|
### XXX BIG NASTY HACK XXX FIXME at some point.
|
|
### when installing Bundle::CPANPLUS::Dependencies, we want to
|
|
### install all packages matching 'cpanplus' to be installed last,
|
|
### as all CPANPLUS' prereqs are being installed as well, but are
|
|
### being loaded for bootstrapping purposes. This means CPANPLUS
|
|
### can find them, but for example cpanplus::dist::build won't,
|
|
### which gets messy FAST. So, here we sort our prereqs only IF
|
|
### the parent module is Bundle::CPANPLUS::Dependencies.
|
|
### Really, we would want some sort of sorted prereq mechanism,
|
|
### but Bundle:: doesn't support it, and we flatten everything
|
|
### to a hash internally. A sorted hash *might* do the trick if
|
|
### we got a transparent implementation.. that would mean we would
|
|
### just have to remove the 'sort' here, and all will be well
|
|
my @sorted_prereqs;
|
|
|
|
### use regex, could either be a module name, or a package name
|
|
if( $self->module =~ /^Bundle(::|-)CPANPLUS(::|-)Dependencies/ ) {
|
|
my (@first, @last);
|
|
for my $mod ( sort keys %$prereqs ) {
|
|
$mod =~ /CPANPLUS/
|
|
? push @last, $mod
|
|
: push @first, $mod;
|
|
}
|
|
@sorted_prereqs = (@first, @last);
|
|
} else {
|
|
@sorted_prereqs = sort keys %$prereqs;
|
|
}
|
|
|
|
### first, transfer this key/value pairing into a
|
|
### list of module objects + desired versions
|
|
my @install_me;
|
|
|
|
my $flag;
|
|
|
|
for my $mod ( @sorted_prereqs ) {
|
|
( my $version = $prereqs->{$mod} ) =~ s#[^0-9\._]+##g;
|
|
|
|
### 'perl' is a special case, there's no mod object for it
|
|
if( $mod eq PERL_CORE ) {
|
|
|
|
unless( $cb->_vcmp( sprintf('v%vd',$^V), $version ) >= 0 ) {
|
|
error(loc( "Module '%1' needs perl version '%2', but you ".
|
|
"only have version '%3' -- can not proceed",
|
|
$self->module, $version,
|
|
$cb->_perl_version( perl => $^X ) ) );
|
|
return;
|
|
}
|
|
|
|
next;
|
|
}
|
|
|
|
my $modobj = $cb->module_tree($mod);
|
|
|
|
#### XXX we ignore the version, and just assume that the latest
|
|
#### version from cpan will meet your requirements... dodgy =/
|
|
unless( $modobj ) {
|
|
# Check if it is a core module
|
|
my $sub = CPANPLUS::Module->can(
|
|
'module_is_supplied_with_perl_core' );
|
|
my $core = $sub->( $mod );
|
|
unless ( defined $core ) {
|
|
error( loc( "No such module '%1' found on CPAN", $mod ) );
|
|
$flag++ unless $tolerant;
|
|
next;
|
|
}
|
|
if ( $cb->_vcmp( $version, $core ) > 0 ) {
|
|
error(loc( "Version of core module '%1' ('%2') is too low for ".
|
|
"'%3' (needs '%4') -- carrying on but this may be a problem",
|
|
$mod, $core,
|
|
$self->module, $version ));
|
|
}
|
|
next;
|
|
}
|
|
|
|
### it's not uptodate, we need to install it
|
|
if( !$dist->prereq_satisfied(modobj => $modobj, version => $version)) {
|
|
msg(loc("Module '%1' requires '%2' version '%3' to be installed ",
|
|
$self->module, $modobj->module, $version), $verbose );
|
|
|
|
push @install_me, [$modobj, $version];
|
|
|
|
### it's not an MM or Build format, that means it's a package
|
|
### manager... we'll need to install it as well, via the PM
|
|
} elsif ( INSTALL_VIA_PACKAGE_MANAGER->($format) and
|
|
!$modobj->package_is_perl_core and
|
|
($target ne TARGET_IGNORE)
|
|
) {
|
|
msg(loc("Module '%1' depends on '%2', may need to build a '%3' ".
|
|
"package for it as well", $self->module, $modobj->module,
|
|
$format));
|
|
push @install_me, [$modobj, $version];
|
|
}
|
|
}
|
|
|
|
|
|
|
|
### so you just want to ignore prereqs? ###
|
|
if( $target eq TARGET_IGNORE ) {
|
|
|
|
### but you have modules you need to install
|
|
if( @install_me ) {
|
|
msg(loc("Ignoring prereqs, this may mean your install will fail"),
|
|
$verbose);
|
|
msg(loc("'%1' listed the following dependencies:", $self->module),
|
|
$verbose);
|
|
|
|
for my $aref (@install_me) {
|
|
my ($mod,$version) = @$aref;
|
|
|
|
my $str = sprintf "\t%-35s %8s\n", $mod->module, $version;
|
|
msg($str,$verbose);
|
|
}
|
|
|
|
return;
|
|
|
|
### ok, no problem, you have all needed prereqs anyway
|
|
} else {
|
|
return 1;
|
|
}
|
|
}
|
|
|
|
for my $aref (@install_me) {
|
|
my($modobj,$version) = @$aref;
|
|
|
|
### another prereq may have already installed this one...
|
|
### so don't ask again if the module turns out to be uptodate
|
|
### see bug [#11840]
|
|
### if either force or prereq_build are given, the prereq
|
|
### should be built anyway
|
|
next if (!$force and !$prereq_build) &&
|
|
$dist->prereq_satisfied(modobj => $modobj, version => $version);
|
|
|
|
### either we're told to ignore the prereq,
|
|
### or the user wants us to ask him
|
|
if( ( $conf->get_conf('prereqs') == PREREQ_ASK and not
|
|
$cb->_callbacks->install_prerequisite->($self, $modobj)
|
|
)
|
|
) {
|
|
msg(loc("Will not install prerequisite '%1' -- Note " .
|
|
"that the overall install may fail due to this",
|
|
$modobj->module), $verbose);
|
|
next;
|
|
}
|
|
|
|
### value set and false -- means failure ###
|
|
if( defined $modobj->status->installed
|
|
&& !$modobj->status->installed
|
|
) {
|
|
error( loc( "Prerequisite '%1' failed to install before in " .
|
|
"this session", $modobj->module ) );
|
|
$flag++;
|
|
last;
|
|
}
|
|
|
|
### part of core?
|
|
if( $modobj->package_is_perl_core ) {
|
|
error(loc("Prerequisite '%1' is perl-core (%2) -- not ".
|
|
"installing that. -- Note that the overall ".
|
|
"install may fail due to this.",
|
|
$modobj->module, $modobj->package ) );
|
|
next;
|
|
}
|
|
|
|
### circular dependency code ###
|
|
my $pending = $cb->_status->pending_prereqs || {};
|
|
|
|
### recursive dependency ###
|
|
if ( $pending->{ $modobj->module } ) {
|
|
error( loc( "Recursive dependency detected (%1) -- skipping",
|
|
$modobj->module ) );
|
|
next;
|
|
}
|
|
|
|
### register this dependency as pending ###
|
|
$pending->{ $modobj->module } = $modobj;
|
|
$cb->_status->pending_prereqs( $pending );
|
|
|
|
### call $modobj->install rather than doing
|
|
### CPANPLUS::Dist->new and the like ourselves,
|
|
### since ->install will take care of fetch &&
|
|
### extract as well
|
|
my $pa = $dist->status->_prepare_args || {};
|
|
my $ca = $dist->status->_create_args || {};
|
|
my $ia = $dist->status->_install_args || {};
|
|
|
|
unless( $modobj->install( %$pa, %$ca, %$ia,
|
|
force => $force,
|
|
verbose => $verbose,
|
|
format => $format,
|
|
target => $target )
|
|
) {
|
|
error(loc("Failed to install '%1' as prerequisite " .
|
|
"for '%2'", $modobj->module, $self->module ) );
|
|
$flag++;
|
|
}
|
|
|
|
### unregister the pending dependency ###
|
|
$pending->{ $modobj->module } = 0;
|
|
$cb->_status->pending_prereqs( $pending );
|
|
|
|
last if $flag;
|
|
|
|
### don't want us to install? ###
|
|
if( $target ne TARGET_INSTALL ) {
|
|
my $dir = $modobj->status->extract
|
|
or error(loc("No extraction dir for '%1' found ".
|
|
"-- weird", $modobj->module));
|
|
|
|
$modobj->add_to_includepath();
|
|
|
|
next;
|
|
}
|
|
}
|
|
|
|
### reset the $prereqs iterator, in case we bailed out early ###
|
|
keys %$prereqs;
|
|
|
|
### chdir back to where we started
|
|
$cb->_chdir( dir => $original_wd );
|
|
|
|
return 1 unless $flag;
|
|
return;
|
|
}
|
|
|
|
1;
|
|
|
|
# Local variables:
|
|
# c-indentation-style: bsd
|
|
# c-basic-offset: 4
|
|
# indent-tabs-mode: nil
|
|
# End:
|
|
# vim: expandtab shiftwidth=4:
|