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