From: Andreas Koenig Date: Mon, 17 Feb 1997 05:59:13 +0000 (+1200) Subject: Refresh CPAN.pm to 1.21 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d4fd5c69aa67ee57d4d0286857bcd78a0847cbe3;p=p5sagit%2Fp5-mst-13.2.git Refresh CPAN.pm to 1.21 --- diff --git a/lib/CPAN.pm b/lib/CPAN.pm index 2a5ef29..08246f7 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 3127a5e..c996a1c 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 b0b70fe..dc56197 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;