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.13_02', # win32 file:// 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.18', # Better parsing: #23995,
50 # uses version.pm for <=>
51 'version' => '0.73', # needed for M::L::C
52 # addresses #24630 and
54 # Address ~0 overflow issue
55 'Params::Check' => '0.22',
56 'Package::Constants' => '0.01',
57 'Term::UI' => '0.18', # option parsing
58 'Test::Harness' => '2.62', # due to bug #19505
59 # only 2.58 and 2.60 are bad
60 'Test::More' => '0.47', # to run our tests
61 'Archive::Extract' => '0.16', # ./Dir bug fix
62 'Archive::Tar' => '1.23',
63 'IO::Zlib' => '1.04', # needed for Archive::Tar
64 'Object::Accessor' => '0.32', # overloaded stringification
65 'Module::CoreList' => '2.09',
66 'Module::Pluggable' => '2.4',
67 'Module::Loaded' => '0.01',
71 # config_key_name => [
72 # sub { } to list module key/value pairs
73 # sub { } to check if feature is enabled
78 $cb->configure_object->get_conf('prefer_makefile')
80 : { 'CPANPLUS::Dist::Build' => '0.04' };
82 sub { return 1 }, # always enabled
86 'YAML::Tiny' => '0.0',
87 'Test::Reporter' => '1.34',
91 return $cb->configure_object->get_conf('cpantest');
97 my $dist = $cb->configure_object->get_conf('dist_type');
98 return { $dist => '0.0' } if $dist;
103 return $cb->configure_object->get_conf('dist_type');
109 'Digest::MD5' => '0.0',
113 return $cb->configure_object->get_conf('md5');
119 my $dist = $cb->configure_object->get_conf('shell');
121 ### we bundle these shells, so don't bother having a dep
122 ### on them... If we don't do this, CPAN.pm actually detects
123 ### a recursive dependency and breaks (see #26077).
124 ### This is not an issue for CPANPLUS itself, it handles
126 return if $dist eq SHELL_DEFAULT or $dist eq SHELL_CLASSIC;
127 return { $dist => '0.0' } if $dist;
136 'Module::Signature' => '0.06',
138 ### leave this out -- Crypt::OpenPGP is fairly
139 ### painful to install, and broken on some platforms
140 ### so we'll just always fall back to gpg. It may
141 ### issue a warning or 2, but that's about it.
142 ### this change due to this ticket: #26914
143 # and $cb->configure_object->get_conf('prefer_bin');
146 'Crypt::OpenPGP' => '0.0',
147 'Module::Signature' => '0.06',
152 return $cb->configure_object->get_conf('signature');
156 { 'Storable' => '0.0' },
159 return $cb->configure_object->get_conf('storable');
168 sub _get_config { return $Modules }
173 =head2 $self = CPANPLUS::Selfupdate->new( $backend_object );
175 Sets up a new selfupdate object. Called automatically when
176 a new backend object is created.
182 my $cb = shift or return;
183 return bless sub { $cb }, $class;
187 { ### cache to find the relevant modules
190 => sub { my $self = shift;
191 core => [ $self->list_core_modules ] },
194 => sub { my $self = shift;
195 dependencies => [ $self->list_core_dependencies ] },
198 => sub { my $self = shift;
199 map { $_ => [ $self->modules_for_feature( $_ ) ] }
200 $self->list_enabled_features
203 => sub { my $self = shift;
204 map { $_ => [ $self->modules_for_feature( $_ ) ] }
207 ### make sure to do 'core' first, in case
208 ### we are out of date ourselves
209 all => [ qw|core dependencies enabled_features| ],
213 =head2 @cat = $self->list_categories
215 Returns a list of categories that the C<selfupdate> method accepts.
217 See C<selfupdate> for details.
221 sub list_categories { return sort keys %$cache }
223 =head2 %list = $self->list_modules_to_update( update => "core|dependencies|enabled_features|features|all", [latest => BOOL] )
225 List which modules C<selfupdate> would upgrade. You can update either
226 the core (CPANPLUS itself), the core dependencies, all features you have
227 currently turned on, or all features available, or everything.
229 The C<latest> option determines whether it should update to the latest
230 version on CPAN, or if the minimal required version for CPANPLUS is
233 Returns a hash of feature names and lists of module objects to be
234 upgraded based on the category you provided. For example:
236 %list = $self->list_modules_to_update( update => 'core' );
240 ( core => [ $module_object_for_cpanplus ] );
244 sub list_modules_to_update {
247 my $conf = $cb->configure_object;
252 update => { required => 1, store => \$type,
253 allow => [ keys %$cache ], },
254 latest => { default => 0, store => \$latest, allow => BOOLEANS },
257 { local $Params::Check::ALLOW_UNKNOWN = 1;
258 check( $tmpl, \%hash ) or return;
261 my $ref = $cache->{$type};
263 ### a list of ( feature1 => \@mods, feature2 => \@mods, etc )
264 my %list = UNIVERSAL::isa( $ref, 'ARRAY' )
265 ? map { $cache->{$_}->( $self ) } @$ref
268 ### filter based on whether we need the latest ones or not
269 for my $aref ( values %list ) {
271 ? grep { !$_->is_uptodate } @$aref
272 : grep { !$_->is_installed_version_sufficient } @$aref
279 =head2 $bool = $self->selfupdate( update => "core|dependencies|enabled_features|features|all", [latest => BOOL, force => BOOL] )
281 Selfupdate CPANPLUS. You can update either the core (CPANPLUS itself),
282 the core dependencies, all features you have currently turned on, or
283 all features available, or everything.
285 The C<latest> option determines whether it should update to the latest
286 version on CPAN, or if the minimal required version for CPANPLUS is
289 Returns true on success, false on error.
296 my $conf = $cb->configure_object;
301 force => { default => $conf->get_conf('force'), store => \$force },
304 { local $Params::Check::ALLOW_UNKNOWN = 1;
305 check( $tmpl, \%hash ) or return;
308 my %list = $self->list_modules_to_update( %hash ) or return;
310 ### just the modules please
311 my @mods = map { @$_ } values %list;
314 for my $mod ( @mods ) {
315 unless( $mod->install( force => $force ) ) {
317 error(loc("Failed to update module '%1'", $mod->name));
327 =head2 @features = $self->list_features
329 Returns a list of features that are supported by CPANPLUS.
335 return keys %{ $self->_get_config->{'features'} };
338 =head2 @features = $self->list_enabled_features
340 Returns a list of features that are enabled in your current
341 CPANPLUS installation.
345 sub list_enabled_features {
350 for my $feat ( $self->list_features ) {
351 my $ref = $self->_get_config->{'features'}->{$feat}->[1];
352 push @enabled, $feat if $ref->($cb);
358 =head2 @mods = $self->modules_for_feature( FEATURE [,AS_HASH] )
360 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
361 represent the modules required to support this feature.
363 For a list of features, call the C<list_features> method.
365 If the C<AS_HASH> argument is provided, no module objects are
366 returned, but a hashref where the keys are names of the modules,
367 and values are their minimum versions.
371 sub modules_for_feature {
373 my $feature = shift or return;
374 my $as_hash = shift || 0;
377 unless( exists $self->_get_config->{'features'}->{$feature} ) {
378 error(loc("Unknown feature '%1'", $feature));
382 my $ref = $self->_get_config->{'features'}->{$feature}->[0];
384 ### it's either a list of modules/versions or a subroutine that
385 ### returns a list of modules/versions
386 my $href = UNIVERSAL::isa( $ref, 'HASH' ) ? $ref : $ref->( $cb );
388 return unless $href; # nothing needed for the feature?
390 return $href if $as_hash;
391 return $self->_hashref_to_module( $href );
395 =head2 @mods = $self->list_core_dependencies( [AS_HASH] )
397 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
398 represent the modules that comprise the core dependencies of CPANPLUS.
400 If the C<AS_HASH> argument is provided, no module objects are
401 returned, but a hashref where the keys are names of the modules,
402 and values are their minimum versions.
406 sub list_core_dependencies {
408 my $as_hash = shift || 0;
410 my $href = $self->_get_config->{'dependencies'};
412 return $href if $as_hash;
413 return $self->_hashref_to_module( $href );
416 =head2 @mods = $self->list_core_modules( [AS_HASH] )
418 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
419 represent the modules that comprise the core of CPANPLUS.
421 If the C<AS_HASH> argument is provided, no module objects are
422 returned, but a hashref where the keys are names of the modules,
423 and values are their minimum versions.
427 sub list_core_modules {
429 my $as_hash = shift || 0;
431 my $href = $self->_get_config->{'core'};
433 return $href if $as_hash;
434 return $self->_hashref_to_module( $href );
437 sub _hashref_to_module {
440 my $href = shift or return;
443 CPANPLUS::Selfupdate::Module->new(
444 $cb->module_tree($_) => $href->{$_}
450 =head1 CPANPLUS::Selfupdate::Module
452 C<CPANPLUS::Selfupdate::Module> extends C<CPANPLUS::Module> objects
453 by providing accessors to aid in selfupdating CPANPLUS.
455 These objects are returned by all methods of C<CPANPLUS::Selfupdate>
456 that return module objects.
460 { package CPANPLUS::Selfupdate::Module;
461 use base 'CPANPLUS::Module';
463 ### stores module name -> cpanplus required version
464 ### XXX only can deal with 1 pair!
466 my $Acc = 'version_required';
470 my $mod = shift or return;
471 my $ver = shift; return unless defined $ver;
473 my $obj = $mod->clone; # clone the module object
474 bless $obj, $class; # rebless it to our class
481 =head2 $version = $mod->version_required
483 Returns the version of this module required for CPANPLUS.
487 sub version_required {
489 $Cache{ $self->name } = shift() if @_;
490 return $Cache{ $self->name };
493 =head2 $bool = $mod->is_installed_version_sufficient
495 Returns true if the installed version of this module is sufficient
496 for CPANPLUS, or false if it is not.
501 sub is_installed_version_sufficient {
503 return $self->is_uptodate( version => $self->$Acc );
514 Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
518 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
522 The CPAN++ interface (of which this module is a part of) is copyright (c)
523 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
525 This library is free software; you may redistribute and/or modify it
526 under the same terms as Perl itself.
531 # c-indentation-style: bsd
533 # indent-tabs-mode: nil
535 # vim: expandtab shiftwidth=4: