# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
package CPAN;
-$VERSION = '1.59_56';
-# $Id: CPAN.pm,v 1.385 2001/02/09 21:37:57 k Exp $
+$VERSION = '1.75_02';
+# $Id: CPAN.pm,v 1.409 2003/07/28 22:07:23 k Exp $
# only used during development:
$Revision = "";
-# $Revision = "[".substr(q$Revision: 1.385 $, 10)."]";
+# $Revision = "[".substr(q$Revision: 1.409 $, 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
$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;
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);
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};
$CPAN::Frontend->mydie("Could not open >$lockfile: $!");
}
$fh->print($$, "\n");
+ $fh->print(hostname(), "\n");
$self->{LOCK} = $lockfile;
$fh->close;
$SIG{TERM} = sub {
});
sleep 2;
+ } elsif ($mod eq "Module::Signature"){
+ unless ($Have_warned->{"Module::Signature"}++) {
+ # No point in complaining unless the user can
+ # reasonably install and use it.
+ if (eval { require Crypt::OpenPGP; 1 } ||
+ defined $CPAN::Config->{'gpg'}) {
+ $CPAN::Frontend->myprint(qq{
+ CPAN: Module::Signature security checks disabled because Module::Signature
+ not installed. Please consider installing the Module::Signature module.
+ You also need to be able to connect over the Internet to the public
+ keyservers like pgp.mit.edu (port 11371).
+
+})
+ sleep 2;
+ }
+ }
} else {
delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
}
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 ;
my @accept;
for (@arg) {
unless (/^[A-Z\-]+$/i) {
- $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author");
+ $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
next;
}
push @accept, uc $_;
#-> 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 {
print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
}
} else {
+ # chomp $what;
+ # $what .= "\n"; # newlines unless $PRINT_ORNAMENTING
print $what;
}
}
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 "",
@ISA = qw(Exporter LWP::UserAgent);
$SETUPDONE++;
} else {
- $CPAN::Frontent->mywarn("LWP::UserAgent not available\n");
+ $CPAN::Frontend->mywarn("LWP::UserAgent not available\n");
}
}
CPAN::LWP::UserAgent->config;
eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
if ($@) {
- $CPAN::Frontent->mywarn("CPAN::LWP::UserAgent->new dies with $@")
+ $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
if $CPAN::DEBUG;
} else {
my($var);
}
}
}
- $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);
CPAN::LWP::UserAgent->config;
eval { $Ua = CPAN::LWP::UserAgent->new; };
if ($@) {
- $CPAN::Frontent->mywarn("CPAN::LWP::UserAgent->new dies with $@");
+ $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
}
}
my $res = $Ua->mirror($url, $aslocal);
$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;
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,
$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 ;
$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;
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;
package CPAN::InfoObj;
# Accessors
-sub cpan_userid { shift->{RO}{CPAN_USERID} }
+sub cpan_userid {
+ my $self = shift;
+ $self->{RO}{CPAN_USERID}
+}
+
sub id { shift->{ID}; }
#-> sub CPAN::InfoObj::new ;
my $lc_want =
File::Spec->catfile($CPAN::Config->{keep_source_where},
"authors", "id", @$chksumfile);
+
+ my $fh;
+
+ # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
+ # hazard. (Without GPG installed they are not that much better,
+ # though.)
+ $fh = FileHandle->new;
+ if (open($fh, $lc_want)) {
+ my $line = <$fh>; close $fh;
+ unlink($lc_want) unless $line =~ /PGP/;
+ }
+
local($") = "/";
# connect "force" argument with "index_expire".
my $force = 0;
}
# adapted from CPAN::Distribution::MD5_check_file ;
- my $fh = FileHandle->new;
+ $fh = FileHandle->new;
my($cksum);
if (open $fh, $lc_file){
local($/);
) {
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) {
$CPAN::Config->{keep_source_where},
"authors",
"id",
- split("/",$self->id)
+ split(/\//,$self->id)
);
$self->debug("Doing localize") if $CPAN::DEBUG;
}
$self->{'build_dir'} = $packagedir;
- $self->safe_chdir(File::Spec->updir);
+ $self->safe_chdir($builddir);
File::Path::rmtree("tmp");
+ $self->safe_chdir($packagedir);
+ if ($CPAN::META->has_inst("Module::Signature")) {
+ if (-f "SIGNATURE") {
+ $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
+ my $rv = Module::Signature::verify();
+ if ($rv != Module::Signature::SIGNATURE_OK() and
+ $rv != Module::Signature::SIGNATURE_MISSING()) {
+ $CPAN::Frontend->myprint(
+ qq{\nSignature invalid for }.
+ qq{distribution file. }.
+ qq{Please investigate.\n\n}.
+ $self->as_string,
+ $CPAN::META->instance(
+ 'CPAN::Author',
+ $self->cpan_userid,
+ )->as_string
+ );
+
+ my $wrap = qq{I\'d recommend removing $self->{localfile}. Its signature
+is invalid. Maybe you have configured your 'urllist' with
+a bad URL. Please check this array with 'o conf urllist', and
+retry.};
+ $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
+ }
+ } else {
+ $CPAN::Frontend->myprint(qq{Package came without SIGNATURE\n\n});
+ }
+ } else {
+ $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
+ }
+ $self->safe_chdir($builddir);
+ return if $CPAN::Signal;
+
+
+
my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
my($mpl_exists) = -f $mpl;
unless ($mpl_exists) {
my $pwd = CPAN::anycwd();
$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");
+ unless (system($CPAN::Config->{'shell'}) == 0) {
+ my $code = $? >> 8;
+ $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
+ }
$self->safe_chdir($pwd);
}
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};
$CPAN::Config->{keep_source_where},
"authors",
"id",
- split("/","$sans.readme"),
+ split(/\//,"$sans.readme"),
);
$self->debug("Doing localize") if $CPAN::DEBUG;
$local_file = CPAN::FTP->localize("authors/id/$sans.readme",
$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 =
$self->MD5_check_file($lc_file);
}
+sub SIG_check_file {
+ my($self,$chk_file) = @_;
+ my $rv = eval { Module::Signature::_verify($chk_file) };
+
+ if ($rv == Module::Signature::SIGNATURE_OK()) {
+ $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
+ return $self->{SIG_STATUS} = "OK";
+ } else {
+ $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
+ qq{distribution file. }.
+ qq{Please investigate.\n\n}.
+ $self->as_string,
+ $CPAN::META->instance(
+ 'CPAN::Author',
+ $self->cpan_userid
+ )->as_string);
+
+ my $wrap = qq{I\'d recommend removing $chk_file. Its signature
+is invalid. Maybe you have configured your 'urllist' with
+a bad URL. Please check this array with 'o conf urllist', and
+retry.};
+
+ $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
+ }
+}
+
#-> sub CPAN::Distribution::MD5_check_file ;
sub MD5_check_file {
my($self,$chk_file) = @_;
my($cksum,$file,$basename);
+
+ if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) {
+ $self->debug("Module::Signature is installed, verifying");
+ $self->SIG_check_file($chk_file);
+ } else {
+ $self->debug("Module::Signature is NOT installed");
+ }
+
$file = $self->{localfile};
$basename = File::Basename::basename($file);
my $fh = FileHandle->new;
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
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";
$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};
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,;
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+$/;
} 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 ;
# 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.
=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
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
Your mileage may vary...
+=head1 Cryptographically signed modules
+
+Since release 1.72 CPAN.pm has been able to verify cryptographically
+signed module distributions using Module::Signature. The CPAN modules
+can be signed by their authors, thus giving more security. The simple
+unsigned MD5 checksums that were used before by CPAN protect mainly
+against accidental file corruption.
+
+You will need to have Module::Signature installed, which in turn
+requires that you have at least one of Crypt::OpenPGP module or the
+command-line F<gpg> tool installed.
+
+You will also need to be able to connect over the Internet to the public
+keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
+
=head1 FAQ
=over 4