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;
137 return if can_run('gpg');
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');
144 return { 'Crypt::OpenPGP' => '0.0' };
148 return $cb->configure_object->get_conf('signature');
152 { 'Storable' => '0.0' },
155 return $cb->configure_object->get_conf('storable');
164 sub _get_config { return $Modules }
169 =head2 $self = CPANPLUS::Selfupdate->new( $backend_object );
171 Sets up a new selfupdate object. Called automatically when
172 a new backend object is created.
178 my $cb = shift or return;
179 return bless sub { $cb }, $class;
183 { ### cache to find the relevant modules
186 => sub { my $self = shift;
187 core => [ $self->list_core_modules ] },
190 => sub { my $self = shift;
191 dependencies => [ $self->list_core_dependencies ] },
194 => sub { my $self = shift;
195 map { $_ => [ $self->modules_for_feature( $_ ) ] }
196 $self->list_enabled_features
199 => sub { my $self = shift;
200 map { $_ => [ $self->modules_for_feature( $_ ) ] }
203 ### make sure to do 'core' first, in case
204 ### we are out of date ourselves
205 all => [ qw|core dependencies enabled_features| ],
209 =head2 @cat = $self->list_categories
211 Returns a list of categories that the C<selfupdate> method accepts.
213 See C<selfupdate> for details.
217 sub list_categories { return sort keys %$cache }
219 =head2 %list = $self->list_modules_to_update( update => "core|dependencies|enabled_features|features|all", [latest => BOOL] )
221 List which modules C<selfupdate> would upgrade. You can update either
222 the core (CPANPLUS itself), the core dependencies, all features you have
223 currently turned on, or all features available, or everything.
225 The C<latest> option determines whether it should update to the latest
226 version on CPAN, or if the minimal required version for CPANPLUS is
229 Returns a hash of feature names and lists of module objects to be
230 upgraded based on the category you provided. For example:
232 %list = $self->list_modules_to_update( update => 'core' );
236 ( core => [ $module_object_for_cpanplus ] );
240 sub list_modules_to_update {
243 my $conf = $cb->configure_object;
248 update => { required => 1, store => \$type,
249 allow => [ keys %$cache ], },
250 latest => { default => 0, store => \$latest, allow => BOOLEANS },
253 { local $Params::Check::ALLOW_UNKNOWN = 1;
254 check( $tmpl, \%hash ) or return;
257 my $ref = $cache->{$type};
259 ### a list of ( feature1 => \@mods, feature2 => \@mods, etc )
260 my %list = UNIVERSAL::isa( $ref, 'ARRAY' )
261 ? map { $cache->{$_}->( $self ) } @$ref
264 ### filter based on whether we need the latest ones or not
265 for my $aref ( values %list ) {
267 ? grep { !$_->is_uptodate } @$aref
268 : grep { !$_->is_installed_version_sufficient } @$aref
275 =head2 $bool = $self->selfupdate( update => "core|dependencies|enabled_features|features|all", [latest => BOOL, force => BOOL] )
277 Selfupdate CPANPLUS. You can update either the core (CPANPLUS itself),
278 the core dependencies, all features you have currently turned on, or
279 all features available, or everything.
281 The C<latest> option determines whether it should update to the latest
282 version on CPAN, or if the minimal required version for CPANPLUS is
285 Returns true on success, false on error.
292 my $conf = $cb->configure_object;
297 force => { default => $conf->get_conf('force'), store => \$force },
300 { local $Params::Check::ALLOW_UNKNOWN = 1;
301 check( $tmpl, \%hash ) or return;
304 my %list = $self->list_modules_to_update( %hash ) or return;
306 ### just the modules please
307 my @mods = map { @$_ } values %list;
310 for my $mod ( @mods ) {
311 unless( $mod->install( force => $force ) ) {
313 error(loc("Failed to update module '%1'", $mod->name));
323 =head2 @features = $self->list_features
325 Returns a list of features that are supported by CPANPLUS.
331 return keys %{ $self->_get_config->{'features'} };
334 =head2 @features = $self->list_enabled_features
336 Returns a list of features that are enabled in your current
337 CPANPLUS installation.
341 sub list_enabled_features {
346 for my $feat ( $self->list_features ) {
347 my $ref = $self->_get_config->{'features'}->{$feat}->[1];
348 push @enabled, $feat if $ref->($cb);
354 =head2 @mods = $self->modules_for_feature( FEATURE [,AS_HASH] )
356 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
357 represent the modules required to support this feature.
359 For a list of features, call the C<list_features> method.
361 If the C<AS_HASH> argument is provided, no module objects are
362 returned, but a hashref where the keys are names of the modules,
363 and values are their minimum versions.
367 sub modules_for_feature {
369 my $feature = shift or return;
370 my $as_hash = shift || 0;
373 unless( exists $self->_get_config->{'features'}->{$feature} ) {
374 error(loc("Unknown feature '%1'", $feature));
378 my $ref = $self->_get_config->{'features'}->{$feature}->[0];
380 ### it's either a list of modules/versions or a subroutine that
381 ### returns a list of modules/versions
382 my $href = UNIVERSAL::isa( $ref, 'HASH' ) ? $ref : $ref->( $cb );
384 return unless $href; # nothing needed for the feature?
386 return $href if $as_hash;
387 return $self->_hashref_to_module( $href );
391 =head2 @mods = $self->list_core_dependencies( [AS_HASH] )
393 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
394 represent the modules that comprise the core dependencies of CPANPLUS.
396 If the C<AS_HASH> argument is provided, no module objects are
397 returned, but a hashref where the keys are names of the modules,
398 and values are their minimum versions.
402 sub list_core_dependencies {
404 my $as_hash = shift || 0;
406 my $href = $self->_get_config->{'dependencies'};
408 return $href if $as_hash;
409 return $self->_hashref_to_module( $href );
412 =head2 @mods = $self->list_core_modules( [AS_HASH] )
414 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
415 represent the modules that comprise the core of CPANPLUS.
417 If the C<AS_HASH> argument is provided, no module objects are
418 returned, but a hashref where the keys are names of the modules,
419 and values are their minimum versions.
423 sub list_core_modules {
425 my $as_hash = shift || 0;
427 my $href = $self->_get_config->{'core'};
429 return $href if $as_hash;
430 return $self->_hashref_to_module( $href );
433 sub _hashref_to_module {
436 my $href = shift or return;
439 CPANPLUS::Selfupdate::Module->new(
440 $cb->module_tree($_) => $href->{$_}
446 =head1 CPANPLUS::Selfupdate::Module
448 C<CPANPLUS::Selfupdate::Module> extends C<CPANPLUS::Module> objects
449 by providing accessors to aid in selfupdating CPANPLUS.
451 These objects are returned by all methods of C<CPANPLUS::Selfupdate>
452 that return module objects.
456 { package CPANPLUS::Selfupdate::Module;
457 use base 'CPANPLUS::Module';
459 ### stores module name -> cpanplus required version
460 ### XXX only can deal with 1 pair!
462 my $Acc = 'version_required';
466 my $mod = shift or return;
467 my $ver = shift; return unless defined $ver;
469 my $obj = $mod->clone; # clone the module object
470 bless $obj, $class; # rebless it to our class
477 =head2 $version = $mod->version_required
479 Returns the version of this module required for CPANPLUS.
483 sub version_required {
485 $Cache{ $self->name } = shift() if @_;
486 return $Cache{ $self->name };
489 =head2 $bool = $mod->is_installed_version_sufficient
491 Returns true if the installed version of this module is sufficient
492 for CPANPLUS, or false if it is not.
497 sub is_installed_version_sufficient {
499 return $self->is_uptodate( version => $self->$Acc );
510 Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
514 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
518 The CPAN++ interface (of which this module is a part of) is copyright (c)
519 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
521 This library is free software; you may redistribute and/or modify it
522 under the same terms as Perl itself.
527 # c-indentation-style: bsd
529 # indent-tabs-mode: nil
531 # vim: expandtab shiftwidth=4: