Refresh CPAN.pm to 1.21

3 files changed, 92 insertions, 56 deletions

diff --git a/lib/CPAN.pm b/lib/CPAN.pm
index 2a5ef29cd2..08246f7246 100644
--- 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 3127a5e32a..c996a1cfbb 100644
--- 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 b0b70fec04..dc561977c4 100644
--- 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;