diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPAN/Distribution.pm')
| -rw-r--r-- | Master/tlpkg/tlperl/lib/CPAN/Distribution.pm | 1048 |
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', |