# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
package CPAN;
-$VERSION = '1.59_51';
-# $Id: CPAN.pm,v 1.381 2000/12/01 08:13:05 k Exp $
+$VERSION = '1.76_01';
+$VERSION = eval $VERSION;
+# $Id: CPAN.pm,v 1.412 2003/07/31 14:53:04 k Exp $
# only used during development:
$Revision = "";
-# $Revision = "[".substr(q$Revision: 1.381 $, 10)."]";
+# $Revision = "[".substr(q$Revision: 1.412 $, 10)."]";
use Carp ();
use Config ();
use Text::ParseWords ();
use Text::Wrap;
use File::Spec;
+use Sys::Hostname;
no lib "."; # we need to run chdir all over and we would get at wrong
# libraries there
+require Mac::BuildTools if $^O eq 'MacOS';
+
END { $End++; &cleanup; }
%CPAN::DEBUG = qw[
$readline::rl_completion_function =
$readline::rl_completion_function = 'CPAN::Complete::cpl';
}
+ if (my $histfile = $CPAN::Config->{'histfile'}) {{
+ unless ($term->can("AddHistory")) {
+ $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
+ last;
+ }
+ my($fh) = FileHandle->new;
+ open $fh, "<$histfile" or last;
+ local $/ = "\n";
+ while (<$fh>) {
+ chomp;
+ $term->AddHistory($_);
+ }
+ close $fh;
+ }}
# $term->OUT is autoflushed anyway
my $odef = select STDERR;
$| = 1;
use vars qw($Ua $Thesite $Themethod);
@CPAN::FTP::ISA = qw(CPAN::Debug);
+package CPAN::LWP::UserAgent;
+use vars qw(@ISA $USER $PASSWD $SETUPDONE);
+# we delay requiring LWP::UserAgent and setting up inheritence until we need it
+
package CPAN::Complete;
@CPAN::Complete::ISA = qw(CPAN::Debug);
@CPAN::Complete::COMMANDS = sort qw(
) unless @CPAN::Complete::COMMANDS;
package CPAN::Index;
-use vars qw($last_time $date_of_03);
+use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03);
@CPAN::Index::ISA = qw(CPAN::Debug);
-$last_time ||= 0;
-$date_of_03 ||= 0;
+$LAST_TIME ||= 0;
+$DATE_OF_03 ||= 0;
# use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
sub PROTOCOL { 2.0 }
package CPAN::Module;
@CPAN::Module::ISA = qw(CPAN::InfoObj);
+package CPAN::Exception::RecursiveDependency;
+use overload '""' => "as_string";
+
+sub new {
+ my($class) = shift;
+ my($deps) = shift;
+ my @deps;
+ my %seen;
+ for my $dep (@$deps) {
+ push @deps, $dep;
+ last if $seen{$dep}++;
+ }
+ bless { deps => \@deps }, $class;
+}
+
+sub as_string {
+ my($self) = shift;
+ "\nRecursive dependency detected:\n " .
+ join("\n => ", @{$self->{deps}}) .
+ ".\nCannot continue.\n";
+}
+
package CPAN::Shell;
use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY $PRINT_ORNAMENTING);
@CPAN::Shell::ISA = qw(CPAN::Debug);
#-> sub CPAN::checklock ;
sub checklock {
my($self) = @_;
- my $lockfile = MM->catfile($CPAN::Config->{cpan_home},".lock");
+ my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
if (-f $lockfile && -M _ > 0) {
my $fh = FileHandle->new($lockfile) or
$CPAN::Frontend->mydie("Could not open $lockfile: $!");
- my $other = <$fh>;
+ my $otherpid = <$fh>;
+ my $otherhost = <$fh>;
$fh->close;
- if (defined $other && $other) {
- chomp $other;
- return if $$==$other; # should never happen
+ if (defined $otherpid && $otherpid) {
+ chomp $otherpid;
+ }
+ if (defined $otherhost && $otherhost) {
+ chomp $otherhost;
+ }
+ my $thishost = hostname();
+ if (defined $otherhost && defined $thishost &&
+ $otherhost ne '' && $thishost ne '' &&
+ $otherhost ne $thishost) {
+ $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile $lockfile\n".
+ "reports other host $otherhost and other process $otherpid.\n".
+ "Cannot proceed.\n"));
+ }
+ elsif (defined $otherpid && $otherpid) {
+ return if $$ == $otherpid; # should never happen
$CPAN::Frontend->mywarn(
qq{
-There seems to be running another CPAN process ($other). Contacting...
+There seems to be running another CPAN process (pid $otherpid). Contacting...
});
- if (kill 0, $other) {
+ if (kill 0, $otherpid) {
$CPAN::Frontend->mydie(qq{Other job is running.
You may want to kill it and delete the lockfile, maybe. On UNIX try:
- kill $other
+ kill $otherpid
rm $lockfile
});
} elsif (-w $lockfile) {
);
}
} else {
- $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile $lockfile ".
+ $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile $lockfile\n".
"reports other process with ID ".
- "$other. Cannot proceed.\n"));
+ "$otherpid. Cannot proceed.\n"));
}
}
my $dotcpan = $CPAN::Config->{cpan_home};
unless ($fh = FileHandle->new(">$lockfile")) {
if ($! =~ /Permission/) {
my $incc = $INC{'CPAN/Config.pm'};
- my $myincc = MM->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
+ my $myincc = File::Spec->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
$CPAN::Frontend->myprint(qq{
Your configuration suggests that CPAN.pm should use a working
$CPAN::Frontend->mydie("Could not open >$lockfile: $!");
}
$fh->print($$, "\n");
+ $fh->print(hostname(), "\n");
$self->{LOCK} = $lockfile;
$fh->close;
$SIG{TERM} = sub {
}) unless $Have_warned->{"Net::FTP"}++;
sleep 3;
- } elsif ($mod eq "MD5"){
+ } elsif ($mod eq "Digest::MD5"){
$CPAN::Frontend->myprint(qq{
- CPAN: MD5 security checks disabled because MD5 not installed.
- Please consider installing the MD5 module.
+ CPAN: MD5 security checks disabled because Digest::MD5 not installed.
+ Please consider installing the Digest::MD5 module.
});
sleep 2;
my($message) = @_;
my $i = 0;
my $ineval = 0;
- if (
- 0 && # disabled, try reload cpan with it
- $] > 5.004_60 # thereabouts
- ) {
- $ineval = $^S;
- } else {
- my($subroutine);
- while ((undef,undef,undef,$subroutine) = caller(++$i)) {
+ my($subroutine);
+ while ((undef,undef,undef,$subroutine) = caller(++$i)) {
$ineval = 1, last if
$subroutine eq '(eval)';
- }
}
return if $ineval && !$End;
- return unless defined $META->{LOCK}; # unsafe meta access, ok
- return unless -f $META->{LOCK}; # unsafe meta access, ok
- unlink $META->{LOCK}; # unsafe meta access, ok
+ return unless defined $META->{LOCK};
+ return unless -f $META->{LOCK};
+ $META->savehist;
+ unlink $META->{LOCK};
# require Carp;
# Carp::cluck("DEBUGGING");
$CPAN::Frontend->mywarn("Lockfile removed.\n");
}
+#-> sub CPAN::savehist
+sub savehist {
+ my($self) = @_;
+ my($histfile,$histsize);
+ unless ($histfile = $CPAN::Config->{'histfile'}){
+ $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
+ return;
+ }
+ $histsize = $CPAN::Config->{'histsize'} || 100;
+ if ($CPAN::term){
+ unless ($CPAN::term->can("GetHistory")) {
+ $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
+ return;
+ }
+ } else {
+ return;
+ }
+ my @h = $CPAN::term->GetHistory;
+ splice @h, 0, @h-$histsize if @h>$histsize;
+ my($fh) = FileHandle->new;
+ open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
+ local $\ = local $, = "\n";
+ print $fh @h;
+ close $fh;
+}
+
+sub is_tested {
+ my($self,$what) = @_;
+ $self->{is_tested}{$what} = 1;
+}
+
+sub is_installed {
+ my($self,$what) = @_;
+ delete $self->{is_tested}{$what};
+}
+
+sub set_perl5lib {
+ my($self) = @_;
+ $self->{is_tested} ||= {};
+ return unless %{$self->{is_tested}};
+ my $env = $ENV{PERL5LIB};
+ $env = $ENV{PERLLIB} unless defined $env;
+ my @env;
+ push @env, $env if defined $env and length $env;
+ my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
+ $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
+ $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
+}
+
package CPAN::CacheMgr;
#-> sub CPAN::CacheMgr::as_string ;
for ($dh->read) {
next if $_ eq "." || $_ eq "..";
if (-f $_) {
- push @entries, MM->catfile($dir,$_);
+ push @entries, File::Spec->catfile($dir,$_);
} elsif (-d _) {
- push @entries, MM->catdir($dir,$_);
+ push @entries, File::Spec->catdir($dir,$_);
} else {
$CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
}
1;
}
+# This is a piece of repeated code that is abstracted here for
+# maintainability. RMB
+#
+sub _configpmtest {
+ my($configpmdir, $configpmtest) = @_;
+ if (-w $configpmtest) {
+ return $configpmtest;
+ } elsif (-w $configpmdir) {
+ #_#_# following code dumped core on me with 5.003_11, a.k.
+ my $configpm_bak = "$configpmtest.bak";
+ unlink $configpm_bak if -f $configpm_bak;
+ if( -f $configpmtest ) {
+ if( rename $configpmtest, $configpm_bak ) {
+ $CPAN::Frontend->mywarn(<<END)
+Old configuration file $configpmtest
+ moved to $configpm_bak
+END
+ }
+ }
+ my $fh = FileHandle->new;
+ if ($fh->open(">$configpmtest")) {
+ $fh->print("1;\n");
+ return $configpmtest;
+ } else {
+ # Should never happen
+ Carp::confess("Cannot open >$configpmtest");
+ }
+ } else { return }
+}
+
#-> sub CPAN::Config::load ;
sub load {
my($self) = shift;
eval {require CPAN::Config;}; # We eval because of some
# MakeMaker problems
unless ($dot_cpan++){
- unshift @INC, MM->catdir($ENV{HOME},".cpan");
+ unshift @INC, File::Spec->catdir($ENV{HOME},".cpan");
eval {require CPAN::MyConfig;}; # where you can override
# system wide settings
shift @INC;
$redo++;
} else {
my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
- my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
- my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
+ my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN");
+ my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm");
if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
- if (-w $configpmtest) {
- $configpm = $configpmtest;
- } elsif (-w $configpmdir) {
- #_#_# following code dumped core on me with 5.003_11, a.k.
- unlink "$configpmtest.bak" if -f "$configpmtest.bak";
- rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
- my $fh = FileHandle->new;
- if ($fh->open(">$configpmtest")) {
- $fh->print("1;\n");
- $configpm = $configpmtest;
- } else {
- # Should never happen
- Carp::confess("Cannot open >$configpmtest");
- }
- }
+ $configpm = _configpmtest($configpmdir,$configpmtest);
}
unless ($configpm) {
- $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
+ $configpmdir = File::Spec->catdir($ENV{HOME},".cpan","CPAN");
File::Path::mkpath($configpmdir);
- $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
- if (-w $configpmtest) {
- $configpm = $configpmtest;
- } elsif (-w $configpmdir) {
- #_#_# following code dumped core on me with 5.003_11, a.k.
- my $fh = FileHandle->new;
- if ($fh->open(">$configpmtest")) {
- $fh->print("1;\n");
- $configpm = $configpmtest;
- } else {
- # Should never happen
- Carp::confess("Cannot open >$configpmtest");
- }
- } else {
+ $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm");
+ $configpm = _configpmtest($configpmdir,$configpmtest);
+ unless ($configpm) {
Carp::confess(qq{WARNING: CPAN.pm is unable to }.
qq{create a configuration file.});
}
} else {
$CPAN::Frontend->myprint(q{
Display Information
- a authors
- b string display bundles
- d or info distributions
- m /regex/ about modules
- i or anything of above
- r none reinstall recommendations
- u uninstalled distributions
+ command argument description
+ a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
+ i WORD or /REGEXP/ about anything of above
+ r NONE reinstall recommendations
+ ls AUTHOR about files in the author's directory
Download, Test, Make, Install...
get download
make make (implies get)
- test modules, make test (implies make)
- install dists, bundles make install (implies test)
+ test MODULES, make test (implies make)
+ install DISTS, BUNDLES make install (implies test)
clean make clean
look open subshell in these dists' directories
readme display these dists' README files
my($self,@arg) = @_;
# authors are always UPPERCASE
for (@arg) {
- $_ = uc $_;
+ $_ = uc $_ unless /=/;
}
$CPAN::Frontend->myprint($self->format_result('Author',@arg));
}
#-> sub CPAN::Shell::ls ;
sub ls {
my($self,@arg) = @_;
+ my @accept;
for (@arg) {
- $_ = uc $_;
+ unless (/^[A-Z\-]+$/i) {
+ $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
+ next;
+ }
+ push @accept, uc $_;
}
- for my $a (@arg){
+ for my $a (@accept){
my $author = $self->expand('Author',$a) or die "No author found for $a";
$author->ls;
}
foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
my @bbase = "Bundle";
while (my $bbase = shift @bbase) {
- $bdir = MM->catdir($incdir,split /::/, $bbase);
+ $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
if ($dh = DirHandle->new($bdir)) { # may fail
my($entry);
for $entry ($dh->read) {
- next if $entry =~ /^\./; #
- if (-d MM->catdir($bdir,$entry)){
+ next if $entry =~ /^\./;
+ if (-d File::Spec->catdir($bdir,$entry)){
push @bbase, "$bbase\::$entry";
} else {
next unless $entry =~ s/\.pm(?!\n)\Z//;
#-> sub CPAN::Shell::m ;
sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
- $CPAN::Frontend->myprint(shift->format_result('Module',@_));
+ my $self = shift;
+ $CPAN::Frontend->myprint($self->format_result('Module',@_));
}
#-> sub CPAN::Shell::i ;
sub paintdots_onreload {
my($ref) = shift;
sub {
- if ( $_[0] =~ /[Ss]ubroutine (\w+) redefined/ ) {
+ if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
my($subr) = $1;
++$$ref;
local($|) = 1;
$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($/);
- my $redef = 0;
- local($SIG{__WARN__}) = paintdots_onreload(\$redef);
- eval <$fh>;
- warn $@ if $@;
- $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
+ for my $f (qw(CPAN.pm CPAN/FirstTime.pm)) {
+ next unless $INC{$f};
+ CPAN->debug("reloading the whole $f") if $CPAN::DEBUG;
+ my $fh = FileHandle->new($INC{$f});
+ local($/);
+ my $redef = 0;
+ local($SIG{__WARN__}) = paintdots_onreload(\$redef);
+ eval <$fh>;
+ warn $@ if $@;
+ $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
+ }
} elsif ($command =~ /index/) {
CPAN::Index->force_reload;
} else {
my($self) = shift;
CPAN::Config->load unless $CPAN::Config_loaded++;
my(@bundle) = $self->_u_r_common("a",@_);
- my($todir) = MM->catdir($CPAN::Config->{'cpan_home'},"Bundle");
+ my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
File::Path::mkpath($todir);
unless (-d $todir) {
$CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
$m++;
my($c) = 0;
my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
- my($to) = MM->catfile($todir,"$me.pm");
+ my($to) = File::Spec->catfile($todir,"$me.pm");
while (-f $to) {
$me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
- $to = MM->catfile($todir,"$me.pm");
+ $to = File::Spec->catfile($todir,"$me.pm");
}
my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
$fh->print(
print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
}
} else {
+ # chomp $what;
+ # $what .= "\n"; # newlines unless $PRINT_ORNAMENTING
print $what;
}
}
}
if (ref $obj) {
$obj->color_cmd_tmps(0,1);
- CPAN::Queue->new($s);
+ CPAN::Queue->new($obj->id);
push @qcopy, $obj;
} elsif ($CPAN::META->exists('CPAN::Author',$s)) {
$obj = $CPAN::META->instance('CPAN::Author',$s);
- if ($meth eq "dump") {
- $obj->dump;
+ if ($meth =~ /^(dump|ls)$/) {
+ $obj->$meth();
} else {
$CPAN::Frontend->myprint(
join "",
#-> sub CPAN::Shell::cvs_import ;
sub cvs_import { shift->rematein('cvs_import',@_); }
+package CPAN::LWP::UserAgent;
+
+sub config {
+ return if $SETUPDONE;
+ if ($CPAN::META->has_usable('LWP::UserAgent')) {
+ require LWP::UserAgent;
+ @ISA = qw(Exporter LWP::UserAgent);
+ $SETUPDONE++;
+ } else {
+ $CPAN::Frontend->mywarn("LWP::UserAgent not available\n");
+ }
+}
+
+sub get_basic_credentials {
+ my($self, $realm, $uri, $proxy) = @_;
+ return unless $proxy;
+ if ($USER && $PASSWD) {
+ } elsif (defined $CPAN::Config->{proxy_user} &&
+ defined $CPAN::Config->{proxy_pass}) {
+ $USER = $CPAN::Config->{proxy_user};
+ $PASSWD = $CPAN::Config->{proxy_pass};
+ } else {
+ require ExtUtils::MakeMaker;
+ ExtUtils::MakeMaker->import(qw(prompt));
+ $USER = prompt("Proxy authentication needed!
+ (Note: to permanently configure username and password run
+ o conf proxy_user your_username
+ o conf proxy_pass your_password
+ )\nUsername:");
+ if ($CPAN::META->has_inst("Term::ReadKey")) {
+ Term::ReadKey::ReadMode("noecho");
+ } else {
+ $CPAN::Frontend->mywarn("Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n");
+ }
+ $PASSWD = prompt("Password:");
+ if ($CPAN::META->has_inst("Term::ReadKey")) {
+ Term::ReadKey::ReadMode("restore");
+ }
+ $CPAN::Frontend->myprint("\n\n");
+ }
+ return($USER,$PASSWD);
+}
+
+# mirror(): Its purpose is to deal with proxy authentication. When we
+# call SUPER::mirror, we relly call the mirror method in
+# LWP::UserAgent. LWP::UserAgent will then call
+# $self->get_basic_credentials or some equivalent and this will be
+# $self->dispatched to our own get_basic_credentials method.
+
+# Our own get_basic_credentials sets $USER and $PASSWD, two globals.
+
+# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
+# although we have gone through our get_basic_credentials, the proxy
+# server refuses to connect. This could be a case where the username or
+# password has changed in the meantime, so I'm trying once again without
+# $USER and $PASSWD to give the get_basic_credentials routine another
+# chance to set $USER and $PASSWD.
+
+sub mirror {
+ my($self,$url,$aslocal) = @_;
+ my $result = $self->SUPER::mirror($url,$aslocal);
+ if ($result->code == 407) {
+ undef $USER;
+ undef $PASSWD;
+ $result = $self->SUPER::mirror($url,$aslocal);
+ }
+ $result;
+}
+
package CPAN::FTP;
#-> sub CPAN::FTP::ftp_get ;
# Inheritance is not easier to manage than a few if/else branches
if ($CPAN::META->has_usable('LWP::UserAgent')) {
unless ($Ua) {
- eval {$Ua = LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
+ CPAN::LWP::UserAgent->config;
+ eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
if ($@) {
- $CPAN::Frontent->mywarn("LWP::UserAgent->new dies with $@")
+ $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
if $CPAN::DEBUG;
} else {
my($var);
if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
$Ua->proxy('http', $var)
if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
+
+
+# >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
+#
+# > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
+# > use ones that require basic autorization.
+#
+# > Example of when I use it manually in my own stuff:
+#
+# > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
+# > $req->proxy_authorization_basic("username","password");
+# > $res = $ua->request($req);
+#
+
$Ua->no_proxy($var)
if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
}
}
}
- $ENV{ftp_proxy} = $CPAN::Config->{ftp_proxy} if $CPAN::Config->{ftp_proxy};
- $ENV{http_proxy} = $CPAN::Config->{http_proxy}
- if $CPAN::Config->{http_proxy};
- $ENV{no_proxy} = $CPAN::Config->{no_proxy} if $CPAN::Config->{no_proxy};
+ for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
+ $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
+ }
# Try the list of urls for each single object. We keep a record
# where we did get a file from
my(@reordered,$last);
$CPAN::Config->{urllist} ||= [];
+ unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
+ warn "Malformed urllist; ignoring. Configuration file corrupt?\n";
+ }
$last = $#{$CPAN::Config->{urllist}};
if ($force & 2) { # local cpans probably out of date, don't reorder
@reordered = (0..$last);
# meant
# file://localhost
$l =~ s|^/||s unless -f $l; # e.g. /P:
+ $self->debug("without URI::URL we try local file $l") if $CPAN::DEBUG;
}
if ( -f $l && -r _) {
$Thesite = $i;
$url
");
unless ($Ua) {
- require LWP::UserAgent;
- $Ua = LWP::UserAgent->new;
+ CPAN::LWP::UserAgent->config;
+ eval { $Ua = CPAN::LWP::UserAgent->new; };
+ if ($@) {
+ $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
+ }
}
my $res = $Ua->mirror($url, $aslocal);
if ($res->is_success) {
return $aslocal;
}
} else {
+ $CPAN::Frontend->myprint(sprintf(
+ "LWP failed with code[%s] message[%s]\n",
+ $res->code,
+ $res->message,
+ ));
# Alan Burlison informed me that in firewall environments
# Net::FTP can still succeed where LWP fails. So we do not
# skip Net::FTP anymore when LWP is available.
}
} else {
- $self->debug("LWP not installed") if $CPAN::DEBUG;
+ $CPAN::Frontend->myprint("LWP not available\n");
}
return if $CPAN::Signal;
if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
$url
]);
my($system) =
- "$chdir$funkyftp$src_switch '$url' $devnull$stdout_redir";
+ "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
$self->debug("system[$system]") if $CPAN::DEBUG;
my($wstatus);
if (($wstatus = system($system)) == 0
Trying with "$funkyftp$src_switch" to get
$url.gz
]);
- my($system) = "$funkyftp$src_switch '$url.gz' $devnull > $asl_gz";
+ my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
$self->debug("system[$system]") if $CPAN::DEBUG;
my($wstatus);
if (($wstatus = system($system)) == 0
my($i);
my($aslocal_dir) = File::Basename::dirname($aslocal);
File::Path::mkpath($aslocal_dir);
+ my $ftpbin = $CPAN::Config->{ftp};
HOSTHARDEST: for $i (@$host_seq) {
- unless (length $CPAN::Config->{'ftp'}) {
+ unless (length $ftpbin && MM->maybe_command($ftpbin)) {
$CPAN::Frontend->myprint("No external ftp command available\n\n");
last HOSTHARDEST;
}
@dialog,
"lcd $aslocal_dir",
"cd /",
- map("cd $_", split "/", $dir), # RFC 1738
+ map("cd $_", split /\//, $dir), # RFC 1738
"bin",
"get $getfile $targetfile",
"quit"
}
);
- $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose $host",
+ $self->talk_ftp("$ftpbin$verbose $host",
@dialog);
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
# OK, they don't have a valid ~/.netrc. Use 'ftp -n'
# then and login manually to host, using e-mail as
# password.
- $CPAN::Frontend->myprint(qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n});
+ $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
unshift(
@dialog,
"open $host",
"user anonymous $Config::Config{'cf_email'}"
);
- $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose -n", @dialog);
+ $self->talk_ftp("$ftpbin$verbose -n", @dialog);
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
$mtime ||= 0;
sub new {
my($class) = @_;
- my $file = MM->catfile($ENV{HOME},".netrc");
+ my $file = File::Spec->catfile($ENV{HOME},".netrc");
my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
my @return;
if ($pos == 0) {
@return = grep /^$word/, @CPAN::Complete::COMMANDS;
- } elsif ( $line !~ /^[\!abcdhimorutl]/ ) {
+ } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
@return = ();
} elsif ($line =~ /^(a|ls)\s/) {
@return = cplx('CPAN::Author',uc($word));
} elsif ($line =~ /^d\s/) {
@return = cplx('CPAN::Distribution',$word);
} elsif ($line =~ m/^(
- [mru]|make|clean|dump|test|install|readme|look|cvs_import
+ [mru]|make|clean|dump|get|test|install|readme|look|cvs_import
)\s/x ) {
if ($word =~ /^Bundle::/) {
CPAN::Shell->local_bundles;
#-> sub CPAN::Index::force_reload ;
sub force_reload {
my($class) = @_;
- $CPAN::Index::last_time = 0;
+ $CPAN::Index::LAST_TIME = 0;
$class->reload(1);
}
}
if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
# warn "Setting last_time to 0";
- $last_time = 0; # No warning necessary
+ $LAST_TIME = 0; # No warning necessary
}
- return if $last_time + $CPAN::Config->{index_expire}*86400 > $time
+ return if $LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
and ! $force;
if (0) {
# IFF we are developing, it helps to wipe out the memory
}
{
my($debug,$t2);
- local $last_time = $time;
+ local $LAST_TIME = $time;
local $CPAN::META->{PROTOCOL} = PROTOCOL;
my $needshort = $^O eq "dos";
$time = $t2;
CPAN->debug($debug) if $CPAN::DEBUG;
}
- $last_time = $time;
+ $LAST_TIME = $time;
$CPAN::META->{PROTOCOL} = PROTOCOL;
}
CPAN::Config->load; # we should guarantee loading wherever we rely
# on Config XXX
$localname ||= $wanted;
- my $abs_wanted = MM->catfile($CPAN::Config->{'keep_source_where'},
- $localname);
+ my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
+ $localname);
if (
-f $abs_wanted &&
-M $abs_wanted < $CPAN::Config->{'index_expire'} &&
push @lines, @ls;
}
# read header
- my $line_count;
+ my($line_count,$last_updated);
while (@lines) {
my $shift = shift(@lines);
- $shift =~ /^Line-Count:\s+(\d+)/;
- $line_count = $1 if $1;
last if $shift =~ /^\s*$/;
+ $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
+ $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
}
if (not defined $line_count) {
$index_target, $line_count, scalar(@lines);
}
+ if (not defined $last_updated) {
+
+ warn qq{Warning: Your $index_target does not contain a Last-Updated header.
+Please check the validity of the index file by comparing it to more
+than one CPAN mirror. I'll continue but problems seem likely to
+happen.\a
+};
+
+ sleep 5;
+ } else {
+
+ $CPAN::Frontend
+ ->myprint(sprintf qq{ Database was generated on %s\n},
+ $last_updated);
+ $DATE_OF_02 = $last_updated;
+
+ if ($CPAN::META->has_inst(HTTP::Date)) {
+ require HTTP::Date;
+ my($age) = (time - HTTP::Date::str2time($last_updated))/3600/24;
+ if ($age > 30) {
+
+ $CPAN::Frontend
+ ->mywarn(sprintf
+ qq{Warning: This index file is %d days old.
+ Please check the host you chose as your CPAN mirror for staleness.
+ I'll continue but problems seem likely to happen.\a\n},
+ $age);
+
+ }
+ } else {
+ $CPAN::Frontend->myprint(" HTTP::Date not available\n");
+ }
+ }
+
+
# A necessity since we have metadata_cache: delete what isn't
# there anymore
my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
if ($id->cpan_file ne $dist){ # update only if file is
# different. CPAN prohibits same
# name with different version
- $userid = $self->userid($dist);
+ $userid = $id->userid || $self->userid($dist);
$id->set(
'CPAN_USERID' => $userid,
'CPAN_VERSION' => $version,
while (@eval) {
my $shift = shift(@eval);
if ($shift =~ /^Date:\s+(.*)/){
- return if $date_of_03 eq $1;
- ($date_of_03) = $1;
+ return if $DATE_OF_03 eq $1;
+ ($DATE_OF_03) = $1;
}
last if $shift =~ /^\s*$/;
}
CPAN::Distribution)) {
$cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
}
- my $metadata_file = MM->catfile($CPAN::Config->{cpan_home},"Metadata");
- $cache->{last_time} = $last_time;
+ my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
+ $cache->{last_time} = $LAST_TIME;
+ $cache->{DATE_OF_02} = $DATE_OF_02;
$cache->{PROTOCOL} = PROTOCOL;
$CPAN::Frontend->myprint("Going to write $metadata_file\n");
eval { Storable::nstore($cache, $metadata_file) };
- $CPAN::Frontend->mywarn($@) if $@;
+ $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
}
#-> sub CPAN::Index::read_metadata_cache ;
my($self) = @_;
return unless $CPAN::Config->{'cache_metadata'};
return unless $CPAN::META->has_usable("Storable");
- my $metadata_file = MM->catfile($CPAN::Config->{cpan_home},"Metadata");
+ my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
return unless -r $metadata_file and -f $metadata_file;
$CPAN::Frontend->myprint("Going to read $metadata_file\n");
my $cache;
eval { $cache = Storable::retrieve($metadata_file) };
- $CPAN::Frontend->mywarn($@) if $@;
+ $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
if (!$cache || ref $cache ne 'HASH'){
- $last_time = 0;
+ $LAST_TIME = 0;
return;
}
if (exists $cache->{PROTOCOL}) {
if (PROTOCOL > $cache->{PROTOCOL}) {
$CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
- "with protocol v%s, requiring v%s",
+ "with protocol v%s, requiring v%s\n",
$cache->{PROTOCOL},
PROTOCOL)
);
}
} else {
$CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
- "with protocol v1.0");
+ "with protocol v1.0\n");
return;
}
my $clcnt = 0;
$CPAN::META->{PROTOCOL} ||=
$cache->{PROTOCOL}; # reading does not up or downgrade, but it
# does initialize to some protocol
- $last_time = $cache->{last_time};
+ $LAST_TIME = $cache->{last_time};
+ $DATE_OF_02 = $cache->{DATE_OF_02};
+ $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
+ if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
+ return;
}
package CPAN::InfoObj;
# Accessors
-sub cpan_userid { shift->{RO}{CPAN_USERID} }
-sub id { shift->{ID} }
+sub cpan_userid {
+ my $self = shift;
+ $self->{RO}{CPAN_USERID}
+}
+
+sub id { shift->{ID}; }
#-> sub CPAN::InfoObj::new ;
sub new {
package CPAN::Author;
+#-> sub CPAN::Author::id
+sub id {
+ my $self = shift;
+ my $id = $self->{ID};
+ $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
+ $id;
+}
+
#-> sub CPAN::Author::as_glimpse ;
sub as_glimpse {
my($self) = @_;
my(@m);
my $class = ref($self);
$class =~ s/^CPAN:://;
- push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
+ push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
+ $class,
+ $self->{ID},
+ $self->fullname,
+ $self->email);
join "", @m;
}
my $id = $self->id;
# adapted from CPAN::Distribution::verifyMD5 ;
- my(@chksumfile);
- @chksumfile = $self->id =~ /(.)(.)(.*)/;
- $chksumfile[1] = join "", @chksumfile[0,1];
- $chksumfile[2] = join "", @chksumfile[1,2];
- push @chksumfile, "CHECKSUMS";
- print join "", map {
+ my(@csf); # chksumfile
+ @csf = $self->id =~ /(.)(.)(.*)/;
+ $csf[1] = join "", @csf[0,1];
+ $csf[2] = join "", @csf[1,2];
+ my(@dl);
+ @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0);
+ unless (grep {$_->[2] eq $csf[1]} @dl) {
+ $CPAN::Frontend->myprint("No files in the directory of $id\n");
+ return;
+ }
+ @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0);
+ unless (grep {$_->[2] eq $csf[2]} @dl) {
+ $CPAN::Frontend->myprint("No files in the directory of $id\n");
+ return;
+ }
+ @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1);
+ $CPAN::Frontend->myprint(join "", map {
sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
- } sort { $a->[2] cmp $b->[2] } $self->dir_listing(\@chksumfile);
+ } sort { $a->[2] cmp $b->[2] } @dl);
}
+# returns an array of arrays, the latter contain (size,mtime,filename)
#-> sub CPAN::Author::dir_listing ;
sub dir_listing {
my $self = shift;
my $chksumfile = shift;
+ my $recursive = shift;
my $lc_want =
- MM->catfile($CPAN::Config->{keep_source_where},
- "authors", "id", @$chksumfile);
+ File::Spec->catfile($CPAN::Config->{keep_source_where},
+ "authors", "id", @$chksumfile);
local($") = "/";
+ # connect "force" argument with "index_expire".
+ my $force = 0;
+ if (my @stat = stat $lc_want) {
+ $force = $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
+ }
my $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
- $lc_want,1);
+ $lc_want,$force);
unless ($lc_file) {
$CPAN::Frontend->myprint("Trying $lc_want.gz\n");
$chksumfile->[-1] .= ".gz";
$lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
- "$lc_want.gz",1);
+ "$lc_want.gz",1);
if ($lc_file) {
$lc_file =~ s{\.gz(?!\n)\Z}{}; #};
CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file);
my(@result,$f);
for $f (sort keys %$cksum) {
if (exists $cksum->{$f}{isdir}) {
- my(@dir) = @$chksumfile;
- pop @dir;
- push @dir, $f, "CHECKSUMS";
- push @result, map {
- [$_->[0], $_->[1], "$f/$_->[2]"]
- } $self->dir_listing(\@dir);
+ if ($recursive) {
+ my(@dir) = @$chksumfile;
+ pop @dir;
+ push @dir, $f, "CHECKSUMS";
+ push @result, map {
+ [$_->[0], $_->[1], "$f/$_->[2]"]
+ } $self->dir_listing(\@dir,1);
+ } else {
+ push @result, [ 0, "-", $f ];
+ }
} else {
push @result, [
($cksum->{$f}{"size"}||0),
sub normalize {
my($self,$s) = @_;
$s = $self->id unless defined $s;
- if ($s =~ tr|/|| == 1) {
- return $s if $s =~ m|^N/A|;
+ if (
+ $s =~ tr|/|| == 1
+ or
+ $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
+ ) {
+ return $s if $s =~ m:^N/A|^Contact Author: ;
$s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
- $CPAN::Frontend->mywarn("Strange distribution name [$s]");
+ $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
CPAN->debug("s[$s]") if $CPAN::DEBUG;
}
$s;
my($self) = shift;
my($depth) = shift || 0;
my($color) = shift || 0;
+ my($ancestors) = shift || [];
# a distribution needs to recurse into its prereq_pms
return if exists $self->{incommandcolor}
&& $self->{incommandcolor}==$color;
- $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ".
- "color_cmd_tmps depth[%s] self[%s] id[%s]",
- $depth,
- $self,
- $self->id
- )) if $depth>=100;
- ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
+ if ($depth>=100){
+ $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
+ }
+ # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
my $prereq_pm = $self->prereq_pm;
if (defined $prereq_pm) {
for my $pre (keys %$prereq_pm) {
my $premo = CPAN::Shell->expand("Module",$pre);
- $premo->color_cmd_tmps($depth+1,$color);
+ $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
}
}
if ($color==0) {
return $self->{CALLED_FOR};
}
-#-> sub CPAN::Distribution::my_chdir ;
+#-> sub CPAN::Distribution::safe_chdir ;
sub safe_chdir {
my($self,$todir) = @_;
# we die if we cannot chdir and we are debuggable
my($local_file);
my($local_wanted) =
- MM->catfile(
- $CPAN::Config->{keep_source_where},
- "authors",
- "id",
- split("/",$self->id)
- );
+ File::Spec->catfile(
+ $CPAN::Config->{keep_source_where},
+ "authors",
+ "id",
+ split(/\//,$self->id)
+ );
$self->debug("Doing localize") if $CPAN::DEBUG;
- $local_file =
- CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted)
- or $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n");
+ unless ($local_file =
+ CPAN::FTP->localize("authors/id/$self->{ID}",
+ $local_wanted)) {
+ my $note = "";
+ if ($CPAN::Index::DATE_OF_02) {
+ $note = "Note: Current database in memory was generated ".
+ "on $CPAN::Index::DATE_OF_02\n";
+ }
+ $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
+ }
$self->debug("local_file[$local_file]") if $CPAN::DEBUG;
$self->{localfile} = $local_file;
return if $CPAN::Signal;
#
# Check integrity
#
- if ($CPAN::META->has_inst("MD5")) {
- $self->debug("MD5 is installed, verifying");
+ if ($CPAN::META->has_inst("Digest::MD5")) {
+ $self->debug("Digest::MD5 is installed, verifying");
$self->verifyMD5;
} else {
- $self->debug("MD5 is NOT installed");
+ $self->debug("Digest::MD5 is NOT installed");
}
return if $CPAN::Signal;
my ($distdir,$packagedir);
if (@readdir == 1 && -d $readdir[0]) {
$distdir = $readdir[0];
- $packagedir = MM->catdir($builddir,$distdir);
+ $packagedir = File::Spec->catdir($builddir,$distdir);
$self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
if $CPAN::DEBUG;
-d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
my $pragmatic_dir = $userid . '000';
$pragmatic_dir =~ s/\W_//g;
$pragmatic_dir++ while -d "../$pragmatic_dir";
- $packagedir = MM->catdir($builddir,$pragmatic_dir);
+ $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
$self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
File::Path::mkpath($packagedir);
my($f);
for $f (@readdir) { # is already without "." and ".."
- my $to = MM->catdir($packagedir,$f);
+ my $to = File::Spec->catdir($packagedir,$f);
rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
}
}
}
$self->{'build_dir'} = $packagedir;
- $self->safe_chdir(File::Spec->updir);
+ $self->safe_chdir($builddir);
File::Path::rmtree("tmp");
- my($mpl) = MM->catfile($packagedir,"Makefile.PL");
+ my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
my($mpl_exists) = -f $mpl;
unless ($mpl_exists) {
- # Steffen's stupid NFS has problems to see an existing
- # Makefile.PL such a short time after the directory was
- # renamed. Maybe this trick helps
- $dh = DirHandle->new($packagedir)
+ # NFS has been reported to have racing problems after the
+ # renaming of a directory in some environments.
+ # This trick helps.
+ sleep 1;
+ my $mpldh = DirHandle->new($packagedir)
or Carp::croak("Couldn't opendir $packagedir: $!");
- $mpl_exists = grep /^Makefile\.PL$/, $dh->read;
+ $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
+ $mpldh->close;
}
unless ($mpl_exists) {
$self->debug(sprintf("makefilepl[%s]anycwd[%s]",
$mpl,
CPAN::anycwd(),
)) if $CPAN::DEBUG;
- my($configure) = MM->catfile($packagedir,"Configure");
+ my($configure) = File::Spec->catfile($packagedir,"Configure");
if (-f $configure) {
# do we have anything to do?
$self->{'configure'} = $configure;
- } elsif (-f MM->catfile($packagedir,"Makefile")) {
+ } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
$CPAN::Frontend->myprint(qq{
Package comes with a Makefile and without a Makefile.PL.
We\'ll try to build it with that Makefile then.
my($self) = @_;
if ($^O eq 'MacOS') {
- $self->ExtUtils::MM_MacOS::look;
+ $self->Mac::BuildTools::look;
return;
}
return;
}
my $dist = $self->id;
- my $dir = $self->dir or $self->get;
- $dir = $self->dir;
+ my $dir;
+ unless ($dir = $self->dir) {
+ $self->get;
+ }
+ unless ($dir ||= $self->dir) {
+ $CPAN::Frontend->mywarn(qq{
+Could not determine which directory to use for looking at $dist.
+});
+ return;
+ }
my $pwd = CPAN::anycwd();
- chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
+ $self->safe_chdir($dir);
$CPAN::Frontend->myprint(qq{Working directory is $dir\n});
- system($CPAN::Config->{'shell'}) == 0
- or $CPAN::Frontend->mydie("Subprocess shell error");
- chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
+ unless (system($CPAN::Config->{'shell'}) == 0) {
+ my $code = $? >> 8;
+ $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
+ }
+ $self->safe_chdir($pwd);
}
# CPAN::Distribution::cvs_import ;
my $userid = $self->cpan_userid;
- my $cvs_dir = (split '/', $dir)[-1];
+ my $cvs_dir = (split /\//, $dir)[-1];
$cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
my $cvs_root =
$CPAN::Config->{cvsroot} || $ENV{CVSROOT};
$self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
my($local_file);
my($local_wanted) =
- MM->catfile(
- $CPAN::Config->{keep_source_where},
- "authors",
- "id",
- split("/","$sans.readme"),
- );
+ File::Spec->catfile(
+ $CPAN::Config->{keep_source_where},
+ "authors",
+ "id",
+ split(/\//,"$sans.readme"),
+ );
$self->debug("Doing localize") if $CPAN::DEBUG;
$local_file = CPAN::FTP->localize("authors/id/$sans.readme",
$local_wanted)
or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
if ($^O eq 'MacOS') {
- ExtUtils::MM_MacOS::launch_file($local_file);
+ Mac::BuildTools::launch_file($local_file);
return;
}
$CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
}
my($lc_want,$lc_file,@local,$basename);
- @local = split("/",$self->id);
+ @local = split(/\//,$self->id);
pop @local;
push @local, "CHECKSUMS";
$lc_want =
- MM->catfile($CPAN::Config->{keep_source_where},
- "authors", "id", @local);
+ File::Spec->catfile($CPAN::Config->{keep_source_where},
+ "authors", "id", @local);
local($") = "/";
if (
-s $lc_want
unless ($eq) {
# had to inline it, when I tied it, the tiedness got lost on
# the call to eq_MD5. (Jan 1998)
- my $md5 = MD5->new;
+ my $md5 = Digest::MD5->new;
my($data,$ref);
$ref = \$data;
while ($fh->READ($ref, 4096) > 0){
#-> sub CPAN::Distribution::eq_MD5 ;
sub eq_MD5 {
my($self,$fh,$expectMD5) = @_;
- my $md5 = MD5->new;
+ my $md5 = Digest::MD5->new;
my($data);
while (read($fh, $data, 4096)){
$md5->add($data);
#-> sub CPAN::Distribution::perl ;
sub perl {
my($self) = @_;
- my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
+ my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
my $pwd = CPAN::anycwd();
- my $candidate = MM->catfile($pwd,$^X);
+ my $candidate = File::Spec->catfile($pwd,$^X);
$perl ||= $candidate if MM->maybe_command($candidate);
unless ($perl) {
my ($component,$perl_name);
DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
- PATH_COMPONENT: foreach $component (MM->path(),
+ PATH_COMPONENT: foreach $component (File::Spec->path(),
$Config::Config{'binexp'}) {
next unless defined($component) && $component;
- my($abs) = MM->catfile($component,$perl_name);
+ my($abs) = File::Spec->catfile($component,$perl_name);
if (MM->maybe_command($abs)) {
$perl = $abs;
last DIST_PERLNAME;
$self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
if ($^O eq 'MacOS') {
- ExtUtils::MM_MacOS::make($self);
+ Mac::BuildTools::make($self);
return;
}
} else {
$self->{writemakefile} =
qq{NO Makefile.PL refused to write a Makefile.};
- # It's probably worth to record the reason, so let's retry
+ # It's probably worth it to record the reason, so let's retry
# local $/;
# my $fh = IO::File->new("$system |"); # STDERR? STDIN?
# $self->{writemakefile} .= <$fh>;
if ($follow) {
# color them as dirty
for my $p (@prereq) {
+ # 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
if $CPAN::DEBUG;
if ($^O eq 'MacOS') {
- ExtUtils::MM_MacOS::make_test($self);
+ Mac::BuildTools::make_test($self);
return;
}
+ local $ENV{PERL5LIB} = $ENV{PERL5LIB} || "";
+ $CPAN::META->set_perl5lib;
my $system = join " ", $CPAN::Config->{'make'}, "test";
if (system($system) == 0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
+ $CPAN::META->is_tested($self->{'build_dir'});
$self->{make_test} = "YES";
} else {
$self->{make_test} = "NO";
$self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
if ($^O eq 'MacOS') {
- ExtUtils::MM_MacOS::make_clean($self);
+ Mac::BuildTools::make_clean($self);
return;
}
if $CPAN::DEBUG;
if ($^O eq 'MacOS') {
- ExtUtils::MM_MacOS::make_install($self);
+ Mac::BuildTools::make_install($self);
return;
}
$pipe->close;
if ($?==0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
+ $CPAN::META->is_installed($self->{'build_dir'});
return $self->{'install'} = "YES";
} else {
$self->{'install'} = "NO";
package CPAN::Bundle;
+sub look {
+ my $self = shift;
+ $CPAN::Frontend->myprint($self->as_string);
+}
+
sub undelay {
my $self = shift;
delete $self->{later};
my($self) = shift;
my($depth) = shift || 0;
my($color) = shift || 0;
+ my($ancestors) = shift || [];
# a module needs to recurse to its cpan_file, a distribution needs
# to recurse into its prereq_pms, a bundle needs to recurse into its modules
return if exists $self->{incommandcolor}
&& $self->{incommandcolor}==$color;
- $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ".
- "color_cmd_tmps depth[%s] self[%s] id[%s]",
- $depth,
- $self,
- $self->id
- )) if $depth>=100;
- ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
+ if ($depth>=100){
+ $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
+ }
+ # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
for my $c ( $self->contains ) {
my $obj = CPAN::Shell->expandany($c) or next;
CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
- $obj->color_cmd_tmps($depth+1,$color);
+ $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
}
if ($color==0) {
delete $self->{badtestcnt};
#-> sub CPAN::Bundle::contains ;
sub contains {
- my($self) = @_;
- my($parsefile) = $self->inst_file || "";
- my($id) = $self->id;
- $self->debug("parsefile[$parsefile]id[$id]") if $CPAN::DEBUG;
- unless ($parsefile) {
- # Try to get at it in the cpan directory
- $self->debug("no parsefile") if $CPAN::DEBUG;
- Carp::confess "I don't know a $id" unless $self->cpan_file;
- my $dist = $CPAN::META->instance('CPAN::Distribution',
- $self->cpan_file);
- $dist->get;
- $self->debug($dist->as_string) if $CPAN::DEBUG;
- my($todir) = $CPAN::Config->{'cpan_home'};
- my(@me,$from,$to,$me);
- @me = split /::/, $self->id;
- $me[-1] .= ".pm";
- $me = MM->catfile(@me);
- $from = $self->find_bundle_file($dist->{'build_dir'},$me);
- $to = MM->catfile($todir,$me);
- File::Path::mkpath(File::Basename::dirname($to));
- File::Copy::copy($from, $to)
- or Carp::confess("Couldn't copy $from to $to: $!");
- $parsefile = $to;
- }
- my @result;
- my $fh = FileHandle->new;
- local $/ = "\n";
- open($fh,$parsefile) or die "Could not open '$parsefile': $!";
- my $in_cont = 0;
- $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
- while (<$fh>) {
- $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
- m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
- next unless $in_cont;
- next if /^=/;
- s/\#.*//;
- next if /^\s+$/;
- chomp;
- push @result, (split " ", $_, 2)[0];
- }
- close $fh;
- delete $self->{STATUS};
- $self->{CONTAINS} = \@result;
- $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
- unless (@result) {
- $CPAN::Frontend->mywarn(qq{
-The bundle file "$parsefile" may be a broken
+ my($self) = @_;
+ my($inst_file) = $self->inst_file || "";
+ my($id) = $self->id;
+ $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
+ unless ($inst_file) {
+ # Try to get at it in the cpan directory
+ $self->debug("no inst_file") if $CPAN::DEBUG;
+ my $cpan_file;
+ $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
+ $cpan_file = $self->cpan_file;
+ if ($cpan_file eq "N/A") {
+ $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
+ Maybe stale symlink? Maybe removed during session? Giving up.\n");
+ }
+ my $dist = $CPAN::META->instance('CPAN::Distribution',
+ $self->cpan_file);
+ $dist->get;
+ $self->debug($dist->as_string) if $CPAN::DEBUG;
+ my($todir) = $CPAN::Config->{'cpan_home'};
+ my(@me,$from,$to,$me);
+ @me = split /::/, $self->id;
+ $me[-1] .= ".pm";
+ $me = File::Spec->catfile(@me);
+ $from = $self->find_bundle_file($dist->{'build_dir'},$me);
+ $to = File::Spec->catfile($todir,$me);
+ File::Path::mkpath(File::Basename::dirname($to));
+ File::Copy::copy($from, $to)
+ or Carp::confess("Couldn't copy $from to $to: $!");
+ $inst_file = $to;
+ }
+ my @result;
+ my $fh = FileHandle->new;
+ local $/ = "\n";
+ open($fh,$inst_file) or die "Could not open '$inst_file': $!";
+ my $in_cont = 0;
+ $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
+ while (<$fh>) {
+ $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
+ m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
+ next unless $in_cont;
+ next if /^=/;
+ s/\#.*//;
+ next if /^\s+$/;
+ chomp;
+ push @result, (split " ", $_, 2)[0];
+ }
+ close $fh;
+ delete $self->{STATUS};
+ $self->{CONTAINS} = \@result;
+ $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
+ unless (@result) {
+ $CPAN::Frontend->mywarn(qq{
+The bundle file "$inst_file" may be a broken
bundlefile. It seems not to contain any bundle definition.
Please check the file and if it is bogus, please delete it.
Sorry for the inconvenience.
});
- }
- @result;
+ }
+ @result;
}
#-> sub CPAN::Bundle::find_bundle_file
my($self,$where,$what) = @_;
$self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
-### my $bu = MM->catfile($where,$what);
+### my $bu = File::Spec->catfile($where,$what);
### return $bu if -f $bu;
- my $manifest = MM->catfile($where,"MANIFEST");
+ my $manifest = File::Spec->catfile($where,"MANIFEST");
unless (-f $manifest) {
require ExtUtils::Manifest;
my $cwd = CPAN::anycwd();
my $what2 = $what;
if ($^O eq 'MacOS') {
$what =~ s/^://;
- $what2 =~ tr|:|/|;
+ $what =~ tr|:|/|;
$what2 =~ s/:Bundle://;
$what2 =~ tr|:|/|;
} else {
my($file) = /(\S+)/;
if ($file =~ m|\Q$what\E$|) {
$bu = $file;
- # return MM->catfile($where,$bu); # bad
+ # return File::Spec->catfile($where,$bu); # bad
last;
}
# retry if she managed to
$bu = $file if $file =~ m|\Q$what2\E$|;
}
$bu =~ tr|/|:| if $^O eq 'MacOS';
- return MM->catfile($where, $bu) if $bu;
+ return File::Spec->catfile($where, $bu) if $bu;
Carp::croak("Couldn't find a Bundle file in $where");
}
$me[-1] .= ".pm";
my($incdir,$bestv);
foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
- my $bfile = MM->catfile($incdir, @me);
+ my $bfile = File::Spec->catfile($incdir, @me);
CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
next unless -f $bfile;
my $foundv = MM->parse_version($bfile);
package CPAN::Module;
# Accessors
-# sub cpan_userid { shift->{RO}{CPAN_USERID} }
+# sub CPAN::Module::userid
sub userid {
my $self = shift;
return unless exists $self->{RO}; # should never happen
- return $self->{RO}{CPAN_USERID} || $self->{RO}{userid};
+ return $self->{RO}{userid} || $self->{RO}{CPAN_USERID};
}
+# sub CPAN::Module::description
sub description { shift->{RO}{description} }
sub undelay {
my($self) = shift;
my($depth) = shift || 0;
my($color) = shift || 0;
+ my($ancestors) = shift || [];
# a module needs to recurse to its cpan_file
return if exists $self->{incommandcolor}
&& $self->{incommandcolor}==$color;
- $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ".
- "color_cmd_tmps depth[%s] self[%s] id[%s]",
- $depth,
- $self,
- $self->id
- )) if $depth>=100;
- ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
+ if ($depth>=100){
+ $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
+ }
+ # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
- $dist->color_cmd_tmps($depth+1,$color);
+ $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
}
if ($color==0) {
delete $self->{badtestcnt};
sub as_string {
my($self) = @_;
my(@m);
- CPAN->debug($self) if $CPAN::DEBUG;
+ CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
my $class = ref($self);
$class =~ s/^CPAN:://;
local($^W) = 0;
if $self->description;
my $sprintf2 = " %-12s %s (%s)\n";
my($userid);
- if ($userid = $self->cpan_userid || $self->userid){
+ $userid = $self->userid;
+ if ( $userid ){
my $author;
if ($author = CPAN::Shell->expand('Author',$userid)) {
my $email = "";
my(%statd,%stats,%statl,%stati);
@statd{qw,? i c a b R M S,} = qw,unknown idea
pre-alpha alpha beta released mature standard,;
- @stats{qw,? m d u n,} = qw,unknown mailing-list
- developer comp.lang.perl.* none,;
+ @stats{qw,? m d u n a,} = qw,unknown mailing-list
+ developer comp.lang.perl.* none abandoned,;
@statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,;
@stati{qw,? f r O h,} = qw,unknown functions
references+ties object-oriented hybrid,;
# warn "dist[$dist]";
# mff=manifest file; mfh=manifest handle
my($mff,$mfh);
- if ($dist->{build_dir} and
- -f ($mff = MM->catfile($dist->{build_dir}, "MANIFEST")) and
+ if (
+ $dist->{build_dir}
+ and
+ (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
+ and
$mfh = FileHandle->new($mff)
) {
CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
}
$lfl =~ s/\s.*//; # remove comments
$lfl =~ s/\s+//g; # chomp would maybe be too system-specific
- my $lfl_abs = MM->catfile($dist->{build_dir},$lfl);
+ my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
# warn "lfl_abs[$lfl_abs]";
if (-f $lfl_abs) {
$self->{MANPAGE} = $self->manpage_headline($lfl_abs);
my $inpod = 0;
local $/ = "\n";
while (<$fh>) {
- $inpod = m/^=(?!head1\s+NAME)/ ? 0 :
- m/^=head1\s+NAME/ ? 1 : $inpod;
+ $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
+ m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
next unless $inpod;
next if /^=/;
next if /^\s+$/;
}
#-> sub CPAN::Module::cpan_file ;
-sub cpan_file {
+# Note: also inherited by CPAN::Bundle
+sub cpan_file {
my $self = shift;
CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
unless (defined $self->{RO}{CPAN_FILE}) {
}
return "Contact Author $fullname <$email>";
} else {
- return "UserID $userid";
+ return "Contact Author $userid (Email address not available)";
}
} else {
return "N/A";
} else {
$doit = 1;
}
+ if ($self->{RO}{stats} && $self->{RO}{stats} eq "a") {
+ $CPAN::Frontend->mywarn(qq{
+\n\n\n ***WARNING***
+ The module $self->{ID} has no active maintainer.\n\n\n
+});
+ sleep 5;
+ }
$self->rematein('install') if $doit;
}
#-> sub CPAN::Module::clean ;
@packpath = split /::/, $self->{ID};
$packpath[-1] .= ".pm";
foreach $dir (@INC) {
- my $pmfile = MM->catfile($dir,@packpath);
+ my $pmfile = File::Spec->catfile($dir,@packpath);
if (-f $pmfile){
return $pmfile;
}
push @packpath, $packpath[-1];
$packpath[-1] .= "." . $Config::Config{'dlext'};
foreach $dir (@INC) {
- my $xsfile = MM->catfile($dir,'auto',@packpath);
+ my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
if (-f $xsfile){
return $xsfile;
}
# compare it use utility for compare
# print it do nothing
- # Alt2 maintain it as what is is
+ # Alt2 maintain it as what it is
# read index files convert
# compare it use utility because there's still a ">" vs "gt" issue
# print it use CPAN::Version for print
$ret = bless {GZ => $gz}, $class;
} else {
my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $file |";
- my $fh = FileHandle->new($pipe) or die "Could pipe[$pipe]: $!";
+ my $fh = FileHandle->new($pipe) or die "Could not pipe[$pipe]: $!";
binmode $fh;
$ret = bless {FH => $fh}, $class;
}
$tar->extract(@af);
}
- ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1)
+ Mac::BuildTools::convert_files([$tar->list_files], 1)
if ($^O eq 'MacOS');
return 1;
# And if they say v1.2, then the old perl takes it as "v12"
- $CPAN::Frontend->mywarn("Suspicious version string seen [$n]");
+ $CPAN::Frontend->mywarn("Suspicious version string seen [$n]\n");
return $n;
}
my $better = sprintf "v%vd", $n;
autobundle, clean, install, make, recompile, test
+=head1 STATUS
+
+This module will eventually be replaced by CPANPLUS. CPANPLUS is kind
+of a modern rewrite from ground up with greater extensibility and more
+features but no full compatibility. If you're new to CPAN.pm, you
+probably should investigate if CPANPLUS is the better choice for you.
+If you're already used to CPAN.pm you're welcome to continue using it,
+if you accept that its development is mostly (though not completely)
+stalled.
+
=head1 DESCRIPTION
The CPAN module is designed to automate the make and install of perl
-modules and extensions. It includes some searching capabilities and
+modules and extensions. It includes some primitive searching capabilities and
knows how to use Net::FTP or LWP (or lynx or an external ftp client)
to fetch the raw data from the net.
and untars (if not yet done) the distribution file, changes to the
appropriate directory and opens a subshell process in that directory.
+=item ls author
+
+C<ls> lists all distribution files in and below an author's CPAN
+directory. Only those files that contain modules are listed and if
+there is more than one for any given module, only the most recent one
+is listed.
+
=item Signals
CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
Modules know their associated Distribution objects. They always refer
to the most recent official release. Developers may mark their releases
as unstable development versions (by inserting an underbar into the
-visible version number), so the really hottest and newest distribution
-file is not always the default. If a module Foo circulates on CPAN in
-both version 1.23 and 1.23_90, CPAN.pm offers a convenient way to
-install version 1.23 by saying
+module version number which will also be reflected in the distribution
+name when you run 'make dist'), so the really hottest and newest
+distribution is not always the default. If a module Foo circulates
+on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
+way to install version 1.23 by saying
install Foo
perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
# install my favorite programs if necessary:
- for $mod (qw(Net::FTP MD5 Data::Dumper)){
+ for $mod (qw(Net::FTP Digest::MD5 Data::Dumper)){
my $obj = CPAN::Shell->expand('Module',$mod);
$obj->install;
}
methods are documented that have proven useful over a longer time and
thus are unlikely to change.
-=over
+=over 4
=item CPAN::Author::as_glimpse()
Changes to the directory where the distribution has been unpacked and
runs the external command C<make install> there. If C<make> has not
yet been run, it will be run first. A C<make test> will be issued in
-any case and if this fails, the install will be cancelled. The
+any case and if this fails, the install will be canceled. The
cancellation can be avoided by letting C<force> run the C<install> for
you.
=item CPAN::Module::description()
-Returns a 44 chracter description of this module. Only available for
+Returns a 44 character description of this module. Only available for
modules listed in The Module List (CPAN/modules/00modlist.long.html
or 00modlist.long.txt.gz)
=item CPAN::Module::look()
-Changes to the directory where the distribution assoicated with this
+Changes to the directory where the distribution associated with this
module has been unpacked and opens a subshell there. Exiting the
subshell returns.
"file:" URLs, then you only need a perl better than perl5.003 to run
this module. Otherwise Net::FTP is strongly recommended. LWP may be
required for non-UNIX systems or if your nearest CPAN site is
-associated with an URL that is not C<ftp:>.
+associated with a URL that is not C<ftp:>.
If you have neither Net::FTP nor LWP, there is a fallback mechanism
implemented for an external ftp command or for an external lynx
=head1 CONFIGURATION
-When the CPAN module is installed, a site wide configuration file is
-created as CPAN/Config.pm. The default values defined there can be
-overridden in another configuration file: CPAN/MyConfig.pm. You can
-store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
-$HOME/.cpan is added to the search path of the CPAN module before the
-use() or require() statements.
+When the CPAN module is used for the first time, a configuration
+dialog tries to determine a couple of site specific options. The
+result of the dialog is stored in a hash reference C< $CPAN::Config >
+in a file CPAN/Config.pm.
+
+The default values defined in the CPAN/Config.pm file can be
+overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
+best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
+added to the search path of the CPAN module before the use() or
+require() statements.
+
+The configuration dialog can be started any time later again by
+issueing the command C< o conf init > in the CPAN shell.
Currently the following keys in the hash reference $CPAN::Config are
defined:
dontload_hash anonymous hash: modules in the keys will not be
loaded by the CPAN::has_inst() routine
gzip location of external program gzip
+ histfile file to maintain history between sessions
+ histsize maximum number of lines to keep in histfile
inactivity_timeout breaks interactive Makefile.PLs after this
many seconds inactivity. Set to 0 to never break.
inhibit_startup_message
prerequisites_policy
what to do if you are missing module prerequisites
('follow' automatically, 'ask' me, or 'ignore')
+ proxy_user username for accessing an authenticating proxy
+ proxy_pass password for accessing an authenticating proxy
scan_cache controls scanning of cache ('atstart' or 'never')
tar location of external program tar
term_is_latin if true internal UTF-8 is translated to ISO-8859-1
Most functions in package CPAN are exported per default. The reason
for this is that the primary use is intended for the cpan shell or for
-oneliners.
+one-liners.
=head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
Firewalls can be categorized into three basic types.
-=over
+=over 4
=item http firewall
outside world you must do it via the web server. If you set environment
variables like http_proxy or ftp_proxy to a values beginning with http://
or in your web browser you have to set proxy information then you know
-you are running a http firewall.
+you are running an http firewall.
To access servers outside these types of firewalls with perl (even for
ftp) you will need to use LWP.
=item ftp firewall
-This where the firewall machine runs a ftp server. This kind of
+This where the firewall machine runs an ftp server. This kind of
firewall will only let you access ftp servers outside the firewall.
This is usually done by connecting to the firewall with ftp, then
entering a username like "user@outside.host.com"
=item One way visibility
-I say one way visibility as these firewalls try to make themselve look
+I say one way visibility as these firewalls try to make themselves look
invisible to the users inside the firewall. An FTP data connection is
normally created by sending the remote server your IP address and then
listening for the connection. But the remote server will not be able to
There are two that I can think off.
-=over
+=over 4
=item SOCKS
hide a complete network behind one IP address. With this firewall no
special compiling is needed as you can access hosts directly.
+For accessing ftp servers behind such firewalls you may need to set
+the environment variable C<FTP_PASSIVE> to a true value, e.g.
+
+ env FTP_PASSIVE=1 perl -MCPAN -eshell
+
+or
+
+ perl -MCPAN -e '$ENV{FTP_PASSIVE} = 1; shell'
+
+
=back
=back
o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
-Your milage may vary...
+Your mileage may vary...
=head1 FAQ
-=over
+=over 4
=item 1)
We should give coverage for B<all> of the CPAN and not just the PAUSE
part, right? In this discussion CPAN and PAUSE have become equal --
-but they are not. PAUSE is authors/, modules/ and scripts/. CPAN is
+but they are not. PAUSE is authors/, modules/ and scripts/. CPAN is
PAUSE plus the clpa/, doc/, misc/, ports/, and src/.
Future development should be directed towards a better integration of
Andreas Koenig E<lt>andreas.koenig@anima.deE<gt>
+=head1 TRANSLATIONS
+
+Kawai,Takanori provides a Japanese translation of this manpage at
+http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm
+
=head1 SEE ALSO
perl(1), CPAN::Nox(3)
https://perl5.git.perl.org / perl5.git / blobdiff