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.pm289
1 files changed, 216 insertions, 73 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm b/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm
index ac8f873a130..637ab277d96 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm
@@ -1,11 +1,14 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
package CPAN::Distribution;
use strict;
use Cwd qw(chdir);
use CPAN::Distroprefs;
use CPAN::InfoObj;
+use File::Path ();
@CPAN::Distribution::ISA = qw(CPAN::InfoObj);
use vars qw($VERSION);
-$VERSION = "1.9456_01";
+$VERSION = "1.9602_01";
# Accessors
sub cpan_comment {
@@ -188,7 +191,7 @@ sub color_cmd_tmps {
my $premo;
unless ($premo = CPAN::Shell->expand("Module",$pre)) {
$CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
- $CPAN::Frontend->mysleep(2);
+ $CPAN::Frontend->mysleep(0.2);
next PREREQ;
}
$premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
@@ -501,6 +504,10 @@ See also http://rt.cpan.org/Ticket/Display.html?id=38932\n");
$from_dir = File::Spec->curdir;
@dirents = @readdir;
}
+ eval { File::Path::mkpath $builddir; };
+ if ($@) {
+ $CPAN::Frontend->mydie("Cannot create directory $builddir: $@");
+ }
$packagedir = File::Temp::tempdir(
"$tdir_base-XXXXXX",
DIR => $builddir,
@@ -575,6 +582,35 @@ EOF
return($packagedir,$local_file);
}
+#-> sub CPAN::Distribution::pick_meta_file ;
+sub pick_meta_file {
+ my($self, $filter) = @_;
+ $filter = '.' unless defined $filter;
+
+ my $build_dir;
+ unless ($build_dir = $self->{build_dir}) {
+ # maybe permission on build_dir was missing
+ $CPAN::Frontend->mywarn("Warning: cannot determine META.yml without a build_dir.\n");
+ return;
+ }
+
+ my $has_cm = $CPAN::META->has_usable("CPAN::Meta");
+ my $has_pcm = $CPAN::META->has_usable("Parse::CPAN::Meta");
+
+ my @choices;
+ push @choices, 'MYMETA.json' if $has_cm;
+ push @choices, 'MYMETA.yml' if $has_cm || $has_pcm;
+ push @choices, 'META.json' if $has_cm;
+ push @choices, 'META.yml' if $has_cm || $has_pcm;
+
+ for my $file ( grep { /$filter/ } @choices ) {
+ my $path = File::Spec->catdir( $build_dir, $file );
+ return $path if -f $path
+ }
+
+ return;
+}
+
#-> sub CPAN::Distribution::parse_meta_yml ;
sub parse_meta_yml {
my($self, $yaml) = @_;
@@ -586,6 +622,7 @@ sub parse_meta_yml {
my $early_yaml;
eval {
$CPAN::META->has_inst("Parse::CPAN::Meta") or die;
+ die "Parse::CPAN::Meta yaml too old" unless $Parse::CPAN::Meta::VERSION >= "1.40";
# P::C::M returns last document in scalar context
$early_yaml = Parse::CPAN::Meta::LoadFile($yaml);
};
@@ -638,20 +675,21 @@ sub satisfy_configure_requires {
# configure_requires simply fail, all others succeed
}
my @prereq = $self->unsat_prereq("configure_requires_later");
- $self->debug("configure_requires[@prereq]") if $CPAN::DEBUG;
+ $self->debug(sprintf "configure_requires[%s]", join(",",map {join "/",@$_} @prereq)) if $CPAN::DEBUG;
return 1 unless @prereq;
$self->debug(\@prereq) if $CPAN::DEBUG;
if ($self->{configure_requires_later}) {
for my $k (keys %{$self->{configure_requires_later_for}||{}}) {
if ($self->{configure_requires_later_for}{$k}>1) {
- # we must not come here a second time
- $CPAN::Frontend->mywarn("Panic: Some prerequisites is not available, please investigate...");
- require YAML::Syck;
- $CPAN::Frontend->mydie
- (
- YAML::Syck::Dump
- ({self=>$self, prereq=>\@prereq})
- );
+ my $type = "";
+ for my $p (@prereq) {
+ if ($p->[0] eq $k) {
+ $type = $p->[1];
+ }
+ }
+ $type = " $type" if $type;
+ $CPAN::Frontend->mywarn("Warning: unmanageable(?) prerequisite $k$type");
+ sleep 1;
}
}
}
@@ -844,12 +882,20 @@ sub try_download {
my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
my $pcommand;
- my $ppp = $self->_patch_p_parameter($readfh);
+ my($ppp,$pfiles) = $self->_patch_p_parameter($readfh);
if ($ppp eq "applypatch") {
$pcommand = "$CPAN::Config->{applypatch} -verbose";
} else {
my $thispatchargs = join " ", $stdpatchargs, $ppp;
$pcommand = "$patchbin $thispatchargs";
+ require Config; # usually loaded from CPAN.pm
+ if ($Config::Config{osname} eq "solaris") {
+ # native solaris patch cannot patch readonly files
+ for my $file (@{$pfiles||[]}) {
+ my @stat = stat $file or next;
+ chmod $stat[2] | 0600, $file; # may fail
+ }
+ }
}
$readfh = CPAN::Tarzip->TIEHANDLE($patch); # open again
@@ -880,10 +926,14 @@ sub try_download {
}
}
+# may return
+# - "applypatch"
+# - ("-p0"|"-p1", $files)
sub _patch_p_parameter {
my($self,$fh) = @_;
my $cnt_files = 0;
my $cnt_p0files = 0;
+ my @files;
local($_);
while ($_ = $fh->READLINE) {
if (
@@ -895,13 +945,15 @@ sub _patch_p_parameter {
}
next unless /^[\*\+]{3}\s(\S+)/;
my $file = $1;
+ push @files, $file;
$cnt_files++;
$cnt_p0files++ if -f $file;
CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]")
if $CPAN::DEBUG;
}
return "-p1" unless $cnt_files;
- return $cnt_files==$cnt_p0files ? "-p0" : "-p1";
+ my $opt_p = $cnt_files==$cnt_p0files ? "-p0" : "-p1";
+ return ($opt_p, \@files);
}
#-> sub CPAN::Distribution::_edge_cases
@@ -2398,8 +2450,19 @@ sub follow_prereqs {
return unless @prereq_tuples;
my(@good_prereq_tuples);
for my $p (@prereq_tuples) {
- # XXX watch out for foul ones
- push @good_prereq_tuples, $p;
+ # 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];
+ } else {
+ push @good_prereq_tuples, $p;
+ }
+ } else {
+ die "Panic: in follow_prereqs: reqtype[$p->[1]] seen, should never happen";
+ }
}
my $pretty_id = $self->pretty_id;
my %map = (
@@ -2436,7 +2499,7 @@ sub follow_prereqs {
of modules we are processing right now?", "yes");
$follow = $answer =~ /^\s*y/i;
} else {
- my @prereq = map { $_=>[0] } @good_prereq_tuples;
+ my @prereq = map { $_->[0] } @good_prereq_tuples;
local($") = ", ";
$CPAN::Frontend->
myprint(" Ignoring dependencies on modules @prereq\n");
@@ -2513,13 +2576,9 @@ sub unsat_prereq {
my $prefs_depends = $self->prefs->{depends}||{};
my $feature_depends = $self->_feature_depends();
if ($slot eq "configure_requires_later") {
- my $meta_yml = $self->parse_meta_yml();
- if (defined $meta_yml && (! ref $meta_yml || ref $meta_yml ne "HASH")) {
- $CPAN::Frontend->mywarn("The content of META.yml is defined but not a HASH reference. Cannot use it.\n");
- $meta_yml = +{};
- }
+ my $meta_configure_requires = $self->configure_requires();
%merged = (
- %{$meta_yml->{configure_requires}||{}},
+ %{$meta_configure_requires||{}},
%{$prefs_depends->{configure_requires}||{}},
%{$feature_depends->{configure_requires}||{}},
);
@@ -2576,10 +2635,9 @@ sub unsat_prereq {
or $need_version eq '0' # "==" would trigger warning when not numeric
or $need_version eq "undef"
)) {
- unless ($nmo->inst_deprecated) {
- next NEED;
- }
-
+ unless ($nmo->inst_deprecated) {
+ next NEED;
+ }
}
$available_version = $nmo->available_version;
@@ -2595,6 +2653,19 @@ sub unsat_prereq {
if ( $available_file ) {
if ( $inst_file && $available_file eq $inst_file && $nmo->inst_deprecated ) {
# continue installing as a prereq
+ } elsif ($self->{reqtype} =~ /^(r|c)$/ && exists $prereq_pm->{requires}{$need_module} && $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
+ # wants it as a requires
+ my $need_distro = $nmo->distribution;
+ if ($need_distro->{install} && $need_distro->{install}->failed && $need_distro->{install}->text =~ /is only/) {
+ CPAN->debug("promotion from build_requires to requires") if $CPAN::DEBUG;
+ delete $need_distro->{install}; # promote to another installation attempt
+ $need_distro->{reqtype} = "r";
+ $need_distro->install;
+ next NEED;
+ }
}
else {
next NEED if $self->_fulfills_all_version_rqs(
@@ -2696,7 +2767,21 @@ sub unsat_prereq {
}
}
}
- my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
+ my $needed_as;
+ if (0) {
+ } elsif (exists $prereq_pm->{requires}{$need_module}) {
+ $needed_as = "r";
+ } elsif ($slot eq "configure_requires_later") {
+ # in ae872487d5 we said: C< we have not yet run the
+ # {Build,Makefile}.PL, we must presume "r" >; but the
+ # meta.yml standard says C< These dependencies are not
+ # required after the distribution is installed. >; so now
+ # we change it back to "b" and care for the proper
+ # promotion later.
+ $needed_as = "b";
+ } else {
+ $needed_as = "b";
+ }
push @need, [$need_module,$needed_as];
}
my @unfolded = map { "[".join(",",@$_)."]" } @need;
@@ -2758,27 +2843,38 @@ sub _fulfills_all_version_rqs {
return $ret;
}
+#-> sub CPAN::Distribution::read_meta
+# read any sort of meta files, return CPAN::Meta object if no errors
+sub read_meta {
+ my($self) = @_;
+ my $meta_file = $self->pick_meta_file
+ or return;
+
+ return unless $CPAN::META->has_usable("CPAN::Meta");
+ my $meta = eval { CPAN::Meta->load_file($meta_file)}
+ or return;
+
+ # Very old EU::MM could have wrong META
+ if ($meta_file eq 'META.yml'
+ && $meta->generated_by =~ /ExtUtils::MakeMaker version ([\d\._]+)/
+ ) {
+ my $eummv = do { local $^W = 0; $1+0; };
+ return if $eummv < 6.2501;
+ }
+
+ return $meta;
+}
+
#-> sub CPAN::Distribution::read_yaml ;
+# XXX This should be DEPRECATED -- dagolden, 2011-02-05
sub read_yaml {
my($self) = @_;
- my $build_dir;
- unless ($build_dir = $self->{build_dir}) {
- # maybe permission on build_dir was missing
- $CPAN::Frontend->mywarn("Warning: cannot determine META.yml without a build_dir.\n");
- return;
- }
- # if MYMETA.yml exists, that takes precedence over META.yml
- my $meta = File::Spec->catfile($build_dir,"META.yml");
- my $mymeta = File::Spec->catfile($build_dir,"MYMETA.yml");
- my $meta_file = -f $mymeta ? $mymeta : $meta;
+ my $meta_file = $self->pick_meta_file;
$self->debug("meta_file[$meta_file]") if $CPAN::DEBUG;
- return unless -f $meta_file;
+ return unless $meta_file;
my $yaml;
eval { $yaml = $self->parse_meta_yml($meta_file) };
if ($@ or ! $yaml) {
- $CPAN::Frontend->mywarnonce("Could not read ".
- "'$meta_file'. Falling back to other ".
- "methods to determine prerequisites\n");
return undef; # if we die, then we cannot read YAML's own META.yml
}
# not "authoritative"
@@ -2790,7 +2886,7 @@ sub read_yaml {
if $CPAN::DEBUG;
$self->debug($yaml) if $CPAN::DEBUG && $yaml;
# MYMETA.yml is static and authoritative by definition
- if ( $meta_file eq $mymeta ) {
+ if ( $meta_file =~ /MYMETA\.yml/ ) {
return $yaml;
}
# META.yml is authoritative only if dynamic_config is defined and false
@@ -2801,6 +2897,21 @@ sub read_yaml {
return undef;
}
+#-> sub CPAN::Distribution::configure_requires ;
+sub configure_requires {
+ my($self) = @_;
+ return unless my $meta_file = $self->pick_meta_file('^META');
+ if (my $meta_obj = $self->read_meta) {
+ my $prereqs = $meta_obj->effective_prereqs;
+ my $cr = $prereqs->requirements_for(qw/configure requires/);
+ return $cr ? $cr->as_string_hash : undef;
+ }
+ else {
+ my $yaml = eval { $self->parse_meta_yml($meta_file) };
+ return $yaml->{configure_requires};
+ }
+}
+
#-> sub CPAN::Distribution::prereq_pm ;
sub prereq_pm {
my($self) = @_;
@@ -2815,7 +2926,19 @@ sub prereq_pm {
$self->{modulebuild}||"",
) if $CPAN::DEBUG;
my($req,$breq);
- if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
+ my $meta_obj = $self->read_meta;
+ # META/MYMETA is only authoritative if dynamic_config is false
+ if ($meta_obj && ! $meta_obj->dynamic_config) {
+ my $prereqs = $meta_obj->effective_prereqs;
+ my $requires = $prereqs->requirements_for(qw/runtime requires/);
+ my $build_requires = $prereqs->requirements_for(qw/build requires/);
+ my $test_requires = $prereqs->requirements_for(qw/test requires/);
+ # XXX we don't yet distinguish build vs test, so merge them for now
+ $build_requires->add_requirements($test_requires);
+ $req = $requires->as_string_hash;
+ $breq = $build_requires->as_string_hash;
+ }
+ elsif (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
$req = $yaml->{requires} || {};
$breq = $yaml->{build_requires} || {};
undef $req unless ref $req eq "HASH" && %$req;
@@ -2833,6 +2956,7 @@ sub prereq_pm {
my $areq;
my $do_replace;
while (my($k,$v) = each %{$req||{}}) {
+ next unless defined $v;
if ($v =~ /\d/) {
$areq->{$k} = $v;
} elsif ($k =~ /[A-Za-z]/ &&
@@ -2851,6 +2975,11 @@ sub prereq_pm {
$req = $areq if $do_replace;
}
}
+ else {
+ $CPAN::Frontend->mywarnonce("Could not read metadata file. Falling back to other ".
+ "methods to determine prerequisites\n");
+ }
+
unless ($req || $breq) {
my $build_dir;
unless ( $build_dir = $self->{build_dir} ) {
@@ -3122,8 +3251,42 @@ sub test {
$tests_ok = system($system) == 0;
}
$self->introduce_myself;
+ my $but = $self->_make_test_illuminate_prereqs();
if ( $tests_ok ) {
- {
+ if ($but) {
+ $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
+ $self->{make_test} = CPAN::Distrostatus->new("NO $but");
+ $self->store_persistent_state;
+ return $self->goodbye("[dependencies] -- NA");
+ }
+ $CPAN::Frontend->myprint(" $system -- OK\n");
+ $self->{make_test} = CPAN::Distrostatus->new("YES");
+ $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
+ # probably impossible to need the next line because badtestcnt
+ # has a lifespan of one command
+ delete $self->{badtestcnt};
+ } else {
+ if ($but) {
+ $but .= "; additionally test harness failed";
+ $CPAN::Frontend->mywarn("$but\n");
+ $self->{make_test} = CPAN::Distrostatus->new("NO $but");
+ } else {
+ $self->{make_test} = CPAN::Distrostatus->new("NO");
+ }
+ $self->{badtestcnt}++;
+ $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
+ CPAN::Shell->optprint
+ ("hint",
+ sprintf
+ ("//hint// to see the cpan-testers results for installing this module, try:
+ reports %s\n",
+ $self->pretty_id));
+ }
+ $self->store_persistent_state;
+}
+
+sub _make_test_illuminate_prereqs {
+ my($self) = @_;
my @prereq;
# local $CPAN::DEBUG = 16; # Distribution
@@ -3154,36 +3317,14 @@ sub test {
push @prereq, $m;
}
}
+ my $but;
if (@prereq) {
my $cnt = @prereq;
my $which = join ",", @prereq;
- my $but = $cnt == 1 ? "one dependency not OK ($which)" :
+ $but = $cnt == 1 ? "one dependency not OK ($which)" :
"$cnt dependencies missing ($which)";
- $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
- $self->{make_test} = CPAN::Distrostatus->new("NO $but");
- $self->store_persistent_state;
- return $self->goodbye("[dependencies] -- NA");
}
- }
-
- $CPAN::Frontend->myprint(" $system -- OK\n");
- $self->{make_test} = CPAN::Distrostatus->new("YES");
- $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
- # probably impossible to need the next line because badtestcnt
- # has a lifespan of one command
- delete $self->{badtestcnt};
- } else {
- $self->{make_test} = CPAN::Distrostatus->new("NO");
- $self->{badtestcnt}++;
- $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
- CPAN::Shell->optprint
- ("hint",
- sprintf
- ("//hint// to see the cpan-testers results for installing this module, try:
- reports %s\n",
- $self->pretty_id));
- }
- $self->store_persistent_state;
+ $but;
}
sub _prefs_with_expect {
@@ -3365,13 +3506,15 @@ sub install {
}
}
if (exists $self->{install}) {
- if (UNIVERSAL::can($self->{install},"text") ?
- $self->{install}->text eq "YES" :
- $self->{install} =~ /^YES/
- ) {
+ 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";