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.
92 =head2 $dist = CPANPLUS::Dist->new( module => MODOBJ, [format => DIST_TYPE] );
94 Create a new C<CPANPLUS::Dist> object based on the provided C<MODOBJ>.
95 The optional argument C<format> is used to indicate what type of dist
96 you would like to create (like C<makemaker> for a C<CPANPLUS::Dist::MM>
97 object, C<build> for a C<CPANPLUS::Dist::Build> object, and so on ).
98 If not provided, will default to the setting as specified by your
101 Returns a C<CPANPLUS::Dist> object on success and false on failure.
109 local $Params::Check::ALLOW_UNKNOWN = 1;
111 ### first verify we got a module object ###
114 module => { required => 1, allow => IS_MODOBJ, store => \$mod },
116 check( $tmpl, \%hash ) or return;
118 ### get the conf object ###
119 my $conf = $mod->parent->configure_object();
121 ### figure out what type of dist object to create ###
124 format => { default => $conf->get_conf('dist_type'),
125 allow => [ __PACKAGE__->dist_types ],
128 check( $tmpl2, \%hash ) or return;
131 unless( can_load( modules => { $format => '0.0' }, verbose => 1 ) ) {
132 error(loc("'%1' not found -- you need '%2' version '%3' or higher ".
133 "to detect plugins", $format, 'Module::Pluggable','2.4'));
137 ### bless the object in the child class ###
138 my $obj = bless { parent => $mod }, $format;
140 ### check if the format is available in this environment ###
141 if( $conf->_get_build('sanity_check') and not $obj->format_available ) {
142 error( loc( "Format '%1' is not available",$format) );
146 ### create a status object ###
147 { my $acc = Object::Accessor->new;
150 ### add minimum supported accessors
151 $acc->mk_accessors( qw[prepared created installed uninstalled
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, @_ };
185 ### locally add the plugins dir to @INC, so we can find extra plugins
186 #local @INC = @INC, File::Spec->catdir(
187 # $conf->get_conf('base'),
188 # $conf->_get_build('plugins') );
190 ### load any possible plugins
193 if ( !$Loaded++ and check_install( module => 'Module::Pluggable',
196 require Module::Pluggable;
198 my $only_re = __PACKAGE__ . '::\w+$';
200 Module::Pluggable->import(
201 sub_name => '_dist_types',
202 search_path => __PACKAGE__,
203 only => qr/$only_re/,
204 except => [ INSTALLER_MM,
209 my %ignore = map { $_ => $_ } @Ignore;
211 push @Dists, grep { not $ignore{$_} } __PACKAGE__->_dist_types;
218 =head2 prereq_satisfied( modobj => $modobj, version => $version_spec )
220 Returns true if this prereq is satisfied. Returns false if it's not.
221 Also issues an error if it seems "unsatisfiable," i.e. if it can't be
222 found on CPAN or the latest CPAN version doesn't satisfy it.
226 sub prereq_satisfied {
228 my $cb = $dist->parent->parent;
233 version => { required => 1, store => \$ver },
234 modobj => { required => 1, store => \$mod, allow => IS_MODOBJ },
237 check( $tmpl, \%hash ) or return;
239 return 1 if $mod->is_uptodate( version => $ver );
241 if ( $cb->_vcmp( $ver, $mod->version ) > 0 ) {
244 "This distribution depends on %1, but the latest version".
245 " of %2 on CPAN (%3) doesn't satisfy the specific version".
246 " dependency (%4). You may have to resolve this dependency ".
248 $mod->module, $mod->module, $mod->version, $ver ));
255 =head2 _resolve_prereqs
257 Makes sure prerequisites are resolved
259 XXX Need docs, internal use only
263 sub _resolve_prereqs {
265 my $self = $dist->parent;
266 my $cb = $self->parent;
267 my $conf = $cb->configure_object;
270 my ($prereqs, $format, $verbose, $target, $force, $prereq_build);
272 ### XXX perhaps this should not be required, since it may not be
273 ### packaged, just installed...
274 ### Let it be empty as well -- that means the $modobj->install
275 ### routine will figure it out, which is fine if we didn't have any
276 ### very specific wishes (it will even detect the favourite
278 format => { required => 1, store => \$format,
279 allow => ['',__PACKAGE__->dist_types], },
280 prereqs => { required => 1, default => { },
281 strict_type => 1, store => \$prereqs },
282 verbose => { default => $conf->get_conf('verbose'),
283 store => \$verbose },
284 force => { default => $conf->get_conf('force'),
286 ### make sure allow matches with $mod->install's list
287 target => { default => '', store => \$target,
288 allow => ['',qw[create ignore install]] },
289 prereq_build => { default => 0, store => \$prereq_build },
292 check( $tmpl, \%hash ) or return;
294 ### so there are no prereqs? then don't even bother
295 return 1 unless keys %$prereqs;
297 ### so you didn't provide an explicit target.
298 ### maybe your config can tell us what to do.
300 PREREQ_ASK, TARGET_INSTALL, # we'll bail out if the user says no
301 PREREQ_BUILD, TARGET_CREATE,
302 PREREQ_IGNORE, TARGET_IGNORE,
303 PREREQ_INSTALL, TARGET_INSTALL,
304 }->{ $conf->get_conf('prereqs') } || '';
306 ### XXX BIG NASTY HACK XXX FIXME at some point.
307 ### when installing Bundle::CPANPLUS::Dependencies, we want to
308 ### install all packages matching 'cpanplus' to be installed last,
309 ### as all CPANPLUS' prereqs are being installed as well, but are
310 ### being loaded for bootstrapping purposes. This means CPANPLUS
311 ### can find them, but for example cpanplus::dist::build won't,
312 ### which gets messy FAST. So, here we sort our prereqs only IF
313 ### the parent module is Bundle::CPANPLUS::Dependencies.
314 ### Really, we would wnat some sort of sorted prereq mechanism,
315 ### but Bundle:: doesn't support it, and we flatten everything
316 ### to a hash internally. A sorted hash *might* do the trick if
317 ### we got a transparent implementation.. that would mean we would
318 ### just have to remove the 'sort' here, and all will be well
321 ### use regex, could either be a module name, or a package name
322 if( $self->module =~ /^Bundle(::|-)CPANPLUS(::|-)Dependencies/ ) {
324 for my $mod ( sort keys %$prereqs ) {
329 @sorted_prereqs = (@first, @last);
331 @sorted_prereqs = sort keys %$prereqs;
334 ### first, transfer this key/value pairing into a
335 ### list of module objects + desired versions
338 for my $mod ( @sorted_prereqs ) {
339 my $version = $prereqs->{$mod};
340 my $modobj = $cb->module_tree($mod);
342 #### XXX we ignore the version, and just assume that the latest
343 #### version from cpan will meet your requirements... dodgy =/
345 error( loc( "No such module '%1' found on CPAN", $mod ) );
349 ### it's not uptodate, we need to install it
350 if( !$dist->prereq_satisfied(modobj => $modobj, version => $version)) {
351 msg(loc("Module '%1' requires '%2' version '%3' to be installed ",
352 $self->module, $modobj->module, $version), $verbose );
354 push @install_me, [$modobj, $version];
356 ### it's not an MM or Build format, that means it's a package
357 ### manager... we'll need to install it as well, via the PM
358 } elsif ( INSTALL_VIA_PACKAGE_MANAGER->($format) and
359 !$modobj->package_is_perl_core and
360 ($target ne TARGET_IGNORE)
362 msg(loc("Module '%1' depends on '%2', may need to build a '%3' ".
363 "package for it as well", $self->module, $modobj->module,
365 push @install_me, [$modobj, $version];
371 ### so you just want to ignore prereqs? ###
372 if( $target eq TARGET_IGNORE ) {
374 ### but you have modules you need to install
376 msg(loc("Ignoring prereqs, this may mean your install will fail"),
378 msg(loc("'%1' listed the following dependencies:", $self->module),
381 for my $aref (@install_me) {
382 my ($mod,$version) = @$aref;
384 my $str = sprintf "\t%-35s %8s\n", $mod->module, $version;
390 ### ok, no problem, you have all needed prereqs anyway
397 for my $aref (@install_me) {
398 my($modobj,$version) = @$aref;
400 ### another prereq may have already installed this one...
401 ### so dont ask again if the module turns out to be uptodate
403 ### if either force or prereq_build are given, the prereq
404 ### should be built anyway
405 next if (!$force and !$prereq_build) &&
406 $dist->prereq_satisfied(modobj => $modobj, version => $version);
408 ### either we're told to ignore the prereq,
409 ### or the user wants us to ask him
410 if( ( $conf->get_conf('prereqs') == PREREQ_ASK and not
411 $cb->_callbacks->install_prerequisite->($self, $modobj)
414 msg(loc("Will not install prerequisite '%1' -- Note " .
415 "that the overall install may fail due to this",
416 $modobj->module), $verbose);
420 ### value set and false -- means failure ###
421 if( defined $modobj->status->installed
422 && !$modobj->status->installed
424 error( loc( "Prerequisite '%1' failed to install before in " .
425 "this session", $modobj->module ) );
431 if( $modobj->package_is_perl_core ) {
432 error(loc("Prerequisite '%1' is perl-core (%2) -- not ".
433 "installing that. Aborting install",
434 $modobj->module, $modobj->package ) );
439 ### circular dependency code ###
440 my $pending = $cb->_status->pending_prereqs || {};
442 ### recursive dependency ###
443 if ( $pending->{ $modobj->module } ) {
444 error( loc( "Recursive dependency detected (%1) -- skipping",
449 ### register this dependency as pending ###
450 $pending->{ $modobj->module } = $modobj;
451 $cb->_status->pending_prereqs( $pending );
454 ### call $modobj->install rather than doing
455 ### CPANPLUS::Dist->new and the like ourselves,
456 ### since ->install will take care of fetch &&
458 my $pa = $dist->status->_prepare_args || {};
459 my $ca = $dist->status->_create_args || {};
460 my $ia = $dist->status->_install_args || {};
462 unless( $modobj->install( %$pa, %$ca, %$ia,
468 error(loc("Failed to install '%1' as prerequisite " .
469 "for '%2'", $modobj->module, $self->module ) );
473 ### unregister the pending dependency ###
474 $pending->{ $modobj->module } = 0;
475 $cb->_status->pending_prereqs( $pending );
479 ### don't want us to install? ###
480 if( $target ne TARGET_INSTALL ) {
481 my $dir = $modobj->status->extract
482 or error(loc("No extraction dir for '%1' found ".
483 "-- weird", $modobj->module));
485 $modobj->add_to_includepath();
491 ### reset the $prereqs iterator, in case we bailed out early ###
494 return 1 unless $flag;
501 # c-indentation-style: bsd
503 # indent-tabs-mode: nil
505 # vim: expandtab shiftwidth=4: