In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/41b0043f16694f5080ec5888f9cec5e89b387f19?hp=103f89a72f1697bbe803bc0808ed936e31469d5d>
- Log -----------------------------------------------------------------
commit 41b0043f16694f5080ec5888f9cec5e89b387f19
Author: Aaron Crane <a...@cpan.org>
Date: Wed Mar 19 16:15:21 2014 +0000
Upgrade CPAN from 2.03-TRIAL to 2.04-TRIAL
[DELTA]
2014-03-18 Andreas Koenig <k@UX31A>
* release 2.04-TRIAL
* history of master branch was rewritten after Tour de France bughunting
(Lyon #QA2014); apologies to all repository followers: the real history,
as it actually went, is not worth being recorded in the master branch.
* address #91706 and #86915: the 'force install' bug and the endless
loop bugs reported in the two tickets are fixed (joined forces)
* new configure option 'use_prompt_default' (David Golden)
* add new dummy distros OptionalPrereq and CircularPrereq for testing
recommends/suggests support
* experimental recommends/suggests support (David Golden, Andreas
Koenig)
* enable hiding of directories in the distroprefs tree (suggested by
Slaven ReziÄ)
-----------------------------------------------------------------------
Summary of changes:
Porting/Maintainers.pl | 2 +-
cpan/CPAN/lib/App/Cpan.pm | 3 +-
cpan/CPAN/lib/CPAN.pm | 3 +-
cpan/CPAN/lib/CPAN/Bundle.pm | 6 +-
cpan/CPAN/lib/CPAN/Complete.pm | 4 +-
cpan/CPAN/lib/CPAN/Distribution.pm | 271 ++++++++++++++++++++++++-------
cpan/CPAN/lib/CPAN/Distroprefs.pm | 8 +-
cpan/CPAN/lib/CPAN/FirstTime.pm | 24 ++-
cpan/CPAN/lib/CPAN/HandleConfig.pm | 3 +-
cpan/CPAN/lib/CPAN/Queue.pm | 24 +--
cpan/CPAN/lib/CPAN/Shell.pm | 317 ++++++++++++++++++++++++++++++++-----
cpan/CPAN/lib/CPAN/Tarzip.pm | 8 +-
cpan/CPAN/lib/CPAN/Version.pm | 6 +-
13 files changed, 553 insertions(+), 126 deletions(-)
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index b9b6732..1366783 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -252,7 +252,7 @@ use File::Glob qw(:case);
},
'CPAN' => {
- 'DISTRIBUTION' => 'ANDK/CPAN-2.03-TRIAL.tar.gz',
+ 'DISTRIBUTION' => 'ANDK/CPAN-2.04-TRIAL.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 bdeb2c2..b548bcc 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.61';
+$VERSION = '1.62';
=head1 NAME
@@ -965,6 +965,7 @@ sub _dump_config # -J
my $fh = $args->[0] || \*STDOUT;
+ local $Data::Dumper::Sortkeys = 1;
my $dd = Data::Dumper->new(
[$CPAN::Config],
['$CPAN::Config']
diff --git a/cpan/CPAN/lib/CPAN.pm b/cpan/CPAN/lib/CPAN.pm
index 7654aec..6d7cff9 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.03';
+$CPAN::VERSION = '2.04';
$CPAN::VERSION =~ s/_//;
# we need to run chdir all over and we would get at wrong libraries
@@ -2129,6 +2129,7 @@ currently defined:
CPAN::Reporter history)
unzip location of external program unzip
urllist arrayref to nearby CPAN sites (or equivalent locations)
+ use_prompt_default set PERL_MM_USE_DEFAULT for configure/make/test/install
use_sqlite use CPAN::SQLite for metadata storage (fast and lean)
username your username if you CPAN server wants one
version_timeout stops version parsing after this many seconds.
diff --git a/cpan/CPAN/lib/CPAN/Bundle.pm b/cpan/CPAN/lib/CPAN/Bundle.pm
index b63d41c..1525dde 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.5";
+$VERSION = "5.5001";
sub look {
my $self = shift;
@@ -229,7 +229,9 @@ Going to $meth that.
my $obj = $CPAN::META->instance($type,$s);
$obj->{reqtype} = $self->{reqtype};
# $obj->$meth();
- CPAN::Queue->queue_item(qmod => $obj->id, reqtype => $self->{reqtype});
+ # XXX should optional be based on whether bundle was optional? -- xdg,
2012-04-01
+ # A: Sure, what could demand otherwise? --andk, 2013-11-25
+ CPAN::Queue->queue_item(qmod => $obj->id, reqtype => $self->{reqtype},
optional => !$self->{mandatory});
}
}
diff --git a/cpan/CPAN/lib/CPAN/Complete.pm b/cpan/CPAN/lib/CPAN/Complete.pm
index e1fe896..588e6e6 100644
--- a/cpan/CPAN/lib/CPAN/Complete.pm
+++ b/cpan/CPAN/lib/CPAN/Complete.pm
@@ -4,7 +4,7 @@ package CPAN::Complete;
use strict;
@CPAN::Complete::ISA = qw(CPAN::Debug);
# Q: where is the "How do I add a new command" HOWTO?
-# A: svn diff -r 1048:1049 where andk added the report command
+# A: git log -p -1 355c44e9caaec857e4b12f51afb96498833c3e36 where andk added
the report command
@CPAN::Complete::COMMANDS = sort qw(
? ! a b d h i m o q r u
autobundle
@@ -42,7 +42,7 @@ use strict;
use vars qw(
$VERSION
);
-$VERSION = "5.5";
+$VERSION = "5.5001";
package CPAN::Complete;
use strict;
diff --git a/cpan/CPAN/lib/CPAN/Distribution.pm
b/cpan/CPAN/lib/CPAN/Distribution.pm
index 91f4f28..9320c78 100644
--- a/cpan/CPAN/lib/CPAN/Distribution.pm
+++ b/cpan/CPAN/lib/CPAN/Distribution.pm
@@ -4,11 +4,12 @@ package CPAN::Distribution;
use strict;
use Cwd qw(chdir);
use CPAN::Distroprefs;
+use CPAN::Meta::Requirements 2;
use CPAN::InfoObj;
use File::Path ();
@CPAN::Distribution::ISA = qw(CPAN::InfoObj);
use vars qw($VERSION);
-$VERSION = "2.00";
+$VERSION = "2.01";
# Accessors
sub cpan_comment {
@@ -186,8 +187,12 @@ sub color_cmd_tmps {
my $prereq_pm = $self->prereq_pm;
if (defined $prereq_pm) {
# XXX also optional_req & optional_breq? -- xdg, 2012-04-01
- PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
- keys %{$prereq_pm->{build_requires}||{}}) {
+ PREREQ: for my $pre (
+ keys %{$prereq_pm->{requires}||{}},
+ keys %{$prereq_pm->{build_requires}||{}},
+ keys %{$prereq_pm->{opt_requires}||{}},
+ keys %{$prereq_pm->{opt_build_requires}||{}}
+ ) {
next PREREQ if $pre eq "perl";
my $premo;
unless ($premo = CPAN::Shell->expand("Module",$pre)) {
@@ -1853,6 +1858,8 @@ sub prepare {
}
local $ENV{PERL} = $ENV{PERL};
local $ENV{PERL5_CPAN_IS_EXECUTING} = $ENV{PERL5_CPAN_IS_EXECUTING};
+ local $ENV{PERL_MM_USE_DEFAULT} = 1 if $CPAN::Config->{use_prompt_default};
+ local $ENV{NONINTERACTIVE_TESTING} = 1 if
$CPAN::Config->{use_prompt_default};
if ($pl_commandline) {
$system = $pl_commandline;
$ENV{PERL} = $^X;
@@ -2129,6 +2136,8 @@ is part of the perl-%s distribution. To install that, you
need to run
$make_commandline = $self->prefs->{make}{commandline};
}
local $ENV{PERL} = $ENV{PERL};
+ local $ENV{PERL_MM_USE_DEFAULT} = 1 if $CPAN::Config->{use_prompt_default};
+ local $ENV{NONINTERACTIVE_TESTING} = 1 if
$CPAN::Config->{use_prompt_default};
if ($make_commandline) {
$system = $make_commandline;
$ENV{PERL} = CPAN::find_perl();
@@ -2569,6 +2578,15 @@ sub _make_install_make_command {
return $mimc;
}
+#-> sub CPAN::Distribution::is_locally_optional
+sub is_locally_optional {
+ my($self, $prereq_pm, $prereq) = @_;
+ $prereq_pm ||= $self->{prereq_pm};
+ exists $prereq_pm->{opt_requires}{$prereq}
+ ||
+ exists $prereq_pm->{opt_build_requires}{$prereq};
+}
+
#-> sub CPAN::Distribution::follow_prereqs ;
sub follow_prereqs {
my($self) = shift;
@@ -2577,13 +2595,14 @@ sub follow_prereqs {
return unless @prereq_tuples;
my(@good_prereq_tuples);
for my $p (@prereq_tuples) {
+ # e.g. $p = ['Devel::PartialDump', 'r', 1]
# promote if possible
if ($p->[1] =~ /^(r|c)$/) {
push @good_prereq_tuples, $p;
} elsif ($p->[1] =~ /^(b)$/) {
my $reqtype = CPAN::Queue->reqtype_of($p->[0]);
if ($reqtype =~ /^(r|c)$/) {
- push @good_prereq_tuples, [$p->[0], $reqtype];
+ push @good_prereq_tuples, [$p->[0], $reqtype, $p->[2]];
} else {
push @good_prereq_tuples, $p;
}
@@ -2615,7 +2634,7 @@ sub follow_prereqs {
$CPAN::Frontend->
myprint("$filler1 $unsat $filler2".
"$filler3 $pretty_id $filler4".
- join("", map {" $_->[0] \[$map{$_->[1]}]\n"}
@good_prereq_tuples),
+ join("", map {sprintf " %s \[%s%s]\n", $_->[0],
$map{$_->[1]}, $self->is_locally_optional(undef,$_->[0]) ? ",optional" : ""}
@good_prereq_tuples),
);
my $follow = 0;
if ($CPAN::Config->{prerequisites_policy} eq "follow") {
@@ -2633,24 +2652,42 @@ of modules we are processing right now?", "yes");
}
if ($follow) {
my $id = $self->id;
- # color them as dirty
+ my(@to_queue_mand,@to_queue_opt);
for my $gp (@good_prereq_tuples) {
- # warn "calling color_cmd_tmps(0,1)";
- my $p = $gp->[0];
- my $any = CPAN::Shell->expandany($p);
- $self->{$slot . "_for"}{$any->id}++;
- if ($any) {
- $any->color_cmd_tmps(0,2);
+ my($prereq,$reqtype,$optional) = @$gp;
+ my $qthing =
+{qmod=>$prereq,reqtype=>$reqtype,optional=>$optional};
+ if ($optional &&
+ $self->is_locally_optional(undef,$prereq)
+ ){
+ # Since we do not depend on this one, we do not need
+ # this in a mandatory arrangement:
+ push @to_queue_opt, $qthing;
} else {
- $CPAN::Frontend->mywarn("Warning (maybe a bug): Cannot expand
prereq '$p'\n");
- $CPAN::Frontend->mysleep(2);
+ my $any = CPAN::Shell->expandany($prereq);
+ $self->{$slot . "_for"}{$any->id}++;
+ if ($any) {
+ unless ($optional) {
+ # No recursion check in an optional area of the tree
+ $any->color_cmd_tmps(0,2);
+ }
+ } else {
+ $CPAN::Frontend->mywarn("Warning (maybe a bug): Cannot
expand prereq '$prereq'\n");
+ $CPAN::Frontend->mysleep(2);
+ }
+ # order everything that is not locally_optional just
+ # like mandatory items: this keeps leaves before
+ # branches
+ unshift @to_queue_mand, $qthing;
}
}
- # queue them and re-queue yourself
- CPAN::Queue->jumpqueue({qmod => $id, reqtype => $self->{reqtype}},
- map {+{qmod=>$_->[0],reqtype=>$_->[1]}} reverse
@good_prereq_tuples);
- $self->{$slot} = "Delayed until after prerequisites";
- return 1; # signal we need dependencies
+ if (@to_queue_mand) {
+ unshift @to_queue_mand, {qmod => $id, reqtype => $self->{reqtype},
optional=> !$self->{mandatory}};
+ CPAN::Queue->jumpqueue(@to_queue_opt,@to_queue_mand);
+ $self->{$slot} = "Delayed until after prerequisites";
+ return 1; # signal we need dependencies
+ } elsif (@to_queue_opt) {
+ CPAN::Queue->jumpqueue(@to_queue_opt);
+ }
}
return;
}
@@ -2695,19 +2732,22 @@ sub _feature_depends {
sub prereqs_for_slot {
my($self,$slot) = @_;
- my(%merged,$prereq_pm);
+ my($prereq_pm);
+ my $merged = CPAN::Meta::Requirements->new;
my $prefs_depends = $self->prefs->{depends}||{};
my $feature_depends = $self->_feature_depends();
if ($slot eq "configure_requires_later") {
- my $meta_configure_requires = $self->configure_requires();
- %merged = (
- %{$meta_configure_requires||{}},
- %{$prefs_depends->{configure_requires}||{}},
- %{$feature_depends->{configure_requires}||{}},
- );
- if (-f File::Spec->catfile($self->{build_dir},"Build.PL")
+ for my $hash ( $self->configure_requires,
+ $prefs_depends->{configure_requires},
+ $feature_depends->{configure_requires},
+ ) {
+ $merged->add_requirements(
+ CPAN::Meta::Requirements->from_string_hash($hash)
+ );
+ }
+ if (-f "Build.PL"
&& ! -f File::Spec->catfile($self->{build_dir},"Makefile.PL")
- && ! exists $merged{"Module::Build"}
+ && ! $merged->requirements_for_module("Module::Build")
&& ! $CPAN::META->has_inst("Module::Build")
) {
$CPAN::Frontend->mywarn(
@@ -2715,13 +2755,13 @@ sub prereqs_for_slot {
" Adding it now as such.\n"
);
$CPAN::Frontend->mysleep(5);
- $merged{"Module::Build"} = 0;
+ $merged->add_minimum( "Module::Build" => 0 );
delete $self->{writemakefile};
}
$prereq_pm = {}; # configure_requires defined as "b"
} elsif ($slot eq "later") {
my $prereq_pm_0 = $self->prereq_pm || {};
- for my $reqtype (qw(requires build_requires)) {
+ for my $reqtype (qw(requires build_requires opt_requires
opt_build_requires)) {
$prereq_pm->{$reqtype} = {%{$prereq_pm_0->{$reqtype}||{}}}; # copy
to not pollute it
for my $dep ($prefs_depends,$feature_depends) {
for my $k (keys %{$dep->{$reqtype}||{}}) {
@@ -2729,12 +2769,22 @@ sub prereqs_for_slot {
}
}
}
- %merged =
(%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
# XXX what about optional_req|breq? -- xdg, 2012-04-01
+ for my $hash (
+ $prereq_pm->{requires},
+ $prereq_pm->{build_requires},
+ $prereq_pm->{opt_requires},
+ $prereq_pm->{opt_build_requires},
+
+ ) {
+ $merged->add_requirements(
+ CPAN::Meta::Requirements->from_string_hash($hash)
+ );
+ }
} else {
die "Panic: illegal slot '$slot'";
}
- return (\%merged, $prereq_pm);
+ return ($merged->as_string_hash, $prereq_pm);
}
#-> sub CPAN::Distribution::unsat_prereq ;
@@ -2743,11 +2793,13 @@ sub prereqs_for_slot {
# (sorry for the inconsistency, it was an accident)
sub unsat_prereq {
my($self,$slot) = @_;
- my($merged,$prereq_pm) = $self->prereqs_for_slot($slot);
+ my($merged_hash,$prereq_pm) = $self->prereqs_for_slot($slot);
my(@need);
- my @merged = my %merged = %$merged;
+ my $merged = CPAN::Meta::Requirements->from_string_hash($merged_hash);
+ my @merged = $merged->required_modules;
CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG;
- NEED: while (my($need_module, $need_version) = each %merged) {
+ NEED: for my $need_module ( @merged ) {
+ my $need_version = $merged->requirements_for_module($need_module);
my($available_version,$inst_file,$available_file,$nmo);
if ($need_module eq "perl") {
$available_version = $];
@@ -2792,8 +2844,7 @@ sub unsat_prereq {
$available_version,
$need_version,
);
- if (0) {
- } elsif ( $inst_file
+ if ( $inst_file
&& $available_file eq $inst_file
&& $nmo->inst_deprecated
) {
@@ -2810,7 +2861,12 @@ sub unsat_prereq {
# loop CPANPLUS => CPANPLUS::Dist::Build RT#83042)
next NEED;
}
- } elsif ($self->{reqtype} =~ /^(r|c)$/ && exists
$prereq_pm->{requires}{$need_module} && $nmo && !$inst_file) {
+ } elsif (
+ $self->{reqtype} =~ /^(r|c)$/
+ && (exists $prereq_pm->{requires}{$need_module} || exists
$prereq_pm->{opt_requires} )
+ && $nmo
+ && !$inst_file
+ ) {
# continue installing as a prereq; this may be a
# distro we already used when it was a build_requires
# so we did not install it. But suddenly somebody
@@ -2873,8 +2929,6 @@ sub unsat_prereq {
);
next NEED;
}
- ### XXX here do next NEED if needed module is recommends/suggests
- ### so we don't complain about missing optional deps -- xdg,
2012-04-01
NOSAYER: for my $nosayer (
"unwrapped",
"writemakefile",
@@ -2896,14 +2950,20 @@ sub unsat_prereq {
) {
next NOSAYER;
}
- $CPAN::Frontend->mywarn("Warning: Prerequisite ".
- "'$need_module =>
$need_version' ".
- "for '$selfid' failed when ".
- "processing '$did' with ".
- "'$nosayer =>
$do->{$nosayer}'. Continuing, ".
- "but chances to succeed are
limited.\n"
- );
- $CPAN::Frontend->mysleep($sponsoring/10);
+ ### XXX don't complain about missing optional deps --
xdg, 2012-04-01
+ if ($self->is_locally_optional($prereq_pm,
$need_module)) {
+ # don't complain about failing optional prereqs
+ }
+ else {
+ $CPAN::Frontend->mywarn("Warning: Prerequisite ".
+ "'$need_module =>
$need_version' ".
+ "for '$selfid' failed when
".
+ "processing '$did' with ".
+ "'$nosayer =>
$do->{$nosayer}'. Continuing, ".
+ "but chances to succeed
are limited.\n"
+ );
+ $CPAN::Frontend->mysleep($sponsoring/10);
+ }
next NEED;
} else { # the other guy succeeded
if ($nosayer =~ /^(install|make_test)$/) {
@@ -2925,10 +2985,10 @@ sub unsat_prereq {
}
}
my $needed_as;
- # XXX here need to flag as optional somehow for recommends/suggests
- # -- xdg, 2012-04-01
if (0) {
- } elsif (exists $prereq_pm->{requires}{$need_module}) {
+ } elsif (exists $prereq_pm->{requires}{$need_module}
+ || exists $prereq_pm->{opt_requires}{$need_module}
+ ) {
$needed_as = "r";
} elsif ($slot eq "configure_requires_later") {
# in ae872487d5 we said: C< we have not yet run the
@@ -2941,7 +3001,11 @@ sub unsat_prereq {
} else {
$needed_as = "b";
}
- push @need, [$need_module,$needed_as];
+ # here need to flag as optional for recommends/suggests
+ # -- xdg, 2012-04-01
+ my $optional = !$self->{mandatory}
+ || $self->is_locally_optional($prereq_pm, $need_module);
+ push @need, [$need_module,$needed_as,$optional];
}
my @unfolded = map { "[".join(",",@$_)."]" } @need;
CPAN->debug("returning from unsat_prereq[@unfolded]") if $CPAN::DEBUG;
@@ -3087,7 +3151,7 @@ sub prereq_pm {
$self->{writemakefile}||"",
$self->{modulebuild}||"",
) if $CPAN::DEBUG;
- my($req,$breq);
+ my($req,$breq, $opt_req, $opt_breq);
my $meta_obj = $self->read_meta;
# META/MYMETA is only authoritative if dynamic_config is false
if ($meta_obj && ! $meta_obj->dynamic_config) {
@@ -3095,16 +3159,35 @@ sub prereq_pm {
my $requires = $prereqs->requirements_for(qw/runtime requires/);
my $build_requires = $prereqs->requirements_for(qw/build requires/);
my $test_requires = $prereqs->requirements_for(qw/test requires/);
- # XXX assemble optional_req && optional_breq from recommends/suggests
- # depending on corresponding policies -- xdg, 2012-04-01
# XXX we don't yet distinguish build vs test, so merge them for now
$build_requires->add_requirements($test_requires);
$req = $requires->as_string_hash;
$breq = $build_requires->as_string_hash;
+
+ # XXX assemble optional_req && optional_breq from recommends/suggests
+ # depending on corresponding policies -- xdg, 2012-04-01
+ my $opt_runtime = CPAN::Meta::Requirements->new;
+ my $opt_build = CPAN::Meta::Requirements->new;
+ if ( $CPAN::Config->{recommends_policy} ) {
+ $opt_runtime->add_requirements(
$prereqs->requirements_for(qw/runtime recommends/));
+ $opt_build->add_requirements(
$prereqs->requirements_for(qw/build recommends/));
+ $opt_build->add_requirements( $prereqs->requirements_for(qw/test
recommends/));
+
+ }
+ if ( $CPAN::Config->{suggests_policy} ) {
+ $opt_runtime->add_requirements(
$prereqs->requirements_for(qw/runtime suggests/));
+ $opt_build->add_requirements(
$prereqs->requirements_for(qw/build suggests/));
+ $opt_build->add_requirements( $prereqs->requirements_for(qw/test
suggests/));
+ }
+ $opt_req = $opt_runtime->as_string_hash;
+ $opt_breq = $opt_build->as_string_hash;
}
elsif (my $yaml = $self->read_yaml) { # often dynamic_config prevents a
result here
$req = $yaml->{requires} || {};
$breq = $yaml->{build_requires} || {};
+ if ( $CPAN::Config->{recommends_policy} ) {
+ $opt_req = $yaml->{recommends} || {};
+ }
undef $req unless ref $req eq "HASH" && %$req;
if ($req) {
if ($yaml->{generated_by} &&
@@ -3211,9 +3294,14 @@ sub prereq_pm {
}
}
}
- # XXX needs to be adapted for optional_req & optional_breq
- if ($req || $breq) {
- return $self->{prereq_pm} = { requires => $req, build_requires =>
$breq };
+ # XXX needs to be adapted for optional_req & optional_breq -- xdg,
2012-04-01
+ if ($req || $breq || $opt_req || $opt_breq ) {
+ return $self->{prereq_pm} = {
+ requires => $req,
+ build_requires => $breq,
+ opt_requires => $opt_req,
+ opt_build_requires => $opt_breq,
+ };
}
}
@@ -3269,6 +3357,58 @@ sub shortcut_test {
return undef; # no shortcut
}
+#-> sub CPAN::Distribution::_exe_files ;
+sub _exe_files {
+ my($self) = @_;
+ return unless $self->{writemakefile} # no need to have succeeded
+ # but we must have run it
+ || $self->{modulebuild};
+ unless ($self->{build_dir}) {
+ return;
+ }
+ CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]",
+ $self->{writemakefile}||"",
+ $self->{modulebuild}||"",
+ ) if $CPAN::DEBUG;
+ my $build_dir;
+ unless ( $build_dir = $self->{build_dir} ) {
+ return;
+ }
+ my $makefile = File::Spec->catfile($build_dir,"Makefile");
+ my $fh;
+ my @exe_files;
+ if (-f $makefile
+ and
+ $fh = FileHandle->new("<$makefile\0")) {
+ CPAN->debug("Getting exefiles from Makefile") if $CPAN::DEBUG;
+ local($/) = "\n";
+ while (<$fh>) {
+ last if /MakeMaker post_initialize section/;
+ my($p) = m{^[\#]
+ \s+EXE_FILES\s+=>\s+\[(.+)\]
+ }x;
+ next unless $p;
+ # warn "Found exefiles expr[$p]";
+ my @p = split /,\s*/, $p;
+ for my $p2 (@p) {
+ if ($p2 =~ /^q\[(.+)\]/) {
+ push @exe_files, $1;
+ }
+ }
+ }
+ }
+ return \@exe_files if @exe_files;
+ my $buildparams = File::Spec->catfile($build_dir,"_build","build_params");
+ if (-f $buildparams) {
+ CPAN->debug("Found '$buildparams'") if $CPAN::DEBUG;
+ my $x = do $buildparams;
+ for my $sf (@{$x->[2]{script_files} || []}) {
+ push @exe_files, $sf;
+ }
+ }
+ return \@exe_files;
+}
+
#-> sub CPAN::Distribution::test ;
sub test {
my($self) = @_;
@@ -3299,6 +3439,8 @@ sub test {
local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
$CPAN::META->set_perl5lib;
local $ENV{MAKEFLAGS}; # protect us from outer make calls
+ local $ENV{PERL_MM_USE_DEFAULT} = 1 if $CPAN::Config->{use_prompt_default};
+ local $ENV{NONINTERACTIVE_TESTING} = 1 if
$CPAN::Config->{use_prompt_default};
$CPAN::Frontend->myprint("Running $make test\n");
@@ -3431,6 +3573,10 @@ sub test {
$but .= "; additionally test harness failed";
$CPAN::Frontend->mywarn("$but\n");
$self->{make_test} = CPAN::Distrostatus->new("NO $but");
+ } elsif ( $self->{force_update} ) {
+ $self->{make_test} = CPAN::Distrostatus->new(
+ "NO but failure ignored because 'force' in effect"
+ );
} else {
$self->{make_test} = CPAN::Distrostatus->new("NO");
}
@@ -3444,7 +3590,8 @@ sub test {
$self->pretty_id));
}
$self->store_persistent_state;
- return !! $tests_ok;
+
+ return $self->{force_update} ? 1 : !! $tests_ok;
}
sub _make_test_illuminate_prereqs {
@@ -3476,7 +3623,8 @@ sub _make_test_illuminate_prereqs {
CPAN->debug("m[$m] have available_file[$available_file]")
if $CPAN::DEBUG;
} else {
- push @prereq, $m;
+ push @prereq, $m
+ if $m_obj->{mandatory};
}
}
my $but;
@@ -3760,6 +3908,9 @@ sub install {
local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
$CPAN::META->set_perl5lib;
+ 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($pipe) = FileHandle->new("$system $stderr |") || Carp::croak
("Can't execute $system: $!");
my($makeout) = "";
diff --git a/cpan/CPAN/lib/CPAN/Distroprefs.pm
b/cpan/CPAN/lib/CPAN/Distroprefs.pm
index 3859530..05b19fa 100644
--- a/cpan/CPAN/lib/CPAN/Distroprefs.pm
+++ b/cpan/CPAN/lib/CPAN/Distroprefs.pm
@@ -6,7 +6,7 @@ use strict;
package CPAN::Distroprefs;
use vars qw($VERSION);
-$VERSION = '6';
+$VERSION = '6.0001';
package CPAN::Distroprefs::Result;
@@ -162,7 +162,7 @@ sub _build_file_list {
while (my $fn = readdir $dh) {
next if $fn eq '.' || $fn eq '..';
if (-d "$dir/$fn") {
- next if $fn eq '.svn' || $fn eq '.git' || $fn eq '.hg' || $fn eq
'_darcs';
+ next if $fn =~ /^[._]/; # prune .svn, .git, .hg, _darcs and what
the user wants to hide
push @list, _build_file_list("$dir/$fn", "$dir1$fn/", $ext_re);
} else {
if ($fn =~ $ext_re) {
@@ -374,7 +374,9 @@ This module encapsulates reading L<Distroprefs|CPAN> and
matching them against C
while (my $result = $finder->next) { ... }
-Build an iterator which finds distroprefs files in the given directory.
+Build an iterator which finds distroprefs files in the tree below the
+given directory. Within the tree directories matching C<m/^[._]/> are
+pruned.
C<%ext_map> is a hashref whose keys are file extensions and whose values are
modules used to load matching files:
diff --git a/cpan/CPAN/lib/CPAN/FirstTime.pm b/cpan/CPAN/lib/CPAN/FirstTime.pm
index 8aa6b06..0998ff6 100644
--- a/cpan/CPAN/lib/CPAN/FirstTime.pm
+++ b/cpan/CPAN/lib/CPAN/FirstTime.pm
@@ -10,7 +10,7 @@ use File::Path ();
use File::Spec ();
use CPAN::Mirrors ();
use vars qw($VERSION $auto_config);
-$VERSION = "5.5304";
+$VERSION = "5.5305";
=head1 NAME
@@ -132,6 +132,9 @@ warnings, debugging output, and the output of the modules
being
installed. Set your favorite colors after some experimenting with the
Term::ANSIColor module.
+Please note that on Windows platforms colorized output also requires
+the Win32::Console::ANSI module.
+
Do you want to turn on colored output?
=item colorize_print
@@ -203,7 +206,8 @@ Preferred method for determining the current working
directory?
Normally, CPAN.pm continues processing the full list of targets and
dependencies, even if one of them fails. However, you can specify
-that CPAN should halt after the first failure.
+that CPAN should halt after the first failure. (Note that optional
+recommended or suggested modules that fail will not cause a halt.)
Do you want to halt on failure (yes/no)?
@@ -554,6 +558,17 @@ regardless of the history using "force".
Do you want to rely on the test report history (yes/no)?
+=item use_prompt_default
+
+When this is true, CPAN will set PERL_MM_USE_DEFAULT to a true
+value. This causes ExtUtils::MakeMaker (and compatible) prompts
+to use default values instead of stopping to prompt you to answer
+questions. It also sets NONINTERACTIVE_TESTING to a true value to
+signal more generally that distributions should not try to
+interact with you.
+
+Do you want to use prompt defaults (yes/no)?
+
=item use_sqlite
CPAN::SQLite is a layer between the index files that are downloaded
@@ -1064,6 +1079,11 @@ sub init {
my_dflt_prompt(mbuild_install_arg => "", $matcher);
#
+ #== use_prompt_default
+ #
+ my_yn_prompt(use_prompt_default => 0, $matcher);
+
+ #
#= Alarm period
#
diff --git a/cpan/CPAN/lib/CPAN/HandleConfig.pm
b/cpan/CPAN/lib/CPAN/HandleConfig.pm
index 73563d3..f114321 100644
--- a/cpan/CPAN/lib/CPAN/HandleConfig.pm
+++ b/cpan/CPAN/lib/CPAN/HandleConfig.pm
@@ -110,6 +110,7 @@ $VERSION = "5.5003"; # see also CPAN::Config::VERSION at
end of file
"trust_test_report_history",
"unzip",
"urllist",
+ "use_prompt_default",
"use_sqlite",
"username",
"version_timeout",
@@ -767,7 +768,7 @@ sub prefs_lookup {
use strict;
use vars qw($AUTOLOAD $VERSION);
- $VERSION = "5.5001";
+ $VERSION = "5.5002";
# formerly CPAN::HandleConfig was known as CPAN::Config
sub AUTOLOAD { ## no critic
diff --git a/cpan/CPAN/lib/CPAN/Queue.pm b/cpan/CPAN/lib/CPAN/Queue.pm
index 7e08ed9..8027d22 100644
--- a/cpan/CPAN/lib/CPAN/Queue.pm
+++ b/cpan/CPAN/lib/CPAN/Queue.pm
@@ -20,6 +20,11 @@ sub reqtype {
$self->{reqtype};
}
+sub optional {
+ my($self) = @_;
+ $self->{optional};
+}
+
package CPAN::Queue;
# One use of the queue is to determine if we should or shouldn't
@@ -67,7 +72,7 @@ package CPAN::Queue;
# in CPAN::Distribution::rematein.
use vars qw{ @All $VERSION };
-$VERSION = "5.5001";
+$VERSION = "5.5002";
# CPAN::Queue::queue_item ;
sub queue_item {
@@ -82,7 +87,7 @@ sub qpush {
my($class,$obj) = @_;
push @All, $obj;
CPAN->debug(sprintf("in new All[%s]",
- join("",map {sprintf "
%s\[%s]\n",$_->{qmod},$_->{reqtype}} @All),
+ join("",map {sprintf "
%s\[%s][%s]\n",$_->{qmod},$_->{reqtype},$_->{optional}} @All),
)) if $CPAN::DEBUG;
}
@@ -104,7 +109,7 @@ sub delete_first {
}
CPAN->debug(sprintf("after delete_first mod[%s] All[%s]",
$what,
- join("",map {sprintf "
%s\[%s]\n",$_->{qmod},$_->{reqtype}} @All)
+ join("",map {sprintf "
%s\[%s][%s]\n",$_->{qmod},$_->{reqtype},$_->{optional}} @All)
)) if $CPAN::DEBUG;
}
@@ -113,8 +118,8 @@ sub jumpqueue {
my $class = shift;
my @what = @_;
CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
- join("",map {sprintf "
%s\[%s]\n",$_->{qmod},$_->{reqtype}} @All),
- join("",map {sprintf "
%s\[%s]\n",$_->{qmod},$_->{reqtype}} @what),
+ join("",map {sprintf "
%s\[%s][%s]\n",$_->{qmod},$_->{reqtype},$_->{optional}} @All),
+ join("",map {sprintf "
%s\[%s][%s]\n",$_->{qmod},$_->{reqtype},$_->{optional}} @what),
)) if $CPAN::DEBUG;
unless (defined $what[0]{reqtype}) {
# apparently it was not the Shell that sent us this enquiry,
@@ -123,7 +128,7 @@ sub jumpqueue {
}
my $inherit_reqtype = $what[0]{reqtype} =~ /^(c|r)$/ ? "r" : "b";
WHAT: for my $what_tuple (@what) {
- my($qmod,$reqtype) = @$what_tuple{qw(qmod reqtype)};
+ my($qmod,$reqtype,$optional) = @$what_tuple{qw(qmod reqtype optional)};
if ($reqtype eq "r"
&&
$inherit_reqtype eq "b"
@@ -142,12 +147,13 @@ sub jumpqueue {
CPAN->debug("qmod[$qmod]jumped[$jumped]") if $CPAN::DEBUG;
my $obj = "$class\::Item"->new(
qmod => $qmod,
- reqtype => $reqtype
+ reqtype => $reqtype,
+ optional => !! $optional,
);
unshift @All, $obj;
}
CPAN->debug(sprintf("after jumpqueue All[%s]",
- join("",map {sprintf "
%s\[%s]\n",$_->{qmod},$_->{reqtype}} @All)
+ join("",map {sprintf "
%s\[%s][%s]\n",$_->{qmod},$_->{reqtype},$_->{optional}} @All)
)) if $CPAN::DEBUG;
}
@@ -166,7 +172,7 @@ sub delete {
@All = grep { $_->{qmod} ne $mod } @All;
CPAN->debug(sprintf("after delete mod[%s] All[%s]",
$mod,
- join("",map {sprintf "
%s\[%s]\n",$_->{qmod},$_->{reqtype}} @All)
+ join("",map {sprintf "
%s\[%s][%s]\n",$_->{qmod},$_->{reqtype},$_->{optional}} @All)
)) if $CPAN::DEBUG;
}
diff --git a/cpan/CPAN/lib/CPAN/Shell.pm b/cpan/CPAN/lib/CPAN/Shell.pm
index 323ecdb..a5cec99 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.5002";
+$VERSION = "5.5003";
# record the initial timestamp for reload.
$reload = { map {$INC{$_} ? ($_,(stat $INC{$_})[9]) : ()} @relo };
@CPAN::Shell::ISA = qw(CPAN::Debug);
@@ -772,6 +772,201 @@ sub scripts {
}
}
+sub _guess_manpage {
+ my($self,$d,$contains,$dist) = @_;
+ $dist =~ s/-/::/g;
+ my $module;
+ if (exists $contains->{$dist}) {
+ $module = $dist;
+ } elsif (1 == keys %$contains) {
+ ($module) = keys %$contains;
+ }
+ my $manpage;
+ if ($module) {
+ my $m = $self->expand("Module",$module);
+ $m->as_string; # called for side-effects, shame
+ $manpage = $m->{MANPAGE};
+ } else {
+ $manpage = "unknown";
+ }
+ return $manpage;
+}
+
+#-> sub CPAN::Shell::_specfile ;
+sub _specfile {
+ my $self = shift;
+ my $distribution = shift;
+ unless ($CPAN::META->has_inst("CPAN::DistnameInfo")){
+ $CPAN::Frontend->mydie("CPAN::DistnameInfo not installed; cannot
continue");
+ }
+ my $d = CPAN::Shell->expand("Distribution",$distribution)
+ or $CPAN::Frontend->mydie("Unknowns distribution '$distribution'\n");
+ my $build_dir = $d->{build_dir} or $CPAN::Frontend->mydie("Distribution
has not been built yet, cannot proceed");
+ my %contains = map {($_ => undef)} $d->containsmods;
+ my @m;
+ my $width = 16;
+ my $header = sub {
+ my($header,$value) = @_;
+ push @m, sprintf("%-s:%*s%s\n", $header, $width-length($header), "",
$value);
+ };
+ my $dni = CPAN::DistnameInfo->new($distribution);
+ my $dist = $dni->dist;
+ my $summary = $self->_guess_manpage($d,\%contains,$dist);
+ $header->("Name", "perl-$dist");
+ my $version = $dni->version;
+ $header->("Version", $version);
+ $header->("Release", "1%{?dist}");
+#Summary: Template processing system
+#Group: Development/Libraries
+#License: GPL+ or Artistic
+#URL: http://www.template-toolkit.org/
+#Source0:
http://search.cpan.org/CPAN/authors/id/A/AB/ABW/Template-Toolkit-%{version}.tar.gz
+#Patch0: Template-2.22-SREZIC-01.patch
+#BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)
+ for my $h_tuple
+ ([Summary => $summary],
+ [Group => "Development/Libraries"],
+ [License =>],
+ [URL =>],
+ [BuildRoot =>
"%{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)"],
+ [Requires => "perl(:MODULE_COMPAT_%(eval \"`%{__perl}
-V:version`\"; echo \$version))"],
+ ) {
+ my($h,$v) = @$h_tuple;
+ $v = "unknown" unless defined $v;
+ $header->($h, $v);
+ }
+ $header->("Source0", sprintf(
+
"http://search.cpan.org/CPAN/authors/id/%s/%s/%s";,
+ substr($distribution,0,1),
+ substr($distribution,0,2),
+ $distribution
+ ));
+ require POSIX;
+ my @xs = glob "$build_dir/*.xs"; # quick try
+ unless (@xs) {
+ require ExtUtils::Manifest;
+ my $manifest_file = "$build_dir/MANIFEST";
+ my $manifest = ExtUtils::Manifest::maniread($manifest_file);
+ @xs = grep /\.xs$/, keys %$manifest;
+ }
+ if (! @xs) {
+ $header->('BuildArch', 'noarch');
+ }
+ for my $k (sort keys %contains) {
+ my $m = CPAN::Shell->expand("Module",$k);
+ my $v = $contains{$k} = $m->cpan_version;
+ my $vspec = $v eq "undef" ? "" : " = $v";
+ $header->("Provides", "perl($k)$vspec");
+ }
+ if (my $prereq_pm = $d->{prereq_pm}) {
+ my %req;
+ for my $reqkey (keys %$prereq_pm) {
+ while (my($k,$v) = each %{$prereq_pm->{$reqkey}}) {
+ $req{$k} = $v;
+ }
+ }
+ if (-e "$build_dir/Build.PL" && ! exists $req{"Module::Build"}) {
+ $req{"Module::Build"} = 0;
+ }
+ for my $k (sort keys %req) {
+ next if $k eq "perl";
+ my $v = $req{$k};
+ my $vspec = defined $v && length $v && $v > 0 ? " >= $v" : "";
+ $header->(BuildRequires => "perl($k)$vspec");
+ next if $k =~ /^(Module::Build)$/; # MB is always only a
+ # BuildRequires; if we
+ # turn it into a
+ # Requires, then we
+ # would have to make it
+ # a BuildRequires
+ # everywhere we depend
+ # on *one* MB built
+ # module.
+ $header->(Requires => "perl($k)$vspec");
+ }
+ }
+ push @m, "\n%define _use_internal_dependency_generator 0
+%define __find_requires %{nil}
+%define __find_provides %{nil}
+";
+ push @m, "\n%description\n%{summary}.\n";
+ push @m, "\n%prep\n%setup -q -n $dist-%{version}\n";
+ if (-e "$build_dir/Build.PL") {
+ # see http://www.redhat.com/archives/rpm-list/2002-July/msg00110.html
about RPM_BUILD_ROOT vs %{buildroot}
+ push @m, <<'EOF';
+
+%build
+%{__perl} Build.PL --installdirs=vendor --libdoc installvendorman3dir
+./Build
+
+%install
+rm -rf $RPM_BUILD_ROOT
+./Build install destdir=$RPM_BUILD_ROOT create_packlist=0
+find $RPM_BUILD_ROOT -depth -type d -exec rmdir {} 2>/dev/null \;
+%{_fixperms} $RPM_BUILD_ROOT/*
+
+%check
+./Build test
+EOF
+ } elsif (-e "$build_dir/Makefile.PL") {
+ push @m, <<'EOF';
+
+%build
+%{__perl} Makefile.PL INSTALLDIRS=vendor
+make %{?_smp_mflags}
+
+%install
+rm -rf $RPM_BUILD_ROOT
+make pure_install DESTDIR=$RPM_BUILD_ROOT
+find $RPM_BUILD_ROOT -type f -name .packlist -exec rm -f {} ';'
+find $RPM_BUILD_ROOT -depth -type d -exec rmdir {} 2>/dev/null ';'
+%{_fixperms} $RPM_BUILD_ROOT/*
+
+%check
+make test
+EOF
+ } else {
+ $CPAN::Frontend->mydie("'$distribution' has neither a Build.PL nor a
Makefile.PL\n");
+ }
+ push @m, "\n%clean\nrm -rf \$RPM_BUILD_ROOT\n";
+ my $vendorlib = @xs ? "vendorarch" : "vendorlib";
+ my $date = POSIX::strftime("%a %b %d %Y", gmtime);
+ my @doc = grep { -e "$build_dir/$_" } qw(README Changes);
+ my $exe_stanza = "\n";
+ if (my $exe_files = $d->_exe_files) {
+ if (@$exe_files) {
+ $exe_stanza = "%{_mandir}/man1/*.1*\n";
+ for my $e (@$exe_files) {
+ unless (CPAN->has_inst("File::Basename")) {
+ $CPAN::Frontend->mydie("File::Basename not installed,
cannot continue");
+ }
+ my $basename = File::Basename::basename($e);
+ $exe_stanza .= "/usr/bin/$basename\n";
+ }
+ }
+ }
+ push @m, <<EOF;
+
+%files
+%defattr(-,root,root,-)
+%doc @doc
+%{perl_$vendorlib}/*
+%{_mandir}/man3/*.3*
+$exe_stanza
+%changelog
+* $date <akoenig\@specfile.cpan.org> - $version-1
+- autogenerated by _specfile() in CPAN.pm
+
+EOF
+
+ my $ret = join "", @m;
+ $CPAN::Frontend->myprint($ret);
+ open my $specout, ">", "perl-$dist.spec" or die;
+ print $specout $ret;
+ $CPAN::Frontend->myprint("Wrote perl-$dist.spec");
+ $ret;
+}
+
#-> sub CPAN::Shell::report ;
sub report {
my($self,@args) = @_;
@@ -1043,6 +1238,41 @@ sub u {
#-> sub CPAN::Shell::failed ;
sub failed {
my($self,$only_id,$silent) = @_;
+ my @failed = $self->find_failed($only_id);
+ my $scope;
+ if ($only_id) {
+ $scope = "this command";
+ } elsif ($CPAN::Index::HAVE_REANIMATED) {
+ $scope = "this or a previous session";
+ # it might be nice to have a section for previous session and
+ # a second for this
+ } else {
+ $scope = "this session";
+ }
+ if (@failed) {
+ my $print;
+ my $debug = 0;
+ if ($debug) {
+ $print = join "",
+ map { sprintf "%5d %-45s: %s %s\n", @$_ }
+ sort { $a->[0] <=> $b->[0] } @failed;
+ } else {
+ $print = join "",
+ map { sprintf " %-45s: %s %s\n", @$_[1..3] }
+ sort {
+ $a->[0] <=> $b->[0]
+ ||
+ $a->[4] <=> $b->[4]
+ } @failed;
+ }
+ $CPAN::Frontend->myprint("Failed during $scope:\n$print");
+ } elsif (!$only_id || !$silent) {
+ $CPAN::Frontend->myprint("Nothing failed in $scope\n");
+ }
+}
+
+sub find_failed {
+ my($self,$only_id) = @_;
my @failed;
DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
my $failed = "";
@@ -1075,6 +1305,10 @@ sub failed {
next DIST unless $failed;
my $id = $d->id;
$id =~ s|^./../||;
+ ### XXX need to flag optional modules as '(optional)' if they are
+ # from recommends/suggests -- i.e. *show* failure, but make it clear
+ # it was failure of optional module -- xdg, 2012-04-01
+ $id = "(optional) $id" if ! $d->{mandatory};
#$print .= sprintf(
# " %-45s: %s %s\n",
push @failed,
@@ -1086,6 +1320,7 @@ sub failed {
$failed,
$d->{$failed}->text,
$d->{$failed}{TIME}||0,
+ !! $d->{mandatory},
] :
[
1,
@@ -1093,42 +1328,16 @@ sub failed {
$failed,
$d->{$failed},
0,
+ !! $d->{mandatory},
]
);
}
- my $scope;
- if ($only_id) {
- $scope = "this command";
- } elsif ($CPAN::Index::HAVE_REANIMATED) {
- $scope = "this or a previous session";
- # it might be nice to have a section for previous session and
- # a second for this
- } else {
- $scope = "this session";
- }
- ### XXX need to flag optional modules as '(optional)' if they are
- # from recommends/suggests -- i.e. *show* failure, but make it clear
- # it was failure of optional module -- xdg, 2012-04-01
- if (@failed) {
- my $print;
- my $debug = 0;
- if ($debug) {
- $print = join "",
- map { sprintf "%5d %-45s: %s %s\n", @$_ }
- sort { $a->[0] <=> $b->[0] } @failed;
- } else {
- $print = join "",
- map { sprintf " %-45s: %s %s\n", @$_[1..3] }
- sort {
- $a->[0] <=> $b->[0]
- ||
- $a->[4] <=> $b->[4]
- } @failed;
- }
- $CPAN::Frontend->myprint("Failed during $scope:\n$print");
- } elsif (!$only_id || !$silent) {
- $CPAN::Frontend->myprint("Nothing failed in $scope\n");
- }
+ return @failed;
+}
+
+sub mandatory_dist_failed {
+ my ($self) = @_;
+ return grep { $_->[5] } $self->find_failed($CPAN::CurrentCommandID);
}
# XXX intentionally undocumented because completely bogus, unportable,
@@ -1434,6 +1643,14 @@ sub format_result {
my $print_ornamented_have_warned = 0;
sub colorize_output {
my $colorize_output = $CPAN::Config->{colorize_output};
+ if ($colorize_output && $^O eq 'MSWin32' &&
!$CPAN::META->has_inst("Win32::Console::ANSI")) {
+ unless ($print_ornamented_have_warned++) {
+ # no myprint/mywarn within myprint/mywarn!
+ warn "Colorize_output is set to true but Win32::Console::ANSI
is not
+installed. To activate colorized output, please install
Win32::Console::ANSI.\n\n";
+ }
+ $colorize_output = 0;
+ }
if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
unless ($print_ornamented_have_warned++) {
# no myprint/mywarn within myprint/mywarn!
@@ -1706,7 +1923,7 @@ sub rematein {
}
}
}
- CPAN::Queue->queue_item(qmod => $obj->id, reqtype => "c");
+ CPAN::Queue->queue_item(qmod => $obj->id, reqtype => "c", optional
=> '');
push @qcopy, $obj;
} elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
$obj = $CPAN::META->instance('CPAN::Author',uc($s));
@@ -1744,6 +1961,7 @@ to find objects with matching identifiers.
my $obj;
my $s = $q->as_string;
my $reqtype = $q->reqtype || "";
+ my $optional = $q->optional || "";
$obj = CPAN::Shell->expandany($s);
unless ($obj) {
# don't know how this can happen, maybe we should panic,
@@ -1756,6 +1974,23 @@ to find objects with matching identifiers.
next QITEM;
}
$obj->{reqtype} ||= "";
+ my $type = ref $obj;
+ if ( $type eq 'CPAN::Distribution' || $type eq 'CPAN::Bundle' ) {
+ $obj->{mandatory} ||= ! $optional; # once mandatory, always
mandatory
+ }
+ elsif ( $type eq 'CPAN::Module' ) {
+ $obj->{mandatory} ||= ! $optional; # once mandatory, always
mandatory
+ if (my $d = $obj->distribution) {
+ $d->{mandatory} ||= ! $optional; # once mandatory, always
mandatory
+ } elsif ($optional) {
+ # the queue object does not know who was
recommending/suggesting us:(
+ # So we only vaguely write "optional".
+ $CPAN::Frontend->mywarn("Warning: optional module '$s' ".
+ "not known. Skipping.\n");
+ CPAN::Queue->delete_first($s);
+ next QITEM;
+ }
+ }
{
# force debugging because CPAN::SQLite somehow delivers us
# an empty object;
@@ -1839,10 +2074,14 @@ to find objects with matching identifiers.
$obj->$unpragma();
}
}
- if ($CPAN::Config->{halt_on_failure}
- &&
- CPAN::Distrostatus::something_has_just_failed()
- ) {
+ # if any failures occurred and the current object is mandatory, we
+ # still don't know if *it* failed or if it was another (optional)
+ # module, so we have to check that explicitly (and expensively)
+ if ( $CPAN::Config->{halt_on_failure}
+ && $obj->{mandatory}
+ && CPAN::Distrostatus::something_has_just_failed()
+ && $self->mandatory_dist_failed()
+ ) {
$CPAN::Frontend->mywarn("Stopping: '$meth' failed for '$s'.\n");
CPAN::Queue->nullify_queue;
last QITEM;
diff --git a/cpan/CPAN/lib/CPAN/Tarzip.pm b/cpan/CPAN/lib/CPAN/Tarzip.pm
index 5e4593b..f585a01 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.5011";
+$VERSION = "5.5012";
# module is internal to CPAN.pm
@ISA = qw(CPAN::Debug); ## no critic
@@ -105,7 +105,7 @@ sub gunzip {
return 1;
} else {
my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- system(qq{$command -dc "$read" > "$write"})==0;
+ system(qq{$command -d -c "$read" > "$write"})==0;
}
}
@@ -190,7 +190,7 @@ sub TIEHANDLE {
$class->debug("via Compress::Zlib");
} else {
my $gzip = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- my $pipe = "$gzip -dc $file |";
+ my $pipe = "$gzip -d -c $file |";
my $fh = FileHandle->new($pipe) or $CPAN::Frontend->mydie("Could not
pipe[$pipe]: $!");
binmode $fh;
$self->{FH} = $fh;
@@ -324,7 +324,7 @@ Can't continue cutting file '$file'.
my $tarcommand = CPAN::HandleConfig->safe_quote($exttar);
if ($is_compressed) {
my $command = CPAN::HandleConfig->safe_quote($extgzip);
- $system = qq{$command -dc }.
+ $system = qq{$command -d -c }.
qq{< "$file" | $tarcommand x${tar_verb}f -};
} else {
$system = qq{$tarcommand x${tar_verb}f "$file"};
diff --git a/cpan/CPAN/lib/CPAN/Version.pm b/cpan/CPAN/lib/CPAN/Version.pm
index 43aaa1c..fa75221 100644
--- a/cpan/CPAN/lib/CPAN/Version.pm
+++ b/cpan/CPAN/lib/CPAN/Version.pm
@@ -2,7 +2,7 @@ package CPAN::Version;
use strict;
use vars qw($VERSION);
-$VERSION = "5.5001";
+$VERSION = "5.5003";
# CPAN::Version::vcmp courtesy Jost Krieger
sub vcmp {
@@ -10,6 +10,10 @@ sub vcmp {
local($^W) = 0;
CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
+ # treat undef as zero
+ $l = 0 if $l eq 'undef';
+ $r = 0 if $r eq 'undef';
+
return 0 if $l eq $r; # short circuit for quicker success
for ($l,$r) {
--
Perl5 Master Repository
