This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[PAUSE] CPAN Upload: A/AN/ANDK/CPAN-1.88_51.tar.gz
authorAndreas König <a.koenig@mind.de>
Sat, 30 Sep 2006 13:44:02 +0000 (15:44 +0200)
committerSteve Peters <steve@fisharerojo.org>
Sat, 30 Sep 2006 14:17:55 +0000 (14:17 +0000)
Message-ID: <87ejttmvel.fsf@k75.linux.bogus>

p4raw-id: //depot/perl@28909

MANIFEST
lib/CPAN.pm
lib/CPAN/Debug.pm
lib/CPAN/FirstTime.pm
lib/CPAN/HandleConfig.pm
lib/CPAN/Queue.pm [new file with mode: 0644]
lib/CPAN/SIGNATURE
lib/CPAN/t/03pkgs.t

index 64e5bf6..a07bd39 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1490,6 +1490,7 @@ lib/CPAN/HandleConfig.pm  helper package for CPAN.pm
 lib/CPAN/Nox.pm                        Runs CPAN while avoiding compiled extensions
 lib/CPAN/PAUSE2003.pub         CPAN public key
 lib/CPAN/PAUSE2005.pub         CPAN public key
+lib/CPAN/Queue.pm              queueing system for CPAN.pm
 lib/CPAN.pm                    Interface to Comprehensive Perl Archive Network
 lib/CPAN/SIGNATURE             CPAN public key
 lib/CPAN/t/01loadme.t          See if CPAN the module works
index baa8cc8..23764a3 100644 (file)
@@ -1,12 +1,13 @@
 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
 use strict;
 package CPAN;
-$CPAN::VERSION = '1.8801';
+$CPAN::VERSION = '1.88_51';
 $CPAN::VERSION = eval $CPAN::VERSION;
 
 use CPAN::HandleConfig;
 use CPAN::Version;
 use CPAN::Debug;
+use CPAN::Queue;
 use CPAN::Tarzip;
 use Carp ();
 use Config ();
@@ -60,7 +61,9 @@ $CPAN::Defaultrecent ||= "http://search.cpan.org/recent";
 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term
             $Signal $Suppress_readline $Frontend
             @Defaultsites $Have_warned $Defaultdocs $Defaultrecent
-            $Be_Silent );
+            $Be_Silent
+            $autoload_recursion
+           );
 
 @CPAN::ISA = qw(CPAN::Debug Exporter);
 
@@ -89,18 +92,35 @@ use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term
 
 sub soft_chdir_with_alternatives ($);
 
-#-> sub CPAN::AUTOLOAD ;
-sub AUTOLOAD {
-    my($l) = $AUTOLOAD;
-    $l =~ s/.*:://;
-    my(%EXPORT);
-    @EXPORT{@EXPORT} = '';
-    CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
-    if (exists $EXPORT{$l}){
-       CPAN::Shell->$l(@_);
-    } else {
-       die(qq{Unknown CPAN command "$AUTOLOAD". }.
-            qq{Type ? for help.\n});
+{
+    $autoload_recursion ||= 0;
+
+    #-> sub CPAN::AUTOLOAD ;
+    sub AUTOLOAD {
+        $autoload_recursion++;
+        my($l) = $AUTOLOAD;
+        $l =~ s/.*:://;
+        if ($CPAN::Signal) {
+            warn "Refusing to autoload '$l' while signal pending";
+            $autoload_recursion--;
+            return;
+        }
+        if ($autoload_recursion > 1) {
+            my $fullcommand = join " ", map { "'$_'" } $l, @_;
+            warn "Refusing to autoload $fullcommand in recursion\n";
+            $autoload_recursion--;
+            return;
+        }
+        my(%export);
+        @export{@EXPORT} = '';
+        CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
+        if (exists $export{$l}){
+            CPAN::Shell->$l(@_);
+        } else {
+            die(qq{Unknown CPAN command "$AUTOLOAD". }.
+                qq{Type ? for help.\n});
+        }
+        $autoload_recursion--;
     }
 }
 
@@ -161,11 +181,10 @@ sub shell {
 
     # no strict; # I do not recall why no strict was here (2000-09-03)
     $META->checklock();
-    my @cwd = (
-               CPAN::anycwd(),
-               File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
-               File::Spec->rootdir(),
-              );
+    my @cwd = grep { defined $_ and length $_ }
+        CPAN::anycwd(),
+              File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
+                    File::Spec->rootdir();
     my $try_detect_readline;
     $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
     my $rl_avail = $Suppress_readline ? "suppressed" :
@@ -281,14 +300,25 @@ ReadLine support %s
 
 sub soft_chdir_with_alternatives ($) {
     my($cwd) = @_;
-    while (not chdir $cwd->[0]) {
-        if (@$cwd>1) {
-            $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
-Trying to chdir to "$cwd->[1]" instead.
+    unless (@$cwd) {
+        my $root = File::Spec->rootdir();
+        $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to!
+Trying '$root' as temporary haven.
 });
-            shift @$cwd;
+        push @$cwd, $root;
+    }
+    while () {
+        if (chdir $cwd->[0]) {
+            return;
         } else {
-            $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
+            if (@$cwd>1) {
+                $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
+Trying to chdir to "$cwd->[1]" instead.
+});
+                shift @$cwd;
+            } else {
+                $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
+            }
         }
     }
 }
@@ -449,165 +479,55 @@ sub as_string {
 
 package CPAN::Shell;
 use strict;
-use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY);
+use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY
+            $autoload_recursion
+           );
 @CPAN::Shell::ISA = qw(CPAN::Debug);
 $COLOR_REGISTERED ||= 0;
 
-#-> sub CPAN::Shell::AUTOLOAD ;
-sub AUTOLOAD {
-    my($autoload) = $AUTOLOAD;
-    my $class = shift(@_);
-    # warn "autoload[$autoload] class[$class]";
-    $autoload =~ s/.*:://;
-    if ($autoload =~ /^w/) {
-       if ($CPAN::META->has_inst('CPAN::WAIT')) {
-           CPAN::WAIT->$autoload(@_);
-       } else {
-           $CPAN::Frontend->mywarn(qq{
+{
+    # $GLOBAL_AUTOLOAD_RECURSION = 12;
+    $autoload_recursion   ||= 0;
+
+    #-> sub CPAN::Shell::AUTOLOAD ;
+    sub AUTOLOAD {
+        $autoload_recursion++;
+        my($l) = $AUTOLOAD;
+        my $class = shift(@_);
+        # warn "autoload[$l] class[$class]";
+        $l =~ s/.*:://;
+        if ($CPAN::Signal) {
+            warn "Refusing to autoload '$l' while signal pending";
+            $autoload_recursion--;
+            return;
+        }
+        if ($autoload_recursion > 1) {
+            my $fullcommand = join " ", map { "'$_'" } $l, @_;
+            warn "Refusing to autoload $fullcommand in recursion\n";
+            $autoload_recursion--;
+            return;
+        }
+        if ($l =~ /^w/) {
+            # XXX needs to be reconsidered
+            if ($CPAN::META->has_inst('CPAN::WAIT')) {
+                CPAN::WAIT->$l(@_);
+            } else {
+                $CPAN::Frontend->mywarn(qq{
 Commands starting with "w" require CPAN::WAIT to be installed.
 Please consider installing CPAN::WAIT to use the fulltext index.
 For this you just need to type
     install CPAN::WAIT
 });
-       }
-    } else {
-       $CPAN::Frontend->mywarn(qq{Unknown shell command '$autoload @_'. }.
-                               qq{Type ? for help.
-});
-    }
-}
-
-package CPAN::Queue;
-use strict;
-
-# One use of the queue is to determine if we should or shouldn't
-# announce the availability of a new CPAN module
-
-# Now we try to use it for dependency tracking. For that to happen
-# we need to draw a dependency tree and do the leaves first. This can
-# easily be reached by running CPAN.pm recursively, but we don't want
-# to waste memory and run into deep recursion. So what we can do is
-# this:
-
-# CPAN::Queue is the package where the queue is maintained. Dependencies
-# often have high priority and must be brought to the head of the queue,
-# possibly by jumping the queue if they are already there. My first code
-# attempt tried to be extremely correct. Whenever a module needed
-# immediate treatment, I either unshifted it to the front of the queue,
-# or, if it was already in the queue, I spliced and let it bypass the
-# others. This became a too correct model that made it impossible to put
-# an item more than once into the queue. Why would you need that? Well,
-# you need temporary duplicates as the manager of the queue is a loop
-# that
-#
-#  (1) looks at the first item in the queue without shifting it off
-#
-#  (2) cares for the item
-#
-#  (3) removes the item from the queue, *even if its agenda failed and
-#      even if the item isn't the first in the queue anymore* (that way
-#      protecting against never ending queues)
-#
-# So if an item has prerequisites, the installation fails now, but we
-# want to retry later. That's easy if we have it twice in the queue.
-#
-# I also expect insane dependency situations where an item gets more
-# than two lives in the queue. Simplest example is triggered by 'install
-# Foo Foo Foo'. People make this kind of mistakes and I don't want to
-# get in the way. I wanted the queue manager to be a dumb servant, not
-# one that knows everything.
-#
-# Who would I tell in this model that the user wants to be asked before
-# processing? I can't attach that information to the module object,
-# because not modules are installed but distributions. So I'd have to
-# tell the distribution object that it should ask the user before
-# processing. Where would the question be triggered then? Most probably
-# in CPAN::Distribution::rematein.
-# Hope that makes sense, my head is a bit off:-) -- AK
-
-use vars qw{ @All };
-
-# CPAN::Queue::new ;
-sub new {
-  my($class,$s) = @_;
-  my $self = bless { qmod => $s }, $class;
-  push @All, $self;
-  return $self;
-}
-
-# CPAN::Queue::first ;
-sub first {
-  my $obj = $All[0];
-  $obj->{qmod};
-}
-
-# CPAN::Queue::delete_first ;
-sub delete_first {
-  my($class,$what) = @_;
-  my $i;
-  for my $i (0..$#All) {
-    if (  $All[$i]->{qmod} eq $what ) {
-      splice @All, $i, 1;
-      return;
-    }
-  }
-}
-
-# CPAN::Queue::jumpqueue ;
-sub jumpqueue {
-    my $class = shift;
-    my @what = @_;
-    CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
-                        join(",",map {$_->{qmod}} @All),
-                        join(",",@what)
-                       )) if $CPAN::DEBUG;
-  WHAT: for my $what (reverse @what) {
-        my $jumped = 0;
-        for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
-            CPAN->debug("i[$All[$i]]what[$what]") if $CPAN::DEBUG;
-            if ($All[$i]->{qmod} eq $what){
-                $jumped++;
-                if ($jumped > 100) { # one's OK if e.g. just
-                                     # processing now; more are OK if
-                                     # user typed it several times
-                    $CPAN::Frontend->mywarn(
-qq{Object [$what] queued more than 100 times, ignoring}
-                                );
-                    next WHAT;
-                }
             }
+        } else {
+            $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }.
+                                    qq{Type ? for help.
+});
         }
-        my $obj = bless { qmod => $what }, $class;
-        unshift @All, $obj;
+        $autoload_recursion--;
     }
-    CPAN->debug(sprintf("after jumpqueue All[%s] what[%s]",
-                        join(",",map {$_->{qmod}} @All),
-                        join(",",@what)
-                       )) if $CPAN::DEBUG;
-}
-
-# CPAN::Queue::exists ;
-sub exists {
-  my($self,$what) = @_;
-  my @all = map { $_->{qmod} } @All;
-  my $exists = grep { $_->{qmod} eq $what } @All;
-  # warn "in exists what[$what] all[@all] exists[$exists]";
-  $exists;
-}
-
-# CPAN::Queue::delete ;
-sub delete {
-  my($self,$mod) = @_;
-  @All = grep { $_->{qmod} ne $mod } @All;
-}
-
-# CPAN::Queue::nullify_queue ;
-sub nullify_queue {
-  @All = ();
 }
 
-
-
 package CPAN;
 use strict;
 
@@ -766,15 +686,18 @@ this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
     $self->{LOCK} = $lockfile;
     $fh->close;
     $SIG{TERM} = sub {
-      &cleanup;
-      $CPAN::Frontend->mydie("Got SIGTERM, leaving");
+        my $sig = shift;
+        &cleanup;
+        $CPAN::Frontend->mydie("Got SIG$sig, leaving");
     };
     $SIG{INT} = sub {
       # no blocks!!!
-      &cleanup if $Signal;
-      $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
-      $CPAN::Frontend->myprint("Caught SIGINT\n");
-      $Signal++;
+        my $sig = shift;
+        &cleanup if $Signal;
+        die "Got yet another signal" if $Signal > 1;
+        $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
+        $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
+        $Signal++;
     };
 
 #       From: Larry Wall <larry@wall.org>
@@ -1072,8 +995,8 @@ sub is_tested {
     $self->{is_tested}{$what} = 1;
 }
 
-# looks suspicious but maybe it is really intended to set is_tested
-# here. Please document next time around
+# unsets the is_tested flag: as soon as the thing is installed, it is
+# not needed in set_perl5lib anymore
 sub is_installed {
     my($self,$what) = @_;
     delete $self->{is_tested}{$what};
@@ -1175,7 +1098,6 @@ sub disk_usage {
         }
     } else {
         $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
-        $CPAN::Frontend->mysleep(2);
         return;
     }
     find(
@@ -1290,17 +1212,20 @@ Download, Test, Make, Install...
  test     make test (implies make)     readme   display these README files
  install  make install (implies test)  perldoc  display POD documentation
 
+Upgrade
+ r        WORDs or /REGEXP/ or NONE    report updates for some/matching/all modules
+ upgrade  WORDs or /REGEXP/ or NONE    upgrade some/matching/all modules
+
 Pragmas
  force COMMAND    unconditionally do command
  notest COMMAND   skip testing
 
 Other
  h,?           display this menu       ! perl-code   eval a perl command
- r             report module updates   upgrade       upgrade all modules
  o conf [opt]  set and query options   q             quit the cpan shell
  reload cpan   load CPAN.pm again      reload index  load newer indices
  autobundle    Snapshot                recent        latest CPAN uploads});
-    }
+}
 }
 
 *help = \&h;
@@ -1465,8 +1390,8 @@ sub i {
 
 # CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
 # conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
-# have been called 'set' and 'o debug' maybe 'set debug' or 'debug'
-# 'o conf XXX' calls ->edit in CPAN/HandleConfig.pm
+# probably have been called 'set' and 'o debug' maybe 'set debug' or
+# 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm
 sub o {
     my($self,$o_type,@o_what) = @_;
     $DB::single = 1;
@@ -1578,7 +1503,7 @@ sub reload {
     my($self,$command,@arg) = @_;
     $command ||= "";
     $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
-    if ($command =~ /cpan/i) {
+    if ($command =~ /^cpan$/i) {
         my $redef = 0;
         chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
         my $failed;
@@ -1589,24 +1514,31 @@ sub reload {
                     "CPAN/Tarzip.pm",
                     "CPAN/Debug.pm",
                     "CPAN/Version.pm",
+                    "CPAN/Queue.pm",
+                    "CPAN/Reporter.pm",
                    );
-        if ($CPAN::Config->{test_report}) {
-            push @relo, "CPAN/Reporter.pm";
-        }
       MFILE: for my $f (@relo) {
+            next unless exists $INC{$f};
+            my $p = $f;
+            $p =~ s/\.pm$//;
+            $p =~ s|/|::|g;
+            $CPAN::Frontend->myprint("($p");
             local($SIG{__WARN__}) = paintdots_onreload(\$redef);
             $self->reload_this($f) or $failed++;
+            my $v = eval "$p\::->VERSION";
+            $CPAN::Frontend->myprint("v$v)");
         }
         $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
         $failed++ unless $redef;
         if ($failed) {
-            $CPAN::Frontend->mywarn("\n$failed errors during reload. You better quit ".
+            my $errors = $failed == 1 ? "error" : "errors";
+            $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ".
                                     "this session.\n");
         }
-    } elsif ($command =~ /index/) {
+    } elsif ($command =~ /^index$/i) {
       CPAN::Index->force_reload;
     } else {
-      $CPAN::Frontend->myprint(qq{cpan     re-evals the CPAN.pm file
+      $CPAN::Frontend->myprint(qq{cpan     re-evals the CPAN modules
 index    re-reads the index files\n});
     }
 }
@@ -1774,8 +1706,8 @@ sub scripts {
 
 #-> sub CPAN::Shell::upgrade ;
 sub upgrade {
-    my($self) = shift @_;
-    $self->install($self->r);
+    my($self,@args) = @_;
+    $self->install($self->r(@args));
 }
 
 #-> sub CPAN::Shell::_u_r_common ;
@@ -1858,6 +1790,7 @@ sub _u_r_common {
        }
         my $color_on = "";
         my $color_off = "";
+        # $GLOBAL_AUTOLOAD_RECURSION = 12;
         if (
             $COLOR_REGISTERED
             &&
@@ -2121,7 +2054,12 @@ sub expand_by_method {
                     next;
                 }
                 for my $method (@$methods) {
-                    if ($obj->$method() =~ /$regex/i) {
+                    my $match = eval {$obj->$method() =~ /$regex/i};
+                    if ($@) {
+                        my($err) = $@ =~ /^(.+) at .+? line \d+\.$/;
+                        $err ||= $@; # if we were too restrictive above
+                        $CPAN::Frontend->mydie("$err\n");
+                    } elsif ($match) {
                         push @m, $obj;
                         last;
                     }
@@ -2258,43 +2196,18 @@ sub print_ornamented {
             =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
     }
     if ($self->colorize_output) {
+        if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
+            # if you want to have this configurable, please file a bugreport
+            $ornament = "black on_cyan";
+        }
         my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
         if ($@) {
             print "Term::ANSIColor rejects color[$ornament]: $@\n
 Please choose a different color (Hint: try 'o conf init color.*')\n";
         }
-        my $colorstyle = 0; # (=0) works, (=1) tries to make
-                            # background colors more attractive by
-                            # appending whitespace to short lines, it
-                            # seems also to work but is less tested;
-                            # for testing use the make target
-                            # testshell-with-protocol-twice; overall
-                            # seems not worth any effort
-        if ($colorstyle == 1) {
-            my $line;
-            my $longest = 0; # Does list::util work on 5.004?
-            for $line (split /\n/, $swhat) {
-                $longest = length($line) if length($line) > $longest;
-            }
-            $longest = 78 if $longest > 78; # yes, arbitrary, who wants it set-able?
-            my $nl = chomp $swhat ? "\n" : "";
-            my $block = join "",
-                map {
-                    sprintf("%s%-*s%s%s",
-                            $color_on,
-                            $longest,
-                            $_,
-                            Term::ANSIColor::color("reset"),
-                            $nl,
-                           )
-                }
-                    split /[\r\t ]*\n/, $swhat, -1;
-            print $block;
-        } else {
-            print $color_on,
-                $swhat,
-                    Term::ANSIColor::color("reset");
-        }
+        print $color_on,
+            $swhat,
+                Term::ANSIColor::color("reset");
     } else {
         print $swhat;
     }
@@ -2437,7 +2350,7 @@ sub rematein {
        }
        if (ref $obj) {
             $obj->color_cmd_tmps(0,1);
-            CPAN::Queue->new($obj->id);
+            CPAN::Queue->new(qmod => $obj->id, reqtype => "c");
             push @qcopy, $obj;
        } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
            $obj = $CPAN::META->instance('CPAN::Author',uc($s));
@@ -2452,10 +2365,12 @@ sub rematein {
                                        );
                 $CPAN::Frontend->mysleep(2);
             }
-       } else {
+       } elsif ($meth eq "dump") {
+            CPAN::InfoObj->dump($s);
+        } else {
            $CPAN::Frontend
                ->mywarn(qq{Warning: Cannot $meth $s, }.
-                         qq{don\'t know what it is.
+                         qq{don't know what it is.
 Try the command
 
     i /$s/
@@ -2469,13 +2384,35 @@ to find objects with matching identifiers.
     # queuerunner (please be warned: when I started to change the
     # queue to hold objects instead of names, I made one or two
     # mistakes and never found which. I reverted back instead)
-    while ($s = CPAN::Queue->first) {
+    while (my $q = CPAN::Queue->first) {
         my $obj;
-       if (ref $s) {
-           $obj = $s; # I do not believe, we would survive if this happened
-       } else {
-           $obj = CPAN::Shell->expandany($s);
-       }
+        my $s = $q->as_string;
+        my $reqtype = $q->reqtype || "";
+        $obj = CPAN::Shell->expandany($s);
+        $obj->{reqtype} ||= "";
+        CPAN->debug("obj-reqtype[$obj->{reqtype}]".
+                    "q-reqtype[$reqtype]") if $CPAN::DEBUG;
+        if ($obj->{reqtype}) {
+            if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) {
+                $obj->{reqtype} = $reqtype;
+                if (
+                    exists $obj->{install}
+                    &&
+                    (
+                     $obj->{install}->can("failed") ?
+                     $obj->{install}->failed :
+                     $obj->{install} =~ /^NO/
+                    )
+                   ) {
+                    delete $obj->{install};
+                    $CPAN::Frontend->mywarn
+                        ("Promoting $obj->{ID} from 'build_requires' to 'requires'");
+                }
+            }
+        } else {
+            $obj->{reqtype} = $reqtype;
+        }
+
        for my $pragma (@pragma) {
            if ($pragma
                &&
@@ -2489,9 +2426,8 @@ to find objects with matching identifiers.
         if ($]>=5.00303 && $obj->can('called_for')) {
             $obj->called_for($s);
         }
-        CPAN->debug(
-                    qq{pragma[@pragma]meth[$meth]obj[$obj]as_string[$obj->{ID}]}
-                   ) if $CPAN::DEBUG;
+        CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
+                    qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;
 
         if ($obj->$meth()){
             CPAN::Queue->delete($s);
@@ -3692,8 +3628,8 @@ sub reload {
 sub reload_x {
     my($cl,$wanted,$localname,$force) = @_;
     $force |= 2; # means we're dealing with an index here
-    CPAN::HandleConfig->load; # we should guarantee loading wherever we rely
-                        # on Config XXX
+    CPAN::HandleConfig->load; # we should guarantee loading wherever
+                              # we rely on Config XXX
     $localname ||= $wanted;
     my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
                                         $localname);
@@ -4158,7 +4094,8 @@ sub as_glimpse {
     my(@m);
     my $class = ref($self);
     $class =~ s/^CPAN:://;
-    push @m, sprintf "%-15s %s\n", $class, $self->{ID};
+    my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
+    push @m, sprintf "%-15s %s\n", $class, $id;
     join "", @m;
 }
 
@@ -4220,13 +4157,24 @@ sub fullname {
 
 #-> sub CPAN::InfoObj::dump ;
 sub dump {
-  my($self) = @_;
+  my($self, $what) = @_;
   unless ($CPAN::META->has_inst("Data::Dumper")) {
       $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
   }
   local $Data::Dumper::Sortkeys;
   $Data::Dumper::Sortkeys = 1;
-  $CPAN::Frontend->myprint(Data::Dumper::Dumper($self));
+  my $out = Data::Dumper::Dumper($what ? eval $what : $self);
+  if (length $out > 100000) {
+      my $fh_pager = FileHandle->new;
+      local($SIG{PIPE}) = "IGNORE";
+      my $pager = $CPAN::Config->{'pager'} || "cat";
+      $fh_pager->open("|$pager")
+          or die "Could not open pager $pager\: $!";
+      $fh_pager->print($out);
+      close $fh_pager;
+  } else {
+      $CPAN::Frontend->myprint($out);
+  }
 }
 
 package CPAN::Author;
@@ -4485,6 +4433,7 @@ sub fast_yaml {
     }
 }
 
+#-> sub CPAN::Distribution::pretty_id
 sub pretty_id {
     my $self = shift;
     my $id = $self->id;
@@ -4509,7 +4458,8 @@ sub color_cmd_tmps {
     # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
     my $prereq_pm = $self->prereq_pm;
     if (defined $prereq_pm) {
-      PREREQ: for my $pre (keys %$prereq_pm) {
+      PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
+                           keys %{$prereq_pm->{build_requires}||{}}) {
             my $premo;
             unless ($premo = CPAN::Shell->expand("Module",$pre)) {
                 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
@@ -5058,7 +5008,7 @@ sub cvs_import {
     }
     my $cvs_log = qq{"imported $package $version sources"};
     $version =~ s/\./_/g;
-    # XXX cvs
+    # XXX cvs: undocumented and unclear how it was meant to work
     my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
               "$cvs_dir", $userid, "v$version");
 
@@ -5335,7 +5285,7 @@ sub force {
   my($self, $method) = @_;
   for my $att (qw(
   CHECKSUM_STATUS archived build_dir localfile make install unwrapped
-  writemakefile modulebuild make_test
+  writemakefile modulebuild make_test signature_verify
  )) {
     delete $self->{$att};
   }
@@ -5639,15 +5589,20 @@ sub _make_command {
 #-> sub CPAN::Distribution::follow_prereqs ;
 sub follow_prereqs {
     my($self) = shift;
-    my(@prereq) = grep {$_ ne "perl"} @_;
-    return unless @prereq;
+    my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
+    return unless @prereq_tuples;
+    my @prereq = map { $_->[0] } @prereq_tuples;
     my $id = $self->id;
-    $CPAN::Frontend->myprint("---- Unsatisfied dependencies detected ".
-                             "during [$id] -----\n");
-
-    for my $p (@prereq) {
-       $CPAN::Frontend->myprint("    $p\n");
-    }
+    my %map = (
+               b => "build_requires",
+               r => "requires",
+               c => "commandline",
+              );
+    $CPAN::Frontend->
+        myprint("---- Unsatisfied dependencies detected ".
+                "during [$id] -----\n".
+                join("", map {"    $_->[0] \[$map{$_->[1]}]\n"} @prereq_tuples),
+               );
     my $follow = 0;
     if ($CPAN::Config->{prerequisites_policy} eq "follow") {
        $follow = 1;
@@ -5667,7 +5622,9 @@ of modules we are processing right now?", "yes");
             # warn "calling color_cmd_tmps(0,1)";
             CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
         }
-        CPAN::Queue->jumpqueue(@prereq,$id); # queue them and requeue yourself
+        # queue them and re-queue yourself
+        CPAN::Queue->jumpqueue([$id,$self->{reqtype}],
+                               reverse @prereq_tuples);
         $self->{later} = "Delayed until after prerequisites";
         return 1; # signal success to the queuerunner
     }
@@ -5678,7 +5635,8 @@ sub unsat_prereq {
     my($self) = @_;
     my $prereq_pm = $self->prereq_pm or return;
     my(@need);
-  NEED: while (my($need_module, $need_version) = each %$prereq_pm) {
+    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;
@@ -5739,7 +5697,8 @@ sub unsat_prereq {
             # if we push it again, we have a potential infinite loop
             next;
         }
-        push @need, $need_module;
+        my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
+        push @need, [$need_module,$needed_as];
     }
     @need;
 }
@@ -5764,7 +5723,8 @@ sub read_yaml {
             $self->{yaml_content} = undef;
         }
     }
-    $self->debug("yaml_content[$self->{yaml_content}]") if $CPAN::DEBUG;
+    $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
+        if $CPAN::DEBUG;
     return $self->{yaml_content};
 }
 
@@ -5776,9 +5736,10 @@ sub prereq_pm {
     return unless $self->{writemakefile}  # no need to have succeeded
                                           # but we must have run it
         || $self->{modulebuild};
-    my $req;
-    if (my $yaml = $self->read_yaml) {
-        $req =  $yaml->{requires};
+    my($req,$breq);
+    if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
+        $req =  $yaml->{requires} || {};
+        $breq =  $yaml->{build_requires} || {};
         undef $req unless ref $req eq "HASH" && %$req;
         if ($req) {
             if ($yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
@@ -5810,22 +5771,14 @@ sub prereq_pm {
             }
             $req = $areq if $do_replace;
         }
-        if ($yaml->{build_requires}
-            && ref $yaml->{build_requires}
-            && ref $yaml->{build_requires} eq "HASH") {
-            while (my($k,$v) = each %{$yaml->{build_requires}}) {
-                if ($req->{$k}) {
-                    # merging of two "requires"-type values--what should we do?
-                } else {
-                    $req->{$k} = $v;
-                }
-            }
-        }
         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) {
+    unless ($req || $breq) {
         my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
         my $makefile = File::Spec->catfile($build_dir,"Makefile");
         my $fh;
@@ -5855,23 +5808,22 @@ sub prereq_pm {
             }
         } elsif (-f "Build") {
             if ($CPAN::META->has_inst("Module::Build")) {
-                my $requires  = Module::Build->current->requires();
-                my $brequires = Module::Build->current->build_requires();
-                $req = { %$requires, %$brequires };
+                $req  = Module::Build->current->requires();
+                $breq = Module::Build->current->build_requires();
             }
         }
     }
     if (-f "Build.PL" && ! -f "Makefile.PL" && ! exists $req->{"Module::Build"}) {
         $CPAN::Frontend->mywarn("  Warning: CPAN.pm discovered Module::Build as ".
                                 "undeclared prerequisite.\n".
-                                "  Adding it now as a prerequisite.\n"
+                                "  Adding it now as such.\n"
                                );
         $CPAN::Frontend->mysleep(5);
         $req->{"Module::Build"} = 0;
         delete $self->{writemakefile};
     }
     $self->{prereq_pm_detected}++;
-    return $self->{prereq_pm} = $req;
+    return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
 }
 
 #-> sub CPAN::Distribution::test ;
@@ -5915,6 +5867,27 @@ 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}
+            &&
+            !(
+              $self->{make_test}->can("failed") ?
+              $self->{make_test}->failed :
+              $self->{make_test} =~ /^NO/
+             )
+           ) {
+            push @e, "Already tested successfully";
+        }
+
        $CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
     }
     chdir $self->{'build_dir'} or
@@ -6121,6 +6094,35 @@ sub install {
     }
 
     my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
+    $CPAN::Config->{build_requires_install_policy}||="ask/yes";
+    my $id = $self->id;
+    my $reqtype = $self->{reqtype};
+    unless ($reqtype) {
+        $CPAN::Frontend->mywarn("Unknown require type for '$id', setting to 'r'. ".
+                                "This should not happen and is construed a bug.\n");
+        $reqtype = "r";
+    }
+    my $want_install = "yes";
+    if ($reqtype eq "b") {
+        if ($CPAN::Config->{build_requires_install_policy} eq "no") {
+            $want_install = "no";
+        } elsif ($CPAN::Config->{build_requires_install_policy} =~ m|^ask/(.+)|) {
+            my $default = $1;
+            $default = "yes" unless $default =~ /^(y|n)/i;
+            $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)",
+                       $default);
+        }
+    }
+    unless ($want_install =~ /^y/i) {
+        my $is_only = "is only 'build_requires'";
+        $CPAN::Frontend->mywarn("Not installing because $is_only\n");
+        $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
+        delete $self->{force_update};
+        return;
+    }
     my($pipe) = FileHandle->new("$system $stderr |");
     my($makeout) = "";
     while (<$pipe>){
@@ -6273,9 +6275,9 @@ saved output to %s\n},
             my $fh_pager = FileHandle->new;
             local($SIG{PIPE}) = "IGNORE";
             my $pager = $CPAN::Config->{'pager'} || "cat";
-            $fh_pager->open("|pager")
+            $fh_pager->open("|$pager")
                 or $CPAN::Frontend->mydie(qq{
-Could not open pager $pager\: $!});
+Could not open pager '$pager': $!});
             $CPAN::Frontend->myprint(qq{
 Displaying URL
   $url
@@ -6361,7 +6363,6 @@ sub _build_command {
     if ($^O eq "MSWin32") { # special code needed at least up to
                             # Module::Build 0.2611 and 0.2706; a fix
                             # in M:B has been promised 2006-01-30
-                            
         my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
         return "$perl ./Build";
     }
@@ -6580,6 +6581,7 @@ explicitly a file $s.
        # possibly noisy action:
         $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
        my $obj = $CPAN::META->instance($type,$s);
+        $obj->{reqtype} = $self->{reqtype};
        $obj->$meth();
         if ($obj->isa('CPAN::Bundle')
             &&
@@ -7055,6 +7057,31 @@ sub rematein {
     $pack->called_for($self->id);
     $pack->force($meth) if exists $self->{'force_update'};
     $pack->notest($meth) if exists $self->{'notest'};
+
+    $pack->{reqtype} ||= "";
+    CPAN->debug("dist-reqtype[$pack->{reqtype}]".
+                "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
+        if ($pack->{reqtype}) {
+            if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
+                $pack->{reqtype} = $self->{reqtype};
+                if (
+                    exists $pack->{install}
+                    &&
+                    (
+                     $pack->{install}->can("failed") ?
+                     $pack->{install}->failed :
+                     $pack->{install} =~ /^NO/
+                    )
+                   ) {
+                    delete $pack->{install};
+                    $CPAN::Frontend->mywarn
+                        ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
+                }
+            }
+        } else {
+            $pack->{reqtype} = $self->{reqtype};
+        }
+
     eval {
        $pack->$meth();
     };
@@ -7484,10 +7511,11 @@ perl breaks binary compatibility. If one of the modules that CPAN uses
 is in turn depending on binary compatibility (so you cannot run CPAN
 commands), then you should try the CPAN::Nox module for recovery.
 
-=head2 upgrade
+=head2 upgrade [Module|/Regex/]...
 
-The C<upgrade> command first runs an C<r> command and then installs
-the newest versions of all modules that were listed by that.
+The C<upgrade> command first runs an C<r> command with the given
+arguments and then installs the newest versions of all modules that
+were listed by that.
 
 =head2 mkmyconfig
 
@@ -8175,6 +8203,9 @@ defined:
 
   build_cache        size of cache for directories to build modules
   build_dir          locally accessible directory to build modules
+  build_requires_install_policy
+                     to install or not to install: when a module is
+                     only needed for building. yes|no|ask/yes|ask/no
   bzip2              path to external prg
   cache_metadata     use serializer to cache metadata
   commands_quote     prefered character to use for quoting external
index 47c9a20..211cac7 100644 (file)
@@ -2,7 +2,7 @@ package CPAN::Debug;
 use strict;
 use vars qw($VERSION);
 
-$VERSION = sprintf "%.6f", substr(q$Rev: 844 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 924 $,4)/1000000 + 5.4;
 # module is internal to CPAN.pm
 
 %CPAN::DEBUG = qw[
@@ -55,6 +55,7 @@ sub debug {
 1;
 
 __END__
+
 =head1 LICENSE
 
 This program is free software; you can redistribute it and/or
index 9173349..692f6c9 100644 (file)
@@ -1,8 +1,6 @@
 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
 package CPAN::Mirrored::By;
 use strict;
-use vars qw($VERSION);
-$VERSION = sprintf "%.6f", substr(q$Rev: 879 $,4)/1000000 + 5.4;
 
 sub new { 
     my($self,@arg) = @_;
@@ -13,15 +11,15 @@ sub country { shift->[1] }
 sub url { shift->[2] }
 
 package CPAN::FirstTime;
-
 use strict;
+
 use ExtUtils::MakeMaker ();
 use FileHandle ();
 use File::Basename ();
 use File::Path ();
 use File::Spec;
 use vars qw($VERSION $urllist);
-$VERSION = sprintf "%.6f", substr(q$Rev: 879 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 924 $,4)/1000000 + 5.4;
 
 =head1 NAME
 
@@ -249,6 +247,13 @@ Shall we use it as the general CPAN build and cache directory?
                        'follow|ask|ignore');
     }
 
+    if (!$matcher or 'build_requires_install_policy' =~ /$matcher/){
+        $CPAN::Frontend->myprint($prompts{build_requires_install_policy_intro});
+
+        my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher,
+                       'yes|no|ask/yes|ask/no');
+    }
+
     #
     #= Module::Signature
     #
@@ -1319,6 +1324,26 @@ colorize_print => qq{Color for normal output?},
 
 colorize_warn => qq{Color for warnings?},
 
+build_requires_install_policy_intro => qq{
+
+When a module declares another one as a 'build_requires' prerequisite
+this means that the other module is only needed for building or
+testing the module but need not be installed permanently. In this case
+you may wish to install that other module nonetheless or just keep it
+in the 'build_dir' directory to have it available only temporarily.
+Installing saves time on future installations but makes the perl
+installation bigger.
+
+You can choose if you want to always install (yes), never install (no)
+or be always asked. In the latter case you can set the default answer
+for the question to yes (ask/yes) or no (ask/no).
+
+},
+
+build_requires_install_policy =>
+qq{Policy on installing 'build_requires' modules (yes, no, ask/yes,
+ask/no)?},
+
 );
 
 die "Coding error in \@prompts declaration.  Odd number of elements, above"
index f97bb70..dbf2fb3 100644 (file)
@@ -2,7 +2,7 @@ package CPAN::HandleConfig;
 use strict;
 use vars qw(%can %keys $VERSION);
 
-$VERSION = sprintf "%.6f", substr(q$Rev: 847 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 916 $,4)/1000000 + 5.4;
 
 %can = (
         commit   => "Commit changes to disk",
@@ -15,6 +15,7 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 847 $,4)/1000000 + 5.4;
                              #  allow_unauthenticated ?? some day...
                              "build_cache",
                              "build_dir",
+                             "build_requires_install_policy",
                              "bzip2",
                              "cache_metadata",
                              "check_sigs",
@@ -579,7 +580,7 @@ package
 
 use strict;
 use vars qw($AUTOLOAD $VERSION);
-$VERSION = sprintf "%.2f", substr(q$Rev: 847 $,4)/100;
+$VERSION = sprintf "%.2f", substr(q$Rev: 916 $,4)/100;
 
 # formerly CPAN::HandleConfig was known as CPAN::Config
 sub AUTOLOAD {
diff --git a/lib/CPAN/Queue.pm b/lib/CPAN/Queue.pm
new file mode 100644 (file)
index 0000000..0087b0c
--- /dev/null
@@ -0,0 +1,165 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+package CPAN::Queue;
+use strict;
+
+# One use of the queue is to determine if we should or shouldn't
+# announce the availability of a new CPAN module
+
+# Now we try to use it for dependency tracking. For that to happen
+# we need to draw a dependency tree and do the leaves first. This can
+# easily be reached by running CPAN.pm recursively, but we don't want
+# to waste memory and run into deep recursion. So what we can do is
+# this:
+
+# CPAN::Queue is the package where the queue is maintained. Dependencies
+# often have high priority and must be brought to the head of the queue,
+# possibly by jumping the queue if they are already there. My first code
+# attempt tried to be extremely correct. Whenever a module needed
+# immediate treatment, I either unshifted it to the front of the queue,
+# or, if it was already in the queue, I spliced and let it bypass the
+# others. This became a too correct model that made it impossible to put
+# an item more than once into the queue. Why would you need that? Well,
+# you need temporary duplicates as the manager of the queue is a loop
+# that
+#
+#  (1) looks at the first item in the queue without shifting it off
+#
+#  (2) cares for the item
+#
+#  (3) removes the item from the queue, *even if its agenda failed and
+#      even if the item isn't the first in the queue anymore* (that way
+#      protecting against never ending queues)
+#
+# So if an item has prerequisites, the installation fails now, but we
+# want to retry later. That's easy if we have it twice in the queue.
+#
+# I also expect insane dependency situations where an item gets more
+# than two lives in the queue. Simplest example is triggered by 'install
+# Foo Foo Foo'. People make this kind of mistakes and I don't want to
+# get in the way. I wanted the queue manager to be a dumb servant, not
+# one that knows everything.
+#
+# Who would I tell in this model that the user wants to be asked before
+# processing? I can't attach that information to the module object,
+# because not modules are installed but distributions. So I'd have to
+# tell the distribution object that it should ask the user before
+# processing. Where would the question be triggered then? Most probably
+# in CPAN::Distribution::rematein.
+# Hope that makes sense, my head is a bit off:-) -- AK
+
+use vars qw{ @All $VERSION };
+$VERSION = sprintf "%.6f", substr(q$Rev: 922 $,4)/1000000 + 5.4;
+
+# CPAN::Queue::new ;
+sub new {
+  my($class,@attr) = @_;
+  my $self = bless { @attr }, $class;
+  push @All, $self;
+  CPAN->debug(sprintf("in new All[%s]",
+                      join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All),
+                     )) if $CPAN::DEBUG;
+  return $self;
+}
+
+# CPAN::Queue::first ;
+sub first {
+  my $obj = $All[0];
+  $obj;
+}
+
+sub as_string {
+  my($self) = @_;
+  $self->{qmod};
+}
+
+# r => requires, b => build_requires, c => commandline
+sub reqtype {
+  my($self) = @_;
+  $self->{reqtype};
+}
+
+# CPAN::Queue::delete_first ;
+sub delete_first {
+  my($class,$what) = @_;
+  my $i;
+  for my $i (0..$#All) {
+    if (  $All[$i]->{qmod} eq $what ) {
+      splice @All, $i, 1;
+      return;
+    }
+  }
+}
+
+# CPAN::Queue::jumpqueue ;
+sub jumpqueue {
+    my $class = shift;
+    my @what = @_;
+    CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
+                        join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All),
+                        join("",map {sprintf " %s\[%s]",$_->[0],$_->[1]} @what)
+                       )) if $CPAN::DEBUG;
+    my $inherit_reqtype = $what[0][1] =~ /^(c|r)$/ ? "r" : "b";
+  WHAT: for my $what_tuple (@what) {
+        my($what,$reqtype) = @$what_tuple;
+        if ($reqtype eq "r"
+            &&
+            $inherit_reqtype eq "b"
+           ) {
+            $reqtype = "b";
+        }
+        my $jumped = 0;
+        for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
+            # CPAN->debug("i[$i]this[$All[$i]{qmod}]what[$what]") if $CPAN::DEBUG;
+            if ($All[$i]{qmod} eq $what){
+                $jumped++;
+                if ($jumped > 100) { # one's OK if e.g. just
+                                     # processing now; more are OK if
+                                     # user typed it several times
+                    $CPAN::Frontend->mywarn(
+qq{Object [$what] queued more than 100 times, ignoring}
+                                );
+                    next WHAT;
+                }
+            }
+        }
+        my $obj = bless {
+                         qmod => $what,
+                         reqtype => $reqtype
+                        }, $class;
+        unshift @All, $obj;
+    }
+    CPAN->debug(sprintf("after jumpqueue All[%s]",
+                        join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All)
+                       )) if $CPAN::DEBUG;
+}
+
+# CPAN::Queue::exists ;
+sub exists {
+  my($self,$what) = @_;
+  my @all = map { $_->{qmod} } @All;
+  my $exists = grep { $_->{qmod} eq $what } @All;
+  # warn "in exists what[$what] all[@all] exists[$exists]";
+  $exists;
+}
+
+# CPAN::Queue::delete ;
+sub delete {
+  my($self,$mod) = @_;
+  @All = grep { $_->{qmod} ne $mod } @All;
+}
+
+# CPAN::Queue::nullify_queue ;
+sub nullify_queue {
+  @All = ();
+}
+
+1;
+
+__END__
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
index 66583be..7f92b91 100644 (file)
@@ -14,65 +14,65 @@ not run its Makefile.PL or Build.PL.
 -----BEGIN PGP SIGNED MESSAGE-----
 Hash: SHA1
 
-SHA1 53572d7d908d436595023a605cb71a7cef4a4d3b ChangeLog
+SHA1 df3675a6257436492a9814131634527fdb70e5e7 ChangeLog
 SHA1 9b97524a7a91c815e46b19302a33829d3c26bbbf ChangeLog.old
-SHA1 6317b96f33296dc730e29c6dfd31f3bac9892dae Changes
+SHA1 f39dfe02e639d88d99074720b0369015cb21c25d Changes
 SHA1 a029ffa2f2252bb8914eb658666244710994d256 Changes.old
-SHA1 da26a42af413fe2a87b6023ff03e800a399ae306 MANIFEST
-SHA1 d6facfb968686d74e249cc1e45463e61ff18d026 MANIFEST.SKIP
-SHA1 679b0f527622b11b762bd33943a7caa4cf170da3 META.yml
-SHA1 64ba3f2a3bd7fba22ff64028805e1ef7452b8a19 Makefile.PL
+SHA1 bcac708d887442591ac400c72a6be0629f416434 MANIFEST
+SHA1 159c257eb8d294fa6e0612fda7edcad948ab0362 MANIFEST.SKIP
+SHA1 c2d3c4831d1fbbbb247e11cb60d0c7d97adfce85 META.yml
+SHA1 f428cf9c8f7206fe115a1f42e13da5999452d075 Makefile.PL
 SHA1 37e858c51409a297ef5d3fb35dc57cd3b57f9a4d PAUSE2003.pub
 SHA1 af016003ad503ed078c5f8254521d13a3e0c494f PAUSE2005.pub
-SHA1 97f6ee57e6176480d86684b3edf7211dad9db822 README
-SHA1 6193cb7204ce1853d414ba3703521332dadce8bd Todo
+SHA1 f5960fd434593768d500b03f0abfa48d86d39914 README
+SHA1 92c57d89defe2d11ca6bf4b922d90f5bb7e32f25 Todo
 SHA1 efbe8e6882a2caa0d741b113959a706830ab5882 inc/Test/Builder.pm
 SHA1 ae1d68262bedc2475e2c6fd478d99b259b4fb109 inc/Test/More.pm
-SHA1 f8d74d9fde300434f06dc4e765f52321ad502f59 lib/CPAN.pm
+SHA1 3dd7f7792ab2f398d2aea3c051ab52d93bd603bc lib/CPAN.pm
 SHA1 e093af1fcd72420fe4bdc85a5bec2b92a301ab97 lib/CPAN/Admin.pm
-SHA1 32e2db285ecb303ed825193d9273fd306d801482 lib/CPAN/Debug.pm
-SHA1 b898f54ac98dcc712e052551e8c8dbd912cd2e91 lib/CPAN/FirstTime.pm
-SHA1 898d6e7a18dc24db32b8b3c38248fd673349089d lib/CPAN/HandleConfig.pm
+SHA1 91ed95706f4e8cc36bb646467256de455007cd2d lib/CPAN/Debug.pm
+SHA1 9af992904cb4445c306ecf8f7675478865f66c1e lib/CPAN/FirstTime.pm
+SHA1 056a2a7fba83e3aa9c812048fe1757d808a43882 lib/CPAN/HandleConfig.pm
 SHA1 17a1ad839531642ace9bf198bf52964c252f3318 lib/CPAN/Nox.pm
-SHA1 c606ab2b7e18287c9e23fc4dbfbf224734e984ba lib/CPAN/Tarzip.pm
+SHA1 4992722f9e21d4c8f450cf96887b1e82f628b66c lib/CPAN/Queue.pm
+SHA1 977be9f262b7a98699c00929af2eddf8793fd1d0 lib/CPAN/Tarzip.pm
 SHA1 04a0f916787adc090aa4c1423419629370e9357f lib/CPAN/Version.pm
 SHA1 fb08e07d8740ef36e8ab719c6a9b7e89c4fe674a scripts/cpan
 SHA1 2a3adebb8252dc893681d17460082c2e08aa144a t/00signature.t
 SHA1 215dace24b507de20011d36cbe2d16ddea78bcf3 t/01loadme.t
 SHA1 67e80e1cfc3530932de7743dd0c833b2c387609d t/02nox.t
-SHA1 b586d8e1a613880bbd2ec68d3abd0ca21e43b0c2 t/03pkgs.t
+SHA1 deb594e0f60aa9c40706f117198ca202cb424b46 t/03pkgs.t
 SHA1 ebdb653877d5c5e5a071fe9933b18f018cde3250 t/10version.t
 SHA1 325d8a2f72d59c4cd2400c72403c05cd614c3abc t/11mirroredby.t
 SHA1 7696ade95e8c4943a3e3e6a13c03c450cec8d030 t/12cpan.t
-SHA1 fa075e989a5923e73684d13d5e94baa0711bb360 t/30shell.pod
-SHA1 0e473540c2770599b6d29b447f8dfc4654fe2be1 t/30shell.t
+SHA1 fa075e989a5923e73684d13d5e94baa0711bb360 t/30shell.coverage
+SHA1 3d2f626c0a5c86bd0c3fa61aece5ee2700554758 t/30shell.t
 SHA1 6a79f15a10337bd3450604abf39d4462df2a550b t/50pod.t
-SHA1 15571553f41c5a709ab0901c17a713f8792c1e59 t/51pod.t
-SHA1 0890cfccb8d1d026a7f142df290ac5b4e64f5e56 t/52podcover.t
+SHA1 6c194eb30cce245737fe5e1a35118ed78abae0d1 t/51pod.t
+SHA1 c98f4c2aa680bb0e88569f6ab4a9ca4e8deb5c1e t/52podcover.t
 SHA1 413dd29cf8968e69292a2d652e0e0496a8137a01 t/60credentials.t
 SHA1 7efe930efd0a07d8101679ed15d4700dcf208137 t/CPAN/CpanTestDummies-1.55.pm
 SHA1 310b5562df76ff28ab05d741e144d84fb5b5369b t/CPAN/TestConfig.pm
 SHA1 081ed556ae14a75c43ca31e67cfc99d180c9ef41 t/CPAN/TestMirroredBy
 SHA1 b4fd27234696da334ac6a1716222c70610a98c3a t/CPAN/authors/01mailrc.txt
-SHA1 61f6dbc7e5616028952b07a0451e029d41993bb6 t/CPAN/authors/id/A/AN/ANDK/CHECKSUMS
+SHA1 fa94efff2de87bf316ff21c2f972355d2d966b0c t/CPAN/authors/id/A/AN/ANDK/CHECKSUMS
 SHA1 d1a101f24d2d0719c9991df28ede729d58005bb4 t/CPAN/authors/id/A/AN/ANDK/CHECKSUMS@588
-SHA1 3bafbff953a645fccf54e505a71ef711ba895522 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-1.01.tar.gz
+SHA1 f02f801c427f4efa21a7a86433aa0d4a8a45e35d t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-1.02.tar.gz
 SHA1 11f35aa730e452797f5d7371a393e24e40ea8d21 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-Fails-1.01.tar.gz
 SHA1 c0587c6180bd979acfa2b2396688208793366ff5 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-BuildOrMake-1.01.tar.gz
-SHA1 d48f389c1710e44c88a275935d036145860bf5d3 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-1.02.tar.gz
+SHA1 ab7949c878bee53584fcaa280ce7e173bcccd55e t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-1.03.tar.gz
 SHA1 3dc672ec2542810513b26e306a6545bfee069654 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Failearly-1.01.tar.gz
-SHA1 1883e4297cf678df8171929d157efd6815b9c9b1 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Zip-1.01.zip
+SHA1 ebf211b8f5907f9f008abbc756cb0b5a962b9395 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Make-Zip-1.02.zip
 SHA1 541ac9311d4dbabe9bb99d770b221456798be688 t/CPAN/authors/id/A/AN/ANDK/NotInChecksums-0.000.tar.gz
 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 468603b8016e599fec432e807890fb55f07483a6 t/CPAN/modules/02packages.details.txt
+SHA1 3287515f4ddfccd586ddd23a0929f0298a505d67 t/CPAN/modules/02packages.details.txt
 SHA1 f4c1a524de16347b37df6427ca01f98dd27f3c81 t/CPAN/modules/03modlist.data
-SHA1 7336c3b0b4cd33505e02a11c5a09c3c35fe7bc32 t/README.shell.txt
 -----BEGIN PGP SIGNATURE-----
 Version: GnuPG v1.4.5 (GNU/Linux)
 
-iD8DBQFFC9lV7IA58KMXwV0RArjxAJ4p06+APj/p8NKzkPJ4J2ZoJyxrmwCbBxy8
-k8M2zkICjnWa0aAd0Dzmjv0=
-=7ggs
+iD8DBQFFHkh17IA58KMXwV0RAhAOAKChWUfDPZJw1dyRBP5Rnn4ik05kVQCePcSo
+MjOwJh97fgDAK9m6gDfYA/k=
+=oz7x
 -----END PGP SIGNATURE-----
index aad03c6..5848c73 100644 (file)
@@ -2,10 +2,11 @@
 
 use strict;
 eval 'use warnings';
+use lib "lib";
 
 my @m;
 if ($ENV{PERL_CORE}){
-  @m = ("CPAN", map { "CPAN::$_" } qw(Debug FirstTime Nox Tarzip Version));
+  @m = ("CPAN", map { "CPAN::$_" } qw(Debug FirstTime Nox Queue Tarzip Version));
 } else {
   opendir DH, "lib/CPAN" or die;
   @m = ("CPAN", map { "CPAN::$_" } grep { s/\.pm$// } readdir DH);
@@ -17,7 +18,7 @@ plan(tests => scalar @m);
 for my $m (@m) {
   local $^W = 0;
   eval "require $m";
-  ok($m->VERSION >= 1.76, sprintf "%20s: %s", $m, $m->VERSION);
+  ok($m->VERSION >= 1.76, sprintf "Found version > 1.76 for %20s: %s", $m, $m->VERSION);
 }
 
 # Local Variables: