This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade CPAN from version 2.18-TRIAL to 2.20-TRIAL
authorSteve Hay <steve.m.hay@googlemail.com>
Tue, 12 Dec 2017 08:21:04 +0000 (08:21 +0000)
committerSteve Hay <steve.m.hay@googlemail.com>
Tue, 12 Dec 2017 08:21:04 +0000 (08:21 +0000)
Porting/Maintainers.pl
cpan/CPAN/lib/App/Cpan.pm
cpan/CPAN/lib/CPAN.pm
cpan/CPAN/lib/CPAN/Distribution.pm
cpan/CPAN/lib/CPAN/FTP.pm
cpan/CPAN/lib/CPAN/FirstTime.pm
cpan/CPAN/lib/CPAN/Shell.pm

index 7048381..c1f817d 100755 (executable)
@@ -248,7 +248,7 @@ use File::Glob qw(:case);
     },
 
     'CPAN' => {
-        'DISTRIBUTION' => 'ANDK/CPAN-2.18-TRIAL.tar.gz',
+        'DISTRIBUTION' => 'ANDK/CPAN-2.20-TRIAL.tar.gz',
         'FILES'        => q[cpan/CPAN],
         'EXCLUDED'     => [
             qr{^distroprefs/},
@@ -259,6 +259,7 @@ use File::Glob qw(:case);
             qw( lib/CPAN/Admin.pm
                 scripts/cpan-mirrors
                 PAUSE2015.pub
+                PAUSE2019.pub
                 SlayMakefile
                 t/00signature.t
                 t/04clean_load.t
index 3ddcbe8..8754912 100644 (file)
@@ -6,7 +6,7 @@ use vars qw($VERSION);
 
 use if $] < 5.008 => 'IO::Scalar';
 
-$VERSION = '1.66';
+$VERSION = '1.67';
 
 =head1 NAME
 
@@ -545,7 +545,13 @@ package
   Local::Null::Logger; # hide from PAUSE
 
 sub new { bless \ my $x, $_[0] }
-sub AUTOLOAD { 1 }
+sub AUTOLOAD {
+    my $autoload = our $AUTOLOAD;
+    $autoload =~ s/.*://;
+    return if $autoload =~ /^(debug|trace)$/;
+    $CPAN::Frontend->mywarn(">($autoload): $_\n")
+        for split /[\r\n]+/, $_[1];
+}
 sub DESTROY { 1 }
 }
 
@@ -566,7 +572,7 @@ sub _init_logger
 
     unless( $log4perl_loaded )
         {
-        print STDERR "Loading internal null logger. Install Log::Log4perl for logging messages\n";
+        print STDOUT "Loading internal logger. Log::Log4perl recommended for better logging\n";
         $logger = Local::Null::Logger->new;
         return $logger;
         }
@@ -625,6 +631,8 @@ sub _default
        # How do I handle exit codes for multiple arguments?
        my @errors = ();
 
+       $options->{x} or _disable_guessers();
+
        foreach my $arg ( @$args )
                {
                # check the argument and perhaps capture typos
@@ -1517,14 +1525,19 @@ sub _expand_module
        }
 
 my $guessers = [
-       [ qw( Text::Levenshtein::XS distance 7 ) ],
-       [ qw( Text::Levenshtein::Damerau::XS     xs_edistance 7 ) ],
+       [ qw( Text::Levenshtein::XS distance 7 ) ],
+       [ qw( Text::Levenshtein::Damerau::XS     xs_edistance 7 ) ],
 
-       [ qw( Text::Levenshtein     distance 7 ) ],
-       [ qw( Text::Levenshtein::Damerau::PP     pp_edistance 7 ) ],
+       [ qw( Text::Levenshtein     distance 7 ) ],
+       [ qw( Text::Levenshtein::Damerau::PP     pp_edistance 7 ) ],
 
        ];
 
+sub _disable_guessers
+       {
+       $_->[-1] = 0 for @$guessers;
+       }
+
 # for -x
 sub _guess_namespace
        {
@@ -1553,25 +1566,40 @@ sub _list_all_namespaces {
 
 BEGIN {
 my $distance;
+my $_threshold;
+my $can_guess;
+my $shown_help = 0;
 sub _guess_at_module_name
        {
        my( $target, $threshold ) = @_;
 
        unless( defined $distance ) {
                foreach my $try ( @$guessers ) {
-                       my $can_guess = eval "require $try->[0]; 1" or next;
+                       $can_guess = eval "require $try->[0]; 1" or next;
 
+                       $try->[-1] or next; # disabled
                        no strict 'refs';
                        $distance = \&{ join "::", @$try[0,1] };
                        $threshold ||= $try->[2];
                        }
                }
+       $_threshold ||= $threshold;
 
        unless( $distance ) {
-               my $modules = join ", ", map { $_->[0] } @$guessers;
-               substr $modules, rindex( $modules, ',' ), 1, ', and';
+               unless( $shown_help ) {
+                       my $modules = join ", ", map { $_->[0] } @$guessers;
+                       substr $modules, rindex( $modules, ',' ), 1, ', and';
 
-               $logger->info( "I can suggest names if you install one of $modules" );
+                       # Should this be colorized?
+                       if( $can_guess ) {
+                               $logger->info( "I can suggest names if you provide the -x option on invocation." );
+                               }
+                       else {
+                               $logger->info( "I can suggest names if you install one of $modules" );
+                               $logger->info( "and you provide the -x option on invocation." );
+                               }
+                       $shown_help++;
+                       }
                return;
                }
 
@@ -1581,7 +1609,7 @@ sub _guess_at_module_name
        my %guesses;
        foreach my $guess ( @$modules ) {
                my $distance = $distance->( $target, $guess );
-               next if $distance > $threshold;
+               next if $distance > $_threshold;
                $guesses{$guess} = $distance;
                }
 
index 4f02850..1f69119 100644 (file)
@@ -2,7 +2,7 @@
 # vim: ts=4 sts=4 sw=4:
 use strict;
 package CPAN;
-$CPAN::VERSION = '2.18';
+$CPAN::VERSION = '2.20';
 $CPAN::VERSION =~ s/_//;
 
 # we need to run chdir all over and we would get at wrong libraries
@@ -564,7 +564,10 @@ sub _yaml_loadfile {
             }
         } elsif ($code = UNIVERSAL::can($yaml_module, "Load")) {
             local *FH;
-            open FH, $local_file or die "Could not open '$local_file': $!";
+            unless (open FH, $local_file) {
+                $CPAN::Frontend->mywarn("Could not open '$local_file': $!");
+                return +[];
+            }
             local $/;
             my $ystream = <FH>;
             eval { @yaml = $code->($ystream); };
@@ -856,11 +859,12 @@ this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
         }
         my $sleep = 1;
         while (!CPAN::_flock($fh, LOCK_EX|LOCK_NB)) {
-            if ($sleep>10) {
-                $CPAN::Frontend->mydie("Giving up\n");
+            my $err = $! || "unknown error";
+            if ($sleep>3) {
+                $CPAN::Frontend->mydie("Could not lock '$lockfile' with flock: $err; giving up\n");
             }
-            $CPAN::Frontend->mysleep($sleep++);
-            $CPAN::Frontend->mywarn("Could not lock lockfile with flock: $!; retrying\n");
+            $CPAN::Frontend->mysleep($sleep+=0.1);
+            $CPAN::Frontend->mywarn("Could not lock '$lockfile' with flock: $err; retrying\n");
         }
 
         seek $fh, 0, 0;
@@ -1038,6 +1042,11 @@ sub has_usable {
 
                'CPAN::Meta::Requirements' => [
                             sub {
+                                if (defined $CPAN::Meta::Requirements::VERSION
+                                    && CPAN::Version->vlt($CPAN::Meta::Requirements::VERSION, "2.120920")
+                                   ) {
+                                    delete $INC{"CPAN/Meta/Requirements.pm"};
+                                }
                                 require CPAN::Meta::Requirements;
                                 unless (CPAN::Version->vge(CPAN::Meta::Requirements->VERSION, 2.120920)) {
                                     for ("Will not use CPAN::Meta::Requirements, need version 2.120920\n") {
index 64976eb..72101af 100644 (file)
@@ -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});
index a43ea02..6d9800e 100644 (file)
@@ -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;
index 531c115..49fa8ab 100644 (file)
@@ -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
 
index ab2f07e..423131c 100644 (file)
@@ -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");