From: Andreas J Koenig Date: Sat, 27 Jun 2009 07:53:54 +0000 (+0200) Subject: Update CPAN.pm to 1.9402 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6b1bef9ae6121c8c1e2db34b236572e438bab9a7;p=p5sagit%2Fp5-mst-13.2.git Update CPAN.pm to 1.9402 --- diff --git a/lib/CPAN.pm b/lib/CPAN.pm index ca8f596..1196cb0 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, 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 0433e33..45192bd 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 0df385b..102c194 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 d8fb593..e4e462a 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 8b5f6ba..50bebc3 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 7842472..903b414 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 e3ee232..3fa9e60 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 40d5e52..17b3cd7 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;