use vars qw( @EXPORT @ISA $VERSION );
@EXPORT = qw( shell fetch get install );
@ISA = qw( Exporter );
- $VERSION = "0.79_02"; #have to hardcode or cpan.org gets unhappy
+ $VERSION = "0.79_03"; #have to hardcode or cpan.org gets unhappy
}
### purely for backward compatibility, so we can call it from the commandline:
use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
use Module::Load::Conditional qw[check_install];
+
+=pod
+
+=head1 NAME
+
+CPANPLUS::Config
+
+=head1 DESCRIPTION
+
+This module contains defaults and heuristics for configuration
+information for CPANPLUS. To change any of these values, please
+see the documentation in C<CPANPLUS::Configure>.
+
+Below you'll find a list of configuration types and keys, and
+their meaning.
+
+=head1 CONFIGURATION
+
+=cut
+
+### BAH! you can't have POD interleaved with a hash
+### declaration.. so declare every entry seperatedly :(
my $Conf = {
'_fetch' => {
'blacklist' => [ 'ftp' ],
},
- 'conf' => {
- ### default host list
- 'hosts' => [
+
+ ### _source, _build and _mirror are supposed to be static
+ ### no changes should be needed unless pause/cpan changes
+ '_source' => {
+ 'hosts' => 'MIRRORED.BY',
+ 'auth' => '01mailrc.txt.gz',
+ 'stored' => 'sourcefiles',
+ 'dslip' => '03modlist.data.gz',
+ 'update' => '86400',
+ 'mod' => '02packages.details.txt.gz'
+ },
+ '_build' => {
+ 'plugins' => 'plugins',
+ 'moddir' => 'build',
+ 'startdir' => '',
+ 'distdir' => 'dist',
+ 'autobundle' => 'autobundle',
+ 'autobundle_prefix' => 'Snapshot',
+ 'autdir' => 'authors',
+ 'install_log_dir' => 'install-logs',
+ 'sanity_check' => 1,
+ },
+ '_mirror' => {
+ 'base' => 'authors/id/',
+ 'auth' => 'authors/01mailrc.txt.gz',
+ 'dslip' => 'modules/03modlist.data.gz',
+ 'mod' => 'modules/02packages.details.txt.gz'
+ },
+};
+
+=head2 Section 'conf'
+
+=over 4
+
+=item hosts
+
+An array ref containing hosts entries to be queried for packages.
+
+An example entry would like this:
+
+ { 'scheme' => 'ftp',
+ 'path' => '/pub/CPAN/',
+ 'host' => 'ftp.cpan.org'
+ },
+
+=cut
+
+ ### default host list
+ $Conf->{'conf'}->{'hosts'} = [
{
'scheme' => 'ftp',
'path' => '/pub/CPAN/',
'path' => '/pub/languages/perl/CPAN/',
'host' => 'ftp.funet.fi'
}
- ],
- 'allow_build_interactivity' => 1,
- 'base' => File::Spec->catdir(
- __PACKAGE__->_home_dir, DOT_CPANPLUS ),
- 'buildflags' => '',
- 'cpantest' => 0,
- 'cpantest_mx' => '',
- 'debug' => 0,
- 'dist_type' => '',
- 'email' => DEFAULT_EMAIL,
- 'extractdir' => '',
- 'fetchdir' => '',
- 'flush' => 1,
- 'force' => 0,
- 'lib' => [],
- 'makeflags' => '',
- 'makemakerflags' => '',
- 'md5' => (
- check_install( module => 'Digest::MD5' ) ? 1 : 0 ),
- 'no_update' => 0,
- 'passive' => 1,
+ ];
+
+=item allow_build_interactivity
+
+Boolean flag to indicate whether 'perl Makefile.PL' and similar
+are run interactively or not. Defaults to 'true'.
+
+=cut
+
+ $Conf->{'conf'}->{'allow_build_interactivity'} = 1;
+
+=item base
+
+The directory CPANPLUS keeps all it's build and state information in.
+Defaults to ~/.cpanplus.
+
+=cut
+
+ $Conf->{'conf'}->{'base'} = File::Spec->catdir(
+ __PACKAGE__->_home_dir, DOT_CPANPLUS );
+
+=item buildflags
+
+Any flags to be passed to 'perl Build.PL'. See C<perldoc Module::Build>
+for details. Defaults to an empty string.
+
+=cut
+
+ $Conf->{'conf'}->{'buildflags'} = '';
+
+=item cpantest
+
+Boolean flag to indicate whether or not to mail test results of module
+installations to C<http://testers.cpan.org>. Defaults to 'false'.
+
+=cut
+
+ $Conf->{'conf'}->{'cpantest'} = 0;
+
+=item cpantest_mx
+
+String holding an explicit mailserver to use when sending out emails
+for C<http://testers.cpan.org>. An empty string will use your system
+settings. Defaults to an empty string.
+
+=cut
+
+ $Conf->{'conf'}->{'cpantest_mx'} = '';
+
+=item debug
+
+Boolean flag to enable or disable extensive debuggging information.
+Defaults to 'false'.
+
+=cut
+
+ $Conf->{'conf'}->{'debug'} = 0;
+
+=item dist_type
+
+Default distribution type to use when building packages. See C<cpan2dist>
+or C<CPANPLUS::Dist> for details. An empty string will not use any
+package building software. Defaults to an empty string.
+
+=cut
+
+ $Conf->{'conf'}->{'dist_type'} = '';
+
+=item email
+
+Email address to use for anonymous ftp access and as C<from> address
+when sending emails. Defaults to an C<example.com> address.
+
+=cut
+
+ $Conf->{'conf'}->{'email'} = DEFAULT_EMAIL;
+
+=item extractdir
+
+String containing the directory where fetched archives should be
+extracted. An empty string will use a directory under your C<base>
+directory. Defaults to an empty string.
+
+=cut
+
+ $Conf->{'conf'}->{'extractdir'} = '';
+
+=item fetchdir
+
+String containing the directory where fetched archives should be
+stored. An empty string will use a directory under your C<base>
+directory. Defaults to an empty string.
+
+=cut
+
+ $Conf->{'conf'}->{'fetchdir'} = '';
+
+=item flush
+
+Boolean indicating whether build failures, cache dirs etc should
+be flushed after every operation or not. Defaults to 'true'.
+
+=cut
+
+ $Conf->{'conf'}->{'flush'} = 1;
+
+=item force
+
+Boolean indicating whether files should be forcefully overwritten
+if they exist, modules should be installed when they fail tests,
+etc. Defaults to 'false'.
+
+=cut
+
+ $Conf->{'conf'}->{'force'} = 0;
+
+=item lib
+
+An array ref holding directories to be added to C<@INC> when CPANPLUS
+starts up. Defaults to an empty array reference.
+
+=cut
+
+ $Conf->{'conf'}->{'lib'} = [];
+
+=item makeflags
+
+A string holding flags that will be passed to the C<make> program
+when invoked. Defaults to an empty string.
+
+=cut
+
+ $Conf->{'conf'}->{'makeflags'} = '';
+
+=item makemakerflags
+
+A string holding flags that will be passed to C<perl Makefile.PL>
+when invoked. Defaults to an empty string.
+
+=cut
+
+ $Conf->{'conf'}->{'makemakerflags'} = '';
+
+=item md5
+
+A boolean indicating whether or not md5 checks should be done when
+an archive is fetched. Defaults to 'true' if you have C<Digest::MD5>
+installed, 'false' otherwise.
+
+=cut
+
+ $Conf->{'conf'}->{'md5'} = (
+ check_install( module => 'Digest::MD5' ) ? 1 : 0 );
+
+=item no_update
+
+A boolean indicating whether or not C<CPANPLUS>' source files should be
+updated or not. Defaults to 'false'.
+
+=cut
+
+ $Conf->{'conf'}->{'no_update'} = 0;
+
+=item passive
+
+A boolean indicating whether or not to use passive ftp connections.
+Defaults to 'true'.
+
+=cut
+
+ $Conf->{'conf'}->{'passive'} = 1;
+
+=item prefer_bin
+
+A boolean indicating whether or not to prefer command line programs
+over perl modules. Defaults to 'false' unless you do not have
+C<Compress::Zlib> installed (as that would mean we could not extract
+C<.tar.gz> files)
+
+=cut
### if we dont have c::zlib, we'll need to use /bin/tar or we
### can not extract any files. Good time to change the default
- 'prefer_bin' => (eval {require Compress::Zlib; 1}?0:1),
- 'prefer_makefile' => 1,
- 'prereqs' => PREREQ_ASK,
- 'shell' => 'CPANPLUS::Shell::Default',
- 'show_startup_tip' => 1,
- 'signature' => ( (can_run( 'gpg' ) ||
- check_install( module => 'Crypt::OpenPGP' ))?1:0 ),
- 'skiptest' => 0,
- 'storable' => (
- check_install( module => 'Storable' ) ? 1 : 0 ),
- 'timeout' => 300,
- 'verbose' => $ENV{PERL5_CPANPLUS_VERBOSE} || 0,
- 'write_install_logs' => 1,
- },
+ $Conf->{'conf'}->{'prefer_bin'} =
+ (eval {require Compress::Zlib; 1} ? 0 : 1 );
+
+=item prefer_makefile
+
+A boolean indicating whether or not prefer a C<Makefile.PL> over a
+C<Build.PL> file if both are present. Defaults to 'true'.
+
+=cut
+
+ $Conf->{'conf'}->{'prefer_makefile'} = 1;
+
+=item prereqs
+
+A digit indicating what to do when a package you are installing has a
+prerequisite. Options are:
+
+ 0 Do not install
+ 1 Install
+ 2 Ask
+ 3 Ignore (dangerous, install will probably fail!)
+
+The default is to ask.
+
+=cut
+
+ $Conf->{'conf'}->{'prereqs'} = PREREQ_ASK;
+
+=item shell
+
+A string holding the shell class you wish to start up when starting
+C<CPANPLUS> in interactive mode.
+
+Defaults to C<CPANPLUS::Shell::Default>, the default CPANPLUS shell.
+
+=cut
+
+ $Conf->{'conf'}->{'shell'} = 'CPANPLUS::Shell::Default';
+
+=item show_startup_tip
+
+A boolean indicating whether or not to show start up tips in the
+interactive shell. Defaults to 'true'.
+
+=cut
+
+ $Conf->{'conf'}->{'show_startup_tip'} = 1;
+
+=item signature
+
+A boolean indicating whether or not check signatures if packages are
+signed. Defaults to 'true' if you have C<gpg> or C<Crypt::OpenPGP>
+installed, 'false' otherwise.
+
+=cut
+
+ $Conf->{'conf'}->{'signature'} = do {
+ (can_run('gpg') || check_install(module => 'Crypt::OpenPGP')) ?1:0 };
+
+=item skiptest
+
+A boolean indicating whether or not to skip tests when installing modules.
+Defaults to 'false'.
+
+=cut
+
+ $Conf->{'conf'}->{'skiptest'} = 0;
+
+=item storable
+
+A boolean indicating whether or not to use C<Storable> to write compiled
+source file information to disk. This makes for faster startup and look
+up times, but takes extra diskspace. Defaults to 'true' if you have
+C<Storable> installed and 'false' if you don't.
+
+=cut
+
+ $Conf->{'conf'}->{'storable'} =
+ ( check_install( module => 'Storable' ) ? 1 : 0 );
+
+=item timeout
+
+Digit indicating the time before a fetch request times out (in seconds).
+Defaults to 300.
+
+=cut
+
+ $Conf->{'conf'}->{'timeout'} = 300;
+
+=item verbose
+
+A boolean indicating whether or not C<CPANPLUS> runs in verbose mode.
+Defaults to 'true' if you have the environment variable
+C<PERL5_CPANPLUS_VERBOSE> set to true, 'false' otherwise.
+
+It is recommended you run with verbose enabled, but it is disabled
+for historical reasons.
+
+=cut
+
+ $Conf->{'conf'}->{'verbose'} = $ENV{PERL5_CPANPLUS_VERBOSE} || 0;
+
+=item write_install_log
+
+A boolean indicating whether or not to write install logs after installing
+a module using the interactive shell. Defaults to 'true'.
+
+
+=cut
+
+ $Conf->{'conf'}->{'write_install_logs'} = 1;
+
+=back
+
+=head2 Section 'program'
+
+=cut
+
### Paths get stripped of whitespace on win32 in the constructor
### sudo gets emptied if there's no need for it in the constructor
- 'program' => {
- 'editor' => ( $ENV{'EDITOR'} || $ENV{'VISUAL'} ||
- can_run('vi') || can_run('pico')
- ),
- 'make' => ( can_run($Config{'make'}) || can_run('make') ),
- 'pager' => ( $ENV{'PAGER'} || can_run('less') || can_run('more') ),
+
+=over 4
+
+=item editor
+
+A string holding the path to your editor of choice. Defaults to your
+$ENV{EDITOR}, $ENV{VISIUAL}, 'vi' or 'pico' programs, in that order.
+
+=cut
+
+ $Conf->{'program'}->{'editor'} = do {
+ $ENV{'EDITOR'} || $ENV{'VISUAL'} ||
+ can_run('vi') || can_run('pico')
+ };
+
+=item make
+
+A string holding the path to your C<make> binary. Looks for the C<make>
+program used to build perl or failing that, a C<make> in your path.
+
+=cut
+
+ $Conf->{'program'}->{'make'} =
+ can_run($Config{'make'}) || can_run('make');
+
+=item pager
+
+A string holding the path to your pager of choice. Defaults to your
+$ENV{PAGER}, 'less' or 'more' programs, in that order.
+
+=cut
+
+ $Conf->{'program'}->{'pager'} =
+ $ENV{'PAGER'} || can_run('less') || can_run('more');
+
### no one uses this feature anyway, and it's only working for EU::MM
### and not for module::build
#'perl' => '',
- 'shell' => ( $^O eq 'MSWin32' ? $ENV{COMSPEC} : $ENV{SHELL} ),
- 'sudo' => ( $> # check for all install dirs!
- # installsiteman3dir is a 5.8'ism.. don't check
- # it on 5.6.x...
- ? ( -w $Config{'installsitelib'} &&
- ( defined $Config{'installsiteman3dir'} &&
- -w $Config{'installsiteman3dir'}
- ) &&
- -w $Config{'installsitebin'}
- ? undef
- : can_run('sudo')
- )
- : can_run('sudo')
- ),
+
+=item shell
+
+A string holding the path to your login shell of choice. Defaults to your
+$ENV{SHELL} setting, or $ENV{COMSPEC} on Windows.
+
+=cut
+
+ $Conf->{'program'}->{'shell'} = $^O eq 'MSWin32'
+ ? $ENV{COMSPEC}
+ : $ENV{SHELL};
+
+=item sudo
+
+A string holding the path to your C<sudo> binary if your install path
+requires super user permissions. Looks for C<sudo> in your path, or
+remains empty if you do not require super user permissiosn to install.
+
+=cut
+
+ $Conf->{'program'}->{'sudo'} = do {
+ $> # check for all install dirs!
+ # installsiteman3dir is a 5.8'ism.. don't check
+ # it on 5.6.x...
+ ? ( -w $Config{'installsitelib'} &&
+ ( defined $Config{'installsiteman3dir'} &&
+ -w $Config{'installsiteman3dir'}
+ ) &&
+ -w $Config{'installsitebin'}
+ ? undef
+ : can_run('sudo')
+ )
+ : can_run('sudo')
+ };
+
+=item perlwrapper
+
+A string holding the path to the C<cpanp-run-perl> utility bundled
+with CPANPLUS, which is used to enable autoflushing in spawned processes.
+
+=cut
+
### perlwrapper that allows us to turn on autoflushing
- 'perlwrapper' => sub{
+ $Conf->{'program'}->{'perlwrapper'} = sub {
my $name = 'cpanp-run-perl';
my @bins = do{
$name, 'perlwrapper'
));
return '';
- }->(),
- },
+ }->();
+
+=back
+
+=cut
- ### _source, _build and _mirror are supposed to be static
- ### no changes should be needed unless pause/cpan changes
- '_source' => {
- 'hosts' => 'MIRRORED.BY',
- 'auth' => '01mailrc.txt.gz',
- 'stored' => 'sourcefiles',
- 'dslip' => '03modlist.data.gz',
- 'update' => '86400',
- 'mod' => '02packages.details.txt.gz'
- },
- '_build' => {
- 'plugins' => 'plugins',
- 'moddir' => 'build',
- 'startdir' => '',
- 'distdir' => 'dist',
- 'autobundle' => 'autobundle',
- 'autobundle_prefix' => 'Snapshot',
- 'autdir' => 'authors',
- 'install_log_dir' => 'install-logs',
- 'sanity_check' => 1,
- },
- '_mirror' => {
- 'base' => 'authors/id/',
- 'auth' => 'authors/01mailrc.txt.gz',
- 'dslip' => 'modules/03modlist.data.gz',
- 'mod' => 'modules/02packages.details.txt.gz'
- },
-};
-
sub new {
my $class = shift;
my $obj = $class->SUPER::new;
for my $pgm ( $self->program->ls_accessors ) {
$self->program->$pgm(
Win32::GetShortPathName( $self->program->$pgm )
- ) if $self->program->$pgm =~ /\s+/;
+ ) if $self->program->$pgm and $self->program->$pgm =~ /\s+/;
}
}
}
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.
+
+=head1 SEE ALSO
+
+L<CPANPLUS::Backend>, L<CPANPLUS::Configure::Setup>, L<CPANPLUS::Configure>
+
+=cut
+
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4:
Accessors that start with a C<_> are marked private -- regular users
should never need to use these.
+See the C<CPANPLUS::Config> documentation for what items can be
+set and retrieved.
+
=head2 get_SOMETHING( ITEM, [ITEM, ITEM, ... ] );
The C<get_*> style accessors merely retrieves one or more desired
=head1 SEE ALSO
-L<CPANPLUS::Backend>, L<CPANPLUS::Configure::Setup>
+L<CPANPLUS::Backend>, L<CPANPLUS::Configure::Setup>, L<CPANPLUS::Config>
=cut
=cut
+=back
+
=head2 $dist = CPANPLUS::Dist->new( module => MODOBJ, [format => DIST_TYPE] );
Create a new C<CPANPLUS::Dist> object based on the provided C<MODOBJ>.
### send success on force...
$test_fail++;
- unless( $force ) {
+ if( !$force and !$cb->_callbacks->proceed_on_test_failure->(
+ $self, $captured )
+ ) {
$fail++; last RUN;
}
}
CPANPLUS::Internals::Report
];
-$VERSION = "0.79_02";
+$VERSION = "0.79_03";
=pod
=pod
+=back
+
=head1 METHODS
=head2 $internals = CPANPLUS::Internals->_init( _conf => CONFIG_OBJ )
### if extra callbacks are added, don't forget to update the
### 02-internals.t test script with them!
my $callback_map = {
- ### name default value
+ ### name default value
install_prerequisite => 1, # install prereqs when 'ask' is set?
edit_test_report => 0, # edit the prepared test report?
send_test_report => 1, # send the test report?
munge_test_report => sub { return $_[1] },
# filter out unwanted prereqs
filter_prereqs => sub { return $_[1] },
+ # continue if 'make test' fails?
+ proceed_on_test_failure => sub { return 0 },
};
my $status = Object::Accessor->new;
indicating true to edit the test report in an editor and false
to skip it.
+=item proceed_on_test_failure
+
+Is called when 'make test' or 'Build test' fails. Should return
+a boolean indicating whether the install should continue even if
+the test failed.
+
=back
=cut
use constant CONFIG => 'CPANPLUS::Config';
use constant CONFIG_USER => 'CPANPLUS::Config::User';
use constant CONFIG_SYSTEM => 'CPANPLUS::Config::System';
+use constant CONFIG_BOXED => 'CPANPLUS::Config::Boxed';
use constant TARGET_CREATE => 'create';
use constant TARGET_PREPARE => 'prepare';
.
$str .= join '',
- map { my $want = $prq->{$_->name};
-
- sprintf "\t%s %-30s %8s %8s\n",
- do { $_->is_uptodate(
+ map { sprintf "\t%s %-30s %8s %8s\n",
+ @$_
+
+ } [' ', 'Module Name', 'Have', 'Want'],
+ map { my $want = $prq->{$_->name};
+ [ do { $_->is_uptodate(
version => $want
) ? ' ' : '!'
- },
- $_->name,
- $_->installed_version,
- $want
-
+ },
+ $_->name,
+ $_->installed_version,
+ $want
+ ],
### might be empty entries in there
} grep { defined $_ } @prq;
}
+{ ### 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:
-=head2 $bool = $self->selfupdate( update => "core|dependencies|enabled_features|features|all", latest => BOOL )
+ %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
=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->();
+ sub selfupdate {
+ my $self = shift;
+ my $cb = $self->();
+ my $conf = $cb->configure_object;
+ my %hash = @_;
- ### do we need the latest versions?
- @mods = $latest
- ? @mods
- : grep { !$_->is_installed_version_sufficient } @mods;
+ my $force;
+ my $tmpl = {
+ force => { default => $conf->get_conf('force'), store => \$force },
+ };
- my $flag;
- for my $mod ( @mods ) {
- unless( $mod->install( force => $force ) ) {
- $flag++;
- error(loc("Failed to update module '%1'", $mod->name));
+ { local $Params::Check::ALLOW_UNKNOWN = 1;
+ check( $tmpl, \%hash ) or return;
}
- }
- return if $flag;
- return 1;
-}
+ 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
BEGIN {
use vars qw[ $VERSION @ISA ];
@ISA = qw[ CPANPLUS::Shell::_Base::ReadLine ];
- $VERSION = "0.79_02";
+ $VERSION = "0.79_03";
}
load CPANPLUS::Shell;
code => \&__ask_about_send_test_report,
);
+ $cb->_register_callback(
+ name => 'proceed_on_test_failure',
+ code => \&__ask_about_test_failure,
+ );
+
return $self;
}
my $status = {};
### first loop over the mods to install them ###
for my $mod (@$mods) {
- print $prompt, $mod->module, "\n";
+ print $prompt, $mod->module, " (".$mod->version.")", "\n";
my $log_length = length CPANPLUS::Error->stack_as_string;
return $bool;
}
+sub __ask_about_test_failure {
+ my $mod = shift;
+ my $captured = shift || '';
+ my $term = $Shell->term;
+
+ print "\n";
+ print loc( "The tests for '%1' failed. Would you like me to proceed ".
+ "anyway or should we abort?", $mod->module );
+ print "\n\n";
+
+ my $bool = $term->ask_yn(
+ prompt => loc("Proceed anyway?"),
+ default => 'n',
+ );
+
+ return $bool;
+}
sub _details {
### possible options
### XXX hard coded, not optimal :(
- my @types = qw[reconfigure save edit program conf mirrors selfupdate];
+ my %types = (
+ reconfigure => '',
+ save => q([user | system | boxed]),
+ edit => '',
+ program => q([key => val]),
+ conf => q([key => val]),
+ mirrors => '',
+ selfupdate => '', # XXX add all opts here?
+ );
my $args; my $opts; my $input;
my $where = {
user => CONFIG_USER,
system => CONFIG_SYSTEM,
+ boxed => CONFIG_BOXED,
}->{ $key } || CONFIG_USER;
- my $rv = $cb->configure_object->save( $where );
+ ### boxed is special, so let's get it's value from %INC
+ ### so we can tell it where to save
+ ### XXX perhaps this logic should be generic for all
+ ### types, and put in the ->save() routine
+ my $dir;
+ if( $where eq CONFIG_BOXED ) {
+ my $file = join( '/', split( '::', CONFIG_BOXED ) ) . '.pm';
+ my $file_re = quotemeta($file);
+
+ my $path = $INC{$file} || '';
+ $path =~ s/$file_re$//;
+ $dir = $path;
+ }
+
+ my $rv = $cb->configure_object->save( $where => $dir );
print $rv
- ? loc("Configuration successfully saved to %1\n", $where)
+ ? loc("Configuration successfully saved to %1\n (%2)\n",
+ $where, $rv)
: loc("Failed to save configuration\n" );
return $rv;
} elsif ( $type eq 'selfupdate' ) {
my %valid = map { $_ => $_ }
- qw|core dependencies enabled_features features all|;
+ $cb->selfupdate_object->list_categories;
unless( $valid{$key} ) {
print loc( "To update your current CPANPLUS installation, ".
"choose one of the these options:\n%1",
( join $/, map {
- sprintf "\ts selfupdate %-17s [--latest=0]", $_
+ sprintf "\ts selfupdate %-17s " .
+ "[--latest=0] [--dryrun]", $_
} sort keys %valid )
);
} else {
- print loc( "Updating your CPANPLUS installation\n" );
- $cb->selfupdate_object->selfupdate(
- update => $key,
- latest => 1,
- %$opts
- );
+ my %update_args = (
+ update => $key,
+ latest => 1,
+ %$opts
+ );
+
+
+ my %list = $cb->selfupdate_object
+ ->list_modules_to_update( %update_args );
+
+ print loc( "The following updates will take place:" ), $/.$/;
+
+ for my $feature ( sort keys %list ) {
+ my $aref = $list{$feature};
+
+ ### is it a 'feature' or a built in?
+ print $valid{$feature}
+ ? " " . ucfirst($feature) . ":\n"
+ : " Modules for '$feature' support:\n";
+
+ ### show what modules would be installed
+ print scalar @$aref
+ ? map { sprintf " %-42s %-6s -> %-6s \n",
+ $_->name, $_->installed_version, $_->version
+ } @$aref
+ : " No upgrades required\n";
+ print $/;
+ }
+
+
+ unless( $opts->{'dryrun'} ) {
+ print loc( "Updating your CPANPLUS installation\n" );
+ $cb->selfupdate_object->selfupdate( %update_args );
+ }
}
} else {
print loc("Unknown type '%1'",$type || 'EMPTY' );
print $/;
print loc("Try one of the following:");
- print $/, join $/, map { "\t'$_'" } sort @types;
+ print $/, join $/,
+ map { sprintf "\t%-11s %s", $_, $types{$_} }
+ sort keys %types;
}
}
print "\n";
loc( "You can turn off these tips using '%1'",
's conf show_startup_tip 0' ),
loc( "You can use wildcards like '%1' and '%2' on search results",
- '*', '..' ),
+ '*', '2..5' ) ,
loc( "You can use plugins. Type '%1' to list available plugins",
'/plugins' ),
loc( "You can show all your out of date modules using '%1'", 'o' ),
loc( "The documentation in %1 and %2 is very useful",
"CPANPLUS::Module", "CPANPLUS::Backend" ),
loc( "You can type '%1' for help and '%2' to exit", 'h', 'q' ),
+ loc( "You can run an interactive setup using '%1'", 's reconfigure' ),
);
sub _show_random_tip {
use File::Basename;
use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
+local $Data::Dumper::Indent = 1;
+
use constant PREREQ_SKIP_CLASS => 'CPANPLUS::To::Dist::PREREQ_SKIP';
use constant ALARM_CLASS => 'CPANPLUS::To::Dist::ALARM';
my $opts = {};
GetOptions( $opts,
- 'format=s', 'archive',
- 'verbose!', 'force!',
- 'skiptest!', 'keepsource!',
- 'makefile!', 'buildprereq!',
- 'help', 'flushcache',
- 'ban=s@', 'banlist=s@',
- 'ignore=s@', 'ignorelist=s@',
- 'defaults', 'modulelist=s@',
- 'logfile=s', 'timeout=s',
- 'dist-opts=s%',
- 'default-banlist!',
+ 'format=s', 'archive',
+ 'verbose!', 'force!',
+ 'skiptest!', 'keepsource!',
+ 'makefile!', 'buildprereq!',
+ 'help', 'flushcache',
+ 'ban=s@', 'banlist=s@',
+ 'ignore=s@', 'ignorelist=s@',
+ 'defaults', 'modulelist=s@',
+ 'logfile=s', 'timeout=s',
+ 'dist-opts=s%', 'set-config=s%',
+ 'default-banlist!', 'set-program=s%',
'default-ignorelist!',
);
die loc("Invalid format: " . ($format || "[NONE]") ) . usage()
unless $formats{$format};
- my %map = ( verbose => 'verbose',
- force => 'force',
- skiptest => 'skiptest',
- makefile => 'prefer_makefile'
- );
-
- ### set config options from arguments
- while (my($key,$val) = each %map) {
- my $bool = exists $opts->{$key} ? $opts->{$key} : $conf->get_conf($val);
- $conf->set_conf( $val => $bool );
- }
+ ### any options to fix config entries
+ { my $set_conf = $opts->{'set-config'} || {};
+ while( my($key,$val) = each %$set_conf ) {
+ $conf->set_conf( $key => $val );
+ }
+ }
+
+ ### any options to fix program entries
+ { my $set_prog = $opts->{'set-program'} || {};
+ while( my($key,$val) = each %$set_prog ) {
+ $conf->set_program( $key => $val );
+ }
+ }
+
+ ### any other options passed
+ { my %map = ( verbose => 'verbose',
+ force => 'force',
+ skiptest => 'skiptest',
+ makefile => 'prefer_makefile'
+ );
+
+ ### set config options from arguments
+ while (my($key,$val) = each %map) {
+ my $bool = exists $opts->{$key}
+ ? $opts->{$key}
+ : $conf->get_conf($val);
+ $conf->set_conf( $val => $bool );
+ }
+ }
}
+die Dumper $conf;
+
my @modules = @ARGV;
if( exists $opts->{'modulelist'} ) {
push @modules, map { parse_file( $_ ) } @{ $opts->{'modulelist'} };
### the die came from this location, and that it's an
### 'acceptable' death
my $pat = ban_me( $prereq );
- die bless \(loc("Module '%1' requires '%2' to be installed " .
- "but found in your ban list (%3) -- skipping",
- $mod->module, $prereq->module, $pat )),
- PREREQ_SKIP_CLASS if $pat;
+ die bless sub { loc("Module '%1' requires '%2' to be installed " .
+ "but found in your ban list (%3) -- skipping",
+ $mod->module, $prereq->module, $pat )
+ }, PREREQ_SKIP_CLASS if $pat;
return 1;
}
my $mod = shift;
for my $pat ( @ban ) {
- return $pat if $mod->module =~ /$pat/;
+ return $pat if $mod->module =~ /$pat/i;
}
return;
}
my $mod = shift;
for my $pat ( @ignore ) {
- return $pat if $mod->module =~ /$pat/;
- return $pat if $mod->package_name =~ /$pat/;
+ return $pat if $mod->module =~ /$pat/i;
+ return $pat if $mod->package_name =~ /$pat/i;
}
return;
}
### install failed due to a 'die' in our prereq skipper?
if( $@ and ref $@ and $@->isa( PREREQ_SKIP_CLASS ) ) {
warn loc("Dist creation of '%1' skipped: '%2'",
- $obj->module, ${$@} );
+ $obj->module, $@->() );
next;
} elsif ( $@ and ref $@ and $@->isa( ALARM_CLASS ) ) {
### take argument:
--format Installer format to use (defaults to config setting)
- --ban Patterns of module names to skip during installation
- (affects prerequisites too) May be given multiple times
+ --ban Patterns of module names to skip during installation,
+ case-insensitive (affects prerequisites too)
+ May be given multiple times
--banlist File containing patterns that could be given to --ban
Are appended to the ban list built up by --ban
May be given multiple times.
for when a prereq listed by a CPAN module is resolved
in another way than from its corresponding CPAN package
(Match is done on both module name, and package name of
- the package the module is in)
+ the package the module is in, case-insensitive)
--ignorelist File containing patterns that may be given to --ignore.
- Are appended to the ban list build up by --ignore.
+ Are appended to the ban list built up by --ignore.
May be given multiple times.
--modulelist File containing a list of modules that should be built.
Are appended to the list of command line modules.
hang or happen to be interactive despite being told not
to be. Defaults to 300 seconds. To turn off, you can
set it to 0.
+ --set-config Change any options as specified in your config for this
+ invocation only. See CPANPLUS::Config for a list of
+ supported options.
+ --set-program Change any programs as specified in your config for this
+ invocation only. See CPANPLUS::Config for a list of
+ supported programs.
--dist-opts Arbitrary options passed along to the chosen installer
- format's prepare()/create() routine.
+ format's prepare()/create() routine. Please see the
+ documentation of the installer of your choice for
+ options it accepts.
### builtin lists
--default-banlist Use our builtin banlist. Works just like --ban
### don't bother running tests
cpan2dist --format CPANPLUS::Dist::Deb --buildprereq --skiptest DBI
- ### Build a package, whose format is determined by your config of
+ ### Build a package, whose format is determined by your config, of
### the local tarball, reloading cpanplus' indices first and using
### the tarballs Makefile.PL if it has one.
cpan2dist --makefile --flushcache --archive /path/to/Cwd-1.0.tgz
### callback registering tests ###
{ my $callback_map = {
- ### name default value
+ ### name default value
install_prerequisite => 1, # install prereqs when 'ask' is set?
edit_test_report => 0, # edit the prepared test report?
send_test_report => 1, # send the test report?
munge_test_report => $$, # munge the test report
filter_prereqs => $$, # limit prereqs
+ proceed_on_test_failure => 0, # continue on failed 'make test'?
};
for my $callback ( keys %$callback_map ) {
is_deeply( $Conf, $Class->_get_config,
"Config updated succesfully" );
+ my @cat = $CB->$Acc->list_categories;
+ ok( scalar(@cat), "Category list returned" );
+
my @feat = $CB->$Acc->list_features;
ok( scalar(@feat), "Features list returned" );
is_deeply( $href, $Prereq,
" With the proper entries" );
- }
+ }
+ }
+
+ ### see if we can get a list of modules to be updated
+ { my $cat = 'core';
+ my $meth = 'list_modules_to_update';
+
+ ### XXX just test the mechanics, make sure is_uptodate
+ ### returns false
+ ### declare twice because warnings are hateful
+ ### declare in a block to quelch 'sub redefined' warnings.
+ { local *CPANPLUS::Selfupdate::Module::is_uptodate = sub { return }; }
+ local *CPANPLUS::Selfupdate::Module::is_uptodate = sub { return };
+
+ my %list = $CB->$Acc->$meth( update => $cat, latest => 1 );
+
+ cmp_ok( scalar(keys(%list)), '==', 1,
+ "Got modules for '$cat' from '$meth'" );
+ my $aref = $list{$cat};
+ ok( $aref, " Got module list" );
+ cmp_ok( scalar(@$aref), '==', 1,
+ " With right amount of modules" );
+ isa_ok( $aref->[0], $ModClass );
+ is( $aref->[0]->name, $Dep,
+ " With the right name ($Dep)" );
}
### find enabled features
" With the proper entries" );
}
}
+
### now selfupdate ourselves
{ ### XXX just test the mechanics, make sure install returns true
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz.packed
-Created at Tue May 8 13:53:41 2007
+Created at Mon May 28 14:32:03 2007
#########################################################################
__UU__
M'XL("%_EO$4``S`Q;6%I;')C+G1X=`!+S,E,+%9P#8T(5@`#)=>*DM"2S)QB
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz.packed
-Created at Tue May 8 13:53:41 2007
+Created at Mon May 28 14:32:03 2007
#########################################################################
__UU__
M'XL("!1%OT4"`T)U;F1L92U&;V\M0F%R+3`N,#$N=&%R`.V7:V_:,!2&^8I_
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUNOXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUNOXS/Foo-Bar-0.01.tar.gz.packed
-Created at Tue May 8 13:53:41 2007
+Created at Mon May 28 14:32:03 2007
#########################################################################
__UU__
M'XL("/8X34("`T9O;RU"87(M,"XP,2YT87(`[9KQ;]I&%,?Y^?Z*1YE$(A5C
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUNOXS/perl5.005_03.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUNOXS/perl5.005_03.tar.gz.packed
-Created at Tue May 8 13:53:41 2007
+Created at Mon May 28 14:32:03 2007
#########################################################################
__UU__
M'XL(`'3DO44``^W/,0J`,`Q`T1RE)Y"T-O4XXN"DB%2]OR(*NNC4[;_E#\F0
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUXS/Foo-Bar-0.01.tar.gz.packed
-Created at Tue May 8 13:53:41 2007
+Created at Mon May 28 14:32:03 2007
#########################################################################
__UU__
M'XL("`DY34("`T9O;RU"87(M,"XP,2YT87(`[5IK3]M(%,U7YE=<H%5``A.;
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/M/MB/MBNOXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/M/MB/MBNOXS/Foo-Bar-0.01.tar.gz.packed
-Created at Tue May 8 13:53:41 2007
+Created at Mon May 28 14:32:03 2007
#########################################################################
__UU__
M'XL("-<X34(``T9O;RU"87(M,"XP,2YT87(`[9E;;]HP%,=Y]J<X+9722@-R
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/M/MB/MBXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/M/MB/MBXS/Foo-Bar-0.01.tar.gz.packed
-Created at Tue May 8 13:53:41 2007
+Created at Mon May 28 14:32:04 2007
#########################################################################
__UU__
M'XL("-\X34(``T9O;RU"87(M,"XP,2YT87(`[5K_3QI)%/=7YZ]XU39H(BN[
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/modules/02packages.details.txt.gz lib/CPANPLUS/t/dummy-CPAN/modules/02packages.details.txt.gz.packed
-Created at Tue May 8 13:53:41 2007
+Created at Mon May 28 14:32:04 2007
#########################################################################
__UU__
M'XL("-%#OT4``S`R<&%C:V%G97,N9&5T86EL<RYT>'0`E=-1:]LP$`#@=_^*
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz.packed
-Created at Tue May 8 13:53:41 2007
+Created at Mon May 28 14:32:04 2007
#########################################################################
__UU__
M'XL("#'FO$4``S`S;6]D;&ES="YD871A`%U3_6O;,!#].?HKCBXC"20A=<@&
$conf->set_conf( dist_type => '' );
$conf->set_conf( signature => 0 );
+ ### dmq tells us that we should run with /nologo
+ ### if using nmake, as it's very noise otherwise.
+ { my $make = $conf->get_program('make');
+ if( $make and basename($make) =~ /^nmake/i and
+ $make !~ m|/nologo|
+ ) {
+ $make .= ' /nologo';
+ $conf->set_program( make => $make );
+ }
+ }
+
_clean_test_dir( [
$conf->get_conf('base'),
TEST_CONF_MIRROR_DIR,
projects / platform / upstream / perl.git / commitdiff