1 package CPANPLUS::Dist;
6 use CPANPLUS::Internals::Constants;
10 use Parse::CPAN::Meta;
13 use Params::Check qw[check];
14 use Module::Load::Conditional qw[can_load check_install];
15 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
17 use base 'Object::Accessor';
19 local $Params::Check::VERBOSE = 1;
29 my $dist = CPANPLUS::Dist::YOUR_DIST_TYPE_HERE->new(
35 C<CPANPLUS::Dist> is a base class for C<CPANPLUS::Dist::MM>
36 and C<CPANPLUS::Dist::Build>. Developers of other C<CPANPLUS::Dist::*>
37 plugins should look at C<CPANPLUS::Dist::Base>.
45 Returns the C<CPANPLUS::Module> object that parented this object.
49 Returns the C<Object::Accessor> object that keeps the status for
54 =head1 STATUS ACCESSORS
56 All accessors can be accessed as follows:
57 $deb->status->ACCESSOR
63 Boolean indicating whether the dist was created successfully.
64 Explicitly set to C<0> when failed, so a value of C<undef> may be
65 interpreted as C<not yet attempted>.
69 Boolean indicating whether the dist was installed 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 uninstalled 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 The location of the final distribution. This may be a file or
82 directory, depending on how your distribution plug in of choice
83 works. This will be set upon a successful create.
89 =head2 $dist = CPANPLUS::Dist::YOUR_DIST_TYPE_HERE->new( module => MODOBJ );
91 Create a new C<CPANPLUS::Dist::YOUR_DIST_TYPE_HERE> object based on the
95 The optional argument C<format> is used to indicate what type of dist
96 you would like to create (like C<CPANPLUS::Dist::MM> or
97 C<CPANPLUS::Dist::Build> and so on ).
99 C<< CPANPLUS::Dist->new >> is exlusively meant as a method to be
100 inherited by C<CPANPLUS::Dist::MM|Build>.
102 Returns a C<CPANPLUS::Dist::YOUR_DIST_TYPE_HERE> object on success
103 and false on failure.
109 my $class = ref $self || $self;
112 ### first verify we got a module object ###
115 module => { required => 1, allow => IS_MODOBJ, store => \$mod },
116 ### for backwards compatibility
117 format => { default => $class, store => \$format,
118 allow => [ __PACKAGE__->dist_types ],
121 check( $tmpl, \%hash ) or return;
123 unless( can_load( modules => { $format => '0.0' }, verbose => 1 ) ) {
124 error(loc("'%1' not found -- you need '%2' version '%3' or higher ".
125 "to detect plugins", $format, 'Module::Pluggable','2.4'));
129 ### get an empty o::a object for this class
130 my $obj = $format->SUPER::new;
132 $obj->mk_accessors( qw[parent status] );
135 $obj->parent( $mod );
137 ### create a status object ###
138 { my $acc = Object::Accessor->new;
141 ### add minimum supported accessors
142 $acc->mk_accessors( qw[prepared created installed uninstalled
146 ### get the conf object ###
147 my $conf = $mod->parent->configure_object();
149 ### check if the format is available in this environment ###
150 if( $conf->_get_build('sanity_check') and not $obj->format_available ) {
151 error( loc( "Format '%1' is not available", $format) );
155 ### now initialize it or admit failure
156 unless( $obj->init ) {
157 error(loc("Dist initialization of '%1' failed for '%2'",
158 $format, $mod->module));
162 ### return the object
166 =head2 @dists = CPANPLUS::Dist->dist_types;
168 Returns a list of the CPANPLUS::Dist::* classes available
172 ### returns a list of dist_types we support
173 ### will get overridden by Module::Pluggable if loaded
174 ### XXX add support for 'plugin' dir in config as well
176 my @Dists = (INSTALLER_MM);
179 ### backdoor method to add more dist types
180 sub _add_dist_types { my $self = shift; push @Dists, @_ };
182 ### backdoor method to exclude dist types
183 sub _ignore_dist_types { my $self = shift; push @Ignore, @_ };
184 sub _reset_dist_ignore { @Ignore = () };
186 ### locally add the plugins dir to @INC, so we can find extra plugins
187 #local @INC = @INC, File::Spec->catdir(
188 # $conf->get_conf('base'),
189 # $conf->_get_build('plugins') );
191 ### load any possible plugins
194 if ( !$Loaded++ and check_install( module => 'Module::Pluggable',
197 require Module::Pluggable;
199 my $only_re = __PACKAGE__ . '::\w+$';
200 my %except = map { $_ => 1 }
204 Module::Pluggable->import(
205 sub_name => '_dist_types',
206 search_path => __PACKAGE__,
207 only => qr/$only_re/,
209 except => [ keys %except ]
211 my %ignore = map { $_ => $_ } @Ignore;
213 push @Dists, grep { not $ignore{$_} and not $except{$_} }
214 __PACKAGE__->_dist_types;
220 =head2 $bool = CPANPLUS::Dist->rescan_dist_types;
222 Rescans C<@INC> for available dist types. Useful if you've installed new
223 C<CPANPLUS::Dist::*> classes and want to make them available to the
228 sub rescan_dist_types {
230 $Loaded = 0; # reset the flag;
231 return $dist->dist_types;
235 =head2 $bool = CPANPLUS::Dist->has_dist_type( $type )
237 Returns true if distribution type C<$type> is loaded/supported.
243 my $type = shift or return;
245 return scalar grep { $_ eq $type } CPANPLUS::Dist->dist_types;
248 =head2 $bool = $dist->prereq_satisfied( modobj => $modobj, version => $version_spec )
250 Returns true if this prereq is satisfied. Returns false if it's not.
251 Also issues an error if it seems "unsatisfiable," i.e. if it can't be
252 found on CPAN or the latest CPAN version doesn't satisfy it.
256 sub prereq_satisfied {
258 my $cb = $dist->parent->parent;
263 version => { required => 1, store => \$ver },
264 modobj => { required => 1, store => \$mod, allow => IS_MODOBJ },
267 check( $tmpl, \%hash ) or return;
269 return 1 if $mod->is_uptodate( version => $ver );
271 if ( $cb->_vcmp( $ver, $mod->version ) > 0 ) {
274 "This distribution depends on %1, but the latest version".
275 " of %2 on CPAN (%3) doesn't satisfy the specific version".
276 " dependency (%4). You may have to resolve this dependency ".
278 $mod->module, $mod->module, $mod->version, $ver ));
285 =head2 $configure_requires = $dist->find_configure_requires( [file => /path/to/META.yml] )
287 Reads the configure_requires for this distribution from the META.yml
288 file in the root directory and returns a hashref with module names
289 and versions required.
293 sub find_configure_requires {
295 my $mod = $self->parent;
299 my $tmpl = { ### check if we have an extract path. if not, we
300 ### get 'undef value' warnings from file::spec
301 file => { default => do { defined $mod->status->extract
302 ? META_YML->( $mod->status->extract )
308 check( $tmpl, \%hash ) or return;
310 ### default is an empty hashref
311 my $configure_requires = $mod->status->configure_requires || {};
313 ### if there's a meta file, we read it;
316 ### Parse::CPAN::Meta uses exceptions for errors
317 ### hash returned in list context!!!
318 my ($doc) = eval { Parse::CPAN::Meta::LoadFile( $meta ) };
321 error(loc( "Could not read %1: '%2'", $meta, $@ ));
322 return $configure_requires; # Causes problems if we don't return a hashref
325 ### read the configure_requires key, make sure not to throw
326 ### away anything that was already added
327 $configure_requires = {
328 %$configure_requires,
329 %{ $doc->{'configure_requires'} },
330 } if $doc->{'configure_requires'};
333 ### and store it in the module
334 $mod->status->configure_requires( $configure_requires );
336 ### and return a copy
337 return \%{$configure_requires};
340 =head2 $bool = $dist->_resolve_prereqs( ... )
342 Makes sure prerequisites are resolved
344 format The dist class to use to make the prereqs
345 (ie. CPANPLUS::Dist::MM)
347 prereqs Hash of the prerequisite modules and their versions
349 target What to do with the prereqs.
350 create => Just build them
351 install => Install them
352 ignore => Ignore them
354 prereq_build If true, always build the prereqs even if already
359 force Force the prereq to be built, even if already resolved
363 sub _resolve_prereqs {
365 my $self = $dist->parent;
366 my $cb = $self->parent;
367 my $conf = $cb->configure_object;
370 my ($prereqs, $format, $verbose, $target, $force, $prereq_build);
372 ### XXX perhaps this should not be required, since it may not be
373 ### packaged, just installed...
374 ### Let it be empty as well -- that means the $modobj->install
375 ### routine will figure it out, which is fine if we didn't have any
376 ### very specific wishes (it will even detect the favourite
378 format => { required => 1, store => \$format,
379 allow => ['',__PACKAGE__->dist_types], },
380 prereqs => { required => 1, default => { },
381 strict_type => 1, store => \$prereqs },
382 verbose => { default => $conf->get_conf('verbose'),
383 store => \$verbose },
384 force => { default => $conf->get_conf('force'),
386 ### make sure allow matches with $mod->install's list
387 target => { default => '', store => \$target,
388 allow => ['',qw[create ignore install]] },
389 prereq_build => { default => 0, store => \$prereq_build },
392 check( $tmpl, \%hash ) or return;
394 ### so there are no prereqs? then don't even bother
395 return 1 unless keys %$prereqs;
397 ### Make sure we wound up where we started.
398 my $original_wd = Cwd::cwd;
400 ### so you didn't provide an explicit target.
401 ### maybe your config can tell us what to do.
403 PREREQ_ASK, TARGET_INSTALL, # we'll bail out if the user says no
404 PREREQ_BUILD, TARGET_CREATE,
405 PREREQ_IGNORE, TARGET_IGNORE,
406 PREREQ_INSTALL, TARGET_INSTALL,
407 }->{ $conf->get_conf('prereqs') } || '';
409 ### XXX BIG NASTY HACK XXX FIXME at some point.
410 ### when installing Bundle::CPANPLUS::Dependencies, we want to
411 ### install all packages matching 'cpanplus' to be installed last,
412 ### as all CPANPLUS' prereqs are being installed as well, but are
413 ### being loaded for bootstrapping purposes. This means CPANPLUS
414 ### can find them, but for example cpanplus::dist::build won't,
415 ### which gets messy FAST. So, here we sort our prereqs only IF
416 ### the parent module is Bundle::CPANPLUS::Dependencies.
417 ### Really, we would wnat some sort of sorted prereq mechanism,
418 ### but Bundle:: doesn't support it, and we flatten everything
419 ### to a hash internally. A sorted hash *might* do the trick if
420 ### we got a transparent implementation.. that would mean we would
421 ### just have to remove the 'sort' here, and all will be well
424 ### use regex, could either be a module name, or a package name
425 if( $self->module =~ /^Bundle(::|-)CPANPLUS(::|-)Dependencies/ ) {
427 for my $mod ( sort keys %$prereqs ) {
432 @sorted_prereqs = (@first, @last);
434 @sorted_prereqs = sort keys %$prereqs;
437 ### first, transfer this key/value pairing into a
438 ### list of module objects + desired versions
441 for my $mod ( @sorted_prereqs ) {
442 my $version = $prereqs->{$mod};
444 ### 'perl' is a special case, there's no mod object for it
445 if( $mod eq PERL_CORE ) {
447 ### run a CLI invocation to see if the perl you specified is
449 my $ok = run( command => "$^X -M$version -e1", verbose => 0 );
452 error(loc( "Module '%1' needs perl version '%2', but you ".
453 "only have version '%3' -- can not proceed",
454 $self->module, $version,
455 $cb->_perl_version( perl => $^X ) ) );
462 my $modobj = $cb->module_tree($mod);
464 #### XXX we ignore the version, and just assume that the latest
465 #### version from cpan will meet your requirements... dodgy =/
467 error( loc( "No such module '%1' found on CPAN", $mod ) );
471 ### it's not uptodate, we need to install it
472 if( !$dist->prereq_satisfied(modobj => $modobj, version => $version)) {
473 msg(loc("Module '%1' requires '%2' version '%3' to be installed ",
474 $self->module, $modobj->module, $version), $verbose );
476 push @install_me, [$modobj, $version];
478 ### it's not an MM or Build format, that means it's a package
479 ### manager... we'll need to install it as well, via the PM
480 } elsif ( INSTALL_VIA_PACKAGE_MANAGER->($format) and
481 !$modobj->package_is_perl_core and
482 ($target ne TARGET_IGNORE)
484 msg(loc("Module '%1' depends on '%2', may need to build a '%3' ".
485 "package for it as well", $self->module, $modobj->module,
487 push @install_me, [$modobj, $version];
493 ### so you just want to ignore prereqs? ###
494 if( $target eq TARGET_IGNORE ) {
496 ### but you have modules you need to install
498 msg(loc("Ignoring prereqs, this may mean your install will fail"),
500 msg(loc("'%1' listed the following dependencies:", $self->module),
503 for my $aref (@install_me) {
504 my ($mod,$version) = @$aref;
506 my $str = sprintf "\t%-35s %8s\n", $mod->module, $version;
512 ### ok, no problem, you have all needed prereqs anyway
519 for my $aref (@install_me) {
520 my($modobj,$version) = @$aref;
522 ### another prereq may have already installed this one...
523 ### so dont ask again if the module turns out to be uptodate
525 ### if either force or prereq_build are given, the prereq
526 ### should be built anyway
527 next if (!$force and !$prereq_build) &&
528 $dist->prereq_satisfied(modobj => $modobj, version => $version);
530 ### either we're told to ignore the prereq,
531 ### or the user wants us to ask him
532 if( ( $conf->get_conf('prereqs') == PREREQ_ASK and not
533 $cb->_callbacks->install_prerequisite->($self, $modobj)
536 msg(loc("Will not install prerequisite '%1' -- Note " .
537 "that the overall install may fail due to this",
538 $modobj->module), $verbose);
542 ### value set and false -- means failure ###
543 if( defined $modobj->status->installed
544 && !$modobj->status->installed
546 error( loc( "Prerequisite '%1' failed to install before in " .
547 "this session", $modobj->module ) );
553 if( $modobj->package_is_perl_core ) {
554 error(loc("Prerequisite '%1' is perl-core (%2) -- not ".
555 "installing that. Aborting install",
556 $modobj->module, $modobj->package ) );
561 ### circular dependency code ###
562 my $pending = $cb->_status->pending_prereqs || {};
564 ### recursive dependency ###
565 if ( $pending->{ $modobj->module } ) {
566 error( loc( "Recursive dependency detected (%1) -- skipping",
571 ### register this dependency as pending ###
572 $pending->{ $modobj->module } = $modobj;
573 $cb->_status->pending_prereqs( $pending );
575 ### call $modobj->install rather than doing
576 ### CPANPLUS::Dist->new and the like ourselves,
577 ### since ->install will take care of fetch &&
579 my $pa = $dist->status->_prepare_args || {};
580 my $ca = $dist->status->_create_args || {};
581 my $ia = $dist->status->_install_args || {};
583 unless( $modobj->install( %$pa, %$ca, %$ia,
589 error(loc("Failed to install '%1' as prerequisite " .
590 "for '%2'", $modobj->module, $self->module ) );
594 ### unregister the pending dependency ###
595 $pending->{ $modobj->module } = 0;
596 $cb->_status->pending_prereqs( $pending );
600 ### don't want us to install? ###
601 if( $target ne TARGET_INSTALL ) {
602 my $dir = $modobj->status->extract
603 or error(loc("No extraction dir for '%1' found ".
604 "-- weird", $modobj->module));
606 $modobj->add_to_includepath();
612 ### reset the $prereqs iterator, in case we bailed out early ###
615 ### chdir back to where we started
618 return 1 unless $flag;
625 # c-indentation-style: bsd
627 # indent-tabs-mode: nil
629 # vim: expandtab shiftwidth=4: