[p5sagit/p5-mst-13.2.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 any type of C<CPANPLUS::Dist::>
modules.

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