[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;
}    


=head2 $bool = $self->selfupdate( update => "core|dependencies|enabled_features|features|all", latest => 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 = @_;

    ### cache to find the relevant modules
    my $cache = {
        core                => sub { $self->list_core_modules               },
        dependencies        => sub { $self->list_core_dependencies          },
        enabled_features    => sub { map { $self->modules_for_feature( $_ ) }
                                        $self->list_enabled_features   
                                },
        features            => sub { 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| ],
    };
    
    my($type, $latest, $force);
    my $tmpl = {
        update  => { required => 1, store => \$type,
                     allow    => [ keys %$cache ],  },
        latest  => { default  => 0, store => \$latest,    allow => BOOLEANS },                     
        force   => { default => $conf->get_conf('force'), store => \$force },
    };
        
    check( $tmpl, \%hash ) or return;
    
    my $ref     = $cache->{$type};
    my @mods    = UNIVERSAL::isa( $ref, 'ARRAY' )
                    ? map { $cache->{$_}->() } @$ref
                    : $ref->();
    
    ### do we need the latest versions?
    @mods       = $latest 
                    ? @mods 
                    : grep { !$_->is_installed_version_sufficient } @mods;
    
    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
	183
	184	=head2 $bool = $self->selfupdate( update => "core\|dependencies\|enabled_features\|features\|all", latest => BOOL )
	185
	186	Selfupdate CPANPLUS. You can update either the core (CPANPLUS itself),
	187	the core dependencies, all features you have currently turned on, or
	188	all features available, or everything.
	189
	190	The C<latest> option determines whether it should update to the latest
	191	version on CPAN, or if the minimal required version for CPANPLUS is
	192	good enough.
	193
	194	Returns true on success, false on error.
	195
	196	=cut
	197
	198	sub selfupdate {
	199	my $self = shift;
	200	my $cb = $self->();
	201	my $conf = $cb->configure_object;
	202	my %hash = @_;
	203
	204	### cache to find the relevant modules
	205	my $cache = {
	206	core => sub { $self->list_core_modules },
	207	dependencies => sub { $self->list_core_dependencies },
	208	enabled_features => sub { map { $self->modules_for_feature( $_ ) }
	209	$self->list_enabled_features
	210	},
211	features => sub { map { $self->modules_for_feature( $_ ) }
212	$self->list_features
213	},
214	### make sure to do 'core' first, in case
215	### we are out of date ourselves
216	all => [ qw\|core dependencies enabled_features\| ],
217	};
218
219	my($type, $latest, $force);
220	my $tmpl = {
221	update => { required => 1, store => \$type,
222	allow => [ keys %$cache ], },
223	latest => { default => 0, store => \$latest, allow => BOOLEANS },
224	force => { default => $conf->get_conf('force'), store => \$force },
225	};
e3b7d412	226
6aaee015	227	check( $tmpl, \%hash ) or return;
	228
	229	my $ref = $cache->{$type};
	230	my @mods = UNIVERSAL::isa( $ref, 'ARRAY' )
	231	? map { $cache->{$_}->() } @$ref
	232	: $ref->();
	233
	234	### do we need the latest versions?
	235	@mods = $latest
	236	? @mods
e3b7d412	237	: grep { !$_->is_installed_version_sufficient } @mods;
6aaee015	238
	239	my $flag;
	240	for my $mod ( @mods ) {
	241	unless( $mod->install( force => $force ) ) {
	242	$flag++;
	243	error(loc("Failed to update module '%1'", $mod->name));
	244	}
	245	}
	246
	247	return if $flag;
	248	return 1;
	249	}
	250
	251	=head2 @features = $self->list_features
	252
	253	Returns a list of features that are supported by CPANPLUS.
	254
	255	=cut
	256
	257	sub list_features {
	258	my $self = shift;
	259	return keys %{ $self->_get_config->{'features'} };
	260	}
	261
	262	=head2 @features = $self->list_enabled_features
	263
	264	Returns a list of features that are enabled in your current
	265	CPANPLUS installation.
	266
	267	=cut
	268
	269	sub list_enabled_features {
	270	my $self = shift;
	271	my $cb = $self->();
	272
	273	my @enabled;
	274	for my $feat ( $self->list_features ) {
	275	my $ref = $self->_get_config->{'features'}->{$feat}->[1];
	276	push @enabled, $feat if $ref->($cb);
	277	}
	278
	279	return @enabled;
	280	}
	281
	282	=head2 @mods = $self->modules_for_feature( FEATURE [,AS_HASH] )
	283
	284	Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
	285	represent the modules required to support this feature.
	286
	287	For a list of features, call the C<list_features> method.
	288
	289	If the C<AS_HASH> argument is provided, no module objects are
	290	returned, but a hashref where the keys are names of the modules,
	291	and values are their minimum versions.
	292
	293	=cut
	294
	295	sub modules_for_feature {
	296	my $self = shift;
	297	my $feature = shift or return;
	298	my $as_hash = shift \|\| 0;
	299	my $cb = $self->();
	300
	301	unless( exists $self->_get_config->{'features'}->{$feature} ) {
302	error(loc("Unknown feature '%1'", $feature));
303	return;
304	}
305
306	my $ref = $self->_get_config->{'features'}->{$feature}->[0];
307
308	### it's either a list of modules/versions or a subroutine that
309	### returns a list of modules/versions
310	my $href = UNIVERSAL::isa( $ref, 'HASH' ) ? $ref : $ref->( $cb );
311
312	return unless $href; # nothing needed for the feature?
313
314	return $href if $as_hash;
315	return $self->_hashref_to_module( $href );
316	}
317
318
319	=head2 @mods = $self->list_core_dependencies( [AS_HASH] )
320
321	Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
322	represent the modules that comprise the core dependencies of CPANPLUS.
323
324	If the C<AS_HASH> argument is provided, no module objects are
325	returned, but a hashref where the keys are names of the modules,
326	and values are their minimum versions.
327
328	=cut
329
330	sub list_core_dependencies {
331	my $self = shift;
332	my $as_hash = shift \|\| 0;
333	my $cb = $self->();
334	my $href = $self->_get_config->{'dependencies'};
335
336	return $href if $as_hash;
337	return $self->_hashref_to_module( $href );
338	}
339
340	=head2 @mods = $self->list_core_modules( [AS_HASH] )
341
342	Returns a list of C<CPANPLUS::Selfupdate::Module> objects which
343	represent the modules that comprise the core of CPANPLUS.
344
345	If the C<AS_HASH> argument is provided, no module objects are
346	returned, but a hashref where the keys are names of the modules,
347	and values are their minimum versions.
348
349	=cut
350
351	sub list_core_modules {
352	my $self = shift;
353	my $as_hash = shift \|\| 0;
354	my $cb = $self->();
355	my $href = $self->_get_config->{'core'};
356
357	return $href if $as_hash;
358	return $self->_hashref_to_module( $href );
359	}
360
361	sub _hashref_to_module {
362	my $self = shift;
363	my $cb = $self->();
364	my $href = shift or return;
365
366	return map {
367	CPANPLUS::Selfupdate::Module->new(
368	$cb->module_tree($_) => $href->{$_}
369	)
370	} keys %$href;
371	}
372
373
374	=head1 CPANPLUS::Selfupdate::Module
375
376	C<CPANPLUS::Selfupdate::Module> extends C<CPANPLUS::Module> objects
377	by providing accessors to aid in selfupdating CPANPLUS.
378
379	These objects are returned by all methods of C<CPANPLUS::Selfupdate>
380	that return module objects.
381
382	=cut
383
384	{ package CPANPLUS::Selfupdate::Module;
385	use base 'CPANPLUS::Module';
386
387	### stores module name -> cpanplus required version
388	### XXX only can deal with 1 pair!
389	my %Cache = ();
390	my $Acc = 'version_required';
391
392	sub new {
393	my $class = shift;
394	my $mod = shift or return;
395	my $ver = shift; return unless defined $ver;
396
397	my $obj = $mod->clone; # clone the module object
398	bless $obj, $class; # rebless it to our class
399
400	$obj->$Acc( $ver );
401
402	return $obj;
403	}
404
405	=head2 $version = $mod->version_required
406
407	Returns the version of this module required for CPANPLUS.
408
409	=cut
410
411	sub version_required {
412	my $self = shift;
413	$Cache{ $self->name } = shift() if @_;
414	return $Cache{ $self->name };
415	}
416
417	=head2 $bool = $mod->is_installed_version_sufficient
418
419	Returns true if the installed version of this module is sufficient
420	for CPANPLUS, or false if it is not.
421
422	=cut
423
424
425	sub is_installed_version_sufficient {
426	my $self = shift;
427	return $self->is_uptodate( version => $self->$Acc );
428	}
429
430	}
431
432	1;
433
434	=pod
435
436	=head1 BUG REPORTS
437
438	Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
439
440	=head1 AUTHOR
441
442	This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
443
444	=head1 COPYRIGHT
445
446	The CPAN++ interface (of which this module is a part of) is copyright (c)
447	2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
448
449	This library is free software; you may redistribute and/or modify it
450	under the same terms as Perl itself.
451
452	=cut
453
454	# Local variables:
455	# c-indentation-style: bsd
456	# c-basic-offset: 4
457	# indent-tabs-mode: nil
458	# End:
459	# vim: expandtab shiftwidth=4: