From: Steve Peters Date: Tue, 3 Oct 2006 13:13:53 +0000 (+0000) Subject: Upgrade to CPAN-1.88_52 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7d97ad34e1daa2105bc553c4c1183155427a25b3;p=p5sagit%2Fp5-mst-13.2.git Upgrade to CPAN-1.88_52 p4raw-id: //depot/perl@28920 --- diff --git a/lib/CPAN.pm b/lib/CPAN.pm index 23764a3..2382fc2 100644 --- a/lib/CPAN.pm +++ b/lib/CPAN.pm @@ -1,7 +1,7 @@ # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- use strict; package CPAN; -$CPAN::VERSION = '1.88_51'; +$CPAN::VERSION = '1.88_52'; $CPAN::VERSION = eval $CPAN::VERSION; use CPAN::HandleConfig; @@ -1464,7 +1464,7 @@ sub o { $CPAN::Frontend->myprint("\n\n"); } if ($CPAN::DEBUG) { - $CPAN::Frontend->myprint("Options set for debugging:\n"); + $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n"); my($k,$v); for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) { $v = $CPAN::DEBUG{$k}; @@ -1547,31 +1547,39 @@ index re-reads the index files\n}); #-> sub CPAN::Shell::reload_this ; sub reload_this { my($self,$f) = @_; + CPAN->debug("f[$f]") if $CPAN::DEBUG; return 1 unless $INC{$f}; # we never loaded this, so we do not # reload but say OK my $pwd = CPAN::anycwd(); - CPAN->debug("reloading the whole '$f' from '$INC{$f}' while pwd='$pwd'") - if $CPAN::DEBUG; - my $read; + CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG; + my($file); for my $inc (@INC) { - $read = File::Spec->catfile($inc,split /\//, $f); - last if -f $read; - } - unless (-f $read) { - $read = $INC{$f}; - } - unless (-f $read) { + $file = File::Spec->catfile($inc,split /\//, $f); + last if -f $file; + $file = ""; + } + CPAN->debug("file[$file]") if $CPAN::DEBUG; + my @inc = @INC; + unless ($file && -f $file) { + # this thingie is not in the INC path, maybe CPAN/MyConfig.pm? + $file = $INC{$f}; + @inc = substr($file,0,-length($f)); # bring in back to me! + } + CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG; + unless (-f $file) { $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n"); return; } - my $fh = FileHandle->new($read) or - $CPAN::Frontend->mydie("Could not open $read: $!"); + my $fh = FileHandle->new($file) or + $CPAN::Frontend->mydie("Could not open $file: $!"); local($/); local $^W = 1; - my $eval = <$fh>; - CPAN->debug(sprintf("evaling [%s...]\n",substr($eval,0,64))) + my $content = <$fh>; + CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128))) if $CPAN::DEBUG; - eval $eval; + delete $INC{$f}; + local @INC = @inc; + eval "require '$f'"; if ($@){ warn $@; return; @@ -1931,7 +1939,7 @@ sub status { next unless substr($k,0,4) eq "read"; warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024; for my $k2 (sort keys %{$CPAN::META->{$k}}) { - warn sprintf " %-25s %6d %6d\n", + warn sprintf " %-25s %6d (keys: %6d)\n", $k2, Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024, scalar keys %{$CPAN::META->{$k}{$k2}}; @@ -2336,9 +2344,10 @@ sub rematein { if (ref $s) { CPAN->debug("s is an object[$s]") if $CPAN::DEBUG; $obj = $s; + } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable } elsif ($s =~ m|^/|) { # looks like a regexp $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ". - "not supported\n"); + "not supported. Rejecting argument '$s'\n"); $CPAN::Frontend->mysleep(2); next; } elsif ($meth eq "ls") { @@ -2348,7 +2357,8 @@ sub rematein { CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG; $obj = CPAN::Shell->expandany($s); } - if (ref $obj) { + if (0) { + } elsif (ref $obj) { $obj->color_cmd_tmps(0,1); CPAN::Queue->new(qmod => $obj->id, reqtype => "c"); push @qcopy, $obj; @@ -2365,7 +2375,7 @@ sub rematein { ); $CPAN::Frontend->mysleep(2); } - } elsif ($meth eq "dump") { + } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") { CPAN::InfoObj->dump($s); } else { $CPAN::Frontend @@ -3659,6 +3669,8 @@ sub rd_authindex { local($/) = "\n"; local($_); push @lines, split /\012/ while ; + my $i = 0; + my $modulus = int(@lines/75) || 1; foreach (@lines) { my($userid,$fullname,$email) = m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/; @@ -3667,8 +3679,10 @@ sub rd_authindex { # instantiate an author object my $userobj = $CPAN::META->instance('CPAN::Author',$userid); $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email); + $CPAN::Frontend->myprint(".") unless $i++ % $modulus; return if $CPAN::Signal; } + $CPAN::Frontend->myprint("DONE\n"); } sub userid { @@ -3681,18 +3695,19 @@ sub userid { #-> sub CPAN::Index::rd_modpacks ; sub rd_modpacks { my($self, $index_target) = @_; - my @lines; return unless defined $index_target; $CPAN::Frontend->myprint("Going to read $index_target\n"); my $fh = CPAN::Tarzip->TIEHANDLE($index_target); - local($/) = "\n"; local $_; - while ($_ = $fh->READLINE) { - s/\012/\n/g; - my @ls = map {"$_\n"} split /\n/, $_; - unshift @ls, "\n" x length($1) if /^(\n+)/; - push @lines, @ls; - } + CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG; + my $slurp = ""; + my $chunk; + while (my $bytes = $fh->READ(\$chunk,8192)) { + $slurp.=$chunk; + } + my @lines = split /\012/, $slurp; + CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG; + undef $fh; # read header my($line_count,$last_updated); while (@lines) { @@ -3701,6 +3716,7 @@ sub rd_modpacks { $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1; $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1; } + CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG; if (not defined $line_count) { $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header. @@ -3778,8 +3794,9 @@ happen.\a my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN"); CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG; my(%exists); + my $i = 0; + my $modulus = int(@lines/75) || 1; foreach (@lines) { - chomp; # before 1.56 we split into 3 and discarded the rest. From # 1.57 we assign remaining text to $comment thus allowing to # influence isa_perl @@ -3863,20 +3880,21 @@ happen.\a } if ($secondtime) { for my $name ($mod,$dist) { - CPAN->debug("exists name[$name]") if $CPAN::DEBUG; + # $self->debug("exists name[$name]") if $CPAN::DEBUG; $exists{$name} = undef; } } + $CPAN::Frontend->myprint(".") unless $i++ % $modulus; return if $CPAN::Signal; } - undef $fh; + $CPAN::Frontend->myprint("DONE\n"); if ($secondtime) { for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) { for my $o ($CPAN::META->all_objects($class)) { next if exists $exists{$o->{ID}}; $CPAN::META->delete($class,$o->{ID}); - CPAN->debug("deleting ID[$o->{ID}] in class[$class]") - if $CPAN::DEBUG; + # CPAN->debug("deleting ID[$o->{ID}] in class[$class]") + # if $CPAN::DEBUG; } } } @@ -3888,37 +3906,45 @@ sub rd_modlist { return unless defined $index_target; $CPAN::Frontend->myprint("Going to read $index_target\n"); my $fh = CPAN::Tarzip->TIEHANDLE($index_target); - my @eval; - local($/) = "\n"; local $_; - while ($_ = $fh->READLINE) { - s/\012/\n/g; - my @ls = map {"$_\n"} split /\n/, $_; - unshift @ls, "\n" x length($1) if /^(\n+)/; - push @eval, @ls; - } - while (@eval) { - my $shift = shift(@eval); + my $slurp = ""; + my $chunk; + while (my $bytes = $fh->READ(\$chunk,8192)) { + $slurp.=$chunk; + } + my @eval2 = split /\012/, $slurp; + + while (@eval2) { + my $shift = shift(@eval2); if ($shift =~ /^Date:\s+(.*)/){ - return if $DATE_OF_03 eq $1; + if ($DATE_OF_03 eq $1){ + $CPAN::Frontend->myprint("Unchanged.\n"); + return; + } ($DATE_OF_03) = $1; } last if $shift =~ /^\s*$/; } - undef $fh; - push @eval, q{CPAN::Modulelist->data;}; + push @eval2, q{CPAN::Modulelist->data;}; local($^W) = 0; my($comp) = Safe->new("CPAN::Safe1"); - my($eval) = join("", @eval); - my $ret = $comp->reval($eval); + my($eval2) = join("\n", @eval2); + CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG; + my $ret = $comp->reval($eval2); Carp::confess($@) if $@; return if $CPAN::Signal; + my $i = 0; + my $until = keys %$ret; + my $modulus = int($until/75) || 1; + CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG; for (keys %$ret) { my $obj = $CPAN::META->instance("CPAN::Module",$_); delete $ret->{$_}{modid}; # not needed here, maybe elsewhere $obj->set(%{$ret->{$_}}); + $CPAN::Frontend->myprint(".") unless $i++ % $modulus; return if $CPAN::Signal; } + $CPAN::Frontend->myprint("DONE\n"); } #-> sub CPAN::Index::write_metadata_cache ; @@ -3951,7 +3977,7 @@ sub read_metadata_cache { my $cache; eval { $cache = Storable::retrieve($metadata_file) }; $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ?? - if (!$cache || ref $cache ne 'HASH'){ + if (!$cache || !UNIVERSAL::isa($cache, 'HASH')){ $LAST_TIME = 0; return; } @@ -4460,6 +4486,7 @@ sub color_cmd_tmps { if (defined $prereq_pm) { PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}}, keys %{$prereq_pm->{build_requires}||{}}) { + next PREREQ if $pre eq "perl"; my $premo; unless ($premo = CPAN::Shell->expand("Module",$pre)) { $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n"); @@ -5547,7 +5574,15 @@ or return; } if (my @prereq = $self->unsat_prereq){ - return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner + if ($prereq[0][0] eq "perl") { + my $need = "requires perl '$prereq[0][1]'"; + my $id = $self->pretty_id; + $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n"); + $self->{make} = CPAN::Distrostatus->new("NO $need"); + return; + } else { + return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner + } } if ($self->{modulebuild}) { unless (-f "Build") { @@ -5631,27 +5666,37 @@ of modules we are processing right now?", "yes"); } #-> sub CPAN::Distribution::unsat_prereq ; +# return ([Foo=>1],[Bar=>1.2]) for normal modules +# return ([perl=>5.008]) if we need a newer perl than we are running under sub unsat_prereq { my($self) = @_; my $prereq_pm = $self->prereq_pm or return; my(@need); my %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}}); NEED: while (my($need_module, $need_version) = each %merged) { - my $nmo = $CPAN::META->instance("CPAN::Module",$need_module); - # we were too demanding: - next if $nmo->uptodate; - - # if they have not specified a version, we accept any installed one - if (not defined $need_version or - $need_version eq "0" or - $need_version eq "undef") { - next if defined $nmo->inst_file; + my($have_version,$inst_file); + if ($need_module eq "perl") { + $have_version = $]; + $inst_file = $^X; + } else { + my $nmo = $CPAN::META->instance("CPAN::Module",$need_module); + next if $nmo->uptodate; + $inst_file = $nmo->inst_file; + + # if they have not specified a version, we accept any installed one + if (not defined $need_version or + $need_version eq "0" or + $need_version eq "undef") { + next if defined $inst_file; + } + + $have_version = $nmo->inst_version; } # We only want to install prereqs if either they're not installed # or if the installed version is too old. We cannot omit this # check, because if 'force' is in effect, nobody else will check. - if (defined $nmo->inst_file) { + if (defined $inst_file) { my(@all_requirements) = split /\s*,\s*/, $need_version; local($^W) = 0; my $ok = 0; @@ -5659,13 +5704,13 @@ sub unsat_prereq { if ($rq =~ s|>=\s*||) { } elsif ($rq =~ s|>\s*||) { # 2005-12: one user - if (CPAN::Version->vgt($nmo->inst_version,$rq)){ + if (CPAN::Version->vgt($have_version,$rq)){ $ok++; } next RQ; } elsif ($rq =~ s|!=\s*||) { # 2005-12: no user - if (CPAN::Version->vcmp($nmo->inst_version,$rq)){ + if (CPAN::Version->vcmp($have_version,$rq)){ $ok++; next RQ; } else { @@ -5677,20 +5722,24 @@ sub unsat_prereq { $ok++; next RQ; } - if (! CPAN::Version->vgt($rq, $nmo->inst_version)){ + if (! CPAN::Version->vgt($rq, $have_version)){ $ok++; } - CPAN->debug(sprintf "id[%s]inst_file[%s]inst_version[%s]rq[%s]ok[%d]", - $nmo->id, - $nmo->inst_file, - $nmo->inst_version, - CPAN::Version->readable($rq), - $ok, - ) if $CPAN::DEBUG; + CPAN->debug(sprintf("need_module[%s]inst_file[%s]". + "inst_version[%s]rq[%s]ok[%d]", + $need_module, + $inst_file, + $have_version, + CPAN::Version->readable($rq), + $ok, + )) if $CPAN::DEBUG; } next NEED if $ok == @all_requirements; } + if ($need_module eq "perl") { + return ["perl", $need_version]; + } if ($self->{sponsored_mods}{$need_module}++){ # We have already sponsored it and for some reason it's still # not available. So we do nothing. Or what should we do? @@ -5771,12 +5820,6 @@ sub prereq_pm { } $req = $areq if $do_replace; } - if ($req) { - # XXX maybe needs to be reconsidered: what do we if perl - # is too old? I think, we will set $self->{make} to - # Distrostatus NO and wind up the stack. - delete $req->{perl}; - } } unless ($req || $breq) { my $build_dir = $self->{build_dir} or die "Panic: no build_dir?"; @@ -5813,7 +5856,10 @@ sub prereq_pm { } } } - if (-f "Build.PL" && ! -f "Makefile.PL" && ! exists $req->{"Module::Build"}) { + if (-f "Build.PL" + && ! -f "Makefile.PL" + && ! exists $req->{"Module::Build"} + && ! $CPAN::META->has_inst("Module::Build")) { $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ". "undeclared prerequisite.\n". " Adding it now as such.\n" @@ -5843,7 +5889,9 @@ sub test { my $make = $self->{modulebuild} ? "Build" : "make"; $CPAN::Frontend->myprint("Running $make test\n"); if (my @prereq = $self->unsat_prereq){ - return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner + unless ($prereq[0][0] eq "perl") { + return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner + } } EXCUSE: { my @e; @@ -5867,14 +5915,6 @@ sub test { exists $self->{later} and length($self->{later}) and push @e, $self->{later}; - if ($self->{modulebuild}) { - my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version; - if (CPAN::Version->vlt($v,2.62)) { - push @e, qq{The version of your Test::Harness is only - '$v', you need at least '2.62'. Please upgrade your Test::Harness.}; - } - } - if ($CPAN::META->{is_tested}{$self->{build_dir}} && exists $self->{make_test} @@ -5900,6 +5940,16 @@ sub test { return; } + if ($self->{modulebuild}) { + my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version; + if (CPAN::Version->vlt($v,2.62)) { + $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only + '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n}); + $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old"); + return; + } + } + local $ENV{PERL5LIB} = defined($ENV{PERL5LIB}) ? $ENV{PERL5LIB} : ($ENV{PERLLIB} || ""); @@ -8139,13 +8189,45 @@ interferences of the software producing the indices on CPAN, of the mirroring process on CPAN, of packaging, of configuration, of synchronicity, and of bugs within CPAN.pm. -For code debugging in interactive mode you can try "o debug" which -will list options for debugging the various parts of the code. You -should know that "o debug" has built-in completion support. +For debugging the code of CPAN.pm itself in interactive mode some more +or less useful debugging aid can be turned on for most packages within +CPAN.pm with one of + +=over 2 + +=item o debug package... + +sets debug mode for packages. + +=item o debug -package... + +unsets debug mode for packages. + +=item o debug all + +turns debugging on for all packages. + +=item o debug number + +=back + +which sets the debugging packages directly. Note that C +turns debugging off. + +What seems quite a successful strategy is the combination of C and the debugging switches. Add a new debug statement while +running in the shell and then issue a C and see the new +debugging messages immediately without losing the current context. + +C without an argument lists the valid package names and the +current set of packages in debugging mode. C has built-in +completion support. -For data debugging there is the C command which takes the same -arguments as make/test/install and outputs the object's Data::Dumper -dump. +For debugging of CPAN data there is the C command which takes +the same arguments as make/test/install and outputs each object's +Data::Dumper dump. If an argument looks like a perl variable and +contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to +Data::Dumper directly. =head2 Floppy, Zip, Offline Mode diff --git a/lib/CPAN/Debug.pm b/lib/CPAN/Debug.pm index 211cac7..239fb6b 100644 --- a/lib/CPAN/Debug.pm +++ b/lib/CPAN/Debug.pm @@ -1,8 +1,9 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- package CPAN::Debug; use strict; use vars qw($VERSION); -$VERSION = sprintf "%.6f", substr(q$Rev: 924 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 955 $,4)/1000000 + 5.4; # module is internal to CPAN.pm %CPAN::DEBUG = qw[ @@ -30,15 +31,24 @@ $CPAN::DEBUG ||= 0; #-> sub CPAN::Debug::debug ; sub debug { my($self,$arg) = @_; - my($caller,$func,$line,@rest) = caller(1); # caller(0) eg - # Complete, caller(1) - # eg readline - ($caller) = caller(0); - $caller =~ s/.*:://; - $arg = "" unless defined $arg; - pop @rest while @rest > 5; - my $rest = join ",", map { defined $_ ? $_ : "UNDEF" } @rest; - if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){ + + my @caller; + my $i = 0; + while () { + my(@c) = (caller($i))[0 .. ($i ? 3 : 2)]; + last unless defined $c[0]; + push @caller, \@c; + for (0,3) { + last if $_ > $#c; + $c[$_] =~ s/.*:://; + } + for (1) { + $c[$_] =~ s|.*/||; + } + last if ++$i>=3; + } + pop @caller; + if ($CPAN::DEBUG{$caller[0][0]} & $CPAN::DEBUG){ if ($arg and ref $arg) { eval { require Data::Dumper }; if ($@) { @@ -47,7 +57,12 @@ sub debug { $CPAN::Frontend->myprint(Data::Dumper::Dumper($arg)); } } else { - $CPAN::Frontend->myprint("Debug($caller:$func,$line,[$rest]): $arg\n"); + my $outer = ""; + local $" = ","; + if (@caller>1) { + $outer = ",[@{$caller[1]}]"; + } + $CPAN::Frontend->myprint("Debug(@{$caller[0]}$outer): $arg\n"); } } } diff --git a/lib/CPAN/HandleConfig.pm b/lib/CPAN/HandleConfig.pm index dbf2fb3..a755254 100644 --- a/lib/CPAN/HandleConfig.pm +++ b/lib/CPAN/HandleConfig.pm @@ -2,7 +2,7 @@ package CPAN::HandleConfig; use strict; use vars qw(%can %keys $VERSION); -$VERSION = sprintf "%.6f", substr(q$Rev: 916 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 958 $,4)/1000000 + 5.4; %can = ( commit => "Commit changes to disk", @@ -148,7 +148,8 @@ sub edit { $CPAN::Config->{$o} = { @args }; } else { $CPAN::Config->{$o} = $args[0] if defined $args[0]; - $self->prettyprint($o); + $self->prettyprint($o) + if exists $keys{$o} or defined $CPAN::Config->{$o}; return 1; } } @@ -580,7 +581,7 @@ package use strict; use vars qw($AUTOLOAD $VERSION); -$VERSION = sprintf "%.2f", substr(q$Rev: 916 $,4)/100; +$VERSION = sprintf "%.2f", substr(q$Rev: 958 $,4)/100; # formerly CPAN::HandleConfig was known as CPAN::Config sub AUTOLOAD { diff --git a/lib/CPAN/SIGNATURE b/lib/CPAN/SIGNATURE index 7f92b91..d7447f1 100644 --- a/lib/CPAN/SIGNATURE +++ b/lib/CPAN/SIGNATURE @@ -14,35 +14,35 @@ not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 -SHA1 df3675a6257436492a9814131634527fdb70e5e7 ChangeLog +SHA1 6b31a7d5e222880c5d1f3b52758d46ed186e9784 ChangeLog SHA1 9b97524a7a91c815e46b19302a33829d3c26bbbf ChangeLog.old -SHA1 f39dfe02e639d88d99074720b0369015cb21c25d Changes +SHA1 d07abcd12ef7ee717592607dadd79fc64ab0cd15 Changes SHA1 a029ffa2f2252bb8914eb658666244710994d256 Changes.old SHA1 bcac708d887442591ac400c72a6be0629f416434 MANIFEST SHA1 159c257eb8d294fa6e0612fda7edcad948ab0362 MANIFEST.SKIP -SHA1 c2d3c4831d1fbbbb247e11cb60d0c7d97adfce85 META.yml +SHA1 41f58cb5008281bb0d6954a4131e1301f084d980 META.yml SHA1 f428cf9c8f7206fe115a1f42e13da5999452d075 Makefile.PL SHA1 37e858c51409a297ef5d3fb35dc57cd3b57f9a4d PAUSE2003.pub SHA1 af016003ad503ed078c5f8254521d13a3e0c494f PAUSE2005.pub -SHA1 f5960fd434593768d500b03f0abfa48d86d39914 README -SHA1 92c57d89defe2d11ca6bf4b922d90f5bb7e32f25 Todo +SHA1 07fc8068a27f362219008d279729e96eb5fe9d89 README +SHA1 76a7fd2eaec46c78f269da06766dc76b974b7339 Todo SHA1 efbe8e6882a2caa0d741b113959a706830ab5882 inc/Test/Builder.pm SHA1 ae1d68262bedc2475e2c6fd478d99b259b4fb109 inc/Test/More.pm -SHA1 3dd7f7792ab2f398d2aea3c051ab52d93bd603bc lib/CPAN.pm +SHA1 a6a24e27778fcc9dfb12c190e6369cfbd001f25b lib/CPAN.pm SHA1 e093af1fcd72420fe4bdc85a5bec2b92a301ab97 lib/CPAN/Admin.pm -SHA1 91ed95706f4e8cc36bb646467256de455007cd2d lib/CPAN/Debug.pm +SHA1 aa9e4d9384c88c55f9f457e2c2123242d7989406 lib/CPAN/Debug.pm SHA1 9af992904cb4445c306ecf8f7675478865f66c1e lib/CPAN/FirstTime.pm -SHA1 056a2a7fba83e3aa9c812048fe1757d808a43882 lib/CPAN/HandleConfig.pm +SHA1 c1170925e60ffcc14025b975997930a5f3eb6f7b lib/CPAN/HandleConfig.pm SHA1 17a1ad839531642ace9bf198bf52964c252f3318 lib/CPAN/Nox.pm SHA1 4992722f9e21d4c8f450cf96887b1e82f628b66c lib/CPAN/Queue.pm -SHA1 977be9f262b7a98699c00929af2eddf8793fd1d0 lib/CPAN/Tarzip.pm -SHA1 04a0f916787adc090aa4c1423419629370e9357f lib/CPAN/Version.pm +SHA1 fc6de4175a275a4c6791091f2ffcee2636a4a0f2 lib/CPAN/Tarzip.pm +SHA1 9498e9ed9da55227715a049692677b75e825adca lib/CPAN/Version.pm SHA1 fb08e07d8740ef36e8ab719c6a9b7e89c4fe674a scripts/cpan SHA1 2a3adebb8252dc893681d17460082c2e08aa144a t/00signature.t SHA1 215dace24b507de20011d36cbe2d16ddea78bcf3 t/01loadme.t SHA1 67e80e1cfc3530932de7743dd0c833b2c387609d t/02nox.t SHA1 deb594e0f60aa9c40706f117198ca202cb424b46 t/03pkgs.t -SHA1 ebdb653877d5c5e5a071fe9933b18f018cde3250 t/10version.t +SHA1 18368a653b17c7166f43686f8e315fd5e88bbcfa t/10version.t SHA1 325d8a2f72d59c4cd2400c72403c05cd614c3abc t/11mirroredby.t SHA1 7696ade95e8c4943a3e3e6a13c03c450cec8d030 t/12cpan.t SHA1 fa075e989a5923e73684d13d5e94baa0711bb360 t/30shell.coverage @@ -67,12 +67,12 @@ SHA1 541ac9311d4dbabe9bb99d770b221456798be688 t/CPAN/authors/id/A/AN/ANDK/NotInC SHA1 1aee1bed21f0e9755d693419e810ec75543eb0b7 t/CPAN/authors/id/A/AN/CHECKSUMS SHA1 1f3304f219bf0da4db6a60f638e11b61c2c2f4c0 t/CPAN/authors/id/A/CHECKSUMS SHA1 dfc900f5bfbc9683fa91977a1c7198222fbd4452 t/CPAN/authors/id/CHECKSUMS -SHA1 3287515f4ddfccd586ddd23a0929f0298a505d67 t/CPAN/modules/02packages.details.txt +SHA1 f73a986b44f38e126e4c8a50289d5537d80581e8 t/CPAN/modules/02packages.details.txt SHA1 f4c1a524de16347b37df6427ca01f98dd27f3c81 t/CPAN/modules/03modlist.data -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.5 (GNU/Linux) -iD8DBQFFHkh17IA58KMXwV0RAhAOAKChWUfDPZJw1dyRBP5Rnn4ik05kVQCePcSo -MjOwJh97fgDAK9m6gDfYA/k= -=oz7x +iD8DBQFFIjIj7IA58KMXwV0RAidhAJ9x6UiFYhaKWBORJxsSvnMc6Jno/ACcClyR +tkNXFaGx9iPcX6f2Xfh4D7A= +=zuVm -----END PGP SIGNATURE----- diff --git a/lib/CPAN/Tarzip.pm b/lib/CPAN/Tarzip.pm index abd9ace..684417c 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 (); -$VERSION = sprintf "%.6f", substr(q$Rev: 858 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 956 $,4)/1000000 + 5.4; # module is internal to CPAN.pm @ISA = qw(CPAN::Debug); @@ -133,16 +133,19 @@ sub TIEHANDLE { my $fh = FileHandle->new($file) or die "Could not open file[$file]: $!"; binmode $fh; $self->{FH} = $fh; + $class->debug("via uncompressed FH"); } elsif ($CPAN::META->has_inst("Compress::Zlib")) { my $gz = Compress::Zlib::gzopen($file,"rb") or die "Could not gzopen $file"; $self->{GZ} = $gz; + $class->debug("via Compress::Zlib"); } else { my $gzip = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG}); my $pipe = "$gzip -dc $file |"; my $fh = FileHandle->new($pipe) or die "Could not pipe[$pipe]: $!"; binmode $fh; $self->{FH} = $fh; + $class->debug("via external gzip"); } $self; } diff --git a/lib/CPAN/Version.pm b/lib/CPAN/Version.pm index 04f3780..68ab9c1 100644 --- a/lib/CPAN/Version.pm +++ b/lib/CPAN/Version.pm @@ -2,7 +2,7 @@ package CPAN::Version; use strict; use vars qw($VERSION); -$VERSION = sprintf "%.6f", substr(q$Rev: 844 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 950 $,4)/1000000 + 5.4; # CPAN::Version::vcmp courtesy Jost Krieger sub vcmp { @@ -13,16 +13,22 @@ sub vcmp { return 0 if $l eq $r; # short circuit for quicker success for ($l,$r) { + s/_//g; + } + CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; + for ($l,$r) { next unless tr/.// > 1; s/^v?/v/; 1 while s/\.0+(\d)/.$1/; } + CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; if ($l=~/^v/ <=> $r=~/^v/) { for ($l,$r) { next if /^v/; $_ = $self->float2vv($_); } } + CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; return ( ($l ne "undef") <=> ($r ne "undef") || diff --git a/lib/CPAN/t/10version.t b/lib/CPAN/t/10version.t index 2002ebe..0827633 100644 --- a/lib/CPAN/t/10version.t +++ b/lib/CPAN/t/10version.t @@ -33,8 +33,10 @@ while (@$D) { if ($has_versionpm) { local $^W; my $vpack = "version"; # hide the name from 5.004 - my $vres = $vpack->new($l) cmp $vpack->new($r); - if ($vres != $res) { + my $vres = eval { $vpack->new($l) cmp $vpack->new($r); }; + if ($@) { + push @other, "v.pm: $@"; + } elsif ($vres != $res) { push @other, sprintf "v.pm: %d", $vres; } } @@ -61,6 +63,8 @@ VERSION VERSION 0 1.57_00 1.57 1 1.5700 1.57 1 1.57_01 1.57 1 +1.88_51 1.8801 1 +1.8_8_5_1 1.8801 1 0.2.10 0.2 -1 20000000.00 19990108 1 1.00 0.96 1