1 package CPANPLUS::Selfupdate;
4 use Params::Check qw[check];
5 use IPC::Cmd qw[can_run];
6 use CPANPLUS::Error qw[error msg];
7 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
9 use CPANPLUS::Internals::Constants;
11 $Params::Check::VERBOSE = 1;
19 $su = $cb->selfupdate_object;
21 @feats = $su->list_features;
22 @feats = $su->list_enabled_features;
24 @mods = map { $su->modules_for_feature( $_ ) } @feats;
25 @mods = $su->list_core_dependencies;
26 @mods = $su->list_core_modules;
29 print $_->name " should be version " . $_->version_required;
30 print "Installed version is not uptodate!"
31 unless $_->is_installed_version_sufficient;
34 $ok = $su->selfupdate( update => 'all', latest => 0 );
38 ### a config has describing our deps etc
43 'File::Fetch' => '0.08', # win32 ftp support
44 'File::Spec' => '0.82',
45 'IPC::Cmd' => '0.36', # 5.6.2 compat: 2-arg open
46 'Locale::Maketext::Simple' => '0.01',
47 'Log::Message' => '0.01',
48 'Module::Load' => '0.10',
49 'Module::Load::Conditional' => '0.16', # Better parsing: #23995
50 'version' => '0.70', # needed for M::L::C
51 # addresses #24630 and
53 'Params::Check' => '0.22',
54 'Package::Constants' => '0.01',
56 'Test::Harness' => '2.62', # due to bug #19505
57 # only 2.58 and 2.60 are bad
58 'Test::More' => '0.47', # to run our tests
59 'Archive::Extract' => '0.16', # ./Dir bug fix
60 'Archive::Tar' => '1.23',
61 'IO::Zlib' => '1.04', # needed for Archive::Tar
62 'Object::Accessor' => '0.32', # overloaded stringification
63 'Module::CoreList' => '2.09',
64 'Module::Pluggable' => '2.4',
65 'Module::Loaded' => '0.01',
69 # config_key_name => [
70 # sub { } to list module key/value pairs
71 # sub { } to check if feature is enabled
76 $cb->configure_object->get_conf('prefer_makefile')
78 : { 'CPANPLUS::Dist::Build' => '0.04' };
80 sub { return 1 }, # always enabled
85 'LWP::UserAgent' => '0.0',
86 'HTTP::Request' => '0.0',
89 'Test::Reporter' => 1.27,
93 return $cb->configure_object->get_conf('cpantest');
99 my $dist = $cb->configure_object->get_conf('dist_type');
100 return { $dist => '0.0' } if $dist;
105 return $cb->configure_object->get_conf('dist_type');
111 'Digest::MD5' => '0.0',
115 return $cb->configure_object->get_conf('md5');
121 my $dist = $cb->configure_object->get_conf('shell');
123 ### we bundle these shells, so don't bother having a dep
124 ### on them... If we don't do this, CPAN.pm actually detects
125 ### a recursive dependency and breaks (see #26077).
126 ### This is not an issue for CPANPLUS itself, it handles
128 return if $dist eq SHELL_DEFAULT or $dist eq SHELL_CLASSIC;
129 return { $dist => '0.0' } if $dist;
138 'Module::Signature' => '0.06',
140 ### leave this out -- Crypt::OpenPGP is fairly
141 ### painful to install, and broken on some platforms
142 ### so we'll just always fall back to gpg. It may
143 ### issue a warning or 2, but that's about it.
144 ### this change due to this ticket: #26914
145 # and $cb->configure_object->get_conf('prefer_bin');
148 'Crypt::OpenPGP' => '0.0',
149 'Module::Signature' => '0.06',
154 return $cb->configure_object->get_conf('signature');
158 { 'Storable' => '0.0' },
161 return $cb->configure_object->get_conf('storable');
170 sub _get_config { return $Modules }
175 =head2 $self = CPANPLUS::Selfupdate->new( $backend_object );
177 Sets up a new selfupdate object. Called automatically when
178 a new backend object is created.
184 my $cb = shift or return;
185 return bless sub { $cb }, $class;
189 { ### cache to find the relevant modules
192 => sub { my $self = shift;
193 core => [ $self->list_core_modules ] },
196 => sub { my $self = shift;
197 dependencies => [ $self->list_core_dependencies ] },
200 => sub { my $self = shift;
201 map { $_ => [ $self->modules_for_feature( $_ ) ] }
202 $self->list_enabled_features
205 => sub { my $self = shift;
206 map { $_ => [ $self->modules_for_feature( $_ ) ] }
209 ### make sure to do 'core' first, in case
210 ### we are out of date ourselves
211 all => [ qw|core dependencies enabled_features| ],
215 =head2 @cat = $self->list_categories
217 Returns a list of categories that the C<selfupdate> method accepts.
219 See C<selfupdate> for details.
223 sub list_categories { return sort keys %$cache }
225 =head2 %list = $self->list_modules_to_update( update => "core|dependencies|enabled_features|features|all", [latest => BOOL] )
227 List which modules C<selfupdate> would upgrade. You can update either
228 the core (CPANPLUS itself), the core dependencies, all features you have
229 currently turned on, or all features available, or everything.
231 The C<latest> option determines whether it should update to the latest
232 version on CPAN, or if the minimal required version for CPANPLUS is
235 Returns a hash of feature names and lists of module objects to be
236 upgraded based on the category you provided. For example:
238 %list = $self->list_modules_to_update( update => 'core' );
242 ( core => [ $module_object_for_cpanplus ] );
246 sub list_modules_to_update {
249 my $conf = $cb->configure_object;
254 update => { required => 1, store => \$type,
255 allow => [ keys %$cache ], },
256 latest => { default => 0, store => \$latest, allow => BOOLEANS },
259 { local $Params::Check::ALLOW_UNKNOWN = 1;
260 check( $tmpl, \%hash ) or return;
263 my $ref = $cache->{$type};
265 ### a list of ( feature1 => \@mods, feature2 => \@mods, etc )
266 my %list = UNIVERSAL::isa( $ref, 'ARRAY' )
267 ? map { $cache->{$_}->( $self ) } @$ref
270 ### filter based on whether we need the latest ones or not
271 for my $aref ( values %list ) {
273 ? grep { !$_->is_uptodate } @$aref
274 : grep { !$_->is_installed_version_sufficient } @$aref
281 =head2 $bool = $self->selfupdate( update => "core|dependencies|enabled_features|features|all", [latest => BOOL, force => BOOL] )
283 Selfupdate CPANPLUS. You can update either the core (CPANPLUS itself),
284 the core dependencies, all features you have currently turned on, or
285 all features available, or everything.
287 The C<latest> option determines whether it should update to the latest
288 version on CPAN, or if the minimal required version for CPANPLUS is
291 Returns true on success, false on error.
298 my $conf = $cb->configure_object;
303 force => { default => $conf->get_conf('force'), store => \$force },
306 { local $Params::Check::ALLOW_UNKNOWN = 1;
307 check( $tmpl, \%hash ) or return;
310 my %list = $self->list_modules_to_update( %hash ) or return;
312 ### just the modules please
313 my @mods = map { @$_ } values %list;
316 for my $mod ( @mods ) {
317 unless( $mod->install( force => $force ) ) {
319 error(loc("Failed to update module '%1'", $mod->name));
329 =head2 @features = $self->list_features
331 Returns a list of features that are supported by CPANPLUS.
337 return keys %{ $self->_get_config->{'features'} };
340 =head2 @features = $self->list_enabled_features
342 Returns a list of features that are enabled in your current
343 CPANPLUS installation.
347 sub list_enabled_features {
352 for my $feat ( $self->list_features ) {
353 my $ref = $self->_get_config->{'features'}->{$feat}->[1];
354 push @enabled, $feat if $ref->($cb);
360 =head2 @mods = $self->modules_for_feature( FEATURE [,AS_HASH] )
362 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
363 represent the modules required to support this feature.
365 For a list of features, call the C<list_features> method.
367 If the C<AS_HASH> argument is provided, no module objects are
368 returned, but a hashref where the keys are names of the modules,
369 and values are their minimum versions.
373 sub modules_for_feature {
375 my $feature = shift or return;
376 my $as_hash = shift || 0;
379 unless( exists $self->_get_config->{'features'}->{$feature} ) {
380 error(loc("Unknown feature '%1'", $feature));
384 my $ref = $self->_get_config->{'features'}->{$feature}->[0];
386 ### it's either a list of modules/versions or a subroutine that
387 ### returns a list of modules/versions
388 my $href = UNIVERSAL::isa( $ref, 'HASH' ) ? $ref : $ref->( $cb );
390 return unless $href; # nothing needed for the feature?
392 return $href if $as_hash;
393 return $self->_hashref_to_module( $href );
397 =head2 @mods = $self->list_core_dependencies( [AS_HASH] )
399 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
400 represent the modules that comprise the core dependencies of CPANPLUS.
402 If the C<AS_HASH> argument is provided, no module objects are
403 returned, but a hashref where the keys are names of the modules,
404 and values are their minimum versions.
408 sub list_core_dependencies {
410 my $as_hash = shift || 0;
412 my $href = $self->_get_config->{'dependencies'};
414 return $href if $as_hash;
415 return $self->_hashref_to_module( $href );
418 =head2 @mods = $self->list_core_modules( [AS_HASH] )
420 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
421 represent the modules that comprise the core of CPANPLUS.
423 If the C<AS_HASH> argument is provided, no module objects are
424 returned, but a hashref where the keys are names of the modules,
425 and values are their minimum versions.
429 sub list_core_modules {
431 my $as_hash = shift || 0;
433 my $href = $self->_get_config->{'core'};
435 return $href if $as_hash;
436 return $self->_hashref_to_module( $href );
439 sub _hashref_to_module {
442 my $href = shift or return;
445 CPANPLUS::Selfupdate::Module->new(
446 $cb->module_tree($_) => $href->{$_}
452 =head1 CPANPLUS::Selfupdate::Module
454 C<CPANPLUS::Selfupdate::Module> extends C<CPANPLUS::Module> objects
455 by providing accessors to aid in selfupdating CPANPLUS.
457 These objects are returned by all methods of C<CPANPLUS::Selfupdate>
458 that return module objects.
462 { package CPANPLUS::Selfupdate::Module;
463 use base 'CPANPLUS::Module';
465 ### stores module name -> cpanplus required version
466 ### XXX only can deal with 1 pair!
468 my $Acc = 'version_required';
472 my $mod = shift or return;
473 my $ver = shift; return unless defined $ver;
475 my $obj = $mod->clone; # clone the module object
476 bless $obj, $class; # rebless it to our class
483 =head2 $version = $mod->version_required
485 Returns the version of this module required for CPANPLUS.
489 sub version_required {
491 $Cache{ $self->name } = shift() if @_;
492 return $Cache{ $self->name };
495 =head2 $bool = $mod->is_installed_version_sufficient
497 Returns true if the installed version of this module is sufficient
498 for CPANPLUS, or false if it is not.
503 sub is_installed_version_sufficient {
505 return $self->is_uptodate( version => $self->$Acc );
516 Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
520 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
524 The CPAN++ interface (of which this module is a part of) is copyright (c)
525 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
527 This library is free software; you may redistribute and/or modify it
528 under the same terms as Perl itself.
533 # c-indentation-style: bsd
535 # indent-tabs-mode: nil
537 # vim: expandtab shiftwidth=4: