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') and
138 $cb->configure_object->get_conf('prefer_bin');
139 return { 'Crypt::OpenPGP' => '0.0' };
143 return $cb->configure_object->get_conf('signature');
147 { 'Storable' => '0.0' },
150 return $cb->configure_object->get_conf('storable');
159 sub _get_config { return $Modules }
164 =head2 $self = CPANPLUS::Selfupdate->new( $backend_object );
166 Sets up a new selfupdate object. Called automatically when
167 a new backend object is created.
173 my $cb = shift or return;
174 return bless sub { $cb }, $class;
179 =head2 $bool = $self->selfupdate( update => "core|dependencies|enabled_features|features|all", latest => BOOL )
181 Selfupdate CPANPLUS. You can update either the core (CPANPLUS itself),
182 the core dependencies, all features you have currently turned on, or
183 all features available, or everything.
185 The C<latest> option determines whether it should update to the latest
186 version on CPAN, or if the minimal required version for CPANPLUS is
189 Returns true on success, false on error.
196 my $conf = $cb->configure_object;
199 ### cache to find the relevant modules
201 core => sub { $self->list_core_modules },
202 dependencies => sub { $self->list_core_dependencies },
203 enabled_features => sub { map { $self->modules_for_feature( $_ ) }
204 $self->list_enabled_features
206 features => sub { 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| ],
214 my($type, $latest, $force);
216 update => { required => 1, store => \$type,
217 allow => [ keys %$cache ], },
218 latest => { default => 0, store => \$latest, allow => BOOLEANS },
219 force => { default => $conf->get_conf('force'), store => \$force },
222 check( $tmpl, \%hash ) or return;
224 my $ref = $cache->{$type};
225 my @mods = UNIVERSAL::isa( $ref, 'ARRAY' )
226 ? map { $cache->{$_}->() } @$ref
229 ### do we need the latest versions?
232 : grep { $_->is_installed_version_sufficient } @mods;
235 for my $mod ( @mods ) {
236 unless( $mod->install( force => $force ) ) {
238 error(loc("Failed to update module '%1'", $mod->name));
246 =head2 @features = $self->list_features
248 Returns a list of features that are supported by CPANPLUS.
254 return keys %{ $self->_get_config->{'features'} };
257 =head2 @features = $self->list_enabled_features
259 Returns a list of features that are enabled in your current
260 CPANPLUS installation.
264 sub list_enabled_features {
269 for my $feat ( $self->list_features ) {
270 my $ref = $self->_get_config->{'features'}->{$feat}->[1];
271 push @enabled, $feat if $ref->($cb);
277 =head2 @mods = $self->modules_for_feature( FEATURE [,AS_HASH] )
279 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
280 represent the modules required to support this feature.
282 For a list of features, call the C<list_features> method.
284 If the C<AS_HASH> argument is provided, no module objects are
285 returned, but a hashref where the keys are names of the modules,
286 and values are their minimum versions.
290 sub modules_for_feature {
292 my $feature = shift or return;
293 my $as_hash = shift || 0;
296 unless( exists $self->_get_config->{'features'}->{$feature} ) {
297 error(loc("Unknown feature '%1'", $feature));
301 my $ref = $self->_get_config->{'features'}->{$feature}->[0];
303 ### it's either a list of modules/versions or a subroutine that
304 ### returns a list of modules/versions
305 my $href = UNIVERSAL::isa( $ref, 'HASH' ) ? $ref : $ref->( $cb );
307 return unless $href; # nothing needed for the feature?
309 return $href if $as_hash;
310 return $self->_hashref_to_module( $href );
314 =head2 @mods = $self->list_core_dependencies( [AS_HASH] )
316 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
317 represent the modules that comprise the core dependencies of CPANPLUS.
319 If the C<AS_HASH> argument is provided, no module objects are
320 returned, but a hashref where the keys are names of the modules,
321 and values are their minimum versions.
325 sub list_core_dependencies {
327 my $as_hash = shift || 0;
329 my $href = $self->_get_config->{'dependencies'};
331 return $href if $as_hash;
332 return $self->_hashref_to_module( $href );
335 =head2 @mods = $self->list_core_modules( [AS_HASH] )
337 Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
338 represent the modules that comprise the core of CPANPLUS.
340 If the C<AS_HASH> argument is provided, no module objects are
341 returned, but a hashref where the keys are names of the modules,
342 and values are their minimum versions.
346 sub list_core_modules {
348 my $as_hash = shift || 0;
350 my $href = $self->_get_config->{'core'};
352 return $href if $as_hash;
353 return $self->_hashref_to_module( $href );
356 sub _hashref_to_module {
359 my $href = shift or return;
362 CPANPLUS::Selfupdate::Module->new(
363 $cb->module_tree($_) => $href->{$_}
369 =head1 CPANPLUS::Selfupdate::Module
371 C<CPANPLUS::Selfupdate::Module> extends C<CPANPLUS::Module> objects
372 by providing accessors to aid in selfupdating CPANPLUS.
374 These objects are returned by all methods of C<CPANPLUS::Selfupdate>
375 that return module objects.
379 { package CPANPLUS::Selfupdate::Module;
380 use base 'CPANPLUS::Module';
382 ### stores module name -> cpanplus required version
383 ### XXX only can deal with 1 pair!
385 my $Acc = 'version_required';
389 my $mod = shift or return;
390 my $ver = shift; return unless defined $ver;
392 my $obj = $mod->clone; # clone the module object
393 bless $obj, $class; # rebless it to our class
400 =head2 $version = $mod->version_required
402 Returns the version of this module required for CPANPLUS.
406 sub version_required {
408 $Cache{ $self->name } = shift() if @_;
409 return $Cache{ $self->name };
412 =head2 $bool = $mod->is_installed_version_sufficient
414 Returns true if the installed version of this module is sufficient
415 for CPANPLUS, or false if it is not.
420 sub is_installed_version_sufficient {
422 return $self->is_uptodate( version => $self->$Acc );
433 Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
437 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
441 The CPAN++ interface (of which this module is a part of) is copyright (c)
442 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
444 This library is free software; you may redistribute and/or modify it
445 under the same terms as Perl itself.
450 # c-indentation-style: bsd
452 # indent-tabs-mode: nil
454 # vim: expandtab shiftwidth=4: