In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/a5468c61b56732d2b8dc7d6f4ea8a4cd7c6c7bde?hp=9f58603cede336c7540a34eadb4488afb074988c>
- Log -----------------------------------------------------------------
commit a5468c61b56732d2b8dc7d6f4ea8a4cd7c6c7bde
Author: Chris 'BinGOs' Williams <ch...@bingosnet.co.uk>
Date: Mon Jun 3 13:38:43 2019 +0100
Update CPAN to CPAN version 2.26
[DELTA]
2019-03-19 k <a...@cpan.org>
* release 2.26
* testfix release, no functional change
* 97-run.t is now skipped when test is run by root user because
perldoc often fails for root user (thanks to Binarus for
reporting)
* small additions to distroprefs and to the Makefile.PL
2019-03-03 k <a...@cpan.org>
* release 2.25
* two weeks after the TRIAL release cpantesters have produced 298
pass and 2 fail reports on 108 different configurations; the two
fails are outliers I don't understand
* no functional change over 2.25-TRIAL; only a couple in the
distroprefs directory which is not used per default
2019-02-16 k <a...@cpan.org>
* release 2.25-TRIAL
* fix: Avoid a warning when prompting install_help intro (Nicolas
R/atoomic)
* testfix: load the tested module early, before juggling with @INC
* testfix: replace an exec with system and exit (greetings to Windows)
* two more distroprefs lines
2019-02-14 k <a...@cpan.org>
* release 2.24-TRIAL
* fix: set internal error state on writemakefile=NO in a rare case
without any output
* test fix: avoid a so far unreflected dependency on perldoc
* a few more distroprefs
2019-02-10 k <a...@cpan.org>
* release 2.23-TRIAL
* fix: when option cleanup_after_install is active, prevent
rerunning make install after a cleanup; allow it only with the
help of force; also prevent that it is triggered too early
* fix: address #121162: support distroprefs for install.env
* fix: the option h on cpan script now really ignores all other
options and arguments
* fix: Local::Null::Logger on cpan script did not honour
CPANSCRIPT_LOGLEVEL
* address #122520: exit 1 on unknown options on cpan script
* address #94941: refuse to generate reports with CPAN::Reporter
lower than 1.2011
* fix: distropref method "goto" now inherits CALLED_FOR and other
attributes from caller
* fix: correct a buggy version comparison when testing version of
Net::Ping
* portability fix: ensure that Compress::Zlib supports gzopen()
* internal fix: never overwrite internal attribute CALLED_FOR (no
known user-relevant implications)
* tiny test fixed uncovered by cpantesters, various tiny typo
corrections
* a couple of new and updated distroprefs files
-----------------------------------------------------------------------
Summary of changes:
Porting/Maintainers.pl | 2 +-
cpan/CPAN/lib/App/Cpan.pm | 43 +++++++++++++++------
cpan/CPAN/lib/CPAN.pm | 34 ++++++++++++++---
cpan/CPAN/lib/CPAN/Bundle.pm | 3 +-
cpan/CPAN/lib/CPAN/Distribution.pm | 78 +++++++++++++++++++++++++++++++++++---
cpan/CPAN/lib/CPAN/FirstTime.pm | 8 ++--
cpan/CPAN/lib/CPAN/HandleConfig.pm | 4 +-
cpan/CPAN/lib/CPAN/Queue.pm | 13 ++++++-
cpan/CPAN/lib/CPAN/Shell.pm | 9 +++--
cpan/CPAN/lib/CPAN/Tarzip.pm | 21 ++++++----
10 files changed, 172 insertions(+), 43 deletions(-)
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index c3b817f54d..ae4dfc473b 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -253,7 +253,7 @@ use File::Glob qw(:case);
},
'CPAN' => {
- 'DISTRIBUTION' => 'ANDK/CPAN-2.22.tar.gz',
+ 'DISTRIBUTION' => 'ANDK/CPAN-2.26.tar.gz',
'FILES' => q[cpan/CPAN],
'EXCLUDED' => [
qr{^distroprefs/},
diff --git a/cpan/CPAN/lib/App/Cpan.pm b/cpan/CPAN/lib/App/Cpan.pm
index 80c3efec43..b563addf52 100644
--- a/cpan/CPAN/lib/App/Cpan.pm
+++ b/cpan/CPAN/lib/App/Cpan.pm
@@ -6,7 +6,7 @@ use vars qw($VERSION);
use if $] < 5.008 => 'IO::Scalar';
-$VERSION = '1.672';
+$VERSION = '1.675';
=head1 NAME
@@ -414,13 +414,13 @@ sub _process_options
# if no arguments, just drop into the shell
if( 0 == @ARGV ) { CPAN::shell(); exit 0 }
- else
+ elsif (Getopt::Std::getopts(
+ join( '', @option_order ), \%options ))
{
- Getopt::Std::getopts(
- join( '', @option_order ), \%options );
\%options;
}
- }
+ else { exit 1 }
+}
sub _process_setup_options
{
@@ -431,8 +431,7 @@ sub _process_setup_options
$Method_table{j}[ $Method_table_index{code} ]->( $options->{j}
);
delete $options->{j};
}
- else
- {
+ elsif ( ! $options->{h} ) { # h "ignores all of the other options and
arguments"
# this is what CPAN.pm would do otherwise
local $CPAN::Be_Silent = 1;
CPAN::HandleConfig->load(
@@ -542,15 +541,23 @@ sub run
return $return_value;
}
+my $LEVEL;
{
package
Local::Null::Logger; # hide from PAUSE
+my @LOGLEVELS = qw(TRACE DEBUG INFO WARN ERROR FATAL);
+$LEVEL = uc($ENV{CPANSCRIPT_LOGLEVEL} || 'INFO');
+my %LL = map { $LOGLEVELS[$_] => $_ } 0..$#LOGLEVELS;
+unless (defined $LL{$LEVEL}){
+ warn "Unsupported loglevel '$LEVEL', setting to INFO";
+ $LEVEL = 'INFO';
+}
sub new { bless \ my $x, $_[0] }
sub AUTOLOAD {
my $autoload = our $AUTOLOAD;
$autoload =~ s/.*://;
- return if $autoload =~ /^(debug|trace)$/;
+ return if $LL{uc $autoload} < $LL{$LEVEL};
$CPAN::Frontend->mywarn(">($autoload): $_\n")
for split /[\r\n]+/, $_[1];
}
@@ -579,8 +586,6 @@ sub _init_logger
return $logger;
}
- my $LEVEL = $ENV{CPANSCRIPT_LOGLEVEL} || 'INFO';
-
Log::Log4perl::init( \ <<"HERE" );
log4perl.rootLogger=$LEVEL, A1
log4perl.appender.A1=Log::Log4perl::Appender::Screen
@@ -676,7 +681,7 @@ sub _hook_into_CPANpm_report
*CPAN::Shell::myprint = sub {
my($self,$what) = @_;
- $scalar .= $what;
+ $scalar .= $what if defined $what;
$self->print_ornamented($what,
$CPAN::Config->{colorize_print}||'bold blue on_white',
);
@@ -794,7 +799,14 @@ sub _turn_off_testing {
sub _print_help
{
$logger->info( "Use perldoc to read the documentation" );
- exec "perldoc $0";
+ my $HAVE_PERLDOC = eval { require Pod::Perldoc; 1; };
+ if ($HAVE_PERLDOC) {
+ system qq{"$^X" -e "require Pod::Perldoc; Pod::Perldoc->run()"
$0};
+ exit;
+ } else {
+ warn "Please install Pod::Perldoc, maybe try 'cpan -i
Pod::Perldoc'\n";
+ return HEY_IT_WORKED;
+ }
}
sub _print_version # -v
@@ -1698,3 +1710,10 @@ Copyright (c) 2001-2018, brian d foy, All Rights
Reserved.
You may redistribute this under the same terms as Perl itself.
=cut
+
+# Local Variables:
+# mode: cperl
+# indent-tabs-mode: t
+# cperl-indent-level: 8
+# cperl-continued-statement-offset: 8
+# End:
diff --git a/cpan/CPAN/lib/CPAN.pm b/cpan/CPAN/lib/CPAN.pm
index 0c9b9f5b09..a25a5fad7b 100644
--- a/cpan/CPAN/lib/CPAN.pm
+++ b/cpan/CPAN/lib/CPAN.pm
@@ -2,7 +2,7 @@
# vim: ts=4 sts=4 sw=4:
use strict;
package CPAN;
-$CPAN::VERSION = '2.22';
+$CPAN::VERSION = '2.26';
$CPAN::VERSION =~ s/_//;
# we need to run chdir all over and we would get at wrong libraries
@@ -286,7 +286,10 @@ sub shell {
}
if (my $histfile = $CPAN::Config->{'histfile'}) {{
unless ($term->can("AddHistory")) {
- $CPAN::Frontend->mywarn("Terminal does not support
AddHistory.\n\nTo fix enter> install Term::ReadLine::Perl\n\n");
+ $CPAN::Frontend->mywarn("Terminal does not support
AddHistory.\n");
+ unless ($CPAN::META->has_inst('Term::ReadLine::Perl')) {
+ $CPAN::Frontend->mywarn("\nTo fix that, maybe try>
install Term::ReadLine::Perl\n\n");
+ }
last;
}
$META->readhist($term,$histfile);
@@ -1028,7 +1031,10 @@ sub has_usable {
$usable = {
#
- # these subroutines die if they believe the installed version
is unusable;
+ # most of these subroutines warn on the frontend, then
+ # die if the installed version is unusable for some
+ # reason; has_usable() then returns false when it caught
+ # an exception, otherwise returns true and caches that;
#
'CPAN::Meta' => [
sub {
@@ -1059,6 +1065,23 @@ sub has_usable {
},
],
+ 'CPAN::Reporter' => [
+ sub {
+ if (defined $CPAN::Reporter::VERSION
+ &&
CPAN::Version->vlt($CPAN::Reporter::VERSION, "1.2011")
+ ) {
+ delete $INC{"CPAN/Reporter.pm"};
+ }
+ require CPAN::Reporter;
+ unless
(CPAN::Version->vge(CPAN::Reporter->VERSION, "1.2011")) {
+ for ("Will not use CPAN::Reporter, need
version 1.2011\n") {
+ $CPAN::Frontend->mywarn($_);
+ die $_;
+ }
+ }
+ },
+ ],
+
LWP => [ # we frequently had "Can't locate object
# method "new" via package "LWP::UserAgent" at
# (eval 69) line 2006
@@ -2134,7 +2157,8 @@ currently defined:
check_sigs if signatures should be verified
cleanup_after_install
remove build directory immediately after a
- successful install
+ successful install and remember that for the
+ duration of the session
colorize_debug Term::ANSIColor attributes for debugging output
colorize_output boolean if Term::ANSIColor should colorize output
colorize_print Term::ANSIColor attributes for normal output
@@ -2378,7 +2402,7 @@ installed. It is only built and tested, and then kept in
the list of
tested but uninstalled modules. As such, it is available during the
build of the dependent module by integrating the path to the
C<blib/arch> and C<blib/lib> directories in the environment variable
-PERL5LIB. If C<build_requires_install_policy> is set ti C<yes>, then
+PERL5LIB. If C<build_requires_install_policy> is set to C<yes>, then
both modules declared as C<requires> and those declared as
C<build_requires> are treated alike. By setting to C<ask/yes> or
C<ask/no>, CPAN.pm asks the user and sets the default accordingly.
diff --git a/cpan/CPAN/lib/CPAN/Bundle.pm b/cpan/CPAN/lib/CPAN/Bundle.pm
index 3b4e93d8bf..9270502914 100644
--- a/cpan/CPAN/lib/CPAN/Bundle.pm
+++ b/cpan/CPAN/lib/CPAN/Bundle.pm
@@ -8,7 +8,7 @@ use CPAN::Module;
use vars qw(
$VERSION
);
-$VERSION = "5.5003";
+$VERSION = "5.5004";
sub look {
my $self = shift;
@@ -238,6 +238,7 @@ Going to $meth that.
$self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
my $obj = $CPAN::META->instance($type,$s);
$obj->{reqtype} = $self->{reqtype};
+ $obj->{viabundle} ||= { id => $id, reqtype => $self->{reqtype},
optional => !$self->{mandatory}};
# $obj->$meth();
# XXX should optional be based on whether bundle was optional? -- xdg,
2012-04-01
# A: Sure, what could demand otherwise? --andk, 2013-11-25
diff --git a/cpan/CPAN/lib/CPAN/Distribution.pm
b/cpan/CPAN/lib/CPAN/Distribution.pm
index 717c9aa0e4..ea637c865b 100644
--- a/cpan/CPAN/lib/CPAN/Distribution.pm
+++ b/cpan/CPAN/lib/CPAN/Distribution.pm
@@ -8,7 +8,7 @@ use CPAN::InfoObj;
use File::Path ();
@CPAN::Distribution::ISA = qw(CPAN::InfoObj);
use vars qw($VERSION);
-$VERSION = "2.22";
+$VERSION = "2.24";
# no prepare, because prepare is not a command on the shell command line
# TODO: clear instance cache on reload
@@ -317,6 +317,17 @@ sub called_for {
sub shortcut_get {
my ($self) = @_;
+ if (exists $self->{cleanup_after_install_done}) {
+ if ($self->{force_update}) {
+ delete $self->{cleanup_after_install_done};
+ } else {
+ my $id = $self->{CALLED_FOR} || $self->pretty_id;
+ return $self->success(
+ "Has already been *installed and cleaned up in the staging
area* within this session, will not work on it again; if you really want to
start over, try something like `force get $id`"
+ );
+ }
+ }
+
if (my $why = $self->check_disabled) {
$self->{unwrapped} = CPAN::Distrostatus->new("NO $why");
# XXX why is this goodbye() instead of just print/warn?
@@ -1637,23 +1648,28 @@ sub force {
"prefs",
"prefs_file",
"prefs_file_doc",
+ "cleanup_after_install_done",
],
make => [
"writemakefile",
"make",
"modulebuild",
"prereq_pm",
+ "cleanup_after_install_done",
],
test => [
"badtestcnt",
"make_test",
- ],
+ "cleanup_after_install_done",
+ ],
install => [
"install",
+ "cleanup_after_install_done",
],
unknown => [
"reqtype",
"yaml_content",
+ "cleanup_after_install_done",
],
);
my $methodmatch = 0;
@@ -1992,7 +2008,9 @@ sub prepare {
($output, $ret) = eval {
CPAN::Reporter::record_command($system) };
if (! defined $output or $@) {
my $err = $@ || "Unknown error";
- $CPAN::Frontend->mywarn("Error while running PL phase:
$err");
+ $CPAN::Frontend->mywarn("Error while running PL phase:
$err\n");
+ $self->{writemakefile} = CPAN::Distrostatus
+ ->new("NO '$system' returned status $ret and no
output");
return $self->goodbye("$system -- NOT OK");
}
CPAN::Reporter::grade_PL( $self, $system, $output, $ret );
@@ -2062,6 +2080,10 @@ sub make {
$self->pre_make();
+ if (exists $self->{cleanup_after_install_done}) {
+ return $self->get;
+ }
+
$self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
if (my $goto = $self->prefs->{goto}) {
return $self->goto($goto);
@@ -2956,7 +2978,8 @@ sub unsat_prereq {
next NEED;
}
} elsif (
- $self->{reqtype} =~ /^(r|c)$/
+ $self->{reqtype} # e.g. maybe we came via goto?
+ && $self->{reqtype} =~ /^(r|c)$/
&& ( exists $prereq_pm->{requires}{$need_module}
|| exists $prereq_pm->{opt_requires}{$need_module} )
&& $nmo
@@ -3531,6 +3554,10 @@ sub test {
$self->pre_test();
+ if (exists $self->{cleanup_after_install_done}) {
+ return $self->make;
+ }
+
$self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
if (my $goto = $self->prefs->{goto}) {
return $self->goto($goto);
@@ -3895,7 +3922,12 @@ sub goto {
# and run where we left off
my($method) = (caller(1))[3];
- CPAN->instance("CPAN::Distribution",$goto)->$method();
+ my $goto_do = CPAN->instance("CPAN::Distribution",$goto);
+ $goto_do->called_for($self->called_for) unless $goto_do->called_for;
+ $goto_do->{mandatory} ||= $self->{mandatory};
+ $goto_do->{reqtype} ||= $self->{reqtype};
+ $goto_do->{coming_from} = $self->pretty_id;
+ $goto_do->$method();
CPAN::Queue->delete_first($goto);
# XXX delete_first returns undef; is that what this should return
# up the call stack, eg. return $sefl->goto($goto) -- xdg, 2012-04-04
@@ -3932,12 +3964,36 @@ sub shortcut_install {
return undef;
}
+#-> sub CPAN::Distribution::is_being_sponsored ;
+
+# returns true if we find a distro object in the queue that has
+# sponsored this one
+sub is_being_sponsored {
+ my($self) = @_;
+ my $iterator = CPAN::Queue->iterator;
+ QITEM: while (my $q = $iterator->()) {
+ my $s = $q->as_string;
+ my $obj = CPAN::Shell->expandany($s) or next QITEM;
+ my $type = ref $obj;
+ if ( $type eq 'CPAN::Distribution' ){
+ for my $module (sort keys %{$obj->{sponsored_mods} || {}}) {
+ return 1 if grep { $_ eq $module } $self->containsmods;
+ }
+ }
+ }
+ return 0;
+}
+
#-> sub CPAN::Distribution::install ;
sub install {
my($self) = @_;
$self->pre_install();
+ if (exists $self->{cleanup_after_install_done}) {
+ return $self->test;
+ }
+
$self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
if (my $goto = $self->prefs->{goto}) {
$self->goto($goto);
@@ -4044,6 +4100,12 @@ sub install {
local $ENV{PERL_MM_USE_DEFAULT} = 1 if $CPAN::Config->{use_prompt_default};
local $ENV{NONINTERACTIVE_TESTING} = 1 if
$CPAN::Config->{use_prompt_default};
+ my $install_env;
+ if ($self->prefs->{install}) {
+ $install_env = $self->prefs->{install}{env};
+ }
+ local @ENV{keys %$install_env} = values %$install_env if $install_env;
+
my($pipe) = FileHandle->new("$system $stderr |");
unless ($pipe) {
$CPAN::Frontend->mywarn("Can't execute $system: $!");
@@ -4069,7 +4131,8 @@ sub install {
$CPAN::META->is_installed($self->{build_dir});
$self->{install} = CPAN::Distrostatus->new("YES");
if ($CPAN::Config->{'cleanup_after_install'}
- && ! $self->is_dot_dist) {
+ && ! $self->is_dot_dist
+ && ! $self->is_being_sponsored) {
my $parent = File::Spec->catdir( $self->{build_dir},
File::Spec->updir );
chdir $parent or $CPAN::Frontend->mydie("Couldn't chdir to
$parent: $!\n");
File::Path::rmtree($self->{build_dir});
@@ -4077,6 +4140,7 @@ sub install {
if (-e $yml) {
unlink $yml or $CPAN::Frontend->mydie("Couldn't unlink $yml:
$!\n");
}
+ $self->{cleanup_after_install_done}=1;
}
} else {
$self->{install} = CPAN::Distrostatus->new("NO");
@@ -4361,6 +4425,8 @@ sub _should_report {
die "_should_report() requires a 'phase' argument"
if ! defined $phase;
+ return unless $CPAN::META->has_usable("CPAN::Reporter");
+
# configured
my $test_report = CPAN::HandleConfig->prefs_lookup($self,
q{test_report});
diff --git a/cpan/CPAN/lib/CPAN/FirstTime.pm b/cpan/CPAN/lib/CPAN/FirstTime.pm
index 49fa8ab7b9..ae2f662261 100644
--- a/cpan/CPAN/lib/CPAN/FirstTime.pm
+++ b/cpan/CPAN/lib/CPAN/FirstTime.pm
@@ -9,8 +9,9 @@ use File::Basename ();
use File::Path ();
use File::Spec ();
use CPAN::Mirrors ();
+use CPAN::Version ();
use vars qw($VERSION $auto_config);
-$VERSION = "5.5311";
+$VERSION = "5.5313";
=head1 NAME
@@ -1450,7 +1451,7 @@ sub _do_pick_mirrors {
$CPAN::Frontend->myprint($prompts{urls_intro});
# Only prompt for auto-pick if Net::Ping is new enough to do timings
my $_conf = 'n';
- if ( $CPAN::META->has_usable("Net::Ping") && Net::Ping->VERSION gt '2.13')
{
+ if ( $CPAN::META->has_usable("Net::Ping") &&
CPAN::Version->vgt(Net::Ping->VERSION, '2.13')) {
$_conf = prompt($prompts{auto_pick}, "yes");
} else {
prompt("Autoselection disabled due to Net::Ping missing or
insufficient. Please press ENTER");
@@ -1697,7 +1698,8 @@ sub my_prompt_loop {
my $ans;
if (!$auto_config && (!$m || $item =~ /$m/)) {
- $CPAN::Frontend->myprint($prompts{$item . "_intro"});
+ my $intro = $prompts{$item . "_intro"};
+ $CPAN::Frontend->myprint($intro) if defined $intro;
$CPAN::Frontend->myprint(" <$item>\n");
do { $ans = prompt($prompts{$item}, $default);
} until $ans =~ /$ok/;
diff --git a/cpan/CPAN/lib/CPAN/HandleConfig.pm
b/cpan/CPAN/lib/CPAN/HandleConfig.pm
index c72439f92c..6cc12af667 100644
--- a/cpan/CPAN/lib/CPAN/HandleConfig.pm
+++ b/cpan/CPAN/lib/CPAN/HandleConfig.pm
@@ -12,7 +12,7 @@ CPAN::HandleConfig - internal configuration handling for
CPAN.pm
=cut
-$VERSION = "5.5008"; # see also CPAN::Config::VERSION at end of file
+$VERSION = "5.5009"; # see also CPAN::Config::VERSION at end of file
%can = (
commit => "Commit changes to disk",
@@ -751,7 +751,7 @@ sub prefs_lookup {
return $distro->prefs->{cpanconfig}{$what};
} else {
$CPAN::Frontend->mywarn("Warning: $what not yet officially ".
- "supported for distroprefs, doing a normal
lookup");
+ "supported for distroprefs, doing a normal
lookup\n");
return $CPAN::Config->{$what};
}
}
diff --git a/cpan/CPAN/lib/CPAN/Queue.pm b/cpan/CPAN/lib/CPAN/Queue.pm
index 8027d22d3b..259e47e05f 100644
--- a/cpan/CPAN/lib/CPAN/Queue.pm
+++ b/cpan/CPAN/lib/CPAN/Queue.pm
@@ -72,7 +72,7 @@ package CPAN::Queue;
# in CPAN::Distribution::rematein.
use vars qw{ @All $VERSION };
-$VERSION = "5.5002";
+$VERSION = "5.5003";
# CPAN::Queue::queue_item ;
sub queue_item {
@@ -207,6 +207,17 @@ sub reqtype_of {
return $best;
}
+sub iterator {
+ my $i = 0;
+ return sub {
+ until ($All[$i] || $i > $#All) {
+ $i++;
+ }
+ return if $i > $#All;
+ return $All[$i++]
+ };
+}
+
1;
__END__
diff --git a/cpan/CPAN/lib/CPAN/Shell.pm b/cpan/CPAN/lib/CPAN/Shell.pm
index b5d88924df..4140fb8af2 100644
--- a/cpan/CPAN/lib/CPAN/Shell.pm
+++ b/cpan/CPAN/lib/CPAN/Shell.pm
@@ -47,7 +47,7 @@ use vars qw(
"CPAN/Tarzip.pm",
"CPAN/Version.pm",
);
-$VERSION = "5.5008";
+$VERSION = "5.5009";
# record the initial timestamp for reload.
$reload = { map {$INC{$_} ? ($_,(stat $INC{$_})[9]) : ()} @relo };
@CPAN::Shell::ISA = qw(CPAN::Debug);
@@ -1611,9 +1611,10 @@ sub mydie {
# sub CPAN::Shell::colorable_makemaker_prompt ;
sub colorable_makemaker_prompt {
- my($foo,$bar) = @_;
+ my($foo,$bar,$ornament) = @_;
+ $ornament ||= "colorize_print";
if (CPAN::Shell->colorize_output) {
- my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
+ my $ornament = $CPAN::Config->{$ornament}||'bold blue on_white';
my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
print $color_on;
}
@@ -1867,7 +1868,7 @@ to find objects with matching identifiers.
}
}
if (UNIVERSAL::can($obj, 'called_for')) {
- $obj->called_for($s);
+ $obj->called_for($s) unless $obj->called_for;
}
CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;
diff --git a/cpan/CPAN/lib/CPAN/Tarzip.pm b/cpan/CPAN/lib/CPAN/Tarzip.pm
index f585a01bf7..6517cb8fd7 100644
--- a/cpan/CPAN/lib/CPAN/Tarzip.pm
+++ b/cpan/CPAN/lib/CPAN/Tarzip.pm
@@ -4,7 +4,7 @@ use strict;
use vars qw($VERSION @ISA $BUGHUNTING);
use CPAN::Debug;
use File::Basename qw(basename);
-$VERSION = "5.5012";
+$VERSION = "5.5013";
# module is internal to CPAN.pm
@ISA = qw(CPAN::Debug); ## no critic
@@ -41,6 +41,11 @@ CPAN shell prompt to register it as external program.
bless $me, $class;
}
+sub _zlib_ok () {
+ $CPAN::META->has_inst("Compress::Zlib") or return;
+ Compress::Zlib->can('gzopen');
+}
+
sub _my_which {
my($what) = @_;
if ($CPAN::Config->{$what}) {
@@ -66,7 +71,7 @@ sub _my_which {
sub gzip {
my($self,$read) = @_;
my $write = $self->{FILE};
- if ($CPAN::META->has_inst("Compress::Zlib")) {
+ if (_zlib_ok) {
my($buffer,$fhw);
$fhw = FileHandle->new($read)
or $CPAN::Frontend->mydie("Could not open $read: $!");
@@ -89,7 +94,7 @@ sub gzip {
sub gunzip {
my($self,$write) = @_;
my $read = $self->{FILE};
- if ($CPAN::META->has_inst("Compress::Zlib")) {
+ if (_zlib_ok) {
my($buffer,$fhw);
$fhw = FileHandle->new(">$write")
or $CPAN::Frontend->mydie("Could not open >$write: $!");
@@ -120,7 +125,7 @@ sub gtest {
my($buffer,$len);
$len = 0;
my $gz = Compress::Bzip2::bzopen($read, "rb")
- or $CPAN::Frontend->mydie(sprintf("Cannot gzopen %s: %s\n",
+ or $CPAN::Frontend->mydie(sprintf("Cannot bzopen %s: %s\n",
$read,
$Compress::Bzip2::bzerrno));
while ($gz->bzread($buffer) > 0 ) {
@@ -135,7 +140,7 @@ sub gtest {
}
$gz->gzclose();
CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG;
- } elsif ( $read=~/\.(?:gz|tgz)$/ &&
$CPAN::META->has_inst("Compress::Zlib") ) {
+ } elsif ( $read=~/\.(?:gz|tgz)$/ && _zlib_ok ) {
# After I had reread the documentation in zlib.h, I discovered that
# uncompressed files do not lead to an gzerror (anymore?).
my($buffer,$len);
@@ -183,7 +188,7 @@ sub TIEHANDLE {
$CPAN::Frontend->mydie("Could not bzopen $file");
$self->{GZ} = $gz;
$class->debug("via Compress::Bzip2");
- } elsif ($file =~/\.(?:gz|tgz)$/ &&
$CPAN::META->has_inst("Compress::Zlib")) {
+ } elsif ($file =~/\.(?:gz|tgz)$/ && _zlib_ok) {
my $gz = Compress::Zlib::gzopen($file,"rb") or
$CPAN::Frontend->mydie("Could not gzopen $file");
$self->{GZ} = $gz;
@@ -260,7 +265,7 @@ sub untar {
} elsif (
$CPAN::META->has_usable("Archive::Tar")
&&
- $CPAN::META->has_inst("Compress::Zlib") ) {
+ _zlib_ok ) {
my $prefer_external_tar = $CPAN::Config->{prefer_external_tar};
unless (defined $prefer_external_tar) {
if ($^O =~ /(MSWin32|solaris)/) {
@@ -294,7 +299,7 @@ END_WARN
$foundAT = "nothing";
}
my $foundCZ;
- if ($CPAN::META->has_inst("Compress::Zlib")) {
+ if (_zlib_ok) {
$foundCZ = sprintf "'%s'", "Compress::Zlib::"->VERSION;
} elsif ($foundAT) {
$foundCZ = "nothing";
--
Perl5 Master Repository
