Update CPAN.pm to 1.9402

8 files changed, 89 insertions, 35 deletions

diff --git a/lib/CPAN.pm b/lib/CPAN.pm
index ca8f5960b5..1196cb0fcf 100644
--- a/lib/CPAN.pm
+++ b/lib/CPAN.pm
@@ -2,7 +2,7 @@
 # vim: ts=4 sts=4 sw=4:
 use strict;
 package CPAN;
-$CPAN::VERSION = '1.94';
+$CPAN::VERSION = '1.9402';
 $CPAN::VERSION =~ s/_//;
 
 # we need to run chdir all over and we would get at wrong libraries
@@ -313,7 +313,7 @@ sub shell {
         $CPAN::Frontend->myprint(
                                  sprintf qq{
 cpan shell -- CPAN exploration and modules installation (v%s)
-ReadLine support %s
+Enter 'h' for help.
 
 },
                                  $CPAN::VERSION,
@@ -374,10 +374,11 @@ ReadLine support %s
                 @line = _redirect(@line);
                 CPAN::Shell->$command(@line)
               };
+            my $command_error = $@;
             _unredirect;
             my $reported_error;
-            if ($@) {
-                my $err = $@;
+            if ($command_error) {
+                my $err = $command_error;
                 if (ref $err and $err->isa('CPAN::Exception::blocked_urllist')) {
                     $CPAN::Frontend->mywarn("Client not fully configured, please proceed with configuring.$err");
                     $reported_error = ref $err;
@@ -1006,12 +1007,16 @@ sub has_usable {
                                   ],
                'Archive::Tar' => [
                                   sub {require Archive::Tar;
-                                       unless (CPAN::Version->vge(Archive::Tar::->VERSION, 1.00)) {
+                                       unless (CPAN::Version->vge(Archive::Tar::->VERSION, 1.50)) {
                                             for ("Will not use Archive::Tar, need 1.00\n") {
                                                 $CPAN::Frontend->mywarn($_);
                                                 die $_;
                                             }
                                        }
+                                       unless (CPAN::Version->vge(Archive::Tar::->VERSION, 1.50)) {
+                                            my $atv = Archive::Tar->VERSION;
+                                            $CPAN::Frontend->mywarn("You have Archive::Tar $atv, but 1.50 or later is recommended. Please upgrade.\n");
+                                       }
                                   },
                                  ],
                'File::Temp' => [
@@ -2111,7 +2116,7 @@ C<ask/no>, CPAN.pm asks the user and sets the default accordingly.
 still considered beta quality)
 
 Distributions on CPAN usually behave according to what we call the
-CPAN mantra. Or since the event of Module::Build, we should talk about
+CPAN mantra. Or since the advent of Module::Build we should talk about
 two mantras:
 
     perl Makefile.PL     perl Build.PL
diff --git a/lib/CPAN/Distribution.pm b/lib/CPAN/Distribution.pm
index 0433e33dd1..45192bdb9d 100644
--- a/lib/CPAN/Distribution.pm
+++ b/lib/CPAN/Distribution.pm
@@ -3809,15 +3809,18 @@ sub reports {
             unless ($this_version_seen++) {
                 $CPAN::Frontend->myprint ("$rep->{version}:\n");
             }
+            my $arch = $rep->{archname} || $rep->{platform}        || '????';
+            my $grade = $rep->{action}  || $rep->{status}          || '????';
+            my $ostext = $rep->{ostext} || ucfirst($rep->{osname}) || '????';
             $CPAN::Frontend->myprint
                 (sprintf("%1s%1s%-4s %s on %s %s (%s)\n",
-                         $rep->{archname} eq $Config::Config{archname}?"*":"",
-                         $rep->{action}eq"PASS"?"+":$rep->{action}eq"FAIL"?"-":"",
-                         $rep->{action},
+                         $arch eq $Config::Config{archname}?"*":"",
+                         $grade eq "PASS"?"+":$grade eq"FAIL"?"-":"",
+                         $grade,
                          $rep->{perl},
-                         ucfirst $rep->{osname},
+                         $ostext,
                          $rep->{osvers},
-                         $rep->{archname},
+                         $arch,
                         ));
         } else {
             $other_versions{$rep->{version}}++;
diff --git a/lib/CPAN/Exception/blocked_urllist.pm b/lib/CPAN/Exception/blocked_urllist.pm
index 0df385b7d3..102c194e61 100644
--- a/lib/CPAN/Exception/blocked_urllist.pm
+++ b/lib/CPAN/Exception/blocked_urllist.pm
@@ -20,7 +20,7 @@ sub as_string {
     if ($CPAN::Config->{connect_to_internet_ok}) {
         return qq{
 
-You have not configured a urllist. Please consider to set it with
+You have not configured a urllist for CPAN mirrors. Configure it with
 
     o conf init urllist
 
@@ -28,11 +28,17 @@ You have not configured a urllist. Please consider to set it with
     } else {
         return qq{
 
-You have not configured a urllist and did not allow to connect to the
-internet. Please consider to call
+You have not configured a urllist and do not allow connections to the
+internet to get a list of mirrors.  If you wish to get a list of CPAN
+mirrors to pick from, use this command
 
     o conf init connect_to_internet_ok urllist
 
+If you do not wish to get a list of mirrors and would prefer to set
+your urllist manually, use just this command instead
+
+    o conf init urllist
+
 };
     }
 }
diff --git a/lib/CPAN/FTP.pm b/lib/CPAN/FTP.pm
index d8fb5933be..e4e462a7a8 100644
--- a/lib/CPAN/FTP.pm
+++ b/lib/CPAN/FTP.pm
@@ -485,8 +485,7 @@ I would like to connect to one of the following sites to get '%s':
         push @mess, qq{The urllist can be edited.},
             qq{E.g. with 'o conf urllist push ftp://myurl/'};
         $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
-        $CPAN::Frontend->mywarn("Could not fetch $file\n");
-        $CPAN::Frontend->mysleep(2);
+        $CPAN::Frontend->mydie("Could not fetch $file\n");
     }
     if ($maybe_restore) {
         rename "$aslocal.bak$$", $aslocal;
@@ -682,7 +681,8 @@ sub hostdlhard {
     # < /dev/null ";
     my($aslocal_dir) = dirname($aslocal);
     mkpath($aslocal_dir);
-  HOSTHARD: for $ro_url (@$host_seq) {
+    my $some_dl_success = 0;
+ HOSTHARD: for $ro_url (@$host_seq) {
         $self->_set_attempt($stats,"dlhard",$ro_url);
         my $url = "$ro_url$file";
         my($proto,$host,$dir,$getfile);
@@ -706,8 +706,8 @@ sub hostdlhard {
         my $proxy_vars = $self->_proxy_vars($ro_url);
       DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
             my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
-            next unless defined $funkyftp;
-            next if $funkyftp =~ /^\s*$/;
+            next DLPRG unless defined $funkyftp;
+            next DLPRG if $funkyftp =~ /^\s*$/;
 
             my($asl_ungz, $asl_gz);
             ($asl_ungz = $aslocal) =~ s/\.gz//;
@@ -758,6 +758,7 @@ $content
                         $CPAN::Frontend->mysleep(1);
                         next DLPRG;
                     }
+                    $some_dl_success++;
                 } else {
                     $CPAN::Frontend->myprint(qq{
 No success, the file that lynx has downloaded is an empty file.
@@ -768,13 +769,20 @@ No success, the file that lynx has downloaded is an empty file.
             if ($wstatus == 0) {
                 if (-s $aslocal) {
                     # Looks good
+                    $some_dl_success++;
                 } elsif ($asl_ungz ne $aslocal) {
                     # test gzip integrity
                     if (eval{CPAN::Tarzip->new($asl_ungz)->gtest}) {
                         # e.g. foo.tar is gzipped --> foo.tar.gz
                         rename $asl_ungz, $aslocal;
+                        $some_dl_success++;
                     } else {
                         eval{CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz)};
+                        if ($@) {
+                            warn "Warning: $@";
+                        } else {
+                            $some_dl_success++;
+                        }
                     }
                 }
                 $ThesiteURL = $ro_url;
@@ -820,8 +828,16 @@ No success, the file that lynx has downloaded is an empty file.
     });
             }
             return if $CPAN::Signal;
-        } # transfer programs
+        } # download/transfer programs (DLPRG)
     } # host
+    require Carp;
+    if ($some_dl_success) {
+        Carp::cluck("Warning: doesn't seem we had substantial success downloading '$aslocal'. Don't know how to proceed.");
+    } else {
+        Carp::cluck("Warning: no success downloading '$aslocal'. Giving up on it.");
+    }
+    $CPAN::Frontend->mysleep(5);
+    return;
 }
 
 #-> CPAN::FTP::_proxy_vars
diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm
index 8b5f6bac8e..50bebc349a 100644
--- a/lib/CPAN/FirstTime.pm
+++ b/lib/CPAN/FirstTime.pm
@@ -771,6 +771,7 @@ sub init {
         } else {
             $fastread = 1;
             $CPAN::Config->{urllist} ||= [];
+            $CPAN::Config->{connect_to_internet_ok} ||= 1;
 
             local $^W = 0;
             # prototype should match that of &MakeMaker::prompt
@@ -1509,7 +1510,10 @@ sub picklist {
         }
         my $i = scalar @$items;
         unrangify(\@nums);
-        if (grep (/\D/ || $_ < 1 || $_ > $i, @nums)) {
+        if (0 == @nums) {
+            # cannot allow nothing because nothing means paging!
+            # return;
+        } elsif (grep (/\D/ || $_ < 1 || $_ > $i, @nums)) {
             $CPAN::Frontend->mywarn("invalid items entered, try again\n");
             if ("@nums" =~ /\D/) {
                 $CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n");
@@ -1522,7 +1526,10 @@ sub picklist {
         $CPAN::Frontend->myprint("\n");
 
         # a blank line continues...
-        next SELECTION unless @nums;
+        unless (@nums){
+            $CPAN::Frontend->mysleep(0.1); # prevent hot spinning process on the next bug
+            next SELECTION;
+        }
         last;
     }
     for (@nums) { $_-- }
@@ -1597,13 +1604,17 @@ sub read_mirrored_by {
     if (@previous_urls) {
         push @$offer_cont, "(edit previous picks)";
         $default = @$offer_cont;
+    } else {
+        # cannot allow nothing because nothing means paging!
+        # push @$offer_cont, "(none of the above)";
     }
     @cont = picklist($offer_cont,
                      "Select your continent (or several nearby continents)",
                      $default,
                      ! @previous_urls,
                      $no_previous_warn);
-
+    # cannot allow nothing because nothing means paging!
+    # return unless @cont;
 
     foreach $cont (@cont) {
         my @c = sort keys %{$all{$cont}};
@@ -1646,7 +1657,11 @@ put them on one line, separated by blanks, hyphenated ranges allowed
 
     @urls = picklist (\@urls, $prompt, $default);
     foreach (@urls) { s/ \(.*\)//; }
-    push @$urllist, @urls;
+    if (@urls) {
+        $urllist = \@urls;
+    } else {
+        push @$urllist, @urls;
+    }
 }
 
 sub bring_your_own {
@@ -1692,7 +1707,7 @@ later if you\'re sure it\'s right.\n},
     @$urllist = CPAN::_uniq(@$urllist, @urls);
     $CPAN::Config->{urllist} = $urllist;
     # xxx delete or comment these out when you're happy that it works
-    $CPAN::Frontend->myprint("New set of picks:\n");
+    $CPAN::Frontend->myprint("New urllist\n");
     for ( @$urllist ) { $CPAN::Frontend->myprint("  $_\n") };
 }
 
diff --git a/lib/CPAN/HandleConfig.pm b/lib/CPAN/HandleConfig.pm
index 7842472989..903b414464 100644
--- a/lib/CPAN/HandleConfig.pm
+++ b/lib/CPAN/HandleConfig.pm
@@ -123,8 +123,10 @@ sub edit {
     my($o,$str,$func,$args,$key_exists);
     $o = shift @args;
     if($can{$o}) {
-        $self->$o(args => \@args); # o conf init => sub init => sub load
-        return 1;
+        my $success = $self->$o(args => \@args); # o conf init => sub init => sub load
+        unless ($success) {
+            die "Panic: could not configure CPAN.pm for args [@args]. Giving up.";
+        }
     } else {
         CPAN->debug("o[$o]") if $CPAN::DEBUG;
         unless (exists $keys{$o}) {
@@ -572,9 +574,9 @@ some missing parameters...
 END
         $args{args} = \@miss;
     }
-    CPAN::FirstTime::init($configpm, %args);
+    my $initialized = CPAN::FirstTime::init($configpm, %args);
     $loading--;
-    return;
+    return $initialized;
 }
 
 
diff --git a/lib/CPAN/Index.pm b/lib/CPAN/Index.pm
index e3ee232c9a..3fa9e60229 100644
--- a/lib/CPAN/Index.pm
+++ b/lib/CPAN/Index.pm
@@ -146,7 +146,7 @@ sub reanimate_build_dir {
             next DISTRO;
         }
         my $c = $y->[0];
-        if ($c && CPAN->_perl_fingerprint($c->{perl})) {
+        if ($c && $c->{perl} && $c->{distribution} && CPAN->_perl_fingerprint($c->{perl})) {
             my $key = $c->{distribution}{ID};
             for my $k (keys %{$c->{distribution}}) {
                 if ($c->{distribution}{$k}
@@ -177,8 +177,12 @@ sub reanimate_build_dir {
                                )) {
                 delete $do->{$skipper};
             }
-            if ($do->tested_ok_but_not_installed) {
-                $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
+            if ($do->can("tested_ok_but_not_installed")) {
+                if ($do->tested_ok_but_not_installed) {
+                    $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
+                } else {
+                    next DISTRO;
+                }
             }
             $restored++;
         }
diff --git a/lib/CPAN/Tarzip.pm b/lib/CPAN/Tarzip.pm
index 40d5e528c6..17b3cd748d 100644
--- a/lib/CPAN/Tarzip.pm
+++ b/lib/CPAN/Tarzip.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw($VERSION @ISA $BUGHUNTING);
 use CPAN::Debug;
 use File::Basename qw(basename);
-$VERSION = "5.5";
+$VERSION = "5.501";
 # module is internal to CPAN.pm
 
 @ISA = qw(CPAN::Debug); ## no critic
@@ -311,9 +311,12 @@ Can't continue cutting file '$file'.
         unless ($CPAN::META->has_usable("Archive::Tar")) {
             $CPAN::Frontend->mydie("Archive::Tar not installed, please install it to continue");
         }
-        # Make sure AT does not use permissions in the archive
+        # Make sure AT does not use uid/gid/permissions in the archive
         # This leaves it to the user's umask instead
-        local $Archive::Tar::CHMOD = 0;
+        local $Archive::Tar::CHMOD = 1;
+        local $Archive::Tar::SAME_PERMISSIONS = 0;
+        # Make sure AT leaves current user as owner
+        local $Archive::Tar::CHOWN = 0;
         my $tar = Archive::Tar->new($file,1);
         my $af; # archive file
         my @af;