# -*- 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;
$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};
#-> 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;
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}};
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") {
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;
);
$CPAN::Frontend->mysleep(2);
}
- } elsif ($meth eq "dump") {
+ } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") {
CPAN::InfoObj->dump($s);
} else {
$CPAN::Frontend
local($/) = "\n";
local($_);
push @lines, split /\012/ while <FH>;
+ my $i = 0;
+ my $modulus = int(@lines/75) || 1;
foreach (@lines) {
my($userid,$fullname,$email) =
m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
# 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 {
#-> 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) {
$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.
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
}
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;
}
}
}
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 ;
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;
}
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");
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") {
}
#-> 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;
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 {
$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?
}
$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?";
}
}
}
- 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"
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;
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}
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} || "");
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<o debug 0>
+turns debugging off.
+
+What seems quite a successful strategy is the combination of C<reload
+cpan> and the debugging switches. Add a new debug statement while
+running in the shell and then issue a C<reload cpan> and see the new
+debugging messages immediately without losing the current context.
+
+C<o debug> without an argument lists the valid package names and the
+current set of packages in debugging mode. C<o debug> has built-in
+completion support.
-For data debugging there is the C<dump> 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<dump> 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
-----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
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-----