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');
122 return { $dist => '0.0' } if $dist;
130 return if can_run('gpg') and
131 $cb->configure_object->get_conf('prefer_bin');
132 return { 'Crypt::OpenPGP' => '0.0' };
136 return $cb->configure_object->get_conf('signature');
140 { 'Storable' => '0.0' },
143 return $cb->configure_object->get_conf('storable');
152 sub _get_config { return $Modules }
157 =head2 $self = CPANPLUS::Selfupdate->new( $backend_object );
159 Sets up a new selfupdate object. Called automatically when
160 a new backend object is created.
166 my $cb = shift or return;
167 return bless sub { $cb }, $class;
172 =head2 $bool = $self->selfupdate( update => "core|dependencies|enabled_features|features|all", latest => BOOL )
174 Selfupdate CPANPLUS. You can update either the core (CPANPLUS itself),
175 the core dependencies, all features you have currently turned on, or
176 all features available, or everything.
178 The C<latest> option determines whether it should update to the latest
179 version on CPAN, or if the minimal required version for CPANPLUS is
182 Returns true on success, false on error.
189 my $conf = $cb->configure_object;
192 ### cache to find the relevant modules
194 core => sub { $self->list_core_modules },
195 dependencies => sub { $self->list_core_dependencies },
196 enabled_features => sub { map { $self->modules_for_feature( $_ ) }
197 $self->list_enabled_features
199 features => sub { map { $self->modules_for_feature( $_ ) }
202 ### make sure to do 'core' first, in case
203 ### we are out of date ourselves
204 all => [ qw|core dependencies enabled_features| ],
207 my($type, $latest, $force);
209 update => { required => 1, store => \$type,
210 allow => [ keys %$cache ], },
211 latest => { default => 0, store => \$latest, allow => BOOLEANS },
212 force => { default => $conf->get_conf('force'), store => \$force },
215 check( $tmpl, \%hash ) or return;
217 my $ref = $cache->{$type};
218 my @mods = UNIVERSAL::isa( $ref, 'ARRAY' )
219 ? map { $cache->{$_}->() } @$ref
222 ### do we need the latest versions?
225 : grep { $_->is_installed_version_sufficient } @mods;
228 for my $mod ( @mods ) {
229 unless( $mod->install( force => $force ) ) {
231 error(loc("Failed to update module '%1'", $mod->name));
239 =head2 @features = $self->list_features
241 Returns a list of features that are supported by CPANPLUS.
247 return keys %{ $self->_get_config->{'features'} };
250 =head2 @features = $self->list_enabled_features
252 Returns a list of features that are enabled in your current
253 CPANPLUS installation.
257 sub list_enabled_features {
262 for my $feat ( $self->list_features ) {
263 my $ref = $self->_get_config->{'features'}->{$feat}->[1];
264 push @enabled, $feat if $ref->($cb);
270 =head2 @mods = $self->modules_for_feature( FEATURE [,AS_HASH] )
272 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
273 represent the modules required to support this feature.
275 For a list of features, call the C<list_features> method.
277 If the C<AS_HASH> argument is provided, no module objects are
278 returned, but a hashref where the keys are names of the modules,
279 and values are their minimum versions.
283 sub modules_for_feature {
285 my $feature = shift or return;
286 my $as_hash = shift || 0;
289 unless( exists $self->_get_config->{'features'}->{$feature} ) {
290 error(loc("Unknown feature '%1'", $feature));
294 my $ref = $self->_get_config->{'features'}->{$feature}->[0];
296 ### it's either a list of modules/versions or a subroutine that
297 ### returns a list of modules/versions
298 my $href = UNIVERSAL::isa( $ref, 'HASH' ) ? $ref : $ref->( $cb );
300 return unless $href; # nothing needed for the feature?
302 return $href if $as_hash;
303 return $self->_hashref_to_module( $href );
307 =head2 @mods = $self->list_core_dependencies( [AS_HASH] )
309 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
310 represent the modules that comprise the core dependencies of CPANPLUS.
312 If the C<AS_HASH> argument is provided, no module objects are
313 returned, but a hashref where the keys are names of the modules,
314 and values are their minimum versions.
318 sub list_core_dependencies {
320 my $as_hash = shift || 0;
322 my $href = $self->_get_config->{'dependencies'};
324 return $href if $as_hash;
325 return $self->_hashref_to_module( $href );
328 =head2 @mods = $self->list_core_modules( [AS_HASH] )
330 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
331 represent the modules that comprise the core of CPANPLUS.
333 If the C<AS_HASH> argument is provided, no module objects are
334 returned, but a hashref where the keys are names of the modules,
335 and values are their minimum versions.
339 sub list_core_modules {
341 my $as_hash = shift || 0;
343 my $href = $self->_get_config->{'core'};
345 return $href if $as_hash;
346 return $self->_hashref_to_module( $href );
349 sub _hashref_to_module {
352 my $href = shift or return;
355 CPANPLUS::Selfupdate::Module->new(
356 $cb->module_tree($_) => $href->{$_}
362 =head1 CPANPLUS::Selfupdate::Module
364 C<CPANPLUS::Selfupdate::Module> extends C<CPANPLUS::Module> objects
365 by providing accessors to aid in selfupdating CPANPLUS.
367 These objects are returned by all methods of C<CPANPLUS::Selfupdate>
368 that return module objects.
372 { package CPANPLUS::Selfupdate::Module;
373 use base 'CPANPLUS::Module';
375 ### stores module name -> cpanplus required version
376 ### XXX only can deal with 1 pair!
378 my $Acc = 'version_required';
382 my $mod = shift or return;
383 my $ver = shift; return unless defined $ver;
385 my $obj = $mod->clone; # clone the module object
386 bless $obj, $class; # rebless it to our class
393 =head2 $version = $mod->version_required
395 Returns the version of this module required for CPANPLUS.
399 sub version_required {
401 $Cache{ $self->name } = shift() if @_;
402 return $Cache{ $self->name };
405 =head2 $bool = $mod->is_installed_version_sufficient
407 Returns true if the installed version of this module is sufficient
408 for CPANPLUS, or false if it is not.
413 sub is_installed_version_sufficient {
415 return $self->is_uptodate( version => $self->$Acc );
426 Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
430 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
434 The CPAN++ interface (of which this module is a part of) is copyright (c)
435 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
437 This library is free software; you may redistribute and/or modify it
438 under the same terms as Perl itself.
443 # c-indentation-style: bsd
445 # indent-tabs-mode: nil
447 # vim: expandtab shiftwidth=4: