Refresh CPAN.pm to 1.21

diff --git a/lib/CPAN.pm b/lib/CPAN.pm
index 2a5ef29..08246f7 100644 (file)
--- a/lib/CPAN.pm
+++ b/lib/CPAN.pm
@@ -1,11 +1,11 @@
 package CPAN;
 use vars qw{$META $Signal $Cwd $End $Suppress_readline};
 
-$VERSION = '1.19';
+$VERSION = '1.21';
 
-# $Id: CPAN.pm,v 1.121 1997/02/03 09:08:23 k Exp $
+# $Id: CPAN.pm,v 1.127 1997/02/11 06:23:10 k Exp $
 
-# my $version = substr q$Revision: 1.121 $, 10; # only used during development
+# my $version = substr q$Revision: 1.127 $, 10; # only used during development
 
 use Carp ();
 use Config ();
@@ -56,8 +56,6 @@ use strict qw(vars);
 $META ||= new CPAN;                 # In case we reeval ourselves we
                                     # need a ||
 
-CPAN::Config->load unless defined $CPAN::No_Config_is_ok;
-
 @EXPORT = qw( 
             autobundle bundle expand force get
             install make readme recompile shell test clean
@@ -234,7 +232,7 @@ sub hasMD5 {
        eval {require MD5;};
        if ($@) {
            print "MD5 security checks disabled because MD5 not installed.
-  Please consider installing MD5\n";
+  Please consider installing the MD5 module\n";
            $self->{'hasMD5'} = 0;
        } else {
            $self->{'hasMD5'}++;
@@ -297,7 +295,7 @@ sub shell {
     local($^W) = 1;
     unless ($Suppress_readline) {
        require Term::ReadLine;
-       import Term::ReadLine;
+#      import Term::ReadLine;
        $term = new Term::ReadLine 'CPAN Monitor';
        $readline::rl_completion_function =
            $readline::rl_completion_function = 'CPAN::Complete::complete';
@@ -322,7 +320,7 @@ Readline support $rl_avail
            last unless defined ($_ = <>);
            chomp;
        } else {
-#           if ($CPAN::DEBUG) {
+#           if (defined($CPAN::ANDK) && $CPAN::DEBUG) { # !$CPAN::ANDK++;$CPAN::DEBUG=1024
 #               my($report,$item);
 #               $report = "";
 #               for $item (qw/ReadLine IN OUT MinLine findConsole Features/) {
@@ -330,8 +328,9 @@ Readline support $rl_avail
 #                   $report .= $term->$item() || "";
 #                   $report .= "\n";
 #               }
-#               CPAN->debug($report);
-#           }
+#               print $report;
+#              CPAN->debug($report);
+#          }
            last unless defined ($_ = $term->readline($prompt));
        }
        s/^\s//;
@@ -782,7 +781,7 @@ sub AUTOLOAD {
            CPAN::WAIT->wh;
            return;
        } else {
-           warn qq{
+           print STDERR qq{
 Commands starting with "w" require CPAN::WAIT to be installed.
 Please consider installing CPAN::WAIT to use the fulltext index.
 Type "install CPAN::WAIT" and restart CPAN.pm.
@@ -917,11 +916,13 @@ sub o {
                    }
                    $CPAN::DEBUG = $max;
                } else {
+                   my($known) = 0;
                    for (keys %CPAN::DEBUG) {
                        next unless lc($_) eq lc($what);
                        $CPAN::DEBUG |= $CPAN::DEBUG{$_};
+                       $known = 1;
                    }
-                   print "unknown argument [$what]\n";
+                   print "unknown argument [$what]\n" unless $known;
                }
            }
        } else {
@@ -951,7 +952,10 @@ Known options:
 
 #-> sub CPAN::Shell::reload ;
 sub reload {
-    if ($_[1] =~ /cpan/i) {
+    my($self,$command,@arg) = @_;
+    $command ||= "";
+    $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
+    if ($command =~ /cpan/i) {
        CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
        my $fh = FileHandle->new($INC{'CPAN.pm'});
        local($/);
@@ -970,8 +974,11 @@ sub reload {
        eval <$fh>;
        warn $@ if $@;
        print "\n$redef subroutines redefined\n";
-    } elsif ($_[1] =~ /index/) {
+    } elsif ($command =~ /index/) {
        CPAN::Index->force_reload;
+    } else {
+       print qq{cpan     re-evals the CPAN.pm file\n};
+       print qq{index    re-reads the index files\n};
     }
 }
 
@@ -1361,7 +1368,7 @@ sub localize {
            return $l if -f $l && -r _;
            # Maybe mirror has compressed it?
            if (-f "$l.gz") {
-               $self->debug("found compressed $l.gz");
+               $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
                system("$CPAN::Config->{gzip} -dc $l.gz > $aslocal");
                return $aslocal if -f $aslocal;
            }
@@ -1596,7 +1603,7 @@ sub new {
                my($t) = shift @tokens;
                if ($t eq "default"){
                    $hasdefault++;
-                   warn "saw a default entry before tokens[@tokens]";
+                   # warn "saw a default entry before tokens[@tokens]";
                    last NETRC;
                }
                last TOKEN if $t eq "macdef";
@@ -1779,7 +1786,7 @@ sub reload_x {
 sub read_authindex {
     my($cl,$index_target) = @_;
     my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
-    warn "Going to read $index_target\n";
+    print "Going to read $index_target\n";
     my $fh = FileHandle->new("$pipe|");
     while (<$fh>) {
        chomp;
@@ -1799,7 +1806,7 @@ sub read_authindex {
 sub read_modpacks {
     my($cl,$index_target) = @_;
     my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
-    warn "Going to read $index_target\n";
+    print "Going to read $index_target\n";
     my $fh = FileHandle->new("$pipe|");
     while (<$fh>) {
        next if 1../^\s*$/;
@@ -1868,15 +1875,15 @@ sub read_modpacks {
 sub read_modlist {
     my($cl,$index_target) = @_;
     my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
-    warn "Going to read $index_target\n";
+    print "Going to read $index_target\n";
     my $fh = FileHandle->new("$pipe|");
-    my $eval = "";
+    my $eval;
     while (<$fh>) {
-       next if 1../^\s*$/;
-       next if /use vars/; # will go away in 03...
-       $eval .= $_;
-       return if $CPAN::Signal;
+       last if /^\s*$/;
     }
+    local($/) = undef;
+    $eval = <$fh>;
+    $fh->close;
     $eval .= q{CPAN::Modulelist->data;};
     local($^W) = 0;
     my($comp) = Safe->new("CPAN::Safe1");
@@ -2278,6 +2285,27 @@ sub force {
     delete $self->{'writemakefile'};
 }
 
+#-> sub CPAN::Distribution::perl ;
+sub perl {
+    my($self) = @_;
+    my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
+    $perl ||= "$CPAN::Cwd/$^X" if -x "$CPAN::Cwd/$^X";
+    unless ($perl) {
+       my ($component,$perl_name);
+      DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
+           PATH_COMPONENT: foreach $component (MM->path(), $Config::Config{'binexp'}) {
+                 next unless defined($component) && $component;
+                 my($abs) = MM->catfile($component,$perl_name);
+                 if (MM->maybe_command($abs)) {
+                     $perl = $abs;
+                     last DIST_PERLNAME;
+                 }
+             }
+         }
+    }
+    $perl;
+}
+
 #-> sub CPAN::Distribution::make ;
 sub make {
     my($self) = @_;
@@ -2289,7 +2317,7 @@ sub make {
        $self->{archived} eq "NO" and push @e,
        "Is neither a tar nor a zip archive.";
 
-       $self->{unwrapped} eq "NO"   and push @e,
+       $self->{unwrapped} eq "NO" and push @e,
        "had problems unarchiving. Please build manually";
 
        exists $self->{writemakefile} &&
@@ -2310,24 +2338,14 @@ sub make {
     if ($self->{'configure'}) {
        $system = $self->{'configure'};
     } else {
-       my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
-       $perl ||= "$CPAN::Cwd/$^X" if -x "$CPAN::Cwd/$^X";
-       unless ($perl) {
-           my ($component,$perl_name);
-           DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
-                 DIST_COMPONENT: foreach $component (MM->path(), $Config::Config{'binexp'}) {
-                       next unless defined($component) && $component;
-                       my($abs) = MM->catfile($component,$perl_name);
-                       if (MM->maybe_command($abs)) {
-                           $perl = $abs;
-                           last DIST_PERLNAME;
-                       }
-                   }
-               }
-       }
-       die "Couldn\'t find executable perl\n" unless $perl;
-       $system = "$perl Makefile.PL $CPAN::Config->{makepl_arg}";
-   }
+       my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
+       my $switch = "";
+# This needs a handler that can be turned on or off:
+#      $switch = "-MExtUtils::MakeMaker ".
+#          "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
+#          if $] > 5.00310;
+       $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
+    }
     $SIG{ALRM} = sub { die "inactivity_timeout reached\n" };
     my($ret,$pid);
     $@ = "";
@@ -2442,6 +2460,11 @@ sub install {
            $self->{'make'} eq 'NO' and
                push @e, "Oops, make had returned bad status";
 
+       push @e, "make test had returned bad status, won't install without force"
+           if exists $self->{'make_test'} and
+           $self->{'make_test'} eq 'NO' and
+           ! $self->{'force_update'};
+
        exists $self->{'install'} and push @e,
        $self->{'install'} eq "YES" ?
            "Already done" : "Already tried without success";
@@ -2511,6 +2534,7 @@ sub contains {
     local $/ = "\n";
     open($fh,$parsefile) or die "Could not open '$parsefile': $!";
     my $inpod = 0;
+    $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
     while (<$fh>) {
        $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod;
        next unless $inpod;
@@ -2521,7 +2545,8 @@ sub contains {
     }
     close $fh;
     delete $self->{STATUS};
-    $self->{CONTAINS} = [@result];
+    $self->{CONTAINS} = join ", ", @result;
+    $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
     @result;
 }
 
@@ -2532,9 +2557,10 @@ sub inst_file {
     ($me = $self->id) =~ s/.*://;
     $inst_file = $CPAN::META->catfile($CPAN::Config->{'cpan_home'},"Bundle", "$me.pm");
     return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
-    $inst_file = $self->SUPER::inst_file;
-    return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
-    return $self->{'INST_FILE'}; # even if undefined?
+#    $inst_file = 
+    $self->SUPER::inst_file;
+#    return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
+#    return $self->{'INST_FILE'}; # even if undefined?
 }
 
 #-> sub CPAN::Bundle::rematein ;
@@ -2652,7 +2678,10 @@ sub as_string {
        close $fh;
        $self->{MANPAGE} = join " ", @result;
     }
-    push @m, sprintf $sprintf, 'MANPAGE', $self->{MANPAGE} if $self->{MANPAGE};
+    my($item);
+    for $item (qw/MANPAGE CONTAINS/) {
+       push @m, sprintf $sprintf, $item, $self->{$item} if exists $self->{$item};
+    }
     push @m, sprintf $sprintf, 'INST_FILE', $local_file || "(not installed)";
     push @m, sprintf $sprintf, 'INST_VERSION', $self->inst_version if $local_file;
     join "", @m, "\n";
@@ -2742,6 +2771,7 @@ sub inst_file {
            return $pmfile;
        }
     }
+    return;
 }
 
 #-> sub CPAN::Module::xs_file ;
@@ -2757,6 +2787,7 @@ sub xs_file {
            return $xsfile;
        }
     }
+    return;
 }
 
 #-> sub CPAN::Module::inst_version ;
@@ -2771,6 +2802,9 @@ sub inst_version {
     $have;
 }
 
+# Do this after you have set up the whole inheritance
+CPAN::Config->load unless defined $CPAN::No_Config_is_ok;
+
 1;
 
 =head1 NAME

diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm
index 3127a5e..c996a1c 100644 (file)
--- a/lib/CPAN/FirstTime.pm
+++ b/lib/CPAN/FirstTime.pm
@@ -15,7 +15,7 @@ use ExtUtils::MakeMaker qw(prompt);
 use FileHandle ();
 use File::Path ();
 use vars qw($VERSION);
-$VERSION = substr q$Revision: 1.15 $, 10;
+$VERSION = substr q$Revision: 1.16 $, 10;
 
 =head1 NAME
 
@@ -231,17 +231,18 @@ Testing "$input" ...
        }
     }
 
-    print qq{
+    unless (@{$CPAN::Config->{'wait_list'}||[]}) {
+       print qq{
 
 WAIT support is available as a Plugin. You need the CPAN::WAIT module
 to actually use it.  But we need to know your favorite WAIT server. If
 you don\'t know a WAIT server near you, just press ENTER.
 
 };
-
-    $default = "wait://ls6.informatik.uni-dortmund.de:1404";
-    $ans = prompt("Your favorite WAIT server?\n  ",$default);
-    push @{$CPAN::Config->{'wait_list'}}, $ans;
+       $default = "wait://ls6.informatik.uni-dortmund.de:1404";
+       $ans = prompt("Your favorite WAIT server?\n  ",$default);
+       push @{$CPAN::Config->{'wait_list'}}, $ans;
+    }
 
     print qq{
 
@@ -324,8 +325,8 @@ file:, ftp: or http: URL, or "q" to finish selecting.
     $ans = $other = "";
     my(%seen);
     
+    my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
     while () {
-       my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
        my(@valid,$previous_best);
        my $fh = FileHandle->new;
        $fh->open($pipe);
@@ -351,6 +352,7 @@ file:, ftp: or http: URL, or "q" to finish selecting.
                }
            }
        }
+       $fh->close;
        $previous_best ||= 1;
        $default =
            @{$CPAN::Config->{urllist}} >= $expected_size ? "q" : $previous_best;

diff --git a/lib/CPAN/Nox.pm b/lib/CPAN/Nox.pm
index b0b70fe..dc56197 100644 (file)
--- a/lib/CPAN/Nox.pm
+++ b/lib/CPAN/Nox.pm
@@ -1,4 +1,4 @@
-BEGIN{$CPAN::Suppress_readline++;}
+BEGIN{$CPAN::Suppress_readline=1 unless defined $CPAN::term;}
 
 use CPAN;