diff options
author | Karl Berry <karl@freefriends.org> | 2019-03-10 21:56:14 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2019-03-10 21:56:14 +0000 |
commit | e0a2a718e89f9700d627f1e6a8eea8f21d2fbeb8 (patch) | |
tree | 39972f65008b0d70f306a5f976494d29411bc41e /Master/tlpkg/tlperl/lib/CPAN | |
parent | b206fdc77d81ed1600949062f08de5690a4bf66f (diff) |
tl19 perl 5.28.1 for Windows, from Siep
git-svn-id: svn://tug.org/texlive/trunk@50322 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPAN')
-rw-r--r-- | Master/tlpkg/tlperl/lib/CPAN/Distribution.pm | 89 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/CPAN/FTP.pm | 38 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/CPAN/FirstTime.pm | 6 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/CPAN/Shell.pm | 4 |
4 files changed, 101 insertions, 36 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm b/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm index 64976eb7bbd..72101afc7b4 100644 --- a/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm +++ b/Master/tlpkg/tlperl/lib/CPAN/Distribution.pm @@ -8,7 +8,7 @@ use CPAN::InfoObj; use File::Path (); @CPAN::Distribution::ISA = qw(CPAN::InfoObj); use vars qw($VERSION); -$VERSION = "2.18"; +$VERSION = "2.19"; # no prepare, because prepare is not a command on the shell command line # TODO: clear instance cache on reload @@ -660,8 +660,11 @@ sub satisfy_requires { my ($self) = @_; $self->debug("Entering satisfy_requires") if $CPAN::DEBUG; if (my @prereq = $self->unsat_prereq("later")) { - $self->debug("unsatisfied[@prereq]") if $CPAN::DEBUG; - $self->debug(@prereq) if $CPAN::DEBUG && @prereq; + if ($CPAN::DEBUG){ + require Data::Dumper; + my $prereq = Data::Dumper->new(\@prereq)->Terse(1)->Indent(0)->Dump; + $self->debug("unsatisfied[$prereq]"); + } if ($prereq[0][0] eq "perl") { my $need = "requires perl '$prereq[0][1]'"; my $id = $self->pretty_id; @@ -1717,13 +1720,10 @@ sub isa_perl { my($self) = @_; my $file = File::Basename::basename($self->id); if ($file =~ m{ ^ perl - -? - (5) - ([._-]) ( - \d{3}(_[0-4][0-9])? + -5\.\d+\.\d+ | - \d+\.\d+ + 5[._-]00[0-5](_[0-4][0-9])? ) \.tar[._-](?:gz|bz2) (?!\n)\Z @@ -1982,7 +1982,12 @@ sub prepare { } } elsif ( $self->_should_report('pl') ) { - ($output, $ret) = CPAN::Reporter::record_command($system); + ($output, $ret) = eval { CPAN::Reporter::record_command($system) }; + if (! defined $output or $@) { + my $err = $@ || "Unknown error"; + $CPAN::Frontend->mywarn("Error while running PL phase: $err"); + return $self->goodbye("$system -- NOT OK"); + } CPAN::Reporter::grade_PL( $self, $system, $output, $ret ); } else { @@ -2084,7 +2089,7 @@ is part of the perl-%s distribution. To install that, you need to run $self->called_for, $self->isa_perl, $self->called_for, - $self->id, + $self->pretty_id, )); $self->{make} = CPAN::Distrostatus->new("NO isa perl"); $CPAN::Frontend->mysleep(1); @@ -2610,9 +2615,19 @@ sub _make_install_make_command { 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}; + my($nmo,$opt); + for my $rt (qw(requires build_requires)) { + if (exists $prereq_pm->{$rt}{$prereq}) { + # rt 121914 + $nmo ||= $CPAN::META->instance("CPAN::Module",$prereq); + my $av = $nmo->available_version; + return 0 if !$av || CPAN::Version->vlt($av,$prereq_pm->{$rt}{$prereq}); + } + if (exists $prereq_pm->{"opt_$rt"}{$prereq}) { + $opt = 1; + } + } + return $opt||0; } #-> sub CPAN::Distribution::follow_prereqs ; @@ -2761,8 +2776,29 @@ sub _feature_depends { sub prereqs_for_slot { my($self,$slot) = @_; my($prereq_pm); - $CPAN::META->has_usable("CPAN::Meta::Requirements") - or die "CPAN::Meta::Requirements not available"; + unless ($CPAN::META->has_usable("CPAN::Meta::Requirements")) { + my $whynot = "not available"; + if (defined $CPAN::Meta::Requirements::VERSION) { + $whynot = "version $CPAN::Meta::Requirements::VERSION not sufficient"; + } + $CPAN::Frontend->mywarn("CPAN::Meta::Requirements $whynot\n"); + my $before = ""; + if ($self->{CALLED_FOR}){ + if ($self->{CALLED_FOR} =~ + /^( + CPAN::Meta::Requirements + |version + |parent + |ExtUtils::MakeMaker + |Test::Harness + )$/x) { + $CPAN::Frontend->mywarn("Setting requirements to nil as a workaround\n"); + return; + } + $before = " before $self->{CALLED_FOR}"; + } + $CPAN::Frontend->mydie("Please install CPAN::Meta::Requirements manually$before"); + } my $merged = CPAN::Meta::Requirements->new; my $prefs_depends = $self->prefs->{depends}||{}; my $feature_depends = $self->_feature_depends(); @@ -2825,8 +2861,10 @@ sub unsat_prereq { my($self,$slot) = @_; my($merged_hash,$prereq_pm) = $self->prereqs_for_slot($slot); my(@need); - $CPAN::META->has_usable("CPAN::Meta::Requirements") - or die "CPAN::Meta::Requirements not available"; + unless ($CPAN::META->has_usable("CPAN::Meta::Requirements")) { + $CPAN::Frontend->mywarn("CPAN::Meta::Requirements not available, please install as soon as possible, trying to continue with severly limited capabilities\n"); + return; + } my $merged = CPAN::Meta::Requirements->from_string_hash($merged_hash); my @merged = sort $merged->required_modules; CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG; @@ -3047,6 +3085,10 @@ sub unsat_prereq { } # here need to flag as optional for recommends/suggests # -- xdg, 2012-04-01 + $self->debug(sprintf "%s manadory?[%s]", + $self->pretty_id, + $self->{mandatory}) + if $CPAN::DEBUG; my $optional = !$self->{mandatory} || $self->is_locally_optional($prereq_pm, $need_module); push @need, [$need_module,$needed_as,$optional]; @@ -3965,7 +4007,15 @@ sub install { local $ENV{PERL_MM_USE_DEFAULT} = 1 if $CPAN::Config->{use_prompt_default}; local $ENV{NONINTERACTIVE_TESTING} = 1 if $CPAN::Config->{use_prompt_default}; - my($pipe) = FileHandle->new("$system $stderr |") || Carp::croak("Can't execute $system: $!"); + my($pipe) = FileHandle->new("$system $stderr |"); + unless ($pipe) { + $CPAN::Frontend->mywarn("Can't execute $system: $!"); + $self->introduce_myself; + $self->{install} = CPAN::Distrostatus->new("NO"); + $CPAN::Frontend->mywarn(" $system -- NOT OK\n"); + delete $self->{force_update}; + return; + } my($makeout) = ""; while (<$pipe>) { print $_; # intentionally NOT use Frontend->myprint because it @@ -3980,7 +4030,8 @@ sub install { $CPAN::Frontend->myprint(" $system -- OK\n"); $CPAN::META->is_installed($self->{build_dir}); $self->{install} = CPAN::Distrostatus->new("YES"); - if ($CPAN::Config->{'cleanup_after_install'}) { + if ($CPAN::Config->{'cleanup_after_install'} + && ! $self->is_dot_dist) { my $parent = File::Spec->catdir( $self->{build_dir}, File::Spec->updir ); chdir $parent or $CPAN::Frontend->mydie("Couldn't chdir to $parent: $!\n"); File::Path::rmtree($self->{build_dir}); diff --git a/Master/tlpkg/tlperl/lib/CPAN/FTP.pm b/Master/tlpkg/tlperl/lib/CPAN/FTP.pm index a43ea02e9e8..6d9800e31b1 100644 --- a/Master/tlpkg/tlperl/lib/CPAN/FTP.pm +++ b/Master/tlpkg/tlperl/lib/CPAN/FTP.pm @@ -3,6 +3,7 @@ package CPAN::FTP; use strict; +use Errno (); use Fcntl qw(:flock); use File::Basename qw(dirname); use File::Path qw(mkpath); @@ -14,7 +15,20 @@ use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod); use vars qw( $VERSION ); -$VERSION = "5.5008"; +$VERSION = "5.5011"; + +sub _plus_append_open { + my($fh, $file) = @_; + my $parent_dir = dirname $file; + mkpath $parent_dir; + my($cnt); + until (open $fh, "+>>$file") { + next if $! == Errno::EAGAIN; # don't increment on EAGAIN + $CPAN::Frontend->mydie("Could not open '$file' after 10000 tries: $!") if ++$cnt > 100000; + sleep 0.0001; + mkpath $parent_dir; + } +} #-> sub CPAN::FTP::ftp_statistics # if they want to rewrite, they need to pass in a filehandle @@ -28,8 +42,7 @@ sub _ftp_statistics { $fh ||= FileHandle->new; my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml"); - mkpath dirname $file; - open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!"); + _plus_append_open($fh,$file); my $sleep = 1; my $waitstart; while (!CPAN::_flock($fh, $locktype|LOCK_NB)) { @@ -41,13 +54,11 @@ sub _ftp_statistics { sleep($sleep); # this sleep must not be overridden; # Frontend->mysleep with AUTOMATED_TESTING has # provoked complete lock contention on my NFS - if ($sleep <= 3) { - $sleep+=0.33; - } elsif ($sleep <= 6) { - $sleep+=0.11; + if ($sleep <= 6) { + $sleep+=0.5; } else { # retry to get a fresh handle. If it is NFS and the handle is stale, we will never get an flock - open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!"); + _plus_append_open($fh, $file); } } my $stats = eval { CPAN->_yaml_loadfile($file); }; @@ -60,8 +71,11 @@ sub _ftp_statistics { } elsif (ref $@ eq "CPAN::Exception::yaml_process_error") { my $time = time; my $to = "$file.$time"; - $CPAN::Frontend->myprint("Error reading '$file': $@\nStashing away as '$to' to prevent further interruptions. You may want to remove that file later.\n"); - rename $file, $to or $CPAN::Frontend->mydie("Could not rename: $!"); + $CPAN::Frontend->mywarn("Error reading '$file': $@ + Trying to stash it away as '$to' to prevent further interruptions. + You may want to remove that file later.\n"); + # may fail because somebody else has moved it away in the meantime: + rename $file, $to or $CPAN::Frontend->mywarn("Could not rename '$file' to '$to': $!\n"); return; } } else { @@ -139,7 +153,7 @@ sub _add_to_statistics { unlink($sfile) if ($^O eq 'MSWin32' or $^O eq 'os2'); _copy_stat($sfile, "$sfile.$$") if -e $sfile; rename "$sfile.$$", $sfile - or $CPAN::Frontend->mydie("Could not rename '$sfile.$$' to '$sfile': $!\n"); + or $CPAN::Frontend->mywarn("Could not rename '$sfile.$$' to '$sfile': $!\nGiving up\n"); } } @@ -555,7 +569,7 @@ sub hostdleasy { #called from hostdlxxx my($ro_url); HOSTEASY: for $ro_url (@$host_seq) { $self->_set_attempt($stats,"dleasy",$ro_url); - my $url .= "$ro_url$file"; + my $url = "$ro_url$file"; $self->debug("localizing perlish[$url]") if $CPAN::DEBUG; if ($url =~ /^file:/) { my $l; diff --git a/Master/tlpkg/tlperl/lib/CPAN/FirstTime.pm b/Master/tlpkg/tlperl/lib/CPAN/FirstTime.pm index 531c1152a85..49fa8ab7b95 100644 --- a/Master/tlpkg/tlperl/lib/CPAN/FirstTime.pm +++ b/Master/tlpkg/tlperl/lib/CPAN/FirstTime.pm @@ -10,7 +10,7 @@ use File::Path (); use File::Spec (); use CPAN::Mirrors (); use vars qw($VERSION $auto_config); -$VERSION = "5.5310"; +$VERSION = "5.5311"; =head1 NAME @@ -439,7 +439,7 @@ Randomize parameter generally be installed except in resource constrained environments. When this policy is true, recommended modules will be included with required modules. -Included recommended modules? +Include recommended modules? =item scan_cache @@ -489,7 +489,7 @@ Show all individual modules that have a $VERSION of zero? dependencies provide enhanced operation. When this policy is true, suggested modules will be included with required modules. -Included suggested modules? +Include suggested modules? =item tar_verbosity diff --git a/Master/tlpkg/tlperl/lib/CPAN/Shell.pm b/Master/tlpkg/tlperl/lib/CPAN/Shell.pm index ab2f07e2ceb..423131cc2fd 100644 --- a/Master/tlpkg/tlperl/lib/CPAN/Shell.pm +++ b/Master/tlpkg/tlperl/lib/CPAN/Shell.pm @@ -47,7 +47,7 @@ use vars qw( "CPAN/Tarzip.pm", "CPAN/Version.pm", ); -$VERSION = "5.5006"; +$VERSION = "5.5007"; # record the initial timestamp for reload. $reload = { map {$INC{$_} ? ($_,(stat $INC{$_})[9]) : ()} @relo }; @CPAN::Shell::ISA = qw(CPAN::Debug); @@ -1023,7 +1023,7 @@ CPAN_VERSION: %s %s $need{$module->id}++; } unless (%need) { - if ($what eq "u") { + if (!@expand || $what eq "u") { $CPAN::Frontend->myprint("No modules found for @args\n"); } elsif ($what eq "r") { $CPAN::Frontend->myprint("All modules are up to date for @args\n"); |