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