[p5sagit/p5-mst-13.2.git] / lib / CPANPLUS / Selfupdate.pm

package CPANPLUS::Selfupdate;

use strict;
use Params::Check               qw[check];
use IPC::Cmd                    qw[can_run];
use CPANPLUS::Error             qw[error msg];
use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';

use CPANPLUS::Internals::Constants;

$Params::Check::VERBOSE = 1;

=head1 NAME

CPANPLUS::Selfupdate

=head1 SYNOPSIS

    $su     = $cb->selfupdate_object;
    
    @feats  = $su->list_features;
    @feats  = $su->list_enabled_features;
    
    @mods   = map { $su->modules_for_feature( $_ ) } @feats;
    @mods   = $su->list_core_dependencies;
    @mods   = $su->list_core_modules;
    
    for ( @mods ) {
        print $_->name " should be version " . $_->version_required;
        print "Installed version is not uptodate!" 
            unless $_->is_installed_version_sufficient;
    }
    
    $ok     = $su->selfupdate( update => 'all', latest => 0 );

=cut

### a config has describing our deps etc
{

    my $Modules = {
        dependencies => {
            'File::Fetch'               => '0.13_02', # win32 file:// support
            'File::Spec'                => '0.82',
            'IPC::Cmd'                  => '0.36', # 5.6.2 compat: 2-arg open
            'Locale::Maketext::Simple'  => '0.01',
            'Log::Message'              => '0.01',
            'Module::Load'              => '0.10',
            'Module::Load::Conditional' => '0.18', # Better parsing: #23995,
                                                   # uses version.pm for <=>
            'version'                   => '0.73', # needed for M::L::C
                                                   # addresses #24630 and 
                                                   # #24675
                                                   # Address ~0 overflow issue
            'Params::Check'             => '0.22',
            'Package::Constants'        => '0.01',
            'Term::UI'                  => '0.05',
            'Test::Harness'             => '2.62', # due to bug #19505
                                                   # only 2.58 and 2.60 are bad
            'Test::More'                => '0.47', # to run our tests
            'Archive::Extract'          => '0.16', # ./Dir bug fix
            'Archive::Tar'              => '1.23',
            'IO::Zlib'                  => '1.04', # needed for Archive::Tar
            'Object::Accessor'          => '0.32', # overloaded stringification
            'Module::CoreList'          => '2.09',
            'Module::Pluggable'         => '2.4',
            'Module::Loaded'            => '0.01',
        },
    
        features => {
            # config_key_name => [
            #     sub { } to list module key/value pairs
            #     sub { } to check if feature is enabled
            # ]
            prefer_makefile => [
                sub {
                    my $cb = shift;
                    $cb->configure_object->get_conf('prefer_makefile') 
                        ? { }
                        : { 'CPANPLUS::Dist::Build' => '0.04'  };
                },
                sub { return 1 },   # always enabled
            ],            
            cpantest        => [
                {
                    'YAML::Tiny'     => '0.0',
                    'Test::Reporter' => '1.34',
                },
                sub { 
                    my $cb = shift;
                    return $cb->configure_object->get_conf('cpantest');
                },
            ],                
            dist_type => [
                sub { 
                    my $cb      = shift;
                    my $dist    = $cb->configure_object->get_conf('dist_type');
                    return { $dist => '0.0' } if $dist;
                    return;
                },            
                sub { 
                    my $cb = shift;
                    return $cb->configure_object->get_conf('dist_type');
                },
            ],

            md5 => [
                {
                    'Digest::MD5'   => '0.0',
                },            
                sub { 
                    my $cb = shift;
                    return $cb->configure_object->get_conf('md5');
                },
            ],
            shell => [
                sub { 
                    my $cb      = shift;
                    my $dist    = $cb->configure_object->get_conf('shell');
                    
                    ### we bundle these shells, so don't bother having a dep
                    ### on them... If we don't do this, CPAN.pm actually detects
                    ### a recursive dependency and breaks (see #26077).
                    ### This is not an issue for CPANPLUS itself, it handles
                    ### it smartly.
                    return if $dist eq SHELL_DEFAULT or $dist eq SHELL_CLASSIC;
                    return { $dist => '0.0' } if $dist;
                    return;
                },            
                sub { return 1 },
            ],                
            signature => [
                sub {
                    my $cb      = shift;
                    return {
                        'Module::Signature' => '0.06',
                    } if can_run('gpg');
                    ### leave this out -- Crypt::OpenPGP is fairly
                    ### painful to install, and broken on some platforms
                    ### so we'll just always fall back to gpg. It may
                    ### issue a warning or 2, but that's about it.
                    ### this change due to this ticket: #26914
                    # and $cb->configure_object->get_conf('prefer_bin');

                    return { 
                        'Crypt::OpenPGP'    => '0.0', 
                        'Module::Signature' => '0.06',
                    };
                },            
                sub {
                    my $cb = shift;
                    return $cb->configure_object->get_conf('signature');
                },
            ],
            storable => [
                { 'Storable' => '0.0' },         
                sub { 
                    my $cb = shift;
                    return $cb->configure_object->get_conf('storable');
                },
            ],
        },
        core => {
            'CPANPLUS' => '0.0',
        },
    };

    sub _get_config { return $Modules }
}

=head1 METHODS

=head2 $self = CPANPLUS::Selfupdate->new( $backend_object );

Sets up a new selfupdate object. Called automatically when
a new backend object is created.

=cut

sub new {
    my $class = shift;
    my $cb    = shift or return;
    return bless sub { $cb }, $class;
}    


{   ### cache to find the relevant modules
    my $cache = {
        core 
            => sub { my $self = shift;
                     core => [ $self->list_core_modules ]   },
 
        dependencies        
            => sub { my $self = shift;
                     dependencies => [ $self->list_core_dependencies ] },

        enabled_features    
            => sub { my $self = shift;
                     map { $_ => [ $self->modules_for_feature( $_ ) ] }
                        $self->list_enabled_features 
                   },
        features
            => sub { my $self = shift;
                     map { $_ => [ $self->modules_for_feature( $_ ) ] }
                        $self->list_features   
                   },
            ### make sure to do 'core' first, in case
            ### we are out of date ourselves
        all => [ qw|core dependencies enabled_features| ],
    };
    
    
=head2 @cat = $self->list_categories

Returns a list of categories that the C<selfupdate> method accepts.

See C<selfupdate> for details.

=cut

    sub list_categories { return sort keys %$cache }

=head2 %list = $self->list_modules_to_update( update => "core|dependencies|enabled_features|features|all", [latest => BOOL] )
    
List which modules C<selfupdate> would upgrade. You can update either 
the core (CPANPLUS itself), the core dependencies, all features you have
currently turned on, or all features available, or everything.

The C<latest> option determines whether it should update to the latest
version on CPAN, or if the minimal required version for CPANPLUS is
good enough.
    
Returns a hash of feature names and lists of module objects to be
upgraded based on the category you provided. For example:

    %list = $self->list_modules_to_update( update => 'core' );
    
Would return:

    ( core => [ $module_object_for_cpanplus ] );
    
=cut    
    
    sub list_modules_to_update {
        my $self = shift;
        my $cb   = $self->();
        my $conf = $cb->configure_object;
        my %hash = @_;
        
        my($type, $latest);
        my $tmpl = {
            update => { required => 1, store => \$type,
                         allow   => [ keys %$cache ], },
            latest => { default  => 0, store => \$latest, allow => BOOLEANS },                     
        };    
    
        {   local $Params::Check::ALLOW_UNKNOWN = 1;
            check( $tmpl, \%hash ) or return;
        }
    
        my $ref     = $cache->{$type};

        ### a list of ( feature1 => \@mods, feature2 => \@mods, etc )        
        my %list    = UNIVERSAL::isa( $ref, 'ARRAY' )
                            ? map { $cache->{$_}->( $self ) } @$ref
                            : $ref->( $self );

        ### filter based on whether we need the latest ones or not
        for my $aref ( values %list ) {              
              $aref = [ $latest 
                        ? grep { !$_->is_uptodate } @$aref
                        : grep { !$_->is_installed_version_sufficient } @$aref
                      ];
        }
        
        return %list;
    }
    
=head2 $bool = $self->selfupdate( update => "core|dependencies|enabled_features|features|all", [latest => BOOL, force => BOOL] )

Selfupdate CPANPLUS. You can update either the core (CPANPLUS itself),
the core dependencies, all features you have currently turned on, or
all features available, or everything.

The C<latest> option determines whether it should update to the latest
version on CPAN, or if the minimal required version for CPANPLUS is
good enough.

Returns true on success, false on error.

=cut

    sub selfupdate {
        my $self = shift;
        my $cb   = $self->();
        my $conf = $cb->configure_object;
        my %hash = @_;
    
        my $force;
        my $tmpl = {
            force  => { default => $conf->get_conf('force'), store => \$force },
        };    
    
        {   local $Params::Check::ALLOW_UNKNOWN = 1;
            check( $tmpl, \%hash ) or return;
        }
    
        my %list = $self->list_modules_to_update( %hash ) or return;

        ### just the modules please
        my @mods = map { @$_ } values %list;
        
        my $flag;
        for my $mod ( @mods ) {
            unless( $mod->install( force => $force ) ) {
                $flag++;
                error(loc("Failed to update module '%1'", $mod->name));
            }
        }
        
        return if $flag;
        return 1;
    }    

}

=head2 @features = $self->list_features

Returns a list of features that are supported by CPANPLUS.

=cut

sub list_features {
    my $self = shift;
    return keys %{ $self->_get_config->{'features'} };
}

=head2 @features = $self->list_enabled_features

Returns a list of features that are enabled in your current
CPANPLUS installation.

=cut

sub list_enabled_features {
    my $self = shift;
    my $cb   = $self->();
    
    my @enabled;
    for my $feat ( $self->list_features ) {
        my $ref = $self->_get_config->{'features'}->{$feat}->[1];
        push @enabled, $feat if $ref->($cb);
    }
    
    return @enabled;
}

=head2 @mods = $self->modules_for_feature( FEATURE [,AS_HASH] )

Returns a list of C<CPANPLUS::Selfupdate::Module> objects which 
represent the modules required to support this feature.

For a list of features, call the C<list_features> method.

If the C<AS_HASH> argument is provided, no module objects are
returned, but a hashref where the keys are names of the modules,
and values are their minimum versions.

=cut

sub modules_for_feature {
    my $self    = shift;
    my $feature = shift or return;
    my $as_hash = shift || 0;
    my $cb      = $self->();
    
    unless( exists $self->_get_config->{'features'}->{$feature} ) {
        error(loc("Unknown feature '%1'", $feature));
        return;
    }
    
    my $ref = $self->_get_config->{'features'}->{$feature}->[0];
    
    ### it's either a list of modules/versions or a subroutine that
    ### returns a list of modules/versions
    my $href = UNIVERSAL::isa( $ref, 'HASH' ) ? $ref : $ref->( $cb );
    
    return unless $href;    # nothing needed for the feature?

    return $href if $as_hash;
    return $self->_hashref_to_module( $href );
}


=head2 @mods = $self->list_core_dependencies( [AS_HASH] )

Returns a list of C<CPANPLUS::Selfupdate::Module> objects which 
represent the modules that comprise the core dependencies of CPANPLUS.

If the C<AS_HASH> argument is provided, no module objects are
returned, but a hashref where the keys are names of the modules,
and values are their minimum versions.

=cut

sub list_core_dependencies {
    my $self    = shift;
    my $as_hash = shift || 0;
    my $cb      = $self->();
    my $href    = $self->_get_config->{'dependencies'};

    return $href if $as_hash;
    return $self->_hashref_to_module( $href );
}

=head2 @mods = $self->list_core_modules( [AS_HASH] )

Returns a list of C<CPANPLUS::Selfupdate::Module> objects which 
represent the modules that comprise the core of CPANPLUS.

If the C<AS_HASH> argument is provided, no module objects are
returned, but a hashref where the keys are names of the modules,
and values are their minimum versions.

=cut

sub list_core_modules {
    my $self    = shift;
    my $as_hash = shift || 0;
    my $cb      = $self->();
    my $href    = $self->_get_config->{'core'};

    return $href if $as_hash;
    return $self->_hashref_to_module( $href );
}

sub _hashref_to_module {
    my $self = shift;
    my $cb   = $self->();
    my $href = shift or return;
    
    return map { 
            CPANPLUS::Selfupdate::Module->new(
                $cb->module_tree($_) => $href->{$_}
            )
        } keys %$href;
}        
    

=head1 CPANPLUS::Selfupdate::Module

C<CPANPLUS::Selfupdate::Module> extends C<CPANPLUS::Module> objects
by providing accessors to aid in selfupdating CPANPLUS.

These objects are returned by all methods of C<CPANPLUS::Selfupdate>
that return module objects.

=cut

{   package CPANPLUS::Selfupdate::Module;
    use base 'CPANPLUS::Module';
    
    ### stores module name -> cpanplus required version
    ### XXX only can deal with 1 pair!
    my %Cache = ();
    my $Acc   = 'version_required';
    
    sub new {
        my $class = shift;
        my $mod   = shift or return;
        my $ver   = shift;          return unless defined $ver;
        
        my $obj   = $mod->clone;    # clone the module object
        bless $obj, $class;         # rebless it to our class
        
        $obj->$Acc( $ver );
        
        return $obj;
    }

=head2 $version = $mod->version_required

Returns the version of this module required for CPANPLUS.

=cut
    
    sub version_required {
        my $self = shift;
        $Cache{ $self->name } = shift() if @_;
        return $Cache{ $self->name };
    }        

=head2 $bool = $mod->is_installed_version_sufficient

Returns true if the installed version of this module is sufficient
for CPANPLUS, or false if it is not.

=cut

    
    sub is_installed_version_sufficient {
        my $self = shift;
        return $self->is_uptodate( version => $self->$Acc );
    }

}    

1;

=pod

=head1 BUG REPORTS

Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.

=head1 AUTHOR

This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.

=head1 COPYRIGHT

The CPAN++ interface (of which this module is a part of) is copyright (c) 
2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.

This library is free software; you may redistribute and/or modify it 
under the same terms as Perl itself.

=cut

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4:
Commit	Line	Data
6aaee015	1	package CPANPLUS::Selfupdate;
	2
	3	use strict;
	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';
	8
	9	use CPANPLUS::Internals::Constants;
	10
	11	$Params::Check::VERBOSE = 1;
	12
	13	=head1 NAME
	14
	15	CPANPLUS::Selfupdate
	16
	17	=head1 SYNOPSIS
	18
	19	$su = $cb->selfupdate_object;
	20
	21	@feats = $su->list_features;
	22	@feats = $su->list_enabled_features;
	23
	24	@mods = map { $su->modules_for_feature( $_ ) } @feats;
	25	@mods = $su->list_core_dependencies;
	26	@mods = $su->list_core_modules;
	27
	28	for ( @mods ) {
	29	print $_->name " should be version " . $_->version_required;
	30	print "Installed version is not uptodate!"
	31	unless $_->is_installed_version_sufficient;
	32	}
	33
	34	$ok = $su->selfupdate( update => 'all', latest => 0 );
	35
	36	=cut
	37
	38	### a config has describing our deps etc
	39	{
	40
	41	my $Modules = {
	42	dependencies => {
5879cbe1	43	'File::Fetch' => '0.13_02', # win32 file:// support
6aaee015	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',
5bc5f6dc	49	'Module::Load::Conditional' => '0.18', # Better parsing: #23995,
5bc5f6dc	50	# uses version.pm for <=>
5879cbe1	51	'version' => '0.73', # needed for M::L::C
6aaee015	52	# addresses #24630 and
6aaee015	53	# #24675
5879cbe1	54	# Address ~0 overflow issue
6aaee015	55	'Params::Check' => '0.22',
	56	'Package::Constants' => '0.01',
	57	'Term::UI' => '0.05',
	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',
	68	},
	69
	70	features => {
	71	# config_key_name => [
	72	# sub { } to list module key/value pairs
	73	# sub { } to check if feature is enabled
	74	# ]
	75	prefer_makefile => [
	76	sub {
	77	my $cb = shift;
	78	$cb->configure_object->get_conf('prefer_makefile')
	79	? { }
	80	: { 'CPANPLUS::Dist::Build' => '0.04' };
	81	},
	82	sub { return 1 }, # always enabled
	83	],
	84	cpantest => [
	85	{
5bc5f6dc	86	'YAML::Tiny' => '0.0',
5bc5f6dc	87	'Test::Reporter' => '1.34',
6aaee015	88	},
	89	sub {
	90	my $cb = shift;
	91	return $cb->configure_object->get_conf('cpantest');
	92	},
	93	],
	94	dist_type => [
	95	sub {
	96	my $cb = shift;
	97	my $dist = $cb->configure_object->get_conf('dist_type');
	98	return { $dist => '0.0' } if $dist;
	99	return;
	100	},
	101	sub {
	102	my $cb = shift;
	103	return $cb->configure_object->get_conf('dist_type');
	104	},
	105	],
	106
	107	md5 => [
	108	{
	109	'Digest::MD5' => '0.0',
	110	},
	111	sub {
	112	my $cb = shift;
	113	return $cb->configure_object->get_conf('md5');
	114	},
	115	],
	116	shell => [
	117	sub {
	118	my $cb = shift;
	119	my $dist = $cb->configure_object->get_conf('shell');
494f1016	120
	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
	125	### it smartly.
	126	return if $dist eq SHELL_DEFAULT or $dist eq SHELL_CLASSIC;
6aaee015	127	return { $dist => '0.0' } if $dist;
	128	return;
	129	},
	130	sub { return 1 },
	131	],
	132	signature => [
	133	sub {
	134	my $cb = shift;
502c7995	135	return {
	136	'Module::Signature' => '0.06',
	137	} 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
	145	return {
	146	'Crypt::OpenPGP' => '0.0',
	147	'Module::Signature' => '0.06',
	148	};
6aaee015	149	},
e3b7d412	150	sub {
6aaee015	151	my $cb = shift;
	152	return $cb->configure_object->get_conf('signature');
	153	},
	154	],
	155	storable => [
	156	{ 'Storable' => '0.0' },
	157	sub {
	158	my $cb = shift;
	159	return $cb->configure_object->get_conf('storable');
	160	},
	161	],
	162	},
	163	core => {
	164	'CPANPLUS' => '0.0',
	165	},
	166	};
	167
	168	sub _get_config { return $Modules }
	169	}
	170
	171	=head1 METHODS
	172
	173	=head2 $self = CPANPLUS::Selfupdate->new( $backend_object );
	174
	175	Sets up a new selfupdate object. Called automatically when
	176	a new backend object is created.
	177
	178	=cut
	179
	180	sub new {
	181	my $class = shift;
	182	my $cb = shift or return;
	183	return bless sub { $cb }, $class;
	184	}
	185
	186
622d31ac	187	{ ### cache to find the relevant modules
	188	my $cache = {
	189	core
	190	=> sub { my $self = shift;
	191	core => [ $self->list_core_modules ] },
	192
	193	dependencies
	194	=> sub { my $self = shift;
	195	dependencies => [ $self->list_core_dependencies ] },
	196
	197	enabled_features
	198	=> sub { my $self = shift;
	199	map { $_ => [ $self->modules_for_feature( $_ ) ] }
	200	$self->list_enabled_features
	201	},
	202	features
	203	=> sub { my $self = shift;
	204	map { $_ => [ $self->modules_for_feature( $_ ) ] }
	205	$self->list_features
	206	},
	207	### make sure to do 'core' first, in case
	208	### we are out of date ourselves
	209	all => [ qw\|core dependencies enabled_features\| ],
	210	};
	211
	212
	213	=head2 @cat = $self->list_categories
	214
	215	Returns a list of categories that the C<selfupdate> method accepts.
	216
	217	See C<selfupdate> for details.
	218
	219	=cut
	220
	221	sub list_categories { return sort keys %$cache }
	222
	223	=head2 %list = $self->list_modules_to_update( update => "core\|dependencies\|enabled_features\|features\|all", [latest => BOOL] )
	224
	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.
	228
	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
	231	good enough.
	232
	233	Returns a hash of feature names and lists of module objects to be
	234	upgraded based on the category you provided. For example:
	235
	236	%list = $self->list_modules_to_update( update => 'core' );
	237
	238	Would return:
	239
	240	( core => [ $module_object_for_cpanplus ] );
	241
	242	=cut
	243
	244	sub list_modules_to_update {
	245	my $self = shift;
	246	my $cb = $self->();
	247	my $conf = $cb->configure_object;
	248	my %hash = @_;
	249
	250	my($type, $latest);
251	my $tmpl = {
252	update => { required => 1, store => \$type,
253	allow => [ keys %$cache ], },
254	latest => { default => 0, store => \$latest, allow => BOOLEANS },
255	};
256
257	{ local $Params::Check::ALLOW_UNKNOWN = 1;
258	check( $tmpl, \%hash ) or return;
259	}
260
261	my $ref = $cache->{$type};
6aaee015	262
622d31ac	263	### a list of ( feature1 => \@mods, feature2 => \@mods, etc )
	264	my %list = UNIVERSAL::isa( $ref, 'ARRAY' )
	265	? map { $cache->{$_}->( $self ) } @$ref
	266	: $ref->( $self );
	267
	268	### filter based on whether we need the latest ones or not
	269	for my $aref ( values %list ) {
	270	$aref = [ $latest
	271	? grep { !$_->is_uptodate } @$aref
	272	: grep { !$_->is_installed_version_sufficient } @$aref
	273	];
	274	}
	275
	276	return %list;
	277	}
	278
	279	=head2 $bool = $self->selfupdate( update => "core\|dependencies\|enabled_features\|features\|all", [latest => BOOL, force => BOOL] )
6aaee015	280
	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.
	284
	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
	287	good enough.
	288
	289	Returns true on success, false on error.
	290
	291	=cut
	292
622d31ac	293	sub selfupdate {
	294	my $self = shift;
	295	my $cb = $self->();
	296	my $conf = $cb->configure_object;
	297	my %hash = @_;
6aaee015	298
622d31ac	299	my $force;
	300	my $tmpl = {
	301	force => { default => $conf->get_conf('force'), store => \$force },
	302	};
6aaee015	303
622d31ac	304	{ local $Params::Check::ALLOW_UNKNOWN = 1;
622d31ac	305	check( $tmpl, \%hash ) or return;
6aaee015	306	}
6aaee015	307
622d31ac	308	my %list = $self->list_modules_to_update( %hash ) or return;
	309
	310	### just the modules please
	311	my @mods = map { @$_ } values %list;
	312
	313	my $flag;
	314	for my $mod ( @mods ) {
	315	unless( $mod->install( force => $force ) ) {
	316	$flag++;
	317	error(loc("Failed to update module '%1'", $mod->name));
	318	}
	319	}
	320
	321	return if $flag;
	322	return 1;
	323	}
	324
	325	}
6aaee015	326
	327	=head2 @features = $self->list_features
	328
	329	Returns a list of features that are supported by CPANPLUS.
	330
	331	=cut
	332
	333	sub list_features {
	334	my $self = shift;
	335	return keys %{ $self->_get_config->{'features'} };
	336	}
	337
	338	=head2 @features = $self->list_enabled_features
	339
	340	Returns a list of features that are enabled in your current
	341	CPANPLUS installation.
	342
	343	=cut
	344
	345	sub list_enabled_features {
	346	my $self = shift;
	347	my $cb = $self->();
	348
	349	my @enabled;
	350	for my $feat ( $self->list_features ) {
	351	my $ref = $self->_get_config->{'features'}->{$feat}->[1];
	352	push @enabled, $feat if $ref->($cb);
	353	}
	354
	355	return @enabled;
	356	}
	357
	358	=head2 @mods = $self->modules_for_feature( FEATURE [,AS_HASH] )
	359
	360	Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
	361	represent the modules required to support this feature.
	362
	363	For a list of features, call the C<list_features> method.
	364
	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.
	368
	369	=cut
	370
	371	sub modules_for_feature {
	372	my $self = shift;
	373	my $feature = shift or return;
	374	my $as_hash = shift \|\| 0;
	375	my $cb = $self->();
	376
	377	unless( exists $self->_get_config->{'features'}->{$feature} ) {
	378	error(loc("Unknown feature '%1'", $feature));
	379	return;
	380	}
	381
	382	my $ref = $self->_get_config->{'features'}->{$feature}->[0];
	383
	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 );
	387
	388	return unless $href; # nothing needed for the feature?
	389
390	return $href if $as_hash;
391	return $self->_hashref_to_module( $href );
392	}
393
394
395	=head2 @mods = $self->list_core_dependencies( [AS_HASH] )
396
397	Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
398	represent the modules that comprise the core dependencies of CPANPLUS.
399
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.
403
404	=cut
405
406	sub list_core_dependencies {
407	my $self = shift;
408	my $as_hash = shift \|\| 0;
409	my $cb = $self->();
410	my $href = $self->_get_config->{'dependencies'};
411
412	return $href if $as_hash;
413	return $self->_hashref_to_module( $href );
414	}
415
416	=head2 @mods = $self->list_core_modules( [AS_HASH] )
417
418	Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
419	represent the modules that comprise the core of CPANPLUS.
420
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.
424
425	=cut
426
427	sub list_core_modules {
428	my $self = shift;
429	my $as_hash = shift \|\| 0;
430	my $cb = $self->();
431	my $href = $self->_get_config->{'core'};
432
433	return $href if $as_hash;
434	return $self->_hashref_to_module( $href );
435	}
436
437	sub _hashref_to_module {
438	my $self = shift;
439	my $cb = $self->();
440	my $href = shift or return;
441
442	return map {
443	CPANPLUS::Selfupdate::Module->new(
444	$cb->module_tree($_) => $href->{$_}
445	)
446	} keys %$href;
447	}
448
449
450	=head1 CPANPLUS::Selfupdate::Module
451
452	C<CPANPLUS::Selfupdate::Module> extends C<CPANPLUS::Module> objects
453	by providing accessors to aid in selfupdating CPANPLUS.
454
455	These objects are returned by all methods of C<CPANPLUS::Selfupdate>
456	that return module objects.
457
458	=cut
459
460	{ package CPANPLUS::Selfupdate::Module;
461	use base 'CPANPLUS::Module';
462
463	### stores module name -> cpanplus required version
464	### XXX only can deal with 1 pair!
465	my %Cache = ();
466	my $Acc = 'version_required';
467
468	sub new {
469	my $class = shift;
470	my $mod = shift or return;
471	my $ver = shift; return unless defined $ver;
472
473	my $obj = $mod->clone; # clone the module object
474	bless $obj, $class; # rebless it to our class
475
476	$obj->$Acc( $ver );
477
478	return $obj;
479	}
480
481	=head2 $version = $mod->version_required
482
483	Returns the version of this module required for CPANPLUS.
484
485	=cut
486
487	sub version_required {
488	my $self = shift;
489	$Cache{ $self->name } = shift() if @_;
490	return $Cache{ $self->name };
491	}
492
493	=head2 $bool = $mod->is_installed_version_sufficient
494
495	Returns true if the installed version of this module is sufficient
496	for CPANPLUS, or false if it is not.
497
498	=cut
499
500
501	sub is_installed_version_sufficient {
502	my $self = shift;
503	return $self->is_uptodate( version => $self->$Acc );
504	}
505
506	}
507
508	1;
509
510	=pod
511
512	=head1 BUG REPORTS
513
514	Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
515
516	=head1 AUTHOR
517
518	This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
519
520	=head1 COPYRIGHT
521
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.
524
525	This library is free software; you may redistribute and/or modify it
526	under the same terms as Perl itself.
527
528	=cut
529
530	# Local variables:
531	# c-indentation-style: bsd
532	# c-basic-offset: 4
533	# indent-tabs-mode: nil
534	# End:
535	# vim: expandtab shiftwidth=4: