[perl5.git] / lib / CPANPLUS / Dist.pm

package CPANPLUS::Dist;

use strict;


use CPANPLUS::Error;
use CPANPLUS::Internals::Constants;

use Params::Check               qw[check];
use Module::Load::Conditional   qw[can_load check_install];
use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';
use Object::Accessor;

local $Params::Check::VERBOSE = 1;

my @methods = qw[status parent];
for my $key ( @methods ) {
    no strict 'refs';
    *{__PACKAGE__."::$key"} = sub {
        my $self = shift;
        $self->{$key} = $_[0] if @_;
        return $self->{$key};
    }
}

=pod

=head1 NAME

CPANPLUS::Dist

=head1 SYNOPSIS

    my $dist = CPANPLUS::Dist->new(
                                format  => 'build',
                                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->new( module => MODOBJ, [format => DIST_TYPE] );

Create a new C<CPANPLUS::Dist> object based on the provided C<MODOBJ>.
The optional argument C<format> is used to indicate what type of dist
you would like to create (like C<makemaker> for a C<CPANPLUS::Dist::MM>
object, C<build> for a C<CPANPLUS::Dist::Build> object, and so on ).
If not provided, will default to the setting as specified by your
config C<dist_type>.

Returns a C<CPANPLUS::Dist> object on success and false on failure.

=cut

sub new {
    my $self = shift;
    my %hash = @_;

    local $Params::Check::ALLOW_UNKNOWN = 1;

    ### first verify we got a module object ###
    my $mod;
    my $tmpl = {
        module  => { required => 1, allow => IS_MODOBJ, store => \$mod },
    };
    check( $tmpl, \%hash ) or return;

    ### get the conf object ###
    my $conf = $mod->parent->configure_object();

    ### figure out what type of dist object to create ###
    my $format;
    my $tmpl2 = {
        format  => {    default => $conf->get_conf('dist_type'),
                        allow   => [ __PACKAGE__->dist_types ],
                        store   => \$format  },
    };
    check( $tmpl2, \%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;
    }

    ### bless the object in the child class ###
    my $obj = bless { parent => $mod }, $format;

    ### 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;
    }

    ### 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] );
    }

    ### 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, @_ };

    ### 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+$';

            Module::Pluggable->import(
                            sub_name    => '_dist_types',
                            search_path => __PACKAGE__,
                            only        => qr/$only_re/,
                            except      => [ INSTALLER_MM, 
                                             INSTALLER_SAMPLE,
                                             INSTALLER_BASE,
                                        ]
                        );
            my %ignore = map { $_ => $_ } @Ignore;                        
                        
            push @Dists, grep { not $ignore{$_}  } __PACKAGE__->_dist_types;
        }

        return @Dists;
    }
}

=head2 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 _resolve_prereqs

Makes sure prerequisites are resolved

XXX Need docs, internal use only

=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);
    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 },
    };

    check( $tmpl, \%hash ) or return;

    ### so there are no prereqs? then don't even bother
    return 1 unless keys %$prereqs;

    ### 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 wnat 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;
    
    for my $mod ( @sorted_prereqs ) {
        my $version = $prereqs->{$mod};
        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 ) {
            error( loc( "No such module '%1' found on CPAN", $mod ) );
            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;
        }
    }

    my $flag;
    for my $aref (@install_me) {
        my($modobj,$version) = @$aref;

        ### another prereq may have already installed this one...
        ### so dont 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. Aborting install",
                      $modobj->module, $modobj->package ) );
            $flag++;
            last;
        }

        ### 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;

    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:
Commit	Line	Data
6aaee015 RGS	1	package CPANPLUS::Dist;
	2
	3	use strict;
	4
	5
	6	use CPANPLUS::Error;
	7	use CPANPLUS::Internals::Constants;
	8
	9	use Params::Check qw[check];
	10	use Module::Load::Conditional qw[can_load check_install];
	11	use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
	12	use Object::Accessor;
	13
	14	local $Params::Check::VERBOSE = 1;
	15
	16	my @methods = qw[status parent];
	17	for my $key ( @methods ) {
	18	no strict 'refs';
	19	*{__PACKAGE__."::$key"} = sub {
	20	my $self = shift;
	21	$self->{$key} = $_[0] if @_;
	22	return $self->{$key};
	23	}
	24	}
	25
	26	=pod
	27
	28	=head1 NAME
	29
	30	CPANPLUS::Dist
	31
	32	=head1 SYNOPSIS
	33
	34	my $dist = CPANPLUS::Dist->new(
	35	format => 'build',
	36	module => $modobj,
	37	);
	38
	39	=head1 DESCRIPTION
	40
8d5f6fc7 JB	41	C<CPANPLUS::Dist> is a base class for C<CPANPLUS::Dist::MM>
	42	and C<CPANPLUS::Dist::Build>. Developers of other C<CPANPLUS::Dist::*>
	43	plugins should look at C<CPANPLUS::Dist::Base>.
6aaee015 RGS	44
	45	=head1 ACCESSORS
	46
	47	=over 4
	48
	49	=item parent()
	50
	51	Returns the C<CPANPLUS::Module> object that parented this object.
	52
	53	=item status()
	54
	55	Returns the C<Object::Accessor> object that keeps the status for
	56	this module.
	57
	58	=back
	59
	60	=head1 STATUS ACCESSORS
	61
	62	All accessors can be accessed as follows:
	63	$deb->status->ACCESSOR
	64
	65	=over 4
	66
	67	=item created()
	68
	69	Boolean indicating whether the dist was created successfully.
	70	Explicitly set to C<0> when failed, so a value of C<undef> may be
	71	interpreted as C<not yet attempted>.
	72
	73	=item installed()
	74
	75	Boolean indicating whether the dist was installed successfully.
	76	Explicitly set to C<0> when failed, so a value of C<undef> may be
	77	interpreted as C<not yet attempted>.
	78
	79	=item uninstalled()
	80
	81	Boolean indicating whether the dist was uninstalled successfully.
	82	Explicitly set to C<0> when failed, so a value of C<undef> may be
	83	interpreted as C<not yet attempted>.
	84
	85	=item dist()
	86
	87	The location of the final distribution. This may be a file or
	88	directory, depending on how your distribution plug in of choice
	89	works. This will be set upon a successful create.
	90
	91	=cut
	92
622d31ac JB	93	=back
622d31ac JB	94
6aaee015 RGS	95	=head2 $dist = CPANPLUS::Dist->new( module => MODOBJ, [format => DIST_TYPE] );
	96
	97	Create a new C<CPANPLUS::Dist> object based on the provided C<MODOBJ>.
	98	The optional argument C<format> is used to indicate what type of dist
	99	you would like to create (like C<makemaker> for a C<CPANPLUS::Dist::MM>
	100	object, C<build> for a C<CPANPLUS::Dist::Build> object, and so on ).
	101	If not provided, will default to the setting as specified by your
	102	config C<dist_type>.
	103
	104	Returns a C<CPANPLUS::Dist> object on success and false on failure.
	105
	106	=cut
	107
	108	sub new {
	109	my $self = shift;
	110	my %hash = @_;
	111
	112	local $Params::Check::ALLOW_UNKNOWN = 1;
	113
	114	### first verify we got a module object ###
	115	my $mod;
	116	my $tmpl = {
	117	module => { required => 1, allow => IS_MODOBJ, store => \$mod },
	118	};
	119	check( $tmpl, \%hash ) or return;
	120
	121	### get the conf object ###
	122	my $conf = $mod->parent->configure_object();
	123
	124	### figure out what type of dist object to create ###
	125	my $format;
	126	my $tmpl2 = {
	127	format => { default => $conf->get_conf('dist_type'),
	128	allow => [ __PACKAGE__->dist_types ],
	129	store => \$format },
	130	};
	131	check( $tmpl2, \%hash ) or return;
	132
	133
	134	unless( can_load( modules => { $format => '0.0' }, verbose => 1 ) ) {
	135	error(loc("'%1' not found -- you need '%2' version '%3' or higher ".
	136	"to detect plugins", $format, 'Module::Pluggable','2.4'));
	137	return;
	138	}
	139
	140	### bless the object in the child class ###
	141	my $obj = bless { parent => $mod }, $format;
	142
	143	### check if the format is available in this environment ###
	144	if( $conf->_get_build('sanity_check') and not $obj->format_available ) {
	145	error( loc( "Format '%1' is not available",$format) );
	146	return;
	147	}
	148
	149	### create a status object ###
	150	{ my $acc = Object::Accessor->new;
	151	$obj->status($acc);
	152
	153	### add minimum supported accessors
	154	$acc->mk_accessors( qw[prepared created installed uninstalled
	155	distdir dist] );
	156	}
	157
	158	### now initialize it or admit failure
159	unless( $obj->init ) {
160	error(loc("Dist initialization of '%1' failed for '%2'",
161	$format, $mod->module));
162	return;
163	}
164
165	### return the object
166	return $obj;
167	}
168
169	=head2 @dists = CPANPLUS::Dist->dist_types;
170
171	Returns a list of the CPANPLUS::Dist::* classes available
172
173	=cut
174
175	### returns a list of dist_types we support
176	### will get overridden by Module::Pluggable if loaded
177	### XXX add support for 'plugin' dir in config as well
178	{ my $Loaded;
179	my @Dists = (INSTALLER_MM);
180	my @Ignore = ();
181
182	### backdoor method to add more dist types
183	sub _add_dist_types { my $self = shift; push @Dists, @_ };
184
185	### backdoor method to exclude dist types
186	sub _ignore_dist_types { my $self = shift; push @Ignore, @_ };
187
188	### locally add the plugins dir to @INC, so we can find extra plugins
189	#local @INC = @INC, File::Spec->catdir(
190	# $conf->get_conf('base'),
191	# $conf->_get_build('plugins') );
192
193	### load any possible plugins
194	sub dist_types {
195
196	if ( !$Loaded++ and check_install( module => 'Module::Pluggable',
197	version => '2.4')
198	) {
199	require Module::Pluggable;
200
201	my $only_re = __PACKAGE__ . '::\w+$';
202
203	Module::Pluggable->import(
204	sub_name => '_dist_types',
205	search_path => __PACKAGE__,
206	only => qr/$only_re/,
207	except => [ INSTALLER_MM,
208	INSTALLER_SAMPLE,
209	INSTALLER_BASE,
210	]
211	);
212	my %ignore = map { $_ => $_ } @Ignore;
213
214	push @Dists, grep { not $ignore{$_} } __PACKAGE__->_dist_types;
215	}
216
217	return @Dists;
218	}
219	}
220
221	=head2 prereq_satisfied( modobj => $modobj, version => $version_spec )
222
223	Returns true if this prereq is satisfied. Returns false if it's not.
224	Also issues an error if it seems "unsatisfiable," i.e. if it can't be
225	found on CPAN or the latest CPAN version doesn't satisfy it.
226
227	=cut
228
229	sub prereq_satisfied {
230	my $dist = shift;
231	my $cb = $dist->parent->parent;
232	my %hash = @_;
233
234	my($mod,$ver);
235	my $tmpl = {
236	version => { required => 1, store => \$ver },
237	modobj => { required => 1, store => \$mod, allow => IS_MODOBJ },
238	};
239
240	check( $tmpl, \%hash ) or return;
241
242	return 1 if $mod->is_uptodate( version => $ver );
243
244	if ( $cb->_vcmp( $ver, $mod->version ) > 0 ) {
245
246	error(loc(
247	"This distribution depends on %1, but the latest version".
248	" of %2 on CPAN (%3) doesn't satisfy the specific version".
249	" dependency (%4). You may have to resolve this dependency ".
250	"manually.",
251	$mod->module, $mod->module, $mod->version, $ver ));
252
253	}
254
255	return;
256	}
257
258	=head2 _resolve_prereqs
259
260	Makes sure prerequisites are resolved
261
262	XXX Need docs, internal use only
263
264	=cut
265
266	sub _resolve_prereqs {
267	my $dist = shift;
268	my $self = $dist->parent;
269	my $cb = $self->parent;
270	my $conf = $cb->configure_object;
271	my %hash = @_;
272
273	my ($prereqs, $format, $verbose, $target, $force, $prereq_build);
274	my $tmpl = {
275	### XXX perhaps this should not be required, since it may not be
276	### packaged, just installed...
277	### Let it be empty as well -- that means the $modobj->install
278	### routine will figure it out, which is fine if we didn't have any
279	### very specific wishes (it will even detect the favourite
280	### dist_type).
281	format => { required => 1, store => \$format,
282	allow => ['',__PACKAGE__->dist_types], },
283	prereqs => { required => 1, default => { },
284	strict_type => 1, store => \$prereqs },
285	verbose => { default => $conf->get_conf('verbose'),
286	store => \$verbose },
287	force => { default => $conf->get_conf('force'),
288	store => \$force },
289	### make sure allow matches with $mod->install's list
290	target => { default => '', store => \$target,
291	allow => ['',qw[create ignore install]] },
292	prereq_build => { default => 0, store => \$prereq_build },
293	};
294
295	check( $tmpl, \%hash ) or return;
296
297	### so there are no prereqs? then don't even bother
298	return 1 unless keys %$prereqs;
299
300	### so you didn't provide an explicit target.
301	### maybe your config can tell us what to do.
302	$target \|\|= {
303	PREREQ_ASK, TARGET_INSTALL, # we'll bail out if the user says no
304	PREREQ_BUILD, TARGET_CREATE,
305	PREREQ_IGNORE, TARGET_IGNORE,
306	PREREQ_INSTALL, TARGET_INSTALL,
307	}->{ $conf->get_conf('prereqs') } \|\| '';
308
309	### XXX BIG NASTY HACK XXX FIXME at some point.
310	### when installing Bundle::CPANPLUS::Dependencies, we want to
311	### install all packages matching 'cpanplus' to be installed last,
312	### as all CPANPLUS' prereqs are being installed as well, but are
313	### being loaded for bootstrapping purposes. This means CPANPLUS
314	### can find them, but for example cpanplus::dist::build won't,
315	### which gets messy FAST. So, here we sort our prereqs only IF
316	### the parent module is Bundle::CPANPLUS::Dependencies.
317	### Really, we would wnat some sort of sorted prereq mechanism,
318	### but Bundle:: doesn't support it, and we flatten everything
319	### to a hash internally. A sorted hash might do the trick if
320	### we got a transparent implementation.. that would mean we would
321	### just have to remove the 'sort' here, and all will be well
322	my @sorted_prereqs;
323
324	### use regex, could either be a module name, or a package name
325	if( $self->module =~ /^Bundle(::\|-)CPANPLUS(::\|-)Dependencies/ ) {
326	my (@first, @last);
327	for my $mod ( sort keys %$prereqs ) {
328	$mod =~ /CPANPLUS/
329	? push @last, $mod
330	: push @first, $mod;
331	}
332	@sorted_prereqs = (@first, @last);
333	} else {
334	@sorted_prereqs = sort keys %$prereqs;
335	}
336
337	### first, transfer this key/value pairing into a
338	### list of module objects + desired versions
339	my @install_me;
340
341	for my $mod ( @sorted_prereqs ) {
342	my $version = $prereqs->{$mod};
343	my $modobj = $cb->module_tree($mod);
344
345	#### XXX we ignore the version, and just assume that the latest
346	#### version from cpan will meet your requirements... dodgy =/
347	unless( $modobj ) {
348	error( loc( "No such module '%1' found on CPAN", $mod ) );
349	next;
350	}
351
352	### it's not uptodate, we need to install it
353	if( !$dist->prereq_satisfied(modobj => $modobj, version => $version)) {
354	msg(loc("Module '%1' requires '%2' version '%3' to be installed ",
355	$self->module, $modobj->module, $version), $verbose );
356
357	push @install_me, [$modobj, $version];
358
359	### it's not an MM or Build format, that means it's a package
360	### manager... we'll need to install it as well, via the PM
361	} elsif ( INSTALL_VIA_PACKAGE_MANAGER->($format) and
362	!$modobj->package_is_perl_core and
363	($target ne TARGET_IGNORE)
364	) {
365	msg(loc("Module '%1' depends on '%2', may need to build a '%3' ".
366	"package for it as well", $self->module, $modobj->module,
367	$format));
368	push @install_me, [$modobj, $version];
369	}
370	}
371
372
373
374	### so you just want to ignore prereqs? ###
375	if( $target eq TARGET_IGNORE ) {
376
377	### but you have modules you need to install
378	if( @install_me ) {
379	msg(loc("Ignoring prereqs, this may mean your install will fail"),
380	$verbose);
381	msg(loc("'%1' listed the following dependencies:", $self->module),
382	$verbose);
383
384	for my $aref (@install_me) {
385	my ($mod,$version) = @$aref;
386
387	my $str = sprintf "\t%-35s %8s\n", $mod->module, $version;
388	msg($str,$verbose);
389	}
390
391	return;
392
393	### ok, no problem, you have all needed prereqs anyway
394	} else {
395	return 1;
396	}
397	}
398
399	my $flag;
400	for my $aref (@install_me) {
401	my($modobj,$version) = @$aref;
402
403	### another prereq may have already installed this one...
404	### so dont ask again if the module turns out to be uptodate
405	### see bug [#11840]
406	### if either force or prereq_build are given, the prereq
407	### should be built anyway
408	next if (!$force and !$prereq_build) &&
409	$dist->prereq_satisfied(modobj => $modobj, version => $version);
410
411	### either we're told to ignore the prereq,
412	### or the user wants us to ask him
413	if( ( $conf->get_conf('prereqs') == PREREQ_ASK and not
414	$cb->_callbacks->install_prerequisite->($self, $modobj)
415	)
416	) {
417	msg(loc("Will not install prerequisite '%1' -- Note " .
418	"that the overall install may fail due to this",
419	$modobj->module), $verbose);
420	next;
421	}
422
423	### value set and false -- means failure ###
424	if( defined $modobj->status->installed
425	&& !$modobj->status->installed
426	) {
427	error( loc( "Prerequisite '%1' failed to install before in " .
428	"this session", $modobj->module ) );
429	$flag++;
430	last;
431	}
432
433	### part of core?
434	if( $modobj->package_is_perl_core ) {
435	error(loc("Prerequisite '%1' is perl-core (%2) -- not ".
436	"installing that. Aborting install",
437	$modobj->module, $modobj->package ) );
438	$flag++;
439	last;
440	}
441
442	### circular dependency code ###
443	my $pending = $cb->_status->pending_prereqs \|\| {};
444
445	### recursive dependency ###
446	if ( $pending->{ $modobj->module } ) {
447	error( loc( "Recursive dependency detected (%1) -- skipping",
448	$modobj->module ) );
449	next;
450	}
451
452	### register this dependency as pending ###
453	$pending->{ $modobj->module } = $modobj;
454	$cb->_status->pending_prereqs( $pending );
455
456
457	### call $modobj->install rather than doing
458	### CPANPLUS::Dist->new and the like ourselves,
459	### since ->install will take care of fetch &&
460	### extract as well
461	my $pa = $dist->status->_prepare_args \|\| {};
462	my $ca = $dist->status->_create_args \|\| {};
463	my $ia = $dist->status->_install_args \|\| {};
464
465	unless( $modobj->install( %$pa, %$ca, %$ia,
466	force => $force,
467	verbose => $verbose,
468	format => $format,
469	target => $target )
470	) {
471	error(loc("Failed to install '%1' as prerequisite " .
472	"for '%2'", $modobj->module, $self->module ) );
473	$flag++;
474	}
475
476	### unregister the pending dependency ###
477	$pending->{ $modobj->module } = 0;
478	$cb->_status->pending_prereqs( $pending );
479
480	last if $flag;
481
482	### don't want us to install? ###
483	if( $target ne TARGET_INSTALL ) {
484	my $dir = $modobj->status->extract
485	or error(loc("No extraction dir for '%1' found ".
486	"-- weird", $modobj->module));
487
488	$modobj->add_to_includepath();
489
490	next;
491	}
492	}
493
494	### reset the $prereqs iterator, in case we bailed out early ###
495	keys %$prereqs;
496
497	return 1 unless $flag;
498	return;
499	}
500
501	1;
502
503	# Local variables:
504	# c-indentation-style: bsd
505	# c-basic-offset: 4
506	# indent-tabs-mode: nil
507	# End:
508	# vim: expandtab shiftwidth=4: