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.15_02', # lynx & 404 handling
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.28', # returns dir for loaded
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.34', # mk_aliases support
65 'Module::CoreList' => '2.09',
66 'Module::Pluggable' => '2.4',
67 'Module::Loaded' => '0.01',
68 'Parse::CPAN::Meta' => '0.02', # config_requires support
69 'ExtUtils::Install' => '1.42', # uninstall outside @INC
73 # config_key_name => [
74 # sub { } to list module key/value pairs
75 # sub { } to check if feature is enabled
80 $cb->configure_object->get_conf('prefer_makefile')
82 : { 'CPANPLUS::Dist::Build' => '0.24' };
84 sub { return 1 }, # always enabled
87 { 'Test::Reporter' => '1.34',
92 return $cb->configure_object->get_conf('cpantest');
98 my $dist = $cb->configure_object->get_conf('dist_type');
99 return { $dist => '0.0' } if $dist;
104 return $cb->configure_object->get_conf('dist_type');
110 'Digest::MD5' => '0.0',
114 return $cb->configure_object->get_conf('md5');
120 my $dist = $cb->configure_object->get_conf('shell');
122 ### we bundle these shells, so don't bother having a dep
123 ### on them... If we don't do this, CPAN.pm actually detects
124 ### a recursive dependency and breaks (see #26077).
125 ### This is not an issue for CPANPLUS itself, it handles
127 return if $dist eq SHELL_DEFAULT or $dist eq SHELL_CLASSIC;
128 return { $dist => '0.0' } if $dist;
137 'Module::Signature' => '0.06',
139 ### leave this out -- Crypt::OpenPGP is fairly
140 ### painful to install, and broken on some platforms
141 ### so we'll just always fall back to gpg. It may
142 ### issue a warning or 2, but that's about it.
143 ### this change due to this ticket: #26914
144 # and $cb->configure_object->get_conf('prefer_bin');
147 'Crypt::OpenPGP' => '0.0',
148 'Module::Signature' => '0.06',
153 return $cb->configure_object->get_conf('signature');
157 { 'Storable' => '0.0' },
160 return $cb->configure_object->get_conf('storable');
164 { 'DBIx::Simple' => '0.0',
165 'DBD::SQLite' => '0.0',
169 my $conf = $cb->configure_object;
170 return $conf->get_conf('source_engine')
171 eq 'CPANPLUS::Internals::Source::SQLite'
180 sub _get_config { return $Modules }
185 =head2 $self = CPANPLUS::Selfupdate->new( $backend_object );
187 Sets up a new selfupdate object. Called automatically when
188 a new backend object is created.
194 my $cb = shift or return;
195 return bless sub { $cb }, $class;
199 { ### cache to find the relevant modules
202 => sub { my $self = shift;
203 core => [ $self->list_core_modules ] },
206 => sub { my $self = shift;
207 dependencies => [ $self->list_core_dependencies ] },
210 => sub { my $self = shift;
211 map { $_ => [ $self->modules_for_feature( $_ ) ] }
212 $self->list_enabled_features
215 => sub { my $self = shift;
216 map { $_ => [ $self->modules_for_feature( $_ ) ] }
219 ### make sure to do 'core' first, in case
220 ### we are out of date ourselves
221 all => [ qw|core dependencies enabled_features| ],
225 =head2 @cat = $self->list_categories
227 Returns a list of categories that the C<selfupdate> method accepts.
229 See C<selfupdate> for details.
233 sub list_categories { return sort keys %$cache }
235 =head2 %list = $self->list_modules_to_update( update => "core|dependencies|enabled_features|features|all", [latest => BOOL] )
237 List which modules C<selfupdate> would upgrade. You can update either
238 the core (CPANPLUS itself), the core dependencies, all features you have
239 currently turned on, or all features available, or everything.
241 The C<latest> option determines whether it should update to the latest
242 version on CPAN, or if the minimal required version for CPANPLUS is
245 Returns a hash of feature names and lists of module objects to be
246 upgraded based on the category you provided. For example:
248 %list = $self->list_modules_to_update( update => 'core' );
252 ( core => [ $module_object_for_cpanplus ] );
256 sub list_modules_to_update {
259 my $conf = $cb->configure_object;
264 update => { required => 1, store => \$type,
265 allow => [ keys %$cache ], },
266 latest => { default => 0, store => \$latest, allow => BOOLEANS },
269 { local $Params::Check::ALLOW_UNKNOWN = 1;
270 check( $tmpl, \%hash ) or return;
273 my $ref = $cache->{$type};
275 ### a list of ( feature1 => \@mods, feature2 => \@mods, etc )
276 my %list = UNIVERSAL::isa( $ref, 'ARRAY' )
277 ? map { $cache->{$_}->( $self ) } @$ref
280 ### filter based on whether we need the latest ones or not
281 for my $aref ( values %list ) {
283 ? grep { !$_->is_uptodate } @$aref
284 : grep { !$_->is_installed_version_sufficient } @$aref
291 =head2 $bool = $self->selfupdate( update => "core|dependencies|enabled_features|features|all", [latest => BOOL, force => BOOL] )
293 Selfupdate CPANPLUS. You can update either the core (CPANPLUS itself),
294 the core dependencies, all features you have currently turned on, or
295 all features available, or everything.
297 The C<latest> option determines whether it should update to the latest
298 version on CPAN, or if the minimal required version for CPANPLUS is
301 Returns true on success, false on error.
308 my $conf = $cb->configure_object;
313 force => { default => $conf->get_conf('force'), store => \$force },
316 { local $Params::Check::ALLOW_UNKNOWN = 1;
317 check( $tmpl, \%hash ) or return;
320 my %list = $self->list_modules_to_update( %hash ) or return;
322 ### just the modules please
323 my @mods = map { @$_ } values %list;
326 for my $mod ( @mods ) {
327 unless( $mod->install( force => $force ) ) {
329 error(loc("Failed to update module '%1'", $mod->name));
339 =head2 @features = $self->list_features
341 Returns a list of features that are supported by CPANPLUS.
347 return keys %{ $self->_get_config->{'features'} };
350 =head2 @features = $self->list_enabled_features
352 Returns a list of features that are enabled in your current
353 CPANPLUS installation.
357 sub list_enabled_features {
362 for my $feat ( $self->list_features ) {
363 my $ref = $self->_get_config->{'features'}->{$feat}->[1];
364 push @enabled, $feat if $ref->($cb);
370 =head2 @mods = $self->modules_for_feature( FEATURE [,AS_HASH] )
372 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
373 represent the modules required to support this feature.
375 For a list of features, call the C<list_features> method.
377 If the C<AS_HASH> argument is provided, no module objects are
378 returned, but a hashref where the keys are names of the modules,
379 and values are their minimum versions.
383 sub modules_for_feature {
385 my $feature = shift or return;
386 my $as_hash = shift || 0;
389 unless( exists $self->_get_config->{'features'}->{$feature} ) {
390 error(loc("Unknown feature '%1'", $feature));
394 my $ref = $self->_get_config->{'features'}->{$feature}->[0];
396 ### it's either a list of modules/versions or a subroutine that
397 ### returns a list of modules/versions
398 my $href = UNIVERSAL::isa( $ref, 'HASH' ) ? $ref : $ref->( $cb );
400 return unless $href; # nothing needed for the feature?
402 return $href if $as_hash;
403 return $self->_hashref_to_module( $href );
407 =head2 @mods = $self->list_core_dependencies( [AS_HASH] )
409 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
410 represent the modules that comprise the core dependencies of CPANPLUS.
412 If the C<AS_HASH> argument is provided, no module objects are
413 returned, but a hashref where the keys are names of the modules,
414 and values are their minimum versions.
418 sub list_core_dependencies {
420 my $as_hash = shift || 0;
422 my $href = $self->_get_config->{'dependencies'};
424 return $href if $as_hash;
425 return $self->_hashref_to_module( $href );
428 =head2 @mods = $self->list_core_modules( [AS_HASH] )
430 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
431 represent the modules that comprise the core of CPANPLUS.
433 If the C<AS_HASH> argument is provided, no module objects are
434 returned, but a hashref where the keys are names of the modules,
435 and values are their minimum versions.
439 sub list_core_modules {
441 my $as_hash = shift || 0;
443 my $href = $self->_get_config->{'core'};
445 return $href if $as_hash;
446 return $self->_hashref_to_module( $href );
449 sub _hashref_to_module {
452 my $href = shift or return;
455 CPANPLUS::Selfupdate::Module->new(
456 $cb->module_tree($_) => $href->{$_}
462 =head1 CPANPLUS::Selfupdate::Module
464 C<CPANPLUS::Selfupdate::Module> extends C<CPANPLUS::Module> objects
465 by providing accessors to aid in selfupdating CPANPLUS.
467 These objects are returned by all methods of C<CPANPLUS::Selfupdate>
468 that return module objects.
472 { package CPANPLUS::Selfupdate::Module;
473 use base 'CPANPLUS::Module';
475 ### stores module name -> cpanplus required version
476 ### XXX only can deal with 1 pair!
478 my $Acc = 'version_required';
482 my $mod = shift or return;
483 my $ver = shift; return unless defined $ver;
485 my $obj = $mod->clone; # clone the module object
486 bless $obj, $class; # rebless it to our class
493 =head2 $version = $mod->version_required
495 Returns the version of this module required for CPANPLUS.
499 sub version_required {
501 $Cache{ $self->name } = shift() if @_;
502 return $Cache{ $self->name };
505 =head2 $bool = $mod->is_installed_version_sufficient
507 Returns true if the installed version of this module is sufficient
508 for CPANPLUS, or false if it is not.
513 sub is_installed_version_sufficient {
515 return $self->is_uptodate( version => $self->$Acc );
526 Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
530 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
534 The CPAN++ interface (of which this module is a part of) is copyright (c)
535 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
537 This library is free software; you may redistribute and/or modify it
538 under the same terms as Perl itself.
543 # c-indentation-style: bsd
545 # indent-tabs-mode: nil
547 # vim: expandtab shiftwidth=4: