1 package CPANPLUS::Dist;
7 use CPANPLUS::Internals::Constants;
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';
14 local $Params::Check::VERBOSE = 1;
16 my @methods = qw[status parent];
17 for my $key ( @methods ) {
19 *{__PACKAGE__."::$key"} = sub {
21 $self->{$key} = $_[0] if @_;
34 my $dist = CPANPLUS::Dist->new(
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>.
51 Returns the C<CPANPLUS::Module> object that parented this object.
55 Returns the C<Object::Accessor> object that keeps the status for
60 =head1 STATUS ACCESSORS
62 All accessors can be accessed as follows:
63 $deb->status->ACCESSOR
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>.
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>.
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>.
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.
95 =head2 $dist = CPANPLUS::Dist->new( module => MODOBJ, [format => DIST_TYPE] );
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
104 Returns a C<CPANPLUS::Dist> object on success and false on failure.
112 local $Params::Check::ALLOW_UNKNOWN = 1;
114 ### first verify we got a module object ###
117 module => { required => 1, allow => IS_MODOBJ, store => \$mod },
119 check( $tmpl, \%hash ) or return;
121 ### get the conf object ###
122 my $conf = $mod->parent->configure_object();
124 ### figure out what type of dist object to create ###
127 format => { default => $conf->get_conf('dist_type'),
128 allow => [ __PACKAGE__->dist_types ],
131 check( $tmpl2, \%hash ) or return;
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'));
140 ### bless the object in the child class ###
141 my $obj = bless { parent => $mod }, $format;
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) );
149 ### create a status object ###
150 { my $acc = Object::Accessor->new;
153 ### add minimum supported accessors
154 $acc->mk_accessors( qw[prepared created installed uninstalled
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));
165 ### return the object
169 =head2 @dists = CPANPLUS::Dist->dist_types;
171 Returns a list of the CPANPLUS::Dist::* classes available
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
179 my @Dists = (INSTALLER_MM);
182 ### backdoor method to add more dist types
183 sub _add_dist_types { my $self = shift; push @Dists, @_ };
185 ### backdoor method to exclude dist types
186 sub _ignore_dist_types { my $self = shift; push @Ignore, @_ };
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') );
193 ### load any possible plugins
196 if ( !$Loaded++ and check_install( module => 'Module::Pluggable',
199 require Module::Pluggable;
201 my $only_re = __PACKAGE__ . '::\w+$';
203 Module::Pluggable->import(
204 sub_name => '_dist_types',
205 search_path => __PACKAGE__,
206 only => qr/$only_re/,
207 except => [ INSTALLER_MM,
212 my %ignore = map { $_ => $_ } @Ignore;
214 push @Dists, grep { not $ignore{$_} } __PACKAGE__->_dist_types;
221 =head2 prereq_satisfied( modobj => $modobj, version => $version_spec )
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.
229 sub prereq_satisfied {
231 my $cb = $dist->parent->parent;
236 version => { required => 1, store => \$ver },
237 modobj => { required => 1, store => \$mod, allow => IS_MODOBJ },
240 check( $tmpl, \%hash ) or return;
242 return 1 if $mod->is_uptodate( version => $ver );
244 if ( $cb->_vcmp( $ver, $mod->version ) > 0 ) {
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 ".
251 $mod->module, $mod->module, $mod->version, $ver ));
258 =head2 _resolve_prereqs
260 Makes sure prerequisites are resolved
262 XXX Need docs, internal use only
266 sub _resolve_prereqs {
268 my $self = $dist->parent;
269 my $cb = $self->parent;
270 my $conf = $cb->configure_object;
273 my ($prereqs, $format, $verbose, $target, $force, $prereq_build);
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
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'),
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 },
295 check( $tmpl, \%hash ) or return;
297 ### so there are no prereqs? then don't even bother
298 return 1 unless keys %$prereqs;
300 ### so you didn't provide an explicit target.
301 ### maybe your config can tell us what to do.
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') } || '';
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
324 ### use regex, could either be a module name, or a package name
325 if( $self->module =~ /^Bundle(::|-)CPANPLUS(::|-)Dependencies/ ) {
327 for my $mod ( sort keys %$prereqs ) {
332 @sorted_prereqs = (@first, @last);
334 @sorted_prereqs = sort keys %$prereqs;
337 ### first, transfer this key/value pairing into a
338 ### list of module objects + desired versions
341 for my $mod ( @sorted_prereqs ) {
342 my $version = $prereqs->{$mod};
343 my $modobj = $cb->module_tree($mod);
345 #### XXX we ignore the version, and just assume that the latest
346 #### version from cpan will meet your requirements... dodgy =/
348 error( loc( "No such module '%1' found on CPAN", $mod ) );
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 );
357 push @install_me, [$modobj, $version];
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)
365 msg(loc("Module '%1' depends on '%2', may need to build a '%3' ".
366 "package for it as well", $self->module, $modobj->module,
368 push @install_me, [$modobj, $version];
374 ### so you just want to ignore prereqs? ###
375 if( $target eq TARGET_IGNORE ) {
377 ### but you have modules you need to install
379 msg(loc("Ignoring prereqs, this may mean your install will fail"),
381 msg(loc("'%1' listed the following dependencies:", $self->module),
384 for my $aref (@install_me) {
385 my ($mod,$version) = @$aref;
387 my $str = sprintf "\t%-35s %8s\n", $mod->module, $version;
393 ### ok, no problem, you have all needed prereqs anyway
400 for my $aref (@install_me) {
401 my($modobj,$version) = @$aref;
403 ### another prereq may have already installed this one...
404 ### so dont ask again if the module turns out to be uptodate
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);
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)
417 msg(loc("Will not install prerequisite '%1' -- Note " .
418 "that the overall install may fail due to this",
419 $modobj->module), $verbose);
423 ### value set and false -- means failure ###
424 if( defined $modobj->status->installed
425 && !$modobj->status->installed
427 error( loc( "Prerequisite '%1' failed to install before in " .
428 "this session", $modobj->module ) );
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 ) );
442 ### circular dependency code ###
443 my $pending = $cb->_status->pending_prereqs || {};
445 ### recursive dependency ###
446 if ( $pending->{ $modobj->module } ) {
447 error( loc( "Recursive dependency detected (%1) -- skipping",
452 ### register this dependency as pending ###
453 $pending->{ $modobj->module } = $modobj;
454 $cb->_status->pending_prereqs( $pending );
457 ### call $modobj->install rather than doing
458 ### CPANPLUS::Dist->new and the like ourselves,
459 ### since ->install will take care of fetch &&
461 my $pa = $dist->status->_prepare_args || {};
462 my $ca = $dist->status->_create_args || {};
463 my $ia = $dist->status->_install_args || {};
465 unless( $modobj->install( %$pa, %$ca, %$ia,
471 error(loc("Failed to install '%1' as prerequisite " .
472 "for '%2'", $modobj->module, $self->module ) );
476 ### unregister the pending dependency ###
477 $pending->{ $modobj->module } = 0;
478 $cb->_status->pending_prereqs( $pending );
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));
488 $modobj->add_to_includepath();
494 ### reset the $prereqs iterator, in case we bailed out early ###
497 return 1 unless $flag;
504 # c-indentation-style: bsd
506 # indent-tabs-mode: nil
508 # vim: expandtab shiftwidth=4: