From: Andreas J. Koenig Date: Mon, 13 Apr 2009 21:35:16 +0000 (-0500) Subject: [PATCH] Update CPAN.pm to 1.93_52 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2f2071b189aec38784eaa4544119619ec94657b8;p=p5sagit%2Fp5-mst-13.2.git [PATCH] Update CPAN.pm to 1.93_52 --- diff --git a/MANIFEST b/MANIFEST index 9bbc6d0..21c6a76 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1898,11 +1898,11 @@ lib/CPAN/Bundle.pm helper package for CPAN.pm lib/CPAN/CacheMgr.pm helper package for CPAN.pm lib/CPAN/Complete.pm helper package for CPAN.pm lib/CPAN/Debug.pm helper package for CPAN.pm -lib/CPAN/DeferedCode.pm helper package for CPAN.pm lib/CPAN/DeferredCode.pm helper package for CPAN.pm lib/CPAN/Distribution.pm helper package for CPAN.pm lib/CPAN/Distroprefs.pm helper package for CPAN.pm lib/CPAN/Distrostatus.pm helper package for CPAN.pm +lib/CPAN/Exception/blocked_urllist.pm helper package for CPAN.pm lib/CPAN/Exception/RecursiveDependency.pm helper package for CPAN.pm lib/CPAN/Exception/yaml_not_installed.pm helper package for CPAN.pm lib/CPAN/FirstTime.pm Utility for creating CPAN config files diff --git a/lib/CPAN.pm b/lib/CPAN.pm index 9b5e0b3..e7475b8 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.93_51'; +$CPAN::VERSION = '1.93_52'; $CPAN::VERSION =~ s/_//; # we need to run chdir all over and we would get at wrong libraries @@ -25,7 +25,7 @@ use CPAN::Debug; use CPAN::Distribution; use CPAN::Distrostatus; use CPAN::FTP; -use CPAN::Index; +use CPAN::Index 1.93; # https://rt.cpan.org/Ticket/Display.html?id=43349 use CPAN::InfoObj; use CPAN::Module; use CPAN::Prompt; @@ -248,7 +248,7 @@ sub soft_chdir_with_alternatives ($); sub _uniq { my(@list) = @_; my %seen; - return map { !$seen{$_} } @list; + return grep { !$seen{$_}++ } @list; } #-> sub CPAN::shell ; @@ -351,7 +351,8 @@ ReadLine support %s } elsif (/^\!/) { s/^\!//; my($eval) = $_; - package CPAN::Eval; + package + CPAN::Eval; # hide from the indexer use strict; use vars qw($import_done); CPAN->import(':DEFAULT') unless $import_done++; @@ -374,13 +375,20 @@ ReadLine support %s CPAN::Shell->$command(@line) }; _unredirect; + my $reported_error; if ($@) { - my $err = "$@"; - if ($err =~ /\S/) { - require Carp; - require Dumpvalue; - my $dv = Dumpvalue->new(tick => '"'); - Carp::cluck(sprintf "Catching error: %s", $dv->stringify($err)); + my $err = $@; + 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; + } else { + # I'd prefer never to arrive here and make all errors exception objects + if ($err =~ /\S/) { + require Carp; + require Dumpvalue; + my $dv = Dumpvalue->new(tick => '"'); + Carp::cluck(sprintf "Catching error: %s", $dv->stringify($err)); + } } } if ($command =~ /^( @@ -400,7 +408,13 @@ ReadLine support %s |upgrade )$/x) { # only commands that tell us something about failed distros - CPAN::Shell->failed($CPAN::CurrentCommandId,1); + # eval necessary for people without an urllist + eval {CPAN::Shell->failed($CPAN::CurrentCommandId,1);}; + if (my $err = $@) { + unless (ref $err and $reported_error eq ref $err) { + die $@; + } + } } soft_chdir_with_alternatives(\@cwd); $CPAN::Frontend->myprint("\n"); diff --git a/lib/CPAN/Author.pm b/lib/CPAN/Author.pm index 3e7dd97..14ef2ef 100644 --- a/lib/CPAN/Author.pm +++ b/lib/CPAN/Author.pm @@ -82,16 +82,37 @@ sub ls { @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1); if ($glob) { if ($CPAN::META->has_inst("Text::Glob")) { + $glob =~ s|/$|/*|; my $rglob = Text::Glob::glob_to_regex($glob); - @dl = grep { $_->[2] =~ /$rglob/ } @dl; + CPAN->debug("glob[$glob]rglob[$rglob]dl[@dl]") if $CPAN::DEBUG; + my @tmpdl = grep { $_->[2] =~ /$rglob/ } @dl; + if (1==@tmpdl && $tmpdl[0][0]==0) { + $rglob = Text::Glob::glob_to_regex("$glob/*"); + @dl = grep { $_->[2] =~ /$rglob/ } @dl; + } else { + @dl = @tmpdl; + } + CPAN->debug("rglob[$rglob]dl[@dl]") if $CPAN::DEBUG; } else { $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed"); } } unless ($silent >= 2) { - $CPAN::Frontend->myprint(join "", map { - sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2]) - } sort { $a->[2] cmp $b->[2] } @dl); + $CPAN::Frontend->myprint + ( + join "", + map { + sprintf + ( + "%8d %10s %s/%s%s\n", + $_->[0], + $_->[1], + $id, + $_->[2], + 0==$_->[0]?"/":"", + ) + } sort { $a->[2] cmp $b->[2] } @dl + ); } @dl; } @@ -110,6 +131,7 @@ sub dir_listing { my $fh; + CPAN->debug("chksumfile[@$chksumfile]recursive[$recursive]may_ftp[$may_ftp]") if $CPAN::DEBUG; # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security # hazard. (Without GPG installed they are not that much better, # though.) @@ -179,6 +201,7 @@ sub dir_listing { my(@dir) = @$chksumfile; pop @dir; push @dir, $f, "CHECKSUMS"; + push @result, [ 0, "-", $f ]; push @result, map { [$_->[0], $_->[1], "$f/$_->[2]"] } $self->dir_listing(\@dir,1,$may_ftp); diff --git a/lib/CPAN/Complete.pm b/lib/CPAN/Complete.pm index f8e02d2..e1fe896 100644 --- a/lib/CPAN/Complete.pm +++ b/lib/CPAN/Complete.pm @@ -84,8 +84,14 @@ sub cpl { @return = grep /^\Q$word\E/, @CPAN::Complete::COMMANDS; } elsif ( $line !~ /^[\!abcdghimorutl]/ ) { @return = (); - } elsif ($line =~ /^(a|ls)\s/) { + } elsif ($line =~ /^a\s/) { @return = cplx('CPAN::Author',uc($word)); + } elsif ($line =~ /^ls\s/) { + my($author,$rest) = $word =~ m|([^/]+)/?(.*)|; + @return = $rest ? () : map {"$_/"} cplx('CPAN::Author',uc($author||"")); + if (0 && 1==@return) { # XXX too slow and even wrong when there is a * already + @return = grep /^\Q$word\E/, map {"$author/$_->[2]"} CPAN::Shell->expand("Author",$author)->ls("$rest*","2"); + } } elsif ($line =~ /^b\s/) { CPAN::Shell->local_bundles; @return = cplx('CPAN::Bundle',$word); @@ -119,7 +125,9 @@ sub cplx { if (CPAN::_sqlite_running()) { $CPAN::SQLite->search($class, "^\Q$word\E"); } - sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class); + my $method = "id"; + $method = "pretty_id" if $class eq "CPAN::Distribution"; + sort grep /^\Q$word\E/, map { $_->$method() } $CPAN::META->all_objects($class); } #-> sub CPAN::Complete::cpl_any ; diff --git a/lib/CPAN/DeferedCode.pm b/lib/CPAN/DeferedCode.pm deleted file mode 100644 index c57669b..0000000 --- a/lib/CPAN/DeferedCode.pm +++ /dev/null @@ -1,16 +0,0 @@ -package CPAN::DeferedCode; - -use strict; -use vars qw/$VERSION/; - -use overload fallback => 1, map { ($_ => 'run') } qw/ - bool "" 0+ -/; - -$VERSION = "5.50"; - -sub run { - $_[0]->(); -} - -1; diff --git a/lib/CPAN/Distribution.pm b/lib/CPAN/Distribution.pm index ef89f6f..0433e33 100644 --- a/lib/CPAN/Distribution.pm +++ b/lib/CPAN/Distribution.pm @@ -843,6 +843,7 @@ sub try_download { delete $self->{build_dir}; return; } + binmode($writefh); while (my $x = $readfh->READLINE) { print $writefh $x; } @@ -2515,6 +2516,10 @@ sub unsat_prereq { $available_version = $]; $available_file = CPAN::find_perl(); } else { + if (CPAN::_sqlite_running()) { + CPAN::Index->reload; + $CPAN::SQLite->search("CPAN::Module",$need_module); + } $nmo = $CPAN::META->instance("CPAN::Module",$need_module); next if $nmo->uptodate; $available_file = $nmo->available_file; @@ -2694,7 +2699,10 @@ sub read_yaml { $CPAN::Frontend->mywarn("Warning: cannot determine META.yml without a build_dir.\n"); return; } - my $yaml = File::Spec->catfile($build_dir,"META.yml"); + # 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 $yaml = -f $mymeta ? $mymeta : $meta; $self->debug("yaml[$yaml]") if $CPAN::DEBUG; return unless -f $yaml; eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; }; @@ -2713,8 +2721,11 @@ sub read_yaml { $self->{yaml_content} = +{}; } } - if (not exists $self->{yaml_content}{dynamic_config} - or $self->{yaml_content}{dynamic_config} + # MYMETA.yml is not dynamic by definition + if ( $yaml ne $mymeta && + ( not exists $self->{yaml_content}{dynamic_config} + or $self->{yaml_content}{dynamic_config} + ) ) { $self->{yaml_content} = undef; } @@ -3369,7 +3380,7 @@ sub install { $want_install = CPAN::Shell::colorable_makemaker_prompt ("$id is just needed temporarily during building or testing. ". - "Do you want to install it permanently? (Y/n)", + "Do you want to install it permanently?", $default); } } diff --git a/lib/CPAN/Distroprefs.pm b/lib/CPAN/Distroprefs.pm index 3813599..561137f 100644 --- a/lib/CPAN/Distroprefs.pm +++ b/lib/CPAN/Distroprefs.pm @@ -214,7 +214,12 @@ sub has_valid_subkeys { sub _pattern { my $re = shift; - return eval sprintf 'qr{%s}', $re; + my $p = eval sprintf 'qr{%s}', $re; + if ($@) { + $@ =~ s/\n$//; + die "Error in Distroprefs pattern qr{$re}\n$@"; + } + return $p; } sub _match_scalar { diff --git a/lib/CPAN/Exception/RecursiveDependency.pm b/lib/CPAN/Exception/RecursiveDependency.pm index 61dfb50..b928ad7 100644 --- a/lib/CPAN/Exception/RecursiveDependency.pm +++ b/lib/CPAN/Exception/RecursiveDependency.pm @@ -15,9 +15,9 @@ $VERSION = "5.5"; sub new { my($class) = shift; - my($deps) = shift; + my($deps_arg) = shift; my (@deps,%seen,$loop_starts_with); - DCHAIN: for my $dep (@$deps) { + DCHAIN: for my $dep (@$deps_arg) { push @deps, {name => $dep, display_as => $dep}; if ($seen{$dep}++) { $loop_starts_with = $dep; @@ -27,7 +27,7 @@ sub new { my $in_loop = 0; for my $i (0..$#deps) { my $x = $deps[$i]{name}; - $in_loop ||= $x eq $loop_starts_with; + $in_loop ||= $loop_starts_with && $x eq $loop_starts_with; my $xo = CPAN::Shell->expandany($x) or next; if ($xo->isa("CPAN::Module")) { my $have = $xo->inst_version || "N/A"; @@ -66,13 +66,18 @@ sub new { # the next session } } - bless { deps => \@deps }, $class; + bless { deps => \@deps, loop_starts_with => $loop_starts_with }, $class; } sub as_string { my($self) = shift; + my $deps = $self->{deps}; + my $loop_starts_with = $self->{loop_starts_with}; + unless ($loop_starts_with) { + return "--not a recursive/circular dependency--"; + } my $ret = "\nRecursive dependency detected:\n "; - $ret .= join("\n => ", map {$_->{display_as}} @{$self->{deps}}); + $ret .= join("\n => ", map {$_->{display_as}} @$deps); $ret .= ".\nCannot resolve.\n"; $ret; } diff --git a/lib/CPAN/FTP.pm b/lib/CPAN/FTP.pm index a848b27..98391ea 100644 --- a/lib/CPAN/FTP.pm +++ b/lib/CPAN/FTP.pm @@ -4,6 +4,8 @@ package CPAN::FTP; use strict; use Fcntl qw(:flock); +use File::Basename qw(dirname); +use File::Path qw(mkpath); use CPAN::FTP::netrc; use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod); @CPAN::FTP::ISA = qw(CPAN::Debug); @@ -20,6 +22,7 @@ sub _ftp_statistics { my $locktype = $fh ? LOCK_EX : LOCK_SH; $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': $!"); my $sleep = 1; my $waitstart; @@ -164,7 +167,7 @@ sub _recommend_url_for { while (my $last = pop @$history) { last if $last->{end} - time > 3600; # only young results are interesting next unless $last->{file}; # dirname of nothing dies! - next unless $file eq File::Basename::dirname($last->{file}); + next unless $file eq dirname($last->{file}); return $last->{thesiteurl}; } } @@ -269,9 +272,11 @@ sub localize { $force ||= 0; Carp::croak( "Usage: ->localize(cpan_file,as_local_file[,$force])" ) unless defined $aslocal; - $self->debug("file[$file] aslocal[$aslocal] force[$force]") - if $CPAN::DEBUG; - + if ($CPAN::DEBUG){ + require Carp; + my $longmess = Carp::longmess(); + $self->debug("file[$file] aslocal[$aslocal] force[$force] carplongmess[$longmess]"); + } if ($^O eq 'MacOS') { # Comment by AK on 2000-09-03: Uniq short filenames would be # available in CHECKSUMS file @@ -314,8 +319,7 @@ sub localize { $maybe_restore++; } - my($aslocal_dir) = File::Basename::dirname($aslocal); - $self->mymkpath($aslocal_dir); # too early for file URLs / RT #28438 + my($aslocal_dir) = dirname($aslocal); # Inheritance is not easier to manage than a few if/else branches if ($CPAN::META->has_usable('LWP::UserAgent')) { unless ($Ua) { @@ -393,6 +397,7 @@ sub localize { LEVEL: for $levelno (0..$#levels) { my $level_tuple = $levels[$levelno]; my($level,$scheme,$sitetag) = @$level_tuple; + $self->mymkpath($aslocal_dir) unless $scheme && "file" eq $scheme; my $defaultsites = $sitetag && $sitetag eq "defaultsites"; my @urllist; if ($defaultsites) { @@ -415,21 +420,12 @@ I would like to connect to one of the following sites to get '%s': if ($connect_to_internet_ok) { @urllist = @CPAN::Defaultsites; } else { - my $sleep = 5; - $CPAN::Frontend->mywarn(sprintf qq{ - -You have not configured a urllist and did not allow to connect to the -internet. I will continue but it is very likely that we will face -problems. If this happens, please consider to call either - - o conf init connect_to_internet_ok -or - o conf init urllist - -Sleeping $sleep seconds now. -}); - $CPAN::Frontend->mysleep($sleep); - @urllist = (); + my $sleep = 2; + # the tricky thing about dying here is that everybody + # believes that calls to exists() or all_objects() are + # safe. + require CPAN::Exception::blocked_urllist; + die CPAN::Exception::blocked_urllist->new; } } else { my @host_seq = $level =~ /dleasy/ ? @@ -503,7 +499,7 @@ Sleeping $sleep seconds now. sub mymkpath { my($self, $aslocal_dir) = @_; - File::Path::mkpath($aslocal_dir); + mkpath($aslocal_dir); $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }. qq{directory "$aslocal_dir". I\'ll continue, but if you encounter problems, they may be due @@ -684,8 +680,8 @@ sub hostdlhard { my($ro_url); my($devnull) = $CPAN::Config->{devnull} || ""; # < /dev/null "; - my($aslocal_dir) = File::Basename::dirname($aslocal); - File::Path::mkpath($aslocal_dir); + my($aslocal_dir) = dirname($aslocal); + mkpath($aslocal_dir); HOSTHARD: for $ro_url (@$host_seq) { $self->_set_attempt($stats,"dlhard",$ro_url); my $url = "$ro_url$file"; @@ -867,8 +863,8 @@ sub hostdlhardest { return unless @$host_seq; my($ro_url); - my($aslocal_dir) = File::Basename::dirname($aslocal); - File::Path::mkpath($aslocal_dir); + my($aslocal_dir) = dirname($aslocal); + mkpath($aslocal_dir); my $ftpbin = $CPAN::Config->{ftp}; unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) { $CPAN::Frontend->myprint("No external ftp command available\n\n"); diff --git a/lib/CPAN/FTP/netrc.pm b/lib/CPAN/FTP/netrc.pm index 1f106ae..c05405e 100644 --- a/lib/CPAN/FTP/netrc.pm +++ b/lib/CPAN/FTP/netrc.pm @@ -1,6 +1,8 @@ package CPAN::FTP::netrc; use strict; +$CPAN::FTP::netrc::VERSION = $CPAN::FTP::netrc::VERSION = "1.00"; + # package CPAN::FTP::netrc; sub new { my($class) = @_; diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm index 766c797..9f0c695 100644 --- a/lib/CPAN/FirstTime.pm +++ b/lib/CPAN/FirstTime.pm @@ -551,11 +551,12 @@ Do you want to enable code deserialisation (yes/no)? =item yaml_module -At the time of this writing there are two competing YAML modules, -YAML.pm and YAML::Syck. The latter is faster but needs a C compiler -installed on your system. There may be more alternative YAML -conforming modules but at the time of writing a potential third -player, YAML::Tiny, seemed not powerful enough to work with CPAN.pm. +At the time of this writing (2009-03) there are three YAML +implementations working: YAML, YAML::Syck, and YAML::XS. The latter +two are faster but need a C compiler installed on your system. There +may be more alternative YAML conforming modules. When I tried two +other players, YAML::Tiny and YAML::Perl, they seemed not powerful +enough to work with CPAN.pm. This may have changed in the meantime. Which YAML implementation would you prefer? @@ -1379,49 +1380,91 @@ sub my_prompt_loop { sub conf_sites { my $m = 'MIRRORED.BY'; + my $use_mby; my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m); File::Path::mkpath(File::Basename::dirname($mby)); if (-f $mby && -f $m && -M $m < -M $mby) { + $use_mby = 1; require File::Copy; File::Copy::copy($m,$mby) or die "Could not update $mby: $!"; } - my $loopcount = 0; local $^T = time; my $overwrite_local = 0; if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) { + $use_mby = 1; my $mtime = localtime((stat _)[9]); my $prompt = qq{Found $mby as of $mtime -I\'d use that as a database of CPAN sites. If that is OK for you, -please answer 'y', but if you want me to get a new database now, -please answer 'n' to the following question. +I'd use that as a database of CPAN sites. If that is OK for you, +please answer 'y', but if you want me to get a new database from the +internet now, please answer 'n' to the following question. Shall I use the local database in $mby?}; my $ans = prompt($prompt,"y"); - $overwrite_local = 1 unless $ans =~ /^y/i; + if ($ans =~ /^y/i) { + $CPAN::Config->{connect_to_internet_ok} = 1; + } else { + $overwrite_local = 1; + } } - while ($mby) { - if ($overwrite_local) { - $CPAN::Frontend->myprint(qq{Trying to overwrite $mby\n}); - $mby = CPAN::FTP->localize($m,$mby,3); - $overwrite_local = 0; - } elsif ( ! -f $mby ) { - $CPAN::Frontend->myprint(qq{You have no $mby\n I\'m trying to fetch one\n}); - $mby = CPAN::FTP->localize($m,$mby,3); - } elsif (-M $mby > 60 && $loopcount == 0) { - $CPAN::Frontend->myprint(qq{Your $mby is older than 60 days,\n I\'m trying }. - qq{to fetch one\n}); - $mby = CPAN::FTP->localize($m,$mby,3); - $loopcount++; - } elsif (-s $mby == 0) { - $CPAN::Frontend->myprint(qq{You have an empty $mby,\n I\'m trying to fetch one\n}); - $mby = CPAN::FTP->localize($m,$mby,3); + local $urllist = $CPAN::Config->{urllist}; + my $better_mby; + while () { # multiple errors possible + if ($use_mby + or (defined $CPAN::Config->{connect_to_internet_ok} + and $CPAN::Config->{connect_to_internet_ok})){ + if ($overwrite_local) { + $CPAN::Frontend->myprint(qq{Trying to overwrite $mby\n}); + $better_mby = CPAN::FTP->localize($m,$mby,3); + $overwrite_local = 0; + $use_mby=1 if $mby; + } elsif ( ! -f $mby ) { + $CPAN::Frontend->myprint(qq{You have no $mby\n I'm trying to fetch one\n}); + $better_mby = CPAN::FTP->localize($m,$mby,3); + $use_mby=1 if $mby; + } elsif ( -M $mby > 60 ) { + $CPAN::Frontend->myprint(qq{Your $mby is older than 60 days,\n I'm trying }. + qq{to fetch a new one\n}); + $better_mby = CPAN::FTP->localize($m,$mby,3); + $use_mby=1 if $mby; + } elsif (-s $mby == 0) { + $CPAN::Frontend->myprint(qq{You have an empty $mby,\n I'm trying to fetch a better one\n}); + $better_mby = CPAN::FTP->localize($m,$mby,3); + $use_mby=1 if $mby; + } else { + last; + } + if ($better_mby) { + $mby = $better_mby; + } + } elsif (not @$urllist + and (not defined $CPAN::Config->{connect_to_internet_ok} + or not $CPAN::Config->{connect_to_internet_ok})) { + $CPAN::Frontend->myprint(qq{CPAN needs access to at least one CPAN mirror. + +As you did not allow me to connect to the internet you need to supply +a valid CPAN URL now.\n\n}); + + my @default = map {"file://$_"} grep {-e} "/home/ftp/pub/CPAN", "/home/ftp/pub/PAUSE"; + my $ans = prompt("Please enter the URL of your CPAN mirror",shift @default); + if ($ans) { + push @$urllist, $ans; + next; + } } else { last; } } - local $urllist = []; - read_mirrored_by($mby); + if ($use_mby){ + read_mirrored_by($mby); + } else { + if (not defined $CPAN::Config->{connect_to_internet_ok} + or not $CPAN::Config->{connect_to_internet_ok}) { + $CPAN::Frontend->myprint("Configuration does not allow connecting to the internet.\n"); + } + $CPAN::Frontend->myprint("Current set of CPAN URLs:\n"); + map { $CPAN::Frontend->myprint(" $_\n") } @$urllist; + } bring_your_own(); $CPAN::Config->{urllist} = $urllist; } @@ -1646,10 +1689,11 @@ later if you\'re sure it\'s right.\n}, } } while $ans || !%seen; - push @$urllist, @urls; + @$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"); - map { $CPAN::Frontend->myprint(" $_\n") } @$urllist; + for ( @$urllist ) { $CPAN::Frontend->myprint(" $_\n") }; } diff --git a/lib/CPAN/HandleConfig.pm b/lib/CPAN/HandleConfig.pm index 21cc92f..7842472 100644 --- a/lib/CPAN/HandleConfig.pm +++ b/lib/CPAN/HandleConfig.pm @@ -524,6 +524,7 @@ sub load { use Carp; require_myconfig_or_config; my @miss = $self->missing_config_data; + CPAN->debug("doit[$doit]loading[$loading]miss[@miss]") if $CPAN::DEBUG; return unless $doit || @miss; return if $loading; $loading++; diff --git a/lib/CPAN/Index.pm b/lib/CPAN/Index.pm index 1a10a1b..e3ee232 100644 --- a/lib/CPAN/Index.pm +++ b/lib/CPAN/Index.pm @@ -15,6 +15,28 @@ sub force_reload { $class->reload(1); } +my @indexbundle = + ( + { + reader => "rd_authindex", + dir => "authors", + remotefile => '01mailrc.txt.gz', + shortlocalfile => '01mailrc.gz', + }, + { + reader => "rd_modpacks", + dir => "modules", + remotefile => '02packages.details.txt.gz', + shortlocalfile => '02packag.gz', + }, + { + reader => "rd_modlist", + dir => "modules", + remotefile => '03modlist.data.gz', + shortlocalfile => '03mlist.gz', + }, + ); + #-> sub CPAN::Index::reload ; sub reload { my($self,$force) = @_; @@ -54,39 +76,26 @@ sub reload { my $needshort = $^O eq "dos"; - $self->rd_authindex($self - ->reload_x( - "authors/01mailrc.txt.gz", - $needshort ? - File::Spec->catfile('authors', '01mailrc.gz') : - File::Spec->catfile('authors', '01mailrc.txt.gz'), - $force)); - $t2 = time; - $debug = "timing reading 01[".($t2 - $time)."]"; - $time = $t2; - return if $CPAN::Signal; # this is sometimes lengthy - $self->rd_modpacks($self - ->reload_x( - "modules/02packages.details.txt.gz", - $needshort ? - File::Spec->catfile('modules', '02packag.gz') : - File::Spec->catfile('modules', '02packages.details.txt.gz'), - $force)); - $t2 = time; - $debug .= "02[".($t2 - $time)."]"; - $time = $t2; - return if $CPAN::Signal; # this is sometimes lengthy - $self->rd_modlist($self - ->reload_x( - "modules/03modlist.data.gz", - $needshort ? - File::Spec->catfile('modules', '03mlist.gz') : - File::Spec->catfile('modules', '03modlist.data.gz'), - $force)); + INX: for my $indexbundle (@indexbundle) { + my $reader = $indexbundle->{reader}; + my $localfile = $needshort ? $indexbundle->{shortlocalfile} : $indexbundle->{remotefile}; + my $localpath = File::Spec->catfile($indexbundle->{dir}, $localfile); + my $remote = join "/", $indexbundle->{dir}, $indexbundle->{remotefile}; + my $localized = $self->reload_x($remote, $localpath, $force); + $self->$reader($localized); # may die but we let the shell catch it + if ($CPAN::DEBUG){ + $t2 = time; + $debug = "timing reading 01[".($t2 - $time)."]"; + $time = $t2; + } + return if $CPAN::Signal; # this is sometimes lengthy + } $self->write_metadata_cache; - $t2 = time; - $debug .= "03[".($t2 - $time)."]"; - $time = $t2; + if ($CPAN::DEBUG){ + $t2 = time; + $debug .= "03[".($t2 - $time)."]"; + $time = $t2; + } CPAN->debug($debug) if $CPAN::DEBUG; } if ($CPAN::Config->{build_dir_reuse}) { diff --git a/lib/CPAN/LWP/UserAgent.pm b/lib/CPAN/LWP/UserAgent.pm index 44f70e6..8a5d844 100644 --- a/lib/CPAN/LWP/UserAgent.pm +++ b/lib/CPAN/LWP/UserAgent.pm @@ -5,6 +5,8 @@ use strict; use vars qw(@ISA $USER $PASSWD $SETUPDONE); # we delay requiring LWP::UserAgent and setting up inheritance until we need it +$CPAN::LWP::UserAgent::VERSION = $CPAN::LWP::UserAgent::VERSION = "1.00"; + sub config { return if $SETUPDONE; if ($CPAN::META->has_usable('LWP::UserAgent')) { diff --git a/lib/CPAN/Module.pm b/lib/CPAN/Module.pm index 64b2e09..f9520d9 100644 --- a/lib/CPAN/Module.pm +++ b/lib/CPAN/Module.pm @@ -511,13 +511,45 @@ sub uptodate { my $cpan = $self->cpan_version; local ($^W) = 0; CPAN::Version->vgt($cpan,$inst) and return 0; - CPAN->debug(join("", - "returning uptodate. inst_file[", - $self->inst_file, - "cpan[$cpan] inst[$inst]")) if $CPAN::DEBUG; + my $inst_file = $self->inst_file; + # trying to support deprecated.pm by Nicholas 2009-02 + my $in_priv_or_arch = ""; + my $isa_perl = ""; + if ($] >= 5.011) { # probably harmful when distros say INSTALLDIRS=perl? + if (0 == CPAN::Version->vcmp($cpan,$inst)) { + if ($in_priv_or_arch = $self->_in_priv_or_arch($inst_file)) { + if (my $distribution = $self->distribution) { + unless ($isa_perl = $distribution->isa_perl) { + return 0; + } + } + } + } + } + CPAN->debug + (join + ("", + "returning uptodate. ", + "inst_file[$inst_file]", + "cpan[$cpan]inst[$inst]", + "in_priv_or_arch[$in_priv_or_arch]", + "isa_perl[$isa_perl]", + )) if $CPAN::DEBUG; return 1; } +# returns true if installed in privlib or archlib +sub _in_priv_or_arch { + my($self,$inst_file) = @_; + for my $confdirname (qw(archlibexp privlibexp)) { + my $confdir = $Config::Config{$confdirname}; + if ($confdir eq substr($inst_file,0,length($confdir))) { + return 1; + } + } + return 0; +} + #-> sub CPAN::Module::install ; sub install { my($self) = @_; diff --git a/lib/CPAN/Shell.pm b/lib/CPAN/Shell.pm index 28175fa..84f67ff 100644 --- a/lib/CPAN/Shell.pm +++ b/lib/CPAN/Shell.pm @@ -17,16 +17,32 @@ use vars qw( ); @relo = ( "CPAN.pm", + "CPAN/Author.pm", + "CPAN/CacheMgr.pm", + "CPAN/Complete.pm", "CPAN/Debug.pm", + "CPAN/DeferredCode.pm", + "CPAN/Distribution.pm", "CPAN/Distroprefs.pm", + "CPAN/Distrostatus.pm", + "CPAN/Exception/RecursiveDependency.pm", + "CPAN/Exception/yaml_not_installed.pm", "CPAN/FirstTime.pm", + "CPAN/FTP.pm", + "CPAN/FTP/netrc.pm", "CPAN/HandleConfig.pm", + "CPAN/Index.pm", + "CPAN/InfoObj.pm", "CPAN/Kwalify.pm", + "CPAN/LWP/UserAgent.pm", + "CPAN/Module.pm", + "CPAN/Prompt.pm", "CPAN/Queue.pm", "CPAN/Reporter/Config.pm", "CPAN/Reporter/History.pm", "CPAN/Reporter/PrereqCheck.pm", "CPAN/Reporter.pm", + "CPAN/Shell.pm", "CPAN/SQLite.pm", "CPAN/Tarzip.pm", "CPAN/Version.pm", @@ -255,6 +271,7 @@ sub globls { $author->$pragma(); } } + CPAN->debug("author[$author]pathglob[$pathglob]silent[$silent]") if $CPAN::DEBUG; push @results, $author->ls($pathglob,$silent); # silent if # more than one # author