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 any type of C<CPANPLUS::Dist::>
50 Returns the C<CPANPLUS::Module> object that parented this object.
54 Returns the C<Object::Accessor> object that keeps the status for
59 =head1 STATUS ACCESSORS
61 All accessors can be accessed as follows:
62 $deb->status->ACCESSOR
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>.
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>.
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>.
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.
94 =head2 $dist = CPANPLUS::Dist->new( module => MODOBJ, [format => DIST_TYPE] );
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
103 Returns a C<CPANPLUS::Dist> object on success and false on failure.
111 local $Params::Check::ALLOW_UNKNOWN = 1;
113 ### first verify we got a module object ###
116 module => { required => 1, allow => IS_MODOBJ, store => \$mod },
118 check( $tmpl, \%hash ) or return;
120 ### get the conf object ###
121 my $conf = $mod->parent->configure_object();
123 ### figure out what type of dist object to create ###
126 format => { default => $conf->get_conf('dist_type'),
127 allow => [ __PACKAGE__->dist_types ],
130 check( $tmpl2, \%hash ) or return;
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'));
139 ### bless the object in the child class ###
140 my $obj = bless { parent => $mod }, $format;
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) );
148 ### create a status object ###
149 { my $acc = Object::Accessor->new;
152 ### add minimum supported accessors
153 $acc->mk_accessors( qw[prepared created installed uninstalled
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));
164 ### return the object
168 =head2 @dists = CPANPLUS::Dist->dist_types;
170 Returns a list of the CPANPLUS::Dist::* classes available
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
178 my @Dists = (INSTALLER_MM);
181 ### backdoor method to add more dist types
182 sub _add_dist_types { my $self = shift; push @Dists, @_ };
184 ### backdoor method to exclude dist types
185 sub _ignore_dist_types { my $self = shift; push @Ignore, @_ };
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') );
192 ### load any possible plugins
195 if ( !$Loaded++ and check_install( module => 'Module::Pluggable',
198 require Module::Pluggable;
200 my $only_re = __PACKAGE__ . '::\w+$';
202 Module::Pluggable->import(
203 sub_name => '_dist_types',
204 search_path => __PACKAGE__,
205 only => qr/$only_re/,
206 except => [ INSTALLER_MM,
211 my %ignore = map { $_ => $_ } @Ignore;
213 push @Dists, grep { not $ignore{$_} } __PACKAGE__->_dist_types;
220 =head2 prereq_satisfied( modobj => $modobj, version => $version_spec )
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.
228 sub prereq_satisfied {
230 my $cb = $dist->parent->parent;
235 version => { required => 1, store => \$ver },
236 modobj => { required => 1, store => \$mod, allow => IS_MODOBJ },
239 check( $tmpl, \%hash ) or return;
241 return 1 if $mod->is_uptodate( version => $ver );
243 if ( $cb->_vcmp( $ver, $mod->version ) > 0 ) {
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 ".
250 $mod->module, $mod->module, $mod->version, $ver ));
257 =head2 _resolve_prereqs
259 Makes sure prerequisites are resolved
261 XXX Need docs, internal use only
265 sub _resolve_prereqs {
267 my $self = $dist->parent;
268 my $cb = $self->parent;
269 my $conf = $cb->configure_object;
272 my ($prereqs, $format, $verbose, $target, $force, $prereq_build);
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
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'),
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 },
294 check( $tmpl, \%hash ) or return;
296 ### so there are no prereqs? then don't even bother
297 return 1 unless keys %$prereqs;
299 ### so you didn't provide an explicit target.
300 ### maybe your config can tell us what to do.
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') } || '';
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
323 ### use regex, could either be a module name, or a package name
324 if( $self->module =~ /^Bundle(::|-)CPANPLUS(::|-)Dependencies/ ) {
326 for my $mod ( sort keys %$prereqs ) {
331 @sorted_prereqs = (@first, @last);
333 @sorted_prereqs = sort keys %$prereqs;
336 ### first, transfer this key/value pairing into a
337 ### list of module objects + desired versions
340 for my $mod ( @sorted_prereqs ) {
341 my $version = $prereqs->{$mod};
342 my $modobj = $cb->module_tree($mod);
344 #### XXX we ignore the version, and just assume that the latest
345 #### version from cpan will meet your requirements... dodgy =/
347 error( loc( "No such module '%1' found on CPAN", $mod ) );
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 );
356 push @install_me, [$modobj, $version];
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)
364 msg(loc("Module '%1' depends on '%2', may need to build a '%3' ".
365 "package for it as well", $self->module, $modobj->module,
367 push @install_me, [$modobj, $version];
373 ### so you just want to ignore prereqs? ###
374 if( $target eq TARGET_IGNORE ) {
376 ### but you have modules you need to install
378 msg(loc("Ignoring prereqs, this may mean your install will fail"),
380 msg(loc("'%1' listed the following dependencies:", $self->module),
383 for my $aref (@install_me) {
384 my ($mod,$version) = @$aref;
386 my $str = sprintf "\t%-35s %8s\n", $mod->module, $version;
392 ### ok, no problem, you have all needed prereqs anyway
399 for my $aref (@install_me) {
400 my($modobj,$version) = @$aref;
402 ### another prereq may have already installed this one...
403 ### so dont ask again if the module turns out to be uptodate
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);
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)
416 msg(loc("Will not install prerequisite '%1' -- Note " .
417 "that the overall install may fail due to this",
418 $modobj->module), $verbose);
422 ### value set and false -- means failure ###
423 if( defined $modobj->status->installed
424 && !$modobj->status->installed
426 error( loc( "Prerequisite '%1' failed to install before in " .
427 "this session", $modobj->module ) );
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 ) );
441 ### circular dependency code ###
442 my $pending = $cb->_status->pending_prereqs || {};
444 ### recursive dependency ###
445 if ( $pending->{ $modobj->module } ) {
446 error( loc( "Recursive dependency detected (%1) -- skipping",
451 ### register this dependency as pending ###
452 $pending->{ $modobj->module } = $modobj;
453 $cb->_status->pending_prereqs( $pending );
456 ### call $modobj->install rather than doing
457 ### CPANPLUS::Dist->new and the like ourselves,
458 ### since ->install will take care of fetch &&
460 my $pa = $dist->status->_prepare_args || {};
461 my $ca = $dist->status->_create_args || {};
462 my $ia = $dist->status->_install_args || {};
464 unless( $modobj->install( %$pa, %$ca, %$ia,
470 error(loc("Failed to install '%1' as prerequisite " .
471 "for '%2'", $modobj->module, $self->module ) );
475 ### unregister the pending dependency ###
476 $pending->{ $modobj->module } = 0;
477 $cb->_status->pending_prereqs( $pending );
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));
487 $modobj->add_to_includepath();
493 ### reset the $prereqs iterator, in case we bailed out early ###
496 return 1 unless $flag;
503 # c-indentation-style: bsd
505 # indent-tabs-mode: nil
507 # vim: expandtab shiftwidth=4: