use warnings;
use vars qw($VERSION);
-use if $] < 5.008 => "IO::Scalar";
+use if $] < 5.008 => 'IO::Scalar';
-$VERSION = '1.62';
+$VERSION = '1.63';
=head1 NAME
# use local::lib
cpan -I module_name [ module_name ... ]
+ # one time mirror override for faster mirrors
+ cpan -p ...
+
# with just the dot, install from the distribution in the
# current directory
cpan .
Make the specified modules.
+=item -M mirror1,mirror2,...
+
+A comma-separated list of mirrors to use for just this run. The C<-P>
+option can find them for you automatically.
+
=item -n
Do a dry run, but don't actually install anything. (unimplemented)
=item -p
-Ping the configured mirrors
+Ping the configured mirrors and print a report
=item -P
-Find the best mirrors you could be using (but doesn't configure them just yet)
+Find the best mirrors you could be using and use them for the current
+session.
=item -r
# force install modules ( must use -i )
cpan -fi CGI::Minimal URI
+ # install modules but without testing them
+ cpan -Ti CGI::Minimal URI
+
+=head2 Environment variables
+
+There are several components in CPAN.pm that use environment variables.
+The build tools, L<ExtUtils::MakeMaker> and L<Module::Build> use some,
+while others matter to the levels above them. Some of these are specified
+by the Perl Toolchain Gang:
+
+Lancaster Concensus: L<https://github.com/Perl-Toolchain-Gang/toolchain-site/blob/master/lancaster-consensus.md>
+
+Oslo Concensus: L<https://github.com/Perl-Toolchain-Gang/toolchain-site/blob/master/oslo-consensus.md>
+
+=over 4
+
+=item NONINTERACTIVE_TESTING
+
+Assume no one is paying attention and skips prompts for distributions
+that do that correctly. C<cpan(1)> sets this to C<1> unless it already
+has a value (even if that value is false).
+
+=item PERL_MM_USE_DEFAULT
+
+Use the default answer for a prompted questions. C<cpan(1)> sets this
+to C<1> unless it already has a value (even if that value is false).
+
+=item CPAN_OPTS
+
+As with C<PERL5OPTS>, a string of additional C<cpan(1)> options to
+add to those you specify on the command line.
+
+=item CPANSCRIPT_LOGLEVEL
+
+The log level to use, with either the embedded, minimal logger or
+L<Log::Log4perl> if it is installed. Possible values are the same as
+the C<Log::Log4perl> levels: C<TRACE>, C<DEBUG>, C<INFO>, C<WARN>,
+C<ERROR>, and C<FATAL>. The default is C<INFO>.
+
+=item GIT_COMMAND
+
+The path to the C<git> binary to use for the Git features. The default
+is C</usr/local/bin/git>.
+
+=back
=head2 Methods
=cut
use autouse Carp => qw(carp croak cluck);
-use CPAN ();
+use CPAN 1.80 (); # needs no test
use Config;
use autouse Cwd => qw(cwd);
use autouse 'Data::Dumper' => qw(Dumper);
use vars qw( @META_OPTIONS $Default %CPAN_METHODS @CPAN_OPTIONS @option_order
%Method_table %Method_table_index );
-@META_OPTIONS = qw( h v V I g G C A D O l L a r p P j: J w T);
+@META_OPTIONS = qw( h v V I g G M: C A D O l L a r p P j: J w T);
$Default = 'default';
'm' => 'make',
't' => 'test',
'u' => 'upgrade',
+ 'T' => 'notest',
);
@CPAN_OPTIONS = grep { $_ ne $Default } sort keys %CPAN_METHODS;
J => [ \&_dump_config, NO_ARGS, GOOD_EXIT, 'Dump configuration to stdout' ],
F => [ \&_lock_lobotomy, NO_ARGS, GOOD_EXIT, 'Turn off CPAN.pm lock files' ],
I => [ \&_load_local_lib, NO_ARGS, GOOD_EXIT, 'Loading local::lib' ],
+ M => [ \&_use_these_mirrors, ARGS, GOOD_EXIT, 'Setting per session mirrors' ],
+ P => [ \&_find_good_mirrors, NO_ARGS, GOOD_EXIT, 'Finding good mirrors' ],
w => [ \&_turn_on_warnings, NO_ARGS, GOOD_EXIT, 'Turning on warnings' ],
- T => [ \&_turn_off_testing, NO_ARGS, GOOD_EXIT, 'Turning off testing' ],
# options that do their one thing
g => [ \&_download, NO_ARGS, GOOD_EXIT, 'Download the latest distro' ],
L => [ \&_show_author_mods, ARGS, GOOD_EXIT, 'Showing author mods' ],
a => [ \&_create_autobundle, NO_ARGS, GOOD_EXIT, 'Creating autobundle' ],
p => [ \&_ping_mirrors, NO_ARGS, GOOD_EXIT, 'Pinging mirrors' ],
- P => [ \&_find_good_mirrors, NO_ARGS, GOOD_EXIT, 'Finding good mirrors' ],
r => [ \&_recompile, NO_ARGS, GOOD_EXIT, 'Recompiling' ],
u => [ \&_upgrade, NO_ARGS, GOOD_EXIT, 'Running `make test`' ],
i => [ \&_default, ARGS, GOOD_EXIT, 'Running `make install`' ],
'm' => [ \&_default, ARGS, GOOD_EXIT, 'Running `make`' ],
t => [ \&_default, ARGS, GOOD_EXIT, 'Running `make test`' ],
+ T => [ \&_default, ARGS, GOOD_EXIT, 'Installing with notest' ],
);
%Method_table_index = (
);
}
- foreach my $o ( qw(F I w T) )
+ $class->_turn_off_testing if $options->{T};
+
+ foreach my $o ( qw(F I w P M) )
{
next unless exists $options->{$o};
$Method_table{$o}[ $Method_table_index{code} ]->( $options->{$o} );
my $option_count = grep { $options->{$_} } @option_order;
no warnings 'uninitialized';
- $option_count -= $options->{'f'}; # don't count force
+
+ # don't count options that imply installation
+ foreach my $opt ( qw(f T) ) { # don't count force or notest
+ $option_count -= $options->{$opt};
+ }
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# if there are no options, set -i (this line fixes RT ticket 16915)
$options->{i}++ unless $option_count;
}
+sub _setup_environment {
+# should we override or set defaults? If this were a true interactive
+# session, we'd be in the CPAN shell.
+
+# https://github.com/Perl-Toolchain-Gang/toolchain-site/blob/master/lancaster-consensus.md
+ $ENV{NONINTERACTIVE_TESTING} = 1 unless defined $ENV{NONINTERACTIVE_TESTING};
+ $ENV{PERL_MM_USE_DEFAULT} = 1 unless defined $ENV{PERL_MM_USE_DEFAULT};
+ }
=item run()
$class->_process_setup_options( $options );
+ $class->_setup_environment( $options );
+
OPTION: foreach my $option ( @option_order )
{
next unless $options->{$option};
my( $sub, $takes_args, $description ) =
map { $Method_table{$option}[ $Method_table_index{$_} ] }
- qw( code takes_args );
+ qw( code takes_args description );
unless( ref $sub eq ref sub {} )
{
unless( $log4perl_loaded )
{
+ print "Loading internal null logger. Install Log::Log4perl for logging messages\n";
$logger = Local::Null::Logger->new;
return $logger;
}
# we'll deal with 'f' (force) later, so skip it
foreach my $option ( @CPAN_OPTIONS )
{
- next if $option eq 'f';
+ next if ( $option eq 'f' or $option eq 'T' );
next unless $options->{$option};
$switch = $option;
last;
my $method = $CPAN_METHODS{$switch};
die "CPAN.pm cannot $method!\n" unless CPAN::Shell->can( $method );
- # call the CPAN::Shell method, with force if specified
+ # call the CPAN::Shell method, with force or notest if specified
my $action = do {
- if( $options->{f} ) { sub { CPAN::Shell->force( $method, @_ ) } }
- else { sub { CPAN::Shell->$method( @_ ) } }
+ if( $options->{f} ) { sub { CPAN::Shell->force( $method, @_ ) } }
+ elsif( $options->{T} ) { sub { CPAN::Shell->notest( $method, @_ ) } }
+ else { sub { CPAN::Shell->$method( @_ ) } }
};
# How do I handle exit codes for multiple arguments?
- my $errors = 0;
+ my @errors = ();
foreach my $arg ( @$args )
{
_clear_cpanpm_output();
$action->( $arg );
- $errors += defined _cpanpm_output_indicates_failure();
+ my $error = _cpanpm_output_indicates_failure();
+ push @errors, $error if $error;
}
- $errors ? I_DONT_KNOW_WHAT_HAPPENED : HEY_IT_WORKED;
+ return do {
+ if( @errors ) { $errors[0] }
+ else { HEY_IT_WORKED }
+ };
+
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _get_cpanpm_output { $scalar }
+# These are lines I don't care about in CPAN.pm output. If I can
+# filter out the informational noise, I have a better chance to
+# catch the error signal
my @skip_lines = (
qr/^\QWarning \(usually harmless\)/,
qr/\bwill not store persistent state\b/,
qr(//hint//),
qr/^\s+reports\s+/,
+ qr/^Try the command/,
+ qr/^\s+$/,
+ qr/^to find objects/,
+ qr/^\s*Database was generated on/,
+ qr/^Going to read/,
+ qr|^\s+i\s+/|, # the i /Foo::Whatever/ line when it doesn't know
);
sub _get_cpanpm_last_line
{
my $fh;
- if ($] < 5.008) {
- $fh = IO::Scalar->new(\ $scalar);
- } else {
- eval q{open $fh, "<", \\ $scalar;};
- }
+
+ if( $] < 5.008 ) {
+ $fh = IO::Scalar->new( \ $scalar );
+ }
+ else {
+ eval q{ open $fh, '<', \\ $scalar; };
+ }
my @lines = <$fh>;
BEGIN {
my $epic_fail_words = join '|',
- qw( Error stop(?:ping)? problems force not unsupported fail(?:ed)? );
+ qw( Error stop(?:ping)? problems force not unsupported
+ fail(?:ed)? Cannot\s+install );
sub _cpanpm_output_indicates_failure
{
my $last_line = _get_cpanpm_last_line();
my $result = $last_line =~ /\b(?:$epic_fail_words)\b/i;
+ return A_MODULE_FAILED_TO_INSTALL if $last_line =~ /\b(?:Cannot\s+install)\b/i;
+
$result || ();
}
}
sub _find_good_mirrors {
require CPAN::Mirrors;
- my $mirrors = CPAN::Mirrors->new;
my $file = do {
my $file = 'MIRRORED.BY';
my $local_path = File::Spec->catfile(
$local_path;
}
};
-
- $mirrors->parse_mirrored_by( $file );
+ my $mirrors = CPAN::Mirrors->new( $file );
my @mirrors = $mirrors->best_mirrors(
- how_many => 3,
+ how_many => 5,
verbose => 1,
);
_print_ping_report( $mirror->http );
}
+ $CPAN::Config->{urllist} = [
+ map { $_->http } @mirrors
+ ];
}
sub _print_inc_dir_report
my( $mirror ) = @_;
my $rtt = eval { _get_ping_report( $mirror ) };
+ my $result = $rtt ? sprintf "+ (%4d ms)", $rtt * 1000 : '!';
$logger->info(
- sprintf "\t%s (%4d ms) %s", $rtt ? '+' : '!', $rtt * 1000, $mirror
+ sprintf "\t%s %s", $result, $mirror
);
}
return HEY_IT_WORKED;
}
+sub _use_these_mirrors # -M
+ {
+ $logger->debug( "Setting per session mirrors" );
+ unless( $_[0] ) {
+ $logger->die( "The -M switch requires a comma-separated list of mirrors" );
+ }
+
+ $CPAN::Config->{urllist} = [ split /,/, $_[0] ];
+
+ $logger->debug( "Mirrors are @{$CPAN::Config->{urllist}}" );
+
+ }
+
sub _create_autobundle
{
$logger->info(
print "$arg\n", "-" x 73, "\n\t";
print join "\n\t",
$module->description ? $module->description : "(no description)",
- $module->cpan_file,
- $module->inst_file,
- 'Installed: ' . $module->inst_version,
+ $module->cpan_file ? $module->cpan_file : "(no cpanfile)",
+ $module->inst_file ? $module->inst_file :"(no installation file)" ,
+ 'Installed: ' . ($module->inst_version ? $module->inst_version : "not installed"),
'CPAN: ' . $module->cpan_version . ' ' .
($module->uptodate ? "" : "Not ") . "up to date",
$author->fullname . " (" . $module->userid . ")",
sub _path_to_module
{
my( $inc, $path ) = @_;
- return if length $path< length $inc;
+ return if length $path < length $inc;
my $module_path = substr( $path, length $inc );
$module_path =~ s/\.pm\z//;
* When I capture CPAN.pm output, I need to check for errors and
report them to the user.
-* Support local::lib
-
* Warnings switch
* Check then exit
-* ping mirrors support
-
* no test option
=head1 BUGS
=head1 SEE ALSO
-Most behaviour, including environment variables and configuration,
-comes directly from CPAN.pm.
+L<CPAN>, L<App::cpanminus>
=head1 SOURCE AVAILABILITY
-This code is in Github:
+This code is in Github in the CPAN.pm repository:
+
+ https://github.com/andk/cpanpm
- git://github.com/briandfoy/cpan_script.git
+The source used to be tracked separately in another GitHub repo,
+but the canonical source is now in the above repo.
=head1 CREDITS
=head1 COPYRIGHT
-Copyright (c) 2001-2013, brian d foy, All Rights Reserved.
+Copyright (c) 2001-2014, brian d foy, All Rights Reserved.
You may redistribute this under the same terms as Perl itself.
https://perl5.git.perl.org / perl5.git / blobdiff