summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPAN/Distribution.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/Distribution.pm1048
1 files changed, 672 insertions, 376 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm b/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm
index 690d6a063db..9a0870717da 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm
+++ b/Master/tlpkg/tlperl/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.02";
# Accessors
sub cpan_comment {
@@ -70,7 +71,7 @@ sub normalize {
} elsif (
$s =~ tr|/|| == 1
or
- $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
+ $s !~ m|[A-Z]/[A-Z-0-9]{2}/[A-Z-0-9]{2,}/|
) {
return $s if $s =~ m:^N/A|^Contact Author: ;
$s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4|;
@@ -185,8 +186,13 @@ sub color_cmd_tmps {
# warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
my $prereq_pm = $self->prereq_pm;
if (defined $prereq_pm) {
- PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
- keys %{$prereq_pm->{build_requires}||{}}) {
+ # XXX also optional_req & optional_breq? -- xdg, 2012-04-01
+ 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)) {
@@ -275,20 +281,66 @@ sub called_for {
return $self->{CALLED_FOR};
}
+#-> sub CPAN::Distribution::shortcut_get ;
+# return values: undef means don't shortcut; 0 means shortcut as fail;
+# and 1 means shortcut as success
+sub shortcut_get {
+ my ($self) = @_;
+
+ if (my $why = $self->check_disabled) {
+ $self->{unwrapped} = CPAN::Distrostatus->new("NO $why");
+ # XXX why is this goodbye() instead of just print/warn?
+ # Alternatively, should other print/warns here be goodbye()?
+ # -- xdg, 2012-04-05
+ return $self->goodbye("[disabled] -- NA $why");
+ }
+
+ $self->debug("checking already unwrapped[$self->{ID}]") if $CPAN::DEBUG;
+ if (exists $self->{build_dir} && -d $self->{build_dir}) {
+ # this deserves print, not warn:
+ return $self->success("Has already been unwrapped into directory ".
+ "$self->{build_dir}"
+ );
+ }
+
+ # XXX I'm not sure this should be here because it's not really
+ # a test for whether get should continue or return; this is
+ # a side effect -- xdg, 2012-04-05
+ $self->debug("checking missing build_dir[$self->{ID}]") if $CPAN::DEBUG;
+ if (exists $self->{build_dir} && ! -d $self->{build_dir}){
+ # we have lost it.
+ $self->fforce(""); # no method to reset all phases but not set force (dodge)
+ return undef; # no shortcut
+ }
+
+ # although we talk about 'force' we shall not test on
+ # force directly. New model of force tries to refrain from
+ # direct checking of force.
+ $self->debug("checking unwrapping error[$self->{ID}]") if $CPAN::DEBUG;
+ if ( exists $self->{unwrapped} and (
+ UNIVERSAL::can($self->{unwrapped},"failed") ?
+ $self->{unwrapped}->failed :
+ $self->{unwrapped} =~ /^NO/ )
+ ) {
+ return $self->goodbye("Unwrapping had some problem, won't try again without force");
+ }
+
+ return undef; # no shortcut
+}
+
#-> sub CPAN::Distribution::get ;
sub get {
my($self) = @_;
+
$self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
if (my $goto = $self->prefs->{goto}) {
- $CPAN::Frontend->mywarn
- (sprintf(
- "delegating to '%s' as specified in prefs file '%s' doc %d\n",
- $goto,
- $self->{prefs_file},
- $self->{prefs_file_doc},
- ));
return $self->goto($goto);
}
+
+ if ( defined( my $sc = $self->shortcut_get) ) {
+ return $sc;
+ }
+
local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
? $ENV{PERL5LIB}
: ($ENV{PERLLIB} || "");
@@ -296,77 +348,38 @@ sub get {
$CPAN::META->set_perl5lib;
local $ENV{MAKEFLAGS}; # protect us from outer make calls
- EXCUSE: {
- my @e;
- my $goodbye_message;
- $self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG;
- if ($self->prefs->{disabled} && ! $self->{force_update}) {
- my $why = sprintf(
- "Disabled via prefs file '%s' doc %d",
- $self->{prefs_file},
- $self->{prefs_file_doc},
- );
- push @e, $why;
- $self->{unwrapped} = CPAN::Distrostatus->new("NO $why");
- $goodbye_message = "[disabled] -- NA $why";
- # note: not intended to be persistent but at least visible
- # during this session
- } else {
- if (exists $self->{build_dir} && -d $self->{build_dir}
- && ($self->{modulebuild}||$self->{writemakefile})
- ) {
- # this deserves print, not warn:
- $CPAN::Frontend->myprint(" Has already been unwrapped into directory ".
- "$self->{build_dir}\n"
- );
- return 1;
- }
- if (exists $self->{build_dir} && ! -d $self->{build_dir}){
- # we have lost it.
- $self->fforce(""); # no method to reset all phases but not set force (dodge)
- }
-
- # although we talk about 'force' we shall not test on
- # force directly. New model of force tries to refrain from
- # direct checking of force.
- exists $self->{unwrapped} and (
- UNIVERSAL::can($self->{unwrapped},"failed") ?
- $self->{unwrapped}->failed :
- $self->{unwrapped} =~ /^NO/
- )
- and push @e, "Unwrapping had some problem, won't try again without force";
- }
- if (@e) {
- $CPAN::Frontend->mywarn(join "", map {"$_\n"} @e);
- if ($goodbye_message) {
- $self->goodbye($goodbye_message);
- }
- return;
- }
- }
my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
my($local_file);
+ # XXX I don't think this check needs to be here, as it
+ # is already checked in shortcut_get() -- xdg, 2012-04-05
unless ($self->{build_dir} && -d $self->{build_dir}) {
$self->get_file_onto_local_disk;
return if $CPAN::Signal;
$self->check_integrity;
return if $CPAN::Signal;
(my $packagedir,$local_file) = $self->run_preps_on_packagedir;
+ # XXX why is this check here? -- xdg, 2012-04-08
if (exists $self->{writemakefile} && ref $self->{writemakefile}
&& $self->{writemakefile}->can("failed") &&
$self->{writemakefile}->failed) {
+ #
return;
}
$packagedir ||= $self->{build_dir};
$self->{build_dir} = $packagedir;
}
+ # XXX should this move up to after run_preps_on_packagedir?
+ # Otherwise, failing writemakefile can return without
+ # a $CPAN::Signal check -- xdg, 2012-04-05
if ($CPAN::Signal) {
$self->safe_chdir($sub_wd);
return;
}
- return $self->choose_MM_or_MB($local_file);
+ return unless $self->patch;
+ $self->store_persistent_state;
+ return 1; # success
}
#-> CPAN::Distribution::get_file_onto_local_disk
@@ -639,6 +652,8 @@ sub parse_meta_yml {
}
#-> sub CPAN::Distribution::satisfy_requires ;
+# return values: 1 means requirements are satisfied;
+# and 0 means not satisfied (and maybe queued)
sub satisfy_requires {
my ($self) = @_;
$self->debug("Entering satisfy_requires") if $CPAN::DEBUG;
@@ -656,18 +671,19 @@ sub satisfy_requires {
my $follow = eval { $self->follow_prereqs("later",@prereq); };
if (0) {
} elsif ($follow) {
- # signal success to the queuerunner
- return 1;
+ return; # we need deps
} elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
$CPAN::Frontend->mywarn($@);
die "[depend] -- NOT OK\n";
}
}
}
- return;
+ return 1;
}
#-> sub CPAN::Distribution::satisfy_configure_requires ;
+# return values: 1 means configure_require is satisfied;
+# and 0 means not satisfied (and maybe queued)
sub satisfy_configure_requires {
my($self) = @_;
$self->debug("Entering satisfy_configure_requires") if $CPAN::DEBUG;
@@ -710,7 +726,7 @@ sub satisfy_configure_requires {
};
if (0) {
} elsif ($follow) {
- return;
+ return; # we need deps
} elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
$CPAN::Frontend->mywarn($@);
return $self->goodbye("[depend] -- NOT OK");
@@ -724,8 +740,9 @@ sub satisfy_configure_requires {
#-> sub CPAN::Distribution::choose_MM_or_MB ;
sub choose_MM_or_MB {
- my($self,$local_file) = @_;
+ my($self) = @_;
$self->satisfy_configure_requires() or return;
+ my $local_file = $self->{localfile};
my($mpl) = File::Spec->catfile($self->{build_dir},"Makefile.PL");
my($mpl_exists) = -f $mpl;
unless ($mpl_exists) {
@@ -754,7 +771,6 @@ sub choose_MM_or_MB {
$prefer_installer = "mb";
}
}
- return unless $self->patch;
if (lc($prefer_installer) eq "rand") {
$prefer_installer = rand()<.5 ? "eumm" : "mb";
}
@@ -1063,7 +1079,7 @@ sub _exefile_stanza {
$fh->open($script_file)
or Carp::croak("Could not open script '$script_file': $!");
local $/ = "\n";
- # name parsen und prereq
+ # parse name and prereq
my($state) = "poddir";
my($name, $prereq) = ("", "");
while (<$fh>) {
@@ -1720,48 +1736,78 @@ sub perl {
return CPAN::HandleConfig->safe_quote($CPAN::Perl);
}
+#-> sub CPAN::Distribution::shortcut_prepare ;
+# return values: undef means don't shortcut; 0 means shortcut as fail;
+# and 1 means shortcut as success
-#-> sub CPAN::Distribution::make ;
-sub make {
- my($self) = @_;
- if (my $goto = $self->prefs->{goto}) {
- return $self->goto($goto);
+sub shortcut_prepare {
+ my ($self) = @_;
+
+ $self->debug("checking archive type[$self->{ID}]") if $CPAN::DEBUG;
+ if (!$self->{archived} || $self->{archived} eq "NO") {
+ return $self->goodbye("Is neither a tar nor a zip archive.");
}
- my $make = $self->{modulebuild} ? "Build" : "make";
- # Emergency brake if they said install Pippi and get newest perl
- if ($self->isa_perl) {
+
+ $self->debug("checking unwrapping[$self->{ID}]") if $CPAN::DEBUG;
+ if (!$self->{unwrapped}
+ || (
+ UNIVERSAL::can($self->{unwrapped},"failed") ?
+ $self->{unwrapped}->failed :
+ $self->{unwrapped} =~ /^NO/
+ )) {
+ return $self->goodbye("Had problems unarchiving. Please build manually");
+ }
+
+ $self->debug("checking signature[$self->{ID}]") if $CPAN::DEBUG;
+ if ( ! $self->{force_update}
+ && exists $self->{signature_verify}
+ && (
+ UNIVERSAL::can($self->{signature_verify},"failed") ?
+ $self->{signature_verify}->failed :
+ $self->{signature_verify} =~ /^NO/
+ )
+ ) {
+ return $self->goodbye("Did not pass the signature test.");
+ }
+
+ $self->debug("checking writemakefile[$self->{ID}]") if $CPAN::DEBUG;
+ if ($self->{writemakefile}) {
if (
- $self->called_for ne $self->id &&
- ! $self->{force_update}
- ) {
- # if we die here, we break bundles
- $CPAN::Frontend
- ->mywarn(sprintf(
- qq{The most recent version "%s" of the module "%s"
-is part of the perl-%s distribution. To install that, you need to run
- force install %s --or--
- install %s
-},
- $CPAN::META->instance(
- 'CPAN::Module',
- $self->called_for
- )->cpan_version,
- $self->called_for,
- $self->isa_perl,
- $self->called_for,
- $self->id,
- ));
- $self->{make} = CPAN::Distrostatus->new("NO isa perl");
- $CPAN::Frontend->mysleep(1);
- return;
+ UNIVERSAL::can($self->{writemakefile},"failed") ?
+ $self->{writemakefile}->failed :
+ $self->{writemakefile} =~ /^NO/
+ ) {
+ # XXX maybe a retry would be in order?
+ my $err = UNIVERSAL::can($self->{writemakefile},"text") ?
+ $self->{writemakefile}->text :
+ $self->{writemakefile};
+ $err =~ s/^NO\s*(--\s+)?//;
+ $err ||= "Had some problem writing Makefile";
+ $err .= ", not re-running";
+ return $self->goodbye($err);
+ } else {
+ return $self->success("Has already been prepared");
}
}
- $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
- $self->get;
- return if $self->prefs->{disabled} && ! $self->{force_update};
- if ($self->{configure_requires_later}) {
- return;
+
+ $self->debug("checking configure_requires_later[$self->{ID}]") if $CPAN::DEBUG;
+ if( my $later = $self->{configure_requires_later} ) { # see also undelay
+ return $self->goodbye($later);
+ }
+
+ return undef; # no shortcut
+}
+
+sub prepare {
+ my ($self) = @_;
+
+ $self->get
+ or return;
+
+ if ( defined( my $sc = $self->shortcut_prepare) ) {
+ return $sc;
}
+
local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
? $ENV{PERL5LIB}
: ($ENV{PERLLIB} || "");
@@ -1774,103 +1820,37 @@ is part of the perl-%s distribution. To install that, you need to run
return;
}
- my $builddir;
- EXCUSE: {
- my @e;
- if (!$self->{archived} || $self->{archived} eq "NO") {
- push @e, "Is neither a tar nor a zip archive.";
- }
-
- if (!$self->{unwrapped}
- || (
- UNIVERSAL::can($self->{unwrapped},"failed") ?
- $self->{unwrapped}->failed :
- $self->{unwrapped} =~ /^NO/
- )) {
- push @e, "Had problems unarchiving. Please build manually";
- }
-
- unless ($self->{force_update}) {
- exists $self->{signature_verify} and
- (
- UNIVERSAL::can($self->{signature_verify},"failed") ?
- $self->{signature_verify}->failed :
- $self->{signature_verify} =~ /^NO/
- )
- and push @e, "Did not pass the signature test.";
- }
-
- if (exists $self->{writemakefile} &&
- (
- UNIVERSAL::can($self->{writemakefile},"failed") ?
- $self->{writemakefile}->failed :
- $self->{writemakefile} =~ /^NO/
- )) {
- # XXX maybe a retry would be in order?
- my $err = UNIVERSAL::can($self->{writemakefile},"text") ?
- $self->{writemakefile}->text :
- $self->{writemakefile};
- $err =~ s/^NO\s*(--\s+)?//;
- $err ||= "Had some problem writing Makefile";
- $err .= ", won't make";
- push @e, $err;
- }
-
- if (defined $self->{make}) {
- if (UNIVERSAL::can($self->{make},"failed") ?
- $self->{make}->failed :
- $self->{make} =~ /^NO/) {
- if ($self->{force_update}) {
- # Trying an already failed 'make' (unless somebody else blocks)
- } else {
- # introduced for turning recursion detection into a distrostatus
- my $error = length $self->{make}>3
- ? substr($self->{make},3) : "Unknown error";
- $CPAN::Frontend->mywarn("Could not make: $error\n");
- $self->store_persistent_state;
- return;
- }
- } else {
- push @e, "Has already been made";
- my $wait_for_prereqs = eval { $self->satisfy_requires };
- return 1 if $wait_for_prereqs; # tells queuerunner to continue
- return $self->goodbye($@) if $@; # tells queuerunner to stop
- }
- }
-
- my $later = $self->{later} || $self->{configure_requires_later};
- if ($later) { # see also undelay
- if ($later) {
- push @e, $later;
- }
- }
+ my $builddir = $self->dir or
+ $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
- $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
- $builddir = $self->dir or
- $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
- unless (chdir $builddir) {
- push @e, "Couldn't chdir to '$builddir': $!";
- }
- $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
+ unless (chdir $builddir) {
+ $CPAN::Frontend->mywarn("Couldn't chdir to '$builddir': $!");
+ return;
}
+
if ($CPAN::Signal) {
delete $self->{force_update};
return;
}
- $CPAN::Frontend->myprint("\n CPAN.pm: Building ".$self->id."\n\n");
- $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
- if ($^O eq 'MacOS') {
- Mac::BuildTools::make($self);
- return;
- }
+ $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
local $ENV{PERL_AUTOINSTALL} = $ENV{PERL_AUTOINSTALL};
local $ENV{PERL_EXTUTILS_AUTOINSTALL} = $ENV{PERL_EXTUTILS_AUTOINSTALL};
+ $self->choose_MM_or_MB
+ or return;
+
+ my $configurator = $self->{configure} ? "Configure"
+ : $self->{modulebuild} ? "Build.PL"
+ : "Makefile.PL";
+
+ $CPAN::Frontend->myprint("Configuring ".$self->id." with $configurator\n");
+
if ($CPAN::Config->{prerequisites_policy} eq "follow") {
$ENV{PERL_AUTOINSTALL} ||= "--defaultdeps";
$ENV{PERL_EXTUTILS_AUTOINSTALL} ||= "--defaultdeps";
}
+
my $system;
my $pl_commandline;
if ($self->prefs->{pl}) {
@@ -1878,6 +1858,8 @@ is part of the perl-%s distribution. To install that, you need to run
}
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;
@@ -2005,6 +1987,8 @@ is part of the perl-%s distribution. To install that, you need to run
if (-f "Makefile" || -f "Build" || ($^O eq 'VMS' && (-f 'descrip.mms' || -f 'Build.com'))) {
$self->{writemakefile} = CPAN::Distrostatus->new("YES");
delete $self->{make_clean}; # if cleaned before, enable next
+ $self->store_persistent_state;
+ return $self->success("$system -- OK");
} else {
my $makefile = $self->{modulebuild} ? "Build" : "Makefile";
my $why = "No '$makefile' created";
@@ -2015,22 +1999,145 @@ is part of the perl-%s distribution. To install that, you need to run
return $self->goodbye("$system -- NOT OK");
}
}
+ $self->store_persistent_state;
+ return 1; # success
+}
+
+#-> sub CPAN::Distribution::shortcut_make ;
+# return values: undef means don't shortcut; 0 means shortcut as fail;
+# and 1 means shortcut as success
+sub shortcut_make {
+ my ($self) = @_;
+
+ $self->debug("checking make/build results[$self->{ID}]") if $CPAN::DEBUG;
+ if (defined $self->{make}) {
+ if (UNIVERSAL::can($self->{make},"failed") ?
+ $self->{make}->failed :
+ $self->{make} =~ /^NO/
+ ) {
+ if ($self->{force_update}) {
+ # Trying an already failed 'make' (unless somebody else blocks)
+ return undef; # no shortcut
+ } else {
+ # introduced for turning recursion detection into a distrostatus
+ my $error = length $self->{make}>3
+ ? substr($self->{make},3) : "Unknown error";
+ $self->store_persistent_state;
+ return $self->goodbye("Could not make: $error\n");
+ }
+ } else {
+ return $self->success("Has already been made")
+ }
+ }
+ return undef; # no shortcut
+}
+
+#-> sub CPAN::Distribution::make ;
+sub make {
+ my($self) = @_;
+
+ $self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
+ if (my $goto = $self->prefs->{goto}) {
+ return $self->goto($goto);
+ }
+ # Emergency brake if they said install Pippi and get newest perl
+
+ # XXX Would this make more sense in shortcut_prepare, since
+ # that doesn't make sense on a perl dist either? Broader
+ # question: what is the purpose of suggesting force install
+ # on a perl distribution? That seems unlikely to result in
+ # such a dependency being satisfied, even if the perl is
+ # successfully installed. This situation is tantamount to
+ # a prereq on a version of perl greater than the current one
+ # so I think we should just abort. -- xdg, 2012-04-06
+ if ($self->isa_perl) {
+ if (
+ $self->called_for ne $self->id &&
+ ! $self->{force_update}
+ ) {
+ # if we die here, we break bundles
+ $CPAN::Frontend
+ ->mywarn(sprintf(
+ qq{The most recent version "%s" of the module "%s"
+is part of the perl-%s distribution. To install that, you need to run
+ force install %s --or--
+ install %s
+},
+ $CPAN::META->instance(
+ 'CPAN::Module',
+ $self->called_for
+ )->cpan_version,
+ $self->called_for,
+ $self->isa_perl,
+ $self->called_for,
+ $self->id,
+ ));
+ $self->{make} = CPAN::Distrostatus->new("NO isa perl");
+ $CPAN::Frontend->mysleep(1);
+ return;
+ }
+ }
+
+ $self->prepare
+ or return;
+
+ if ( defined( my $sc = $self->shortcut_make) ) {
+ return $sc;
+ }
+
if ($CPAN::Signal) {
delete $self->{force_update};
return;
}
- my $wait_for_prereqs = eval { $self->satisfy_requires };
- return 1 if $wait_for_prereqs; # tells queuerunner to continue
- return $self->goodbye($@) if $@; # tells queuerunner to stop
+
+ my $builddir = $self->dir or
+ $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
+
+ unless (chdir $builddir) {
+ $CPAN::Frontend->mywarn("Couldn't chdir to '$builddir': $!");
+ return;
+ }
+
+ my $make = $self->{modulebuild} ? "Build" : "make";
+ $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
+ local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
+ ? $ENV{PERL5LIB}
+ : ($ENV{PERLLIB} || "");
+ local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
+ $CPAN::META->set_perl5lib;
+ local $ENV{MAKEFLAGS}; # protect us from outer make calls
+
+ if ($CPAN::Signal) {
+ delete $self->{force_update};
+ return;
+ }
+
+ if ($^O eq 'MacOS') {
+ Mac::BuildTools::make($self);
+ return;
+ }
+
+ my %env;
+ while (my($k,$v) = each %ENV) {
+ next unless defined $v;
+ $env{$k} = $v;
+ }
+ local %ENV = %env;
+ my $satisfied = eval { $self->satisfy_requires };
+ return $self->goodbye($@) if $@;
+ return unless $satisfied ;
if ($CPAN::Signal) {
delete $self->{force_update};
return;
}
+ my $system;
my $make_commandline;
if ($self->prefs->{make}) {
$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();
@@ -2093,6 +2200,7 @@ is part of the perl-%s distribution. To install that, you need to run
$CPAN::Frontend->mywarn(" $system -- NOT OK\n");
}
$self->store_persistent_state;
+ return !! $system_ok;
}
# CPAN::Distribution::goodbye ;
@@ -2100,7 +2208,14 @@ sub goodbye {
my($self,$goodbye) = @_;
my $id = $self->pretty_id;
$CPAN::Frontend->mywarn(" $id\n $goodbye\n");
- return;
+ return 0; # must be explicit false, not undef
+}
+
+sub success {
+ my($self,$why) = @_;
+ my $id = $self->pretty_id;
+ $CPAN::Frontend->myprint(" $id\n $why\n");
+ return 1;
}
# CPAN::Distribution::_run_via_expect ;
@@ -2448,6 +2563,30 @@ sub _make_command {
}
}
+sub _make_install_make_command {
+ my ($self) = @_;
+ my $mimc =
+ CPAN::HandleConfig->prefs_lookup($self, q{make_install_make_command});
+ return $self->_make_command() unless $mimc;
+
+ # Quote the "make install" make command on Windows, where it is commonly
+ # found in, e.g., C:\Program Files\... and therefore needs quoting. We can't
+ # do this in general because the command maybe "sudo make..." (i.e. a
+ # program with arguments), but that is unlikely to be the case on Windows.
+ $mimc = CPAN::HandleConfig->safe_quote($mimc) if $^O eq 'MSWin32';
+
+ 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;
@@ -2456,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;
}
@@ -2494,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") {
@@ -2512,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 success to the queuerunner
+ 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;
}
@@ -2572,25 +2730,24 @@ sub _feature_depends {
$dep;
}
-#-> sub CPAN::Distribution::unsat_prereq ;
-# return ([Foo,"r"],[Bar,"b"]) for normal modules
-# return ([perl=>5.008]) if we need a newer perl than we are running under
-# (sorry for the inconsistency, it was an accident)
-sub unsat_prereq {
+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}||{}},
- );
+ 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 "Makefile.PL"
- && ! exists $merged{"Module::Build"}
+ && ! -f File::Spec->catfile($self->{build_dir},"Makefile.PL")
+ && ! $merged->requirements_for_module("Module::Build")
&& ! $CPAN::META->has_inst("Module::Build")
) {
$CPAN::Frontend->mywarn(
@@ -2598,13 +2755,13 @@ sub unsat_prereq {
" 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}||{}}) {
@@ -2612,14 +2769,37 @@ sub unsat_prereq {
}
}
}
- %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->as_string_hash, $prereq_pm);
+}
+
+#-> sub CPAN::Distribution::unsat_prereq ;
+# return ([Foo,"r"],[Bar,"b"]) for normal modules
+# return ([perl=>5.008]) if we need a newer perl than we are running under
+# (sorry for the inconsistency, it was an accident)
+sub unsat_prereq {
+ my($self,$slot) = @_;
+ my($merged_hash,$prereq_pm) = $self->prereqs_for_slot($slot);
my(@need);
- 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 = $];
@@ -2636,7 +2816,7 @@ sub unsat_prereq {
# if they have not specified a version, we accept any installed one
if ( $available_file
- and ( # a few quick shortcurcuits
+ and ( # a few quick short circuits
not defined $need_version
or $need_version eq '0' # "==" would trigger warning when not numeric
or $need_version eq "undef"
@@ -2664,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
) {
@@ -2682,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
@@ -2766,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)$/) {
@@ -2796,7 +2986,9 @@ sub unsat_prereq {
}
my $needed_as;
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
@@ -2809,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;
@@ -2896,7 +3092,7 @@ sub read_meta {
# XXX This should be DEPRECATED -- dagolden, 2011-02-05
sub read_yaml {
my($self) = @_;
- my $meta_file = $self->pick_meta_file;
+ my $meta_file = $self->pick_meta_file('\.yml$');
$self->debug("meta_file[$meta_file]") if $CPAN::DEBUG;
return unless $meta_file;
my $yaml;
@@ -2948,11 +3144,14 @@ sub prereq_pm {
unless ($self->{build_dir}) {
return;
}
+ # no Makefile/Build means configuration aborted, so don't look for prereqs
+ return unless -f File::Spec->catfile($self->{build_dir},'Makefile')
+ || -f File::Spec->catfile($self->{build_dir},'Build');
CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]",
$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) {
@@ -2964,10 +3163,31 @@ sub prereq_pm {
$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} &&
@@ -3074,29 +3294,142 @@ sub prereq_pm {
}
}
}
- 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,
+ };
+ }
+}
+
+#-> sub CPAN::Distribution::shortcut_test ;
+# return values: undef means don't shortcut; 0 means shortcut as fail;
+# and 1 means shortcut as success
+sub shortcut_test {
+ my ($self) = @_;
+
+ $self->debug("checking badtestcnt[$self->{ID}]") if $CPAN::DEBUG;
+ $self->{badtestcnt} ||= 0;
+ if ($self->{badtestcnt} > 0) {
+ require Data::Dumper;
+ CPAN->debug(sprintf "NOREPEAT[%s]", Data::Dumper::Dumper($self)) if $CPAN::DEBUG;
+ return $self->goodbye("Won't repeat unsuccessful test during this command");
+ }
+
+ for my $slot ( qw/later configure_requires_later/ ) {
+ $self->debug("checking $slot slot[$self->{ID}]") if $CPAN::DEBUG;
+ return $self->success($self->{$slot})
+ if $self->{$slot};
+ }
+
+ $self->debug("checking if tests passed[$self->{ID}]") if $CPAN::DEBUG;
+ if ( $self->{make_test} ) {
+ if (
+ UNIVERSAL::can($self->{make_test},"failed") ?
+ $self->{make_test}->failed :
+ $self->{make_test} =~ /^NO/
+ ) {
+ if (
+ UNIVERSAL::can($self->{make_test},"commandid")
+ &&
+ $self->{make_test}->commandid == $CPAN::CurrentCommandId
+ ) {
+ return $self->goodbye("Has already been tested within this command");
+ }
+ } else {
+ # if global "is_tested" has been cleared, we need to mark this to
+ # be added to PERL5LIB if not already installed
+ if ($self->tested_ok_but_not_installed) {
+ $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
+ }
+ return $self->success("Has already been tested successfully");
+ }
+ }
+
+ if ($self->{notest}) {
+ $self->{make_test} = CPAN::Distrostatus->new("YES");
+ return $self->success("Skipping test because of notest pragma");
+ }
+
+ 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) = @_;
+
+ $self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
if (my $goto = $self->prefs->{goto}) {
return $self->goto($goto);
}
- $self->make;
- return if $self->prefs->{disabled} && ! $self->{force_update};
+
+ $self->make
+ or return;
+
+ if ( defined( my $sc = $self->shortcut_test ) ) {
+ return $sc;
+ }
+
if ($CPAN::Signal) {
delete $self->{force_update};
return;
}
# warn "XDEBUG: checking for notest: $self->{notest} $self";
- if ($self->{notest}) {
- $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
- return 1;
- }
-
my $make = $self->{modulebuild} ? "Build" : "make";
local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
@@ -3106,66 +3439,19 @@ 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");
- EXCUSE: {
- my @e;
- if ($self->{make} or $self->{later}) {
- # go ahead
- } else {
- push @e,
- "Make had some problems, won't test";
- }
-
- exists $self->{make} and
- (
- UNIVERSAL::can($self->{make},"failed") ?
- $self->{make}->failed :
- $self->{make} =~ /^NO/
- ) and push @e, "Can't test without successful make";
- $self->{badtestcnt} ||= 0;
- if ($self->{badtestcnt} > 0) {
- require Data::Dumper;
- CPAN->debug(sprintf "NOREPEAT[%s]", Data::Dumper::Dumper($self)) if $CPAN::DEBUG;
- push @e, "Won't repeat unsuccessful test during this command";
- }
-
- push @e, $self->{later} if $self->{later};
- push @e, $self->{configure_requires_later} if $self->{configure_requires_later};
-
- if (exists $self->{build_dir}) {
- if (exists $self->{make_test}) {
- if (
- UNIVERSAL::can($self->{make_test},"failed") ?
- $self->{make_test}->failed :
- $self->{make_test} =~ /^NO/
- ) {
- if (
- UNIVERSAL::can($self->{make_test},"commandid")
- &&
- $self->{make_test}->commandid == $CPAN::CurrentCommandId
- ) {
- push @e, "Has already been tested within this command";
- }
- } else {
- push @e, "Has already been tested successfully";
- # if global "is_tested" has been cleared, we need to mark this to
- # be added to PERL5LIB if not already installed
- if ($self->tested_ok_but_not_installed) {
- $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
- }
- }
- }
- } elsif (!@e) {
- push @e, "Has no own directory";
- }
- $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
- unless (chdir $self->{build_dir}) {
- push @e, "Couldn't chdir to '$self->{build_dir}': $!";
- }
- $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
+ my $builddir = $self->dir or
+ $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
+
+ unless (chdir $builddir) {
+ $CPAN::Frontend->mywarn("Couldn't chdir to '$builddir': $!");
+ return;
}
+
$self->debug("Changed directory to $self->{build_dir}")
if $CPAN::DEBUG;
@@ -3287,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");
}
@@ -3300,6 +3590,8 @@ sub test {
$self->pretty_id));
}
$self->store_persistent_state;
+
+ return $self->{force_update} ? 1 : !! $tests_ok;
}
sub _make_test_illuminate_prereqs {
@@ -3331,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;
@@ -3443,6 +3736,20 @@ sub clean {
$self->store_persistent_state;
}
+#-> sub CPAN::Distribution::check_disabled ;
+sub check_disabled {
+ my ($self) = @_;
+ $self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG;
+ if ($self->prefs->{disabled} && ! $self->{force_update}) {
+ return sprintf(
+ "Disabled via prefs file '%s' doc %d",
+ $self->{prefs_file},
+ $self->{prefs_file_doc},
+ );
+ }
+ return;
+}
+
#-> sub CPAN::Distribution::goto ;
sub goto {
my($self,$goto) = @_;
@@ -3469,87 +3776,76 @@ sub goto {
my($method) = (caller(1))[3];
CPAN->instance("CPAN::Distribution",$goto)->$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
+}
+
+#-> sub CPAN::Distribution::shortcut_install ;
+# return values: undef means don't shortcut; 0 means shortcut as fail;
+# and 1 means shortcut as success
+sub shortcut_install {
+ my ($self) = @_;
+
+ $self->debug("checking previous install results[$self->{ID}]") if $CPAN::DEBUG;
+ if (exists $self->{install}) {
+ my $text = UNIVERSAL::can($self->{install},"text") ?
+ $self->{install}->text :
+ $self->{install};
+ if ($text =~ /^YES/) {
+ $CPAN::META->is_installed($self->{build_dir});
+ return $self->success("Already done");
+ } elsif ($text =~ /is only/) {
+ # e.g. 'is only build_requires'
+ return $self->goodbye($text);
+ } else {
+ # comment in Todo on 2006-02-11; maybe retry?
+ return $self->goodbye("Already tried without success");
+ }
+ }
+
+ for my $slot ( qw/later configure_requires_later/ ) {
+ return $self->success($self->{$slot})
+ if $self->{$slot};
+ }
+
+ return undef;
}
#-> sub CPAN::Distribution::install ;
sub install {
my($self) = @_;
+
+ $self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
if (my $goto = $self->prefs->{goto}) {
return $self->goto($goto);
}
- unless ($self->{badtestcnt}) {
- $self->test;
+
+ $self->test
+ or return;
+
+ if ( defined( my $sc = $self->shortcut_install ) ) {
+ return $sc;
}
+
if ($CPAN::Signal) {
delete $self->{force_update};
return;
}
- my $make = $self->{modulebuild} ? "Build" : "make";
- $CPAN::Frontend->myprint("Running $make install\n");
- EXCUSE: {
- my @e;
- if ($self->{make} or $self->{later}) {
- # go ahead
- } else {
- push @e,
- "Make had some problems, won't install";
- }
-
- exists $self->{make} and
- (
- UNIVERSAL::can($self->{make},"failed") ?
- $self->{make}->failed :
- $self->{make} =~ /^NO/
- ) and
- push @e, "Make had returned bad status, install seems impossible";
-
- if (exists $self->{build_dir}) {
- } elsif (!@e) {
- push @e, "Has no own directory";
- }
-
- if (exists $self->{make_test} and
- (
- UNIVERSAL::can($self->{make_test},"failed") ?
- $self->{make_test}->failed :
- $self->{make_test} =~ /^NO/
- )) {
- if ($self->{force_update}) {
- $self->{make_test}->text("FAILED but failure ignored because ".
- "'force' in effect");
- } else {
- push @e, "make test had returned bad status, ".
- "won't install without force"
- }
- }
- if (exists $self->{install}) {
- my $text = UNIVERSAL::can($self->{install},"text") ?
- $self->{install}->text :
- $self->{install};
- if ($text =~ /^YES/) {
- $CPAN::Frontend->myprint(" Already done\n");
- $CPAN::META->is_installed($self->{build_dir});
- return 1;
- } elsif ($text =~ /is only/) {
- push @e, $text;
- } else {
- # comment in Todo on 2006-02-11; maybe retry?
- push @e, "Already tried without success";
- }
- }
- push @e, $self->{later} if $self->{later};
- push @e, $self->{configure_requires_later} if $self->{configure_requires_later};
+ my $builddir = $self->dir or
+ $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
- $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
- unless (chdir $self->{build_dir}) {
- push @e, "Couldn't chdir to '$self->{build_dir}': $!";
- }
- $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
+ unless (chdir $builddir) {
+ $CPAN::Frontend->mywarn("Couldn't chdir to '$builddir': $!");
+ return;
}
+
$self->debug("Changed directory to $self->{build_dir}")
if $CPAN::DEBUG;
+ my $make = $self->{modulebuild} ? "Build" : "make";
+ $CPAN::Frontend->myprint("Running $make install\n");
+
if ($^O eq 'MacOS') {
Mac::BuildTools::make_install($self);
return;
@@ -3573,10 +3869,7 @@ sub install {
);
} else {
- my($make_install_make_command) =
- CPAN::HandleConfig->prefs_lookup($self,
- q{make_install_make_command})
- || $self->_make_command();
+ my($make_install_make_command) = $self->_make_install_make_command();
$system = sprintf("%s install %s",
$make_install_make_command,
$CPAN::Config->{make_install_arg},
@@ -3605,10 +3898,9 @@ sub install {
}
unless ($want_install =~ /^y/i) {
my $is_only = "is only 'build_requires'";
- $CPAN::Frontend->mywarn("Not installing because $is_only\n");
$self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
delete $self->{force_update};
- return;
+ return $self->goodbye("Not installing because $is_only");
}
local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
? $ENV{PERL5LIB}
@@ -3616,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) = "";
@@ -3659,6 +3954,7 @@ sub install {
}
delete $self->{force_update};
$self->store_persistent_state;
+ return !! $close_ok;
}
sub introduce_myself {
@@ -4011,7 +4307,7 @@ sub reports {
}
$CPAN::Frontend->myprint("DONE\n\n");
my $yaml = $resp->content;
- # was fuer ein Umweg!
+ # what a long way round!
my $fh = File::Temp->new(
dir => File::Spec->tmpdir,
template => 'cpan_reports_XXXX',