+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
package CPAN;
use vars qw{$Try_autoload
$Revision
$META $Signal $Cwd $End
- $Suppress_readline %Dontload
+ $Suppress_readline
$Frontend $Defaultsite
}; #};
-$VERSION = '1.52';
+$VERSION = '1.57_57';
-# $Id: CPAN.pm,v 1.276 2000/01/08 15:29:46 k Exp $
+# $Id: CPAN.pm,v 1.324 2000/09/01 12:04:57 k Exp $
# only used during development:
$Revision = "";
-# $Revision = "[".substr(q$Revision: 1.276 $, 10)."]";
+# $Revision = "[".substr(q$Revision: 1.324 $, 10)."]";
use Carp ();
use Config ();
use Text::ParseWords ();
use Text::Wrap;
use File::Spec;
+no lib "."; # we need to run chdir all over and we would get at wrong
+ # libraries there
END { $End++; &cleanup; }
Eval 2048
Config 4096
Tarzip 8192
+ Version 16384
];
$CPAN::DEBUG ||= 0;
$CPAN::Defaultsite ||= "ftp://ftp.perl.org/pub/CPAN";
package CPAN;
-use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term);
+use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term);
use strict qw(vars);
@CPAN::ISA = qw(CPAN::Debug Exporter);
$Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
CPAN::Config->load unless $CPAN::Config_loaded++;
+ CPAN::Index->read_metadata_cache;
+
my $prompt = "cpan> ";
local($^W) = 1;
unless ($Suppress_readline) {
$try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
my $rl_avail = $Suppress_readline ? "suppressed" :
($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
- "available (try ``install Bundle::CPAN'')";
+ "available (try 'install Bundle::CPAN')";
$CPAN::Frontend->myprint(
qq{
my $command = shift @line;
eval { CPAN::Shell->$command(@line) };
warn $@ if $@;
- chdir $cwd;
+ chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
$CPAN::Frontend->myprint("\n");
$continuation = "";
$prompt = "cpan> ";
use File::Find;
package CPAN::Config;
-import ExtUtils::MakeMaker 'neatvalue';
use vars qw(%can $dot_cpan);
%can = (
$pkg =~ s|::|/|g;
if (defined($name=$INC{"$pkg.pm"}))
{
- $name =~ s|^(.*)$pkg\.pm$|$1auto/$pkg/$func.al|;
+ $name =~ s|^(.*)$pkg\.pm(?!\n)\Z|$1auto/$pkg/$func.al|s;
$name = undef unless (-r $name);
}
unless (defined $name)
*$autoload = sub {};
$ok = 1;
} else {
- if ($name =~ s{(\w{12,})\.al$}{substr($1,0,11).".al"}e){
+ if ($name =~ s{(\w{12,})\.al(?!\n)\Z}{substr($1,0,11).".al"}e){
eval {local $SIG{__DIE__};require $name};
}
if ($@){
}
*all = \&all_objects;
-# Called by shell, not in batch mode. Not clean XXX
+# Called by shell, not in batch mode. In batch mode I see no risk in
+# having many processes updating something as installations are
+# continually checked at runtime. In shell mode I suspect it is
+# unintentional to open more than one shell at a time
+
#-> sub CPAN::checklock ;
sub checklock {
my($self) = @_;
delete $META->{$class}{$id};
}
+#-> sub CPAN::has_usable
+# has_inst is sometimes too optimistic, we should replace it with this
+# has_usable whenever a case is given
+sub has_usable {
+ my($self,$mod,$message) = @_;
+ return 1 if $HAS_USABLE->{$mod};
+ my $has_inst = $self->has_inst($mod,$message);
+ return unless $has_inst;
+ my $capabilities;
+ $capabilities = {
+ LWP => [ # we frequently had "Can't locate object
+ # method "new" via package
+ # "LWP::UserAgent" at (eval 69) line
+ # 2006
+ sub {require LWP},
+ sub {require LWP::UserAgent},
+ sub {require HTTP::Request},
+ sub {require URI::URL},
+ ],
+ Net::FTP => [
+ sub {require Net::FTP},
+ sub {require Net::Config},
+ ]
+ };
+ if ($capabilities->{$mod}) {
+ for my $c (0..$#{$capabilities->{$mod}}) {
+ my $code = $capabilities->{$mod}[$c];
+ my $ret = eval { &$code() };
+ if ($@) {
+ warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
+ return;
+ }
+ }
+ }
+ return $HAS_USABLE->{$mod} = 1;
+}
+
#-> sub CPAN::has_inst
sub has_inst {
my($self,$mod,$message) = @_;
Carp::croak("CPAN->has_inst() called without an argument")
unless defined $mod;
- if (defined $message && $message eq "no") {
- $Dontload{$mod}||=1;
- return 0;
- } elsif (exists $Dontload{$mod}) {
- return 0;
+ if (defined $message && $message eq "no"
+ ||
+ exists $CPAN::META->{dontload_hash}{$mod}
+ ||
+ exists $CPAN::Config->{dontload_hash}{$mod}
+ ) {
+ $CPAN::META->{dontload_hash}{$mod}||=1;
+ return 0;
}
my $file = $mod;
my $obj;
shift->{DU};
}
+#-> sub CPAN::CacheMgr::tidyup ;
sub tidyup {
my($self) = @_;
return unless -d $self->{ID};
package CPAN::Config;
#-> sub CPAN::Config::edit ;
+# returns true on successful action
sub edit {
- my($class,@args) = @_;
+ my($self,@args) = @_;
return unless @args;
- CPAN->debug("class[$class]args[".join(" | ",@args)."]");
+ CPAN->debug("self[$self]args[".join(" | ",@args)."]");
my($o,$str,$func,$args,$key_exists);
$o = shift @args;
if($can{$o}) {
- $class->$o(@args);
+ $self->$o(@args);
return 1;
} else {
- if (ref($CPAN::Config->{$o}) eq ARRAY) {
+ CPAN->debug("o[$o]") if $CPAN::DEBUG;
+ if ($o =~ /list$/) {
$func = shift @args;
$func ||= "";
+ CPAN->debug("func[$func]") if $CPAN::DEBUG;
+ my $changed;
# Let's avoid eval, it's easier to comprehend without.
if ($func eq "push") {
push @{$CPAN::Config->{$o}}, @args;
+ $changed = 1;
} elsif ($func eq "pop") {
pop @{$CPAN::Config->{$o}};
+ $changed = 1;
} elsif ($func eq "shift") {
shift @{$CPAN::Config->{$o}};
+ $changed = 1;
} elsif ($func eq "unshift") {
unshift @{$CPAN::Config->{$o}}, @args;
+ $changed = 1;
} elsif ($func eq "splice") {
splice @{$CPAN::Config->{$o}}, @args;
+ $changed = 1;
} elsif (@args) {
$CPAN::Config->{$o} = [@args];
+ $changed = 1;
} else {
- $CPAN::Frontend->myprint(
- join "",
- " $o ",
- ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
- "\n"
- );
+ $self->prettyprint($o);
}
+ if ($o eq "urllist" && $changed) {
+ # reset the cached values
+ undef $CPAN::FTP::Thesite;
+ undef $CPAN::FTP::Themethod;
+ }
+ return $changed;
} else {
$CPAN::Config->{$o} = $args[0] if defined $args[0];
- $CPAN::Frontend->myprint(" $o " .
- (defined $CPAN::Config->{$o} ?
- $CPAN::Config->{$o} : "UNDEFINED"));
+ $self->prettyprint($o);
}
}
}
+sub prettyprint {
+ my($self,$k) = @_;
+ my $v = $CPAN::Config->{$k};
+ if (ref $v) {
+ my(@report) = ref $v eq "ARRAY" ?
+ @$v :
+ map { sprintf(" %-18s => %s\n",
+ $_,
+ defined $v->{$_} ? $v->{$_} : "UNDEFINED"
+ )} keys %$v;
+ $CPAN::Frontend->myprint(
+ join(
+ "",
+ sprintf(
+ " %-18s\n",
+ $k
+ ),
+ map {"\t$_\n"} @report
+ )
+ );
+ } elsif (defined $v) {
+ $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
+ } else {
+ $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, "UNDEFINED");
+ }
+}
+
#-> sub CPAN::Config::commit ;
sub commit {
my($self,$configpm) = @_;
}
}
- my $msg = <<EOF unless $configpm =~ /MyConfig/;
+ my $msg;
+ $msg = <<EOF unless $configpm =~ /MyConfig/;
# This is CPAN.pm's systemwide configuration file. This file provides
# defaults for users, and the values can be changed in a per-user
# system wide settings
shift @INC;
}
- return unless @miss = $self->not_loaded;
- # XXX better check for arrayrefs too
+ return unless @miss = $self->missing_config_data;
+
require CPAN::FirstTime;
my($configpm,$fh,$redo,$theycalled);
$redo ||= "";
CPAN::FirstTime::init($configpm);
}
-#-> sub CPAN::Config::not_loaded ;
-sub not_loaded {
+#-> sub CPAN::Config::missing_config_data ;
+sub missing_config_data {
my(@miss);
- for (qw(
- cpan_home keep_source_where build_dir build_cache scan_cache
- index_expire gzip tar unzip make pager makepl_arg make_arg
- make_install_arg urllist inhibit_startup_message
- ftp_proxy http_proxy no_proxy prerequisites_policy
- )) {
+ for (
+ "cpan_home", "keep_source_where", "build_dir", "build_cache",
+ "scan_cache", "index_expire", "gzip", "tar", "unzip", "make", "pager",
+ "makepl_arg", "make_arg", "make_install_arg", "urllist",
+ "inhibit_startup_message", "ftp_proxy", "http_proxy", "no_proxy",
+ "prerequisites_policy",
+
+ # "cache_metadata" # not yet stable enough
+
+ ) {
push @miss, $_ unless defined $CPAN::Config->{$_};
}
return @miss;
*help = \&h;
#-> sub CPAN::Shell::a ;
-sub a { $CPAN::Frontend->myprint(shift->format_result('Author',@_));}
+sub a {
+ my($self,@arg) = @_;
+ # authors are always UPPERCASE
+ for (@arg) {
+ $_ = uc $_;
+ }
+ $CPAN::Frontend->myprint($self->format_result('Author',@arg));
+}
#-> sub CPAN::Shell::b ;
sub b {
my($self,@which) = @_;
my($entry);
for $entry ($dh->read) {
next if -d MM->catdir($bdir,$entry);
- next unless $entry =~ s/\.pm$//;
+ next unless $entry =~ s/\.pm(?!\n)\Z//;
$CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
}
}
}
#-> sub CPAN::Shell::o ;
+
+# CPAN::Shell::o and CPAN::Config::edit are closely related. I suspect
+# some code duplication
sub o {
my($self,$o_type,@o_what) = @_;
$o_type ||= "";
CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
if ($o_type eq 'conf') {
shift @o_what if @o_what && $o_what[0] eq 'help';
- if (!@o_what) {
+ if (!@o_what) { # print all things, "o conf"
my($k,$v);
$CPAN::Frontend->myprint("CPAN::Config options");
if (exists $INC{'CPAN/Config.pm'}) {
}
$CPAN::Frontend->myprint("\n");
for $k (sort keys %$CPAN::Config) {
- $v = $CPAN::Config->{$k};
- if (ref $v) {
- $CPAN::Frontend->myprint(
- join(
- "",
- sprintf(
- " %-18s\n",
- $k
- ),
- map {"\t$_\n"} @{$v}
- )
- );
- } else {
- $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
- }
+ CPAN::Config->prettyprint($k);
}
$CPAN::Frontend->myprint("\n");
} elsif (!CPAN::Config->edit(@o_what)) {
my($k,$v);
for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
$v = $CPAN::DEBUG{$k};
- $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v) if $v & $CPAN::DEBUG;
+ $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
+ if $v & $CPAN::DEBUG;
}
} else {
$CPAN::Frontend->myprint("Debugging turned off completely.\n");
sub _binary_extensions {
my($self) = shift @_;
my(@result,$module,%seen,%need,$headerdone);
- my $isaperl = q{perl5[._-]\\d{3}(_[0-4][0-9])?\\.tar[._-]gz$};
for $module ($self->expand('Module','/./')) {
my $file = $module->cpan_file;
next if $file eq "N/A";
next if $file =~ /^Contact Author/;
- next if $file =~ / $isaperl /xo;
+ my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
+ next if $dist->isa_perl;
next unless $module->xs_file;
local($|) = 1;
$CPAN::Frontend->myprint(".");
my($self) = shift @_;
my($what) = shift @_;
CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
- Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
- Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
+ Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
+ $what && $what =~ /^[aru]$/;
my(@args) = @_;
@args = '/./' unless @args;
my(@result,$module,%seen,%need,$headerdone,
for $module ($self->expand('Module',@args)) {
my $file = $module->cpan_file;
next unless defined $file; # ??
- my($latest) = $module->cpan_version;
+ my($latest) = $module->cpan_version; # %vd not needed
my($inst_file) = $module->inst_file;
my($have);
return if $CPAN::Signal;
if ($inst_file){
if ($what eq "a") {
- $have = $module->inst_version;
+ $have = $module->inst_version; # %vd already applied
} elsif ($what eq "r") {
- $have = $module->inst_version;
+ $have = $module->inst_version; # %vd already applied
local($^W) = 0;
if ($have eq "undef"){
$version_undefs++;
} elsif ($have == 0){
$version_zeroes++;
}
- next if $have >= $latest;
+ next unless CPAN::Version->vgt($latest, $have);
# to be pedantic we should probably say:
# && !($have eq "undef" && $latest ne "undef" && $latest gt "");
# to catch the case where CPAN has a version 0 and we have a version undef
"in CPAN file"
));
}
- $latest = substr($latest,0,8) if length($latest) > 8;
- $have = substr($have,0,8) if length($have) > 8;
- $CPAN::Frontend->myprint(sprintf $sprintf, $module->id, $have, $latest, $file);
+ $CPAN::Frontend->myprint(sprintf $sprintf,
+ $module->id,
+ $have,
+ $latest,
+ $file);
$need{$module->id}++;
}
unless (%need) {
my $obj;
if (ref $s) {
$obj = $s;
+ } elsif ($s =~ m|^/|) { # looks like a regexp
+ $CPAN::Frontend->mydie("Sorry, $meth with a regular expression is not supported");
} elsif ($s =~ m|/|) { # looks like a file
$obj = $CPAN::META->instance('CPAN::Distribution',$s);
} elsif ($s =~ m|^Bundle::|) {
if $CPAN::META->exists('CPAN::Module',$s);
}
if (ref $obj) {
+ if ($pragma
+ &&
+ ($] < 5.00303 || $obj->can($pragma))){
+ ### compatibility with 5.003
+ $obj->$pragma($meth); # the pragma "force" in
+ # "CPAN::Distribution" must know
+ # what we are intending
+ }
+ if ($]>=5.00303 && $obj->can('called_for')) {
+ $obj->called_for($s);
+ }
CPAN->debug(
qq{pragma[$pragma]meth[$meth]obj[$obj]as_string\[}.
$obj->as_string.
qq{\]}
) if $CPAN::DEBUG;
- $obj->$pragma()
- if
- $pragma
- &&
- ($] < 5.00303 || $obj->can($pragma)); ###
- ### compatibility
- ### with
- ### 5.003
- if ($]>=5.00303 && $obj->can('called_for')) {
- $obj->called_for($s);
- }
CPAN::Queue->delete($s) if $obj->$meth(); # if it is more
# than once in
# the queue
}
#-> sub CPAN::FTP::localize ;
-# sorry for the ugly code here, I'll clean it up as soon as Net::FTP
-# is in the core
sub localize {
my($self,$file,$aslocal,$force) = @_;
$force ||= 0;
to insufficient permissions.\n}) unless -w $aslocal_dir;
# Inheritance is not easier to manage than a few if/else branches
- if ($CPAN::META->has_inst('LWP::UserAgent')) {
- require LWP::UserAgent;
+ if ($CPAN::META->has_usable('LWP::UserAgent')) {
unless ($Ua) {
$Ua = LWP::UserAgent->new;
my($var);
$Ua->proxy('ftp', $var)
- if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
+ if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
$Ua->proxy('http', $var)
- if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
+ if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
$Ua->no_proxy($var)
- if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
+ 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};
# Try the list of urls for each single object. We keep a record
# where we did get a file from
($a == $Thesite)
} 0..$last;
}
- my($level,@levels);
+ my(@levels);
if ($Themethod) {
@levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
} else {
@levels = qw/easy hard hardest/;
}
@levels = qw/easy/ if $^O eq 'MacOS';
- for $level (@levels) {
+ my($levelno);
+ for $levelno (0..$#levels) {
+ my $level = $levels[$levelno];
my $method = "host$level";
my @host_seq = $level eq "easy" ?
@reordered : 0..$last; # reordered has CDROM up front
return $ret;
} else {
unlink $aslocal;
+ last if $CPAN::Signal; # need to cleanup
}
}
- my(@mess);
- push @mess,
- qq{Please check, if the URLs I found in your configuration file \(}.
- join(", ", @{$CPAN::Config->{urllist}}).
- qq{\) are valid. The urllist can be edited.},
- qq{E.g. with ``o conf urllist push ftp://myurl/''};
- $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
- sleep 2;
- $CPAN::Frontend->myprint("Cannot fetch $file\n\n");
+ unless ($CPAN::Signal) {
+ my(@mess);
+ push @mess,
+ qq{Please check, if the URLs I found in your configuration file \(}.
+ join(", ", @{$CPAN::Config->{urllist}}).
+ qq{\) are valid. The urllist can be edited.},
+ qq{E.g. with 'o conf urllist push ftp://myurl/'};
+ $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
+ sleep 2;
+ $CPAN::Frontend->myprint("Cannot fetch $file\n\n");
+ }
if ($restore) {
rename "$aslocal.bak", $aslocal;
$CPAN::Frontend->myprint("Trying to get away with old file:\n" .
my($self,$host_seq,$file,$aslocal) = @_;
my($i);
HOSTEASY: for $i (@$host_seq) {
- my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
+ my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
unless ($self->is_reachable($url)) {
$CPAN::Frontend->myprint("Skipping $url (seems to be not reachable)\n");
sleep 2;
$self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
if ($url =~ /^file:/) {
my $l;
- if ($CPAN::META->has_inst('LWP')) {
- require URI::URL;
+ if ($CPAN::META->has_inst('URI::URL')) {
my $u = URI::URL->new($url);
$l = $u->path;
} else { # works only on Unix, is poorly constructed, but
$l =~ s|^file:||; # assume they
# meant
# file://localhost
- $l =~ s|^/|| unless -f $l; # e.g. /P:
+ $l =~ s|^/||s unless -f $l; # e.g. /P:
}
if ( -f $l && -r _) {
$Thesite = $i;
}
}
}
- if ($CPAN::META->has_inst('LWP')) {
+ if ($CPAN::META->has_usable('LWP')) {
$CPAN::Frontend->myprint("Fetching with LWP:
$url
");
utime $now, $now, $aslocal; # download time is more
# important than upload time
return $aslocal;
- } elsif ($url !~ /\.gz$/) {
+ } elsif ($url !~ /\.gz(?!\n)\Z/) {
my $gzurl = "$url.gz";
$CPAN::Frontend->myprint("Fetching with LWP:
$gzurl
) {
$Thesite = $i;
return $aslocal;
- } else {
- # next HOSTEASY ;
}
} else {
- # Alan Burlison informed me that in firewall envs Net::FTP
- # can still succeed where LWP fails. So we do not skip
- # Net::FTP anymore when LWP is available.
- # next HOSTEASY ;
+ # 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;
}
+ return if $CPAN::Signal;
if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
# that's the nice and easy way thanks to Graham
my($host,$dir,$getfile) = ($1,$2,$3);
- if ($CPAN::META->has_inst('Net::FTP')) {
+ if ($CPAN::META->has_usable('Net::FTP')) {
$dir =~ s|/+|/|g;
$CPAN::Frontend->myprint("Fetching with Net::FTP:
$url
$Thesite = $i;
return $aslocal;
}
- if ($aslocal !~ /\.gz$/) {
+ if ($aslocal !~ /\.gz(?!\n)\Z/) {
my $gz = "$aslocal.gz";
$CPAN::Frontend->myprint("Fetching with Net::FTP
$url.gz
# next HOSTEASY;
}
}
+ return if $CPAN::Signal;
}
}
$funkyftp = $CPAN::Config->{$f};
next unless defined $funkyftp;
next if $funkyftp =~ /^\s*$/;
- my($want_compressed);
- my $aslocal_uncompressed;
- ($aslocal_uncompressed = $aslocal) =~ s/\.gz//;
- my($source_switch) = "";
+ my($asl_ungz, $asl_gz);
+ ($asl_ungz = $aslocal) =~ s/\.gz//;
+ $asl_gz = "$asl_ungz.gz";
+ my($src_switch) = "";
if ($f eq "lynx"){
- $source_switch = " -source";
+ $src_switch = " -source";
} elsif ($f eq "ncftp"){
- $source_switch = " -c";
+ $src_switch = " -c";
}
my($chdir) = "";
- my($stdout_redir) = " > $aslocal_uncompressed";
+ my($stdout_redir) = " > $asl_ungz";
if ($f eq "ncftpget"){
$chdir = "cd $aslocal_dir && ";
$stdout_redir = "";
}
$CPAN::Frontend->myprint(
qq[
-Trying with "$funkyftp$source_switch" to get
+Trying with "$funkyftp$src_switch" to get
$url
]);
my($system) =
- "$chdir$funkyftp$source_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
&&
($f eq "lynx" ?
- -s $aslocal_uncompressed # lynx returns 0 on my
+ -s $asl_ungz # lynx returns 0 on my
# system even if it fails
: 1
)
) {
if (-s $aslocal) {
# Looks good
- } elsif ($aslocal_uncompressed ne $aslocal) {
+ } elsif ($asl_ungz ne $aslocal) {
# test gzip integrity
if (
- CPAN::Tarzip->gtest($aslocal_uncompressed)
+ CPAN::Tarzip->gtest($asl_ungz)
) {
- rename $aslocal_uncompressed, $aslocal;
+ rename $asl_ungz, $aslocal;
} else {
- CPAN::Tarzip->gzip($aslocal_uncompressed,
- "$aslocal_uncompressed.gz");
+ CPAN::Tarzip->gzip($asl_ungz,$asl_gz);
}
}
$Thesite = $i;
return $aslocal;
- } elsif ($url !~ /\.gz$/) {
- unlink $aslocal_uncompressed if
- -f $aslocal_uncompressed && -s _ == 0;
+ } elsif ($url !~ /\.gz(?!\n)\Z/) {
+ unlink $asl_ungz if
+ -f $asl_ungz && -s _ == 0;
my $gz = "$aslocal.gz";
my $gzurl = "$url.gz";
$CPAN::Frontend->myprint(
qq[
-Trying with "$funkyftp$source_switch" to get
+Trying with "$funkyftp$src_switch" to get
$url.gz
]);
- my($system) = "$funkyftp$source_switch '$url.gz' $devnull > ".
- "$aslocal_uncompressed.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
&&
- -s "$aslocal_uncompressed.gz"
+ -s $asl_gz
) {
# test gzip integrity
- if (CPAN::Tarzip->gtest("$aslocal_uncompressed.gz")) {
- CPAN::Tarzip->gunzip("$aslocal_uncompressed.gz",
- $aslocal);
+ if (CPAN::Tarzip->gtest($asl_gz)) {
+ CPAN::Tarzip->gunzip($asl_gz,$aslocal);
} else {
- rename $aslocal_uncompressed, $aslocal;
+ rename $asl_ungz, $aslocal;
}
$Thesite = $i;
return $aslocal;
} else {
- unlink "$aslocal_uncompressed.gz" if
- -f "$aslocal_uncompressed.gz";
+ unlink $asl_gz if -f $asl_gz;
}
} else {
my $estatus = $wstatus >> 8;
returned status $estatus (wstat $wstatus)$size
});
}
- }
- }
+ return if $CPAN::Signal;
+ } # lynx,ncftpget,ncftp
+ } # host
}
sub hosthardest {
} else {
$CPAN::Frontend->myprint("Hmm... Still failed!\n");
}
+ return if $CPAN::Signal;
} else {
$CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
qq{correctly protected.\n});
} else {
$CPAN::Frontend->myprint("Bad luck... Still failed!\n");
}
+ return if $CPAN::Signal;
$CPAN::Frontend->myprint("Can't access URL $url.\n\n");
sleep 2;
- }
+ } # host
}
sub talk_ftp {
#-> sub CPAN::Complete::cplx ;
sub cplx {
my($class, $word) = @_;
- grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
+ # I believed for many years that this was sorted, today I
+ # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
+ # make it sorted again. Maybe sort was dropped when GNU-readline
+ # support came in? The RCS file is difficult to read on that:-(
+ sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
}
#-> sub CPAN::Complete::cpl_any ;
File::Spec->catfile('modules', '03mlist.gz') :
File::Spec->catfile('modules', '03modlist.data.gz'),
$force));
+ $cl->write_metadata_cache;
$t2 = time;
$debug .= "03[".($t2 - $time)."]";
$time = $t2;
#-> sub CPAN::Index::rd_modpacks ;
sub rd_modpacks {
- my($cl, $index_target) = @_;
+ my($self, $index_target) = @_;
my @lines;
return unless defined $index_target;
$CPAN::Frontend->myprint("Going to read $index_target\n");
unshift @ls, "\n" x length($1) if /^(\n+)/;
push @lines, @ls;
}
+ # read header
+ my $line_count;
while (@lines) {
my $shift = shift(@lines);
+ $shift =~ /^Line-Count:\s+(\d+)/;
+ $line_count = $1 if $1;
last if $shift =~ /^\s*$/;
}
+ if (not defined $line_count) {
+
+ warn qq{Warning: Your $index_target does not contain a Line-Count 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;
+ } elsif ($line_count != scalar @lines) {
+
+ warn sprintf qq{Warning: Your %s
+contains a Line-Count header of %d but I see %d lines there. 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\n},
+$index_target, $line_count, scalar(@lines);
+
+ }
+ # A necessity since we have metadata_cache: delete what isn't
+ # there anymore
+ my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
+ CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
+ my(%exists);
foreach (@lines) {
chomp;
- my($mod,$version,$dist) = split;
-### $version =~ s/^\+//;
-
- # if it is a bundle, instantiate a bundle object
+ # before 1.56 we split into 3 and discarded the rest. From
+ # 1.57 we assign remaining text to $comment thus allowing to
+ # influence isa_perl
+ my($mod,$version,$dist,$comment) = split " ", $_, 4;
my($bundle,$id,$userid);
if ($mod eq 'CPAN' &&
CPAN::Queue->exists('CPAN')
)
) {
- local($^W)= 0;
- if ($version > $CPAN::VERSION){
- $CPAN::Frontend->myprint(qq{
- There\'s a new CPAN.pm version (v$version) available!
+ local($^W)= 0;
+ if ($version > $CPAN::VERSION){
+ $CPAN::Frontend->myprint(qq{
+ There's a new CPAN.pm version (v$version) available!
[Current version is v$CPAN::VERSION]
You might want to try
install Bundle::CPAN
reload cpan
without quitting the current session. It should be a seamless upgrade
while we are running...
-});
- sleep 2;
+}); #});
+ sleep 2;
$CPAN::Frontend->myprint(qq{\n});
}
last if $CPAN::Signal;
if ($bundle){
$id = $CPAN::META->instance('CPAN::Bundle',$mod);
- # warn "made mod[$mod]a bundle";
# Let's make it a module too, because bundles have so much
# in common with modules
$CPAN::META->instance('CPAN::Module',$mod);
- # warn "made mod[$mod]a module";
-# This "next" makes us faster but if the job is running long, we ignore
-# rereads which is bad. So we have to be a bit slower again.
-# } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
-# next;
+ } else {
- }
- else {
# instantiate a module object
$id = $CPAN::META->instance('CPAN::Module',$mod);
+
}
- if ($id->cpan_file ne $dist){
- $userid = $cl->userid($dist);
+ if ($id->cpan_file ne $dist){ # update only if file is
+ # different. CPAN prohibits same
+ # name with different version
+ $userid = $self->userid($dist);
$id->set(
'CPAN_USERID' => $userid,
- 'CPAN_VERSION' => $version,
- 'CPAN_FILE' => $dist
+ 'CPAN_VERSION' => $version, # %vd not needed
+ 'CPAN_FILE' => $dist,
+ 'CPAN_COMMENT' => $comment,
);
}
'CPAN_USERID' => $userid
);
}
-
+ if ($secondtime) {
+ for my $name ($mod,$dist) {
+ # CPAN->debug("confirm existence of name[$name]") if $CPAN::DEBUG;
+ $exists{$name} = undef;
+ }
+ }
return if $CPAN::Signal;
}
undef $fh;
+ if ($secondtime) {
+ for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
+ for my $o ($CPAN::META->all_objects($class)) {
+ next if exists $exists{$o->{ID}};
+ $CPAN::META->delete($class,$o->{ID});
+ CPAN->debug("deleting ID[$o->{ID}] in class[$class]") if $CPAN::DEBUG;
+ }
+ }
+ }
}
#-> sub CPAN::Index::rd_modlist ;
}
}
+#-> sub CPAN::Index::write_metadata_cache ;
+sub write_metadata_cache {
+ my($self) = @_;
+ return unless $CPAN::Config->{'cache_metadata'};
+ return unless $CPAN::META->has_usable("Storable");
+ my $cache;
+ foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
+ CPAN::Distribution)) {
+ $cache->{$k} = $CPAN::META->{$k};
+ }
+ my $metadata_file = MM->catfile($CPAN::Config->{cpan_home},"Metadata");
+ $CPAN::Frontend->myprint("Going to write $metadata_file\n");
+ $cache->{last_time} = $last_time;
+ eval { Storable::nstore($cache, $metadata_file) };
+ $CPAN::Frontent->mywarn($@) if $@;
+}
+
+#-> sub CPAN::Index::read_metadata_cache ;
+sub 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");
+ 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 $@;
+ return if (!$cache || ref $cache ne 'HASH');
+ while(my($k,$v) = each %$cache) {
+ next unless $k =~ /^CPAN::/;
+ for my $k2 (keys %$v) {
+ delete $v->{$k2}{force_update}; # if a buggy CPAN.pm left
+ # over such a mess, it's
+ # high time to correct now
+ }
+ $CPAN::META->{$k} = $v;
+ }
+ $last_time = $cache->{last_time};
+}
+
package CPAN::InfoObj;
#-> sub CPAN::InfoObj::new ;
join "", @m;
}
-# Dead code, I would have liked to have,,, but it was never reached,,,
-#sub make {
-# my($self) = @_;
-# return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
-#}
-
#-> sub CPAN::Author::fullname ;
sub fullname { shift->{'FULLNAME'} }
*name = \&fullname;
EXCUSE: {
my @e;
exists $self->{'build_dir'} and push @e,
- "Unwrapped into directory $self->{'build_dir'}";
+ "Is already unwrapped into directory $self->{'build_dir'}";
$CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
}
my($local_file);
$local_file =
CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted)
or $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n");
+ return if $CPAN::Signal;
$self->{localfile} = $local_file;
+ $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
my $builddir = $CPAN::META->{cachemgr}->dir;
$self->debug("doing chdir $builddir") if $CPAN::DEBUG;
chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
$self->debug("Removing tmp") if $CPAN::DEBUG;
File::Path::rmtree("tmp");
mkdir "tmp", 0755 or Carp::croak "Couldn't mkdir tmp: $!";
- chdir "tmp";
+ chdir "tmp" or $CPAN::Frontend->mydie(qq{Could not chdir to "tmp": $!});;
$self->debug("Changed directory to tmp") if $CPAN::DEBUG;
+ return if $CPAN::Signal;
if (! $local_file) {
Carp::croak "bad download, can't do anything :-(\n";
- } elsif ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)$/i){
+ } elsif ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)(?!\n)\Z/i){
$self->untar_me($local_file);
- } elsif ( $local_file =~ /\.zip$/i ) {
+ } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
$self->unzip_me($local_file);
- } elsif ( $local_file =~ /\.pm\.(gz|Z)$/) {
+ } elsif ( $local_file =~ /\.pm\.(gz|Z)(?!\n)\Z/) {
$self->pm2dir_me($local_file);
} else {
$self->{archived} = "NO";
}
- chdir File::Spec->updir;
+ my $cwd = File::Spec->updir;
+ chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "": $!});
if ($self->{archived} ne 'NO') {
- chdir File::Spec->catdir(File::Spec->curdir, "tmp");
- # Let's check if the package has its own directory.
- my $dh = DirHandle->new(File::Spec->curdir)
- or Carp::croak("Couldn't opendir .: $!");
- my @readdir = grep $_ !~ /^\.\.?$/, $dh->read; ### MAC??
- $dh->close;
- my ($distdir,$packagedir);
- if (@readdir == 1 && -d $readdir[0]) {
- $distdir = $readdir[0];
- $packagedir = MM->catdir($builddir,$distdir);
- -d $packagedir and $CPAN::Frontend->myprint("Removing previously used $packagedir\n");
- File::Path::rmtree($packagedir);
- rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
- } else {
- my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
- $pragmatic_dir =~ s/\W_//g;
- $pragmatic_dir++ while -d "../$pragmatic_dir";
- $packagedir = MM->catdir($builddir,$pragmatic_dir);
- File::Path::mkpath($packagedir);
- my($f);
- for $f (@readdir) { # is already without "." and ".."
- my $to = MM->catdir($packagedir,$f);
- rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
- }
- }
- $self->{'build_dir'} = $packagedir;
- chdir File::Spec->updir;
-
- $self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
- if $CPAN::DEBUG;
- File::Path::rmtree("tmp");
- if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
- $CPAN::Frontend->myprint("Going to unlink $local_file\n");
- unlink $local_file or Carp::carp "Couldn't unlink $local_file";
- }
- my($makefilepl) = MM->catfile($packagedir,"Makefile.PL");
- unless (-f $makefilepl) {
- my($configure) = MM->catfile($packagedir,"Configure");
- if (-f $configure) {
- # do we have anything to do?
- $self->{'configure'} = $configure;
- } elsif (-f MM->catfile($packagedir,"Makefile")) {
- $CPAN::Frontend->myprint(qq{
+ $cwd = File::Spec->catdir(File::Spec->curdir, "tmp");
+ chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
+ # Let's check if the package has its own directory.
+ my $dh = DirHandle->new(File::Spec->curdir)
+ or Carp::croak("Couldn't opendir .: $!");
+ my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
+ $dh->close;
+ my ($distdir,$packagedir);
+ if (@readdir == 1 && -d $readdir[0]) {
+ $distdir = $readdir[0];
+ $packagedir = MM->catdir($builddir,$distdir);
+ -d $packagedir and $CPAN::Frontend->myprint("Removing previously used $packagedir\n");
+ File::Path::rmtree($packagedir);
+ rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
+ } else {
+ my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
+ $pragmatic_dir =~ s/\W_//g;
+ $pragmatic_dir++ while -d "../$pragmatic_dir";
+ $packagedir = MM->catdir($builddir,$pragmatic_dir);
+ File::Path::mkpath($packagedir);
+ my($f);
+ for $f (@readdir) { # is already without "." and ".."
+ my $to = MM->catdir($packagedir,$f);
+ rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
+ }
+ }
+ $self->{'build_dir'} = $packagedir;
+ $cwd = File::Spec->updir;
+ chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
+
+ $self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
+ if $CPAN::DEBUG;
+ File::Path::rmtree("tmp");
+ if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
+ $CPAN::Frontend->myprint("Going to unlink $local_file\n");
+ unlink $local_file or Carp::carp "Couldn't unlink $local_file";
+ }
+ my($makefilepl) = MM->catfile($packagedir,"Makefile.PL");
+ unless (-f $makefilepl) {
+ my($configure) = MM->catfile($packagedir,"Configure");
+ if (-f $configure) {
+ # do we have anything to do?
+ $self->{'configure'} = $configure;
+ } elsif (-f MM->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.
});
- $self->{writemakefile} = "YES";
- sleep 2;
- } else {
- my $fh = FileHandle->new(">$makefilepl")
- or Carp::croak("Could not open >$makefilepl");
- my $cf = $self->called_for || "unknown";
- $fh->print(
+ $self->{writemakefile} = "YES";
+ sleep 2;
+ } else {
+ my $fh = FileHandle->new(">$makefilepl")
+ or Carp::croak("Could not open >$makefilepl");
+ my $cf = $self->called_for || "unknown";
+ $fh->print(
qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
# because there was no Makefile.PL supplied.
# Autogenerated on: }.scalar localtime().qq{
WriteMakefile(NAME => q[$cf]);
});
- $CPAN::Frontend->myprint(qq{Package comes without Makefile.PL.
+ $CPAN::Frontend->myprint(qq{Package comes without Makefile.PL.
Writing one on our own (calling it $cf)\n});
- }
- }
+ }
+ }
}
return $self;
}
sub unzip_me {
my($self,$local_file) = @_;
$self->{archived} = "zip";
- my $system = "$CPAN::Config->{unzip} $local_file";
- if (system($system) == 0) {
+ if (CPAN::Tarzip->unzip($local_file)) {
$self->{unwrapped} = "YES";
} else {
$self->{unwrapped} = "NO";
}
+ return;
}
sub pm2dir_me {
my($self,$local_file) = @_;
$self->{archived} = "pm";
my $to = File::Basename::basename($local_file);
- $to =~ s/\.(gz|Z)$//;
+ $to =~ s/\.(gz|Z)(?!\n)\Z//;
if (CPAN::Tarzip->gunzip($local_file,$to)) {
$self->{unwrapped} = "YES";
} else {
sub new {
my($class,%att) = @_;
- $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
+ # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
my $this = { %att };
return bless $this, $class;
my $getcwd;
$getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
my $pwd = CPAN->$getcwd();
- chdir($dir);
+ chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
$CPAN::Frontend->myprint(qq{Working directory is $dir\n});
system($CPAN::Config->{'shell'}) == 0
or $CPAN::Frontend->mydie("Subprocess shell error");
- chdir($pwd);
+ chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
}
sub cvs_import {
my $package = $self->called_for;
my $module = $CPAN::META->instance('CPAN::Module', $package);
- my $version = $module->cpan_version;
+ my $version = $module->cpan_version; # %vd not needed
my $userid = $self->{CPAN_USERID};
my $cvs_dir = (split '/', $dir)[-1];
- $cvs_dir =~ s/-\d+[^-]+$//;
+ $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
my $cvs_root =
$CPAN::Config->{cvsroot} || $ENV{CVSROOT};
my $cvs_site_perl =
my $getcwd;
$getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
my $pwd = CPAN->$getcwd();
- chdir($dir);
+ chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
$CPAN::Frontend->myprint(qq{Working directory is $dir\n});
$CPAN::Frontend->myprint(qq{@cmd\n});
- system(@cmd) == 0 or
+ system(@cmd) == 0 or
$CPAN::Frontend->mydie("cvs import failed");
- chdir($pwd);
+ chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
}
#-> sub CPAN::Distribution::readme ;
$lc_file = CPAN::FTP->localize("authors/id/@local",
"$lc_want.gz",1);
if ($lc_file) {
- $lc_file =~ s/\.gz$//;
+ $lc_file =~ s/\.gz(?!\n)\Z//;
CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file);
} else {
return;
$CPAN::Frontend->myprint("Checksum for $file ok\n");
return $self->{MD5_STATUS} = "OK";
} else {
- $CPAN::Frontend->myprint(qq{Checksum mismatch for }.
+ $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
qq{distribution file. }.
qq{Please investigate.\n\n}.
$self->as_string,
'CPAN::Author',
$self->{CPAN_USERID}
)->as_string);
- my $wrap = qq{I\'d recommend removing $file. It seems to
-be a bogus file. Maybe you have configured your \`urllist\' with a
-bad URL. Please check this array with \`o conf urllist\', and
+
+ my $wrap = qq{I\'d recommend removing $file. Its MD5
+checksum is incorrect. Maybe you have configured your 'urllist' with
+a bad URL. Please check this array with 'o conf urllist', and
retry.};
- $CPAN::Frontend->myprint(Text::Wrap::wrap("","",$wrap));
- $CPAN::Frontend->myprint("\n\n");
- sleep 3;
- return;
+
+ $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
+
+ # former versions just returned here but this seems a
+ # serious threat that deserves a die
+
+ # $CPAN::Frontend->myprint("\n\n");
+ # sleep 3;
+ # return;
}
# close $fh if fileno($fh);
} else {
}
#-> sub CPAN::Distribution::force ;
+
+# Both modules and distributions know if "force" is in effect by
+# autoinspection, not by inspecting a global variable. One of the
+# reason why this was chosen to work that way was the treatment of
+# dependencies. They should not autpomatically inherit the force
+# status. But this has the downside that ^C and die() will return to
+# the prompt but will not be able to reset the force_update
+# attributes. We try to correct for it currently in the read_metadata
+# routine, and immediately before we check for a Signal. I hope this
+# works out in one of v1.57_53ff
+
sub force {
- my($self) = @_;
- $self->{'force_update'}++;
+ my($self, $method) = @_;
for my $att (qw(
MD5_STATUS archived build_dir localfile make install unwrapped
writemakefile
)) {
delete $self->{$att};
}
+ if ($method && $method eq "install") {
+ $self->{"force_update"}++; # name should probably have been force_install
+ }
}
+#-> sub CPAN::Distribution::unforce ;
+sub unforce {
+ my($self) = @_;
+ delete $self->{'force_update'};
+}
+
+#-> sub CPAN::Distribution::isa_perl ;
sub isa_perl {
my($self) = @_;
my $file = File::Basename::basename($self->id);
- return unless $file =~ m{ ^ perl
- (5)
- ([._-])
- (\d{3}(_[0-4][0-9])?)
- \.tar[._-]gz
- $
- }x;
- "$1.$3";
+ if ($file =~ m{ ^ perl
+ -?
+ (5)
+ ([._-])
+ (
+ \d{3}(_[0-4][0-9])?
+ |
+ \d*[24680]\.\d+
+ )
+ \.tar[._-]gz
+ (?!\n)\Z
+ }xs){
+ return "$1.$3";
+ } elsif ($self->{'CPAN_COMMENT'} && $self->{'CPAN_COMMENT'} =~ /isa_perl\(.+?\)/){
+ return $1;
+ }
}
#-> sub CPAN::Distribution::perl ;
# Emergency brake if they said install Pippi and get newest perl
if ($self->isa_perl) {
if (
- $self->called_for ne $self->id && ! $self->{'force_update'}
+ $self->called_for ne $self->id &&
+ ! $self->{force_update}
) {
- $CPAN::Frontend->mydie(sprintf qq{
+ # if we die here, we break bundles
+ $CPAN::Frontend->mywarn(sprintf qq{
The most recent version "%s" of the module "%s"
comes with the current version of perl (%s).
I\'ll build that only if you ask for something like
$CPAN::META->instance(
'CPAN::Module',
$self->called_for
- )->cpan_version,
+ )->cpan_version, # %vd not needed
$self->called_for,
$self->isa_perl,
$self->called_for,
$self->id);
+ sleep 5; return;
}
}
$self->get;
}
if (-f "Makefile") {
$self->{writemakefile} = "YES";
+ delete $self->{make_clean}; # if cleaned before, enable next
} else {
$self->{writemakefile} =
qq{NO Makefile.PL refused to write a Makefile.};
# $self->{writemakefile} .= <$fh>;
}
}
- return if $CPAN::Signal;
+ if ($CPAN::Signal){
+ delete $self->{force_update};
+ return;
+ }
if (my @prereq = $self->needs_prereq){
my $id = $self->id;
$CPAN::Frontend->myprint("---- Dependencies detected ".
$follow = $answer =~ /^\s*y/i;
} else {
local($") = ", ";
- $CPAN::Frontend->myprint(" Ignoring dependencies on modules @prereq\n");
+ $CPAN::Frontend->
+ myprint(" Ignoring dependencies on modules @prereq\n");
}
if ($follow) {
CPAN::Queue->jumpqueue(@prereq,$id); # requeue yourself
$CPAN::Frontend->mydie("Couldn't open Makefile: $!");
local($/) = "\n";
- my(@p,@need);
+ # A.Speer @p -> %p, where %p is $p{Module::Name}=Required_Version
+ #
+ my(%p,@need);
while (<$fh>) {
last if /MakeMaker post_initialize section/;
my($p) = m{^[\#]
next unless $p;
# warn "Found prereq expr[$p]";
- while ( $p =~ m/(?:\s)([\w\:]+)=>q\[.*?\],?/g ){
- push @p, $1;
+ # Regexp modified by A.Speer to remember actual version of file
+ # PREREQ_PM hash key wants, then add to
+ while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
+ # In case a prereq is mentioned twice, complain.
+ if ( defined $p{$1} ) {
+ warn "Warning: PREREQ_PM mentions $1 more than once, last mention wins";
+ }
+ $p{$1} = $2;
}
last;
}
- for my $p (@p) {
- my $mo = $CPAN::META->instance("CPAN::Module",$p);
- next if $mo->uptodate;
- # it's not needed, so don't push it. We cannot omit this step, because
- # if 'force' is in effect, nobody else will check.
- if ($self->{have_sponsored}{$p}++){
+ NEED: while (my($module, $need_version) = each %p) {
+ my $mo = $CPAN::META->instance("CPAN::Module",$module);
+ # we were too demanding:
+ # next if $mo->uptodate;
+
+ # We only want to install prereqs if either they're not installed
+ # or if the installed version is too old. We cannot omit this
+ # check, because if 'force' is in effect, nobody else will check.
+ {
+ local($^W) = 0;
+ if (
+ defined $mo->inst_file &&
+ ! CPAN::Version->vgt($need_version, $mo->inst_version)
+ ){
+ CPAN->debug(sprintf "inst_file[%s]inst_version[%s]need_version[%s]",
+ $mo->inst_file,
+ $mo->inst_version,
+ CPAN::Version->readable($need_version)
+ );
+ next NEED;
+ }
+ }
+
+ if ($self->{have_sponsored}{$module}++){
# We have already sponsored it and for some reason it's still
# not available. So we do nothing. Or what should we do?
# if we push it again, we have a potential infinite loop
next;
}
- push @need, $p;
+ push @need, $module;
}
return @need;
}
sub test {
my($self) = @_;
$self->make;
- return if $CPAN::Signal;
+ if ($CPAN::Signal){
+ delete $self->{force_update};
+ return;
+ }
$CPAN::Frontend->myprint("Running make test\n");
EXCUSE: {
my @e;
exists $self->{'make'} and
$self->{'make'} eq 'NO' and
- push @e, "Oops, make had returned bad status";
+ push @e, "Can't test without successful make";
exists $self->{'build_dir'} or push @e, "Has no own directory";
$CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
$CPAN::Frontend->myprint("Running make clean\n");
EXCUSE: {
my @e;
- exists $self->{'build_dir'} or push @e, "Has no own directory";
+ exists $self->{make_clean} and $self->{make_clean} eq "YES" and
+ push @e, "make clean already called once";
+ exists $self->{build_dir} or push @e, "Has no own directory";
$CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
}
chdir $self->{'build_dir'} or
my $system = join " ", $CPAN::Config->{'make'}, "clean";
if (system($system) == 0) {
- $CPAN::Frontend->myprint(" $system -- OK\n");
- $self->force;
+ $CPAN::Frontend->myprint(" $system -- OK\n");
+
+ # $self->force;
+
+ # Jost Krieger pointed out that this "force" was wrong because
+ # it has the effect that the next "install" on this distribution
+ # will untar everything again. Instead we should bring the
+ # object's state back to where it is after untarring.
+
+ delete $self->{force_update};
+ delete $self->{install};
+ delete $self->{writemakefile};
+ delete $self->{make};
+ delete $self->{make_test}; # no matter if yes or no, tests must be redone
+ $self->{make_clean} = "YES";
+
} else {
- # Hmmm, what to do if make clean failed?
+ # Hmmm, what to do if make clean failed?
+
+ $CPAN::Frontend->myprint(qq{ $system -- NOT OK
+
+make clean did not succeed, marking directory as unusable for further work.
+});
+ $self->force("make"); # so that this directory won't be used again
+
}
}
sub install {
my($self) = @_;
$self->test;
- return if $CPAN::Signal;
+ if ($CPAN::Signal){
+ delete $self->{force_update};
+ return;
+ }
$CPAN::Frontend->myprint("Running make install\n");
EXCUSE: {
my @e;
exists $self->{'make'} and
$self->{'make'} eq 'NO' and
- push @e, "Oops, make had returned bad status";
+ push @e, "make had returned bad status, won't install without force";
push @e, "make test had returned bad status, ".
"won't install without force"
qq{to root to install the package\n});
}
}
+ delete $self->{force_update};
}
#-> sub CPAN::Distribution::dir ;
sub as_string {
my($self) = @_;
$self->contains;
- $self->{INST_VERSION} = $self->inst_version;
+ # following line must be "=", not "||=" because we have a moving target
+ $self->{INST_VERSION} = $self->inst_version; # %vd already applied
return $self->SUPER::as_string;
}
require ExtUtils::Manifest;
my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
my $cwd = CPAN->$getcwd();
- chdir $where;
+ chdir $where or $CPAN::Frontend->mydie(qq{Could not chdir to "$where": $!});
ExtUtils::Manifest::mkmanifest();
- chdir $cwd;
+ chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
}
my $fh = FileHandle->new($manifest)
or Carp::croak("Couldn't open $manifest: $!");
sleep 3;
}
# possibly noisy action:
+ $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
my $obj = $CPAN::META->instance($type,$s);
$obj->$meth();
- my $success = $obj->can("uptodate") ? $obj->uptodate : 0;
- $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
- $fail{$s} = 1 unless $success;
+ if ($obj->isa(CPAN::Bundle)
+ &&
+ exists $obj->{install_failed}
+ &&
+ ref($obj->{install_failed}) eq "HASH"
+ ) {
+ for (keys %{$obj->{install_failed}}) {
+ $self->{install_failed}{$_} = undef; # propagate faiure up
+ # to me in a
+ # recursive call
+ $fail{$s} = 1; # the bundle itself may have succeeded but
+ # not all children
+ }
+ } else {
+ my $success;
+ $success = $obj->can("uptodate") ? $obj->uptodate : 0;
+ $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
+ if ($success) {
+ delete $self->{install_failed}{$s};
+ } else {
+ $fail{$s} = 1;
+ }
+ }
}
+
# recap with less noise
- if ( $meth eq "install") {
+ if ( $meth eq "install" ) {
if (%fail) {
require Text::Wrap;
my $raw = sprintf(qq{Bundle summary:
$CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
$CPAN::Frontend->myprint("\n");
my $paragraph = "";
+ my %reported;
for $s ($self->contains) {
- $paragraph .= "$s " if $fail{$s};
+ if ($fail{$s}){
+ $paragraph .= "$s ";
+ $self->{install_failed}{$s} = undef;
+ $reported{$s} = undef;
+ }
}
+ my $report_propagated;
+ for $s (sort keys %{$self->{install_failed}}) {
+ next if exists $reported{$s};
+ $paragraph .= "and the following items had problems
+during recursive bundle calls: " unless $report_propagated++;
+ $paragraph .= "$s ";
+ }
$CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
$CPAN::Frontend->myprint("\n");
} else {
);
}
}
- push @m, sprintf($sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION})
- if $self->{CPAN_VERSION};
+ push @m, sprintf($sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION}) # %vd not needed
+ if $self->{CPAN_VERSION}; # %vd not needed
push @m, sprintf($sprintf, 'CPAN_FILE', $self->{CPAN_FILE})
if $self->{CPAN_FILE};
my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
push @m, sprintf($sprintf, 'INST_FILE',
$local_file || "(not installed)");
push @m, sprintf($sprintf, 'INST_VERSION',
- $self->inst_version) if $local_file;
+ $self->inst_version) if $local_file; #%vd already applied
join "", @m, "\n";
}
sub manpage_headline {
my($self,$local_file) = @_;
my(@local_file) = $local_file;
- $local_file =~ s/\.pm$/.pod/;
+ $local_file =~ s/\.pm(?!\n)\Z/.pod/;
push @local_file, $local_file;
my(@result,$locf);
for $locf (@local_file) {
my $email = $CPAN::META->instance(CPAN::Author,
$self->{'userid'})->email;
unless (defined $fullname && defined $email) {
- return "Contact Author $self->{userid} (Try ``a $self->{userid}'')";
+ return "Contact Author $self->{userid} (Try 'a $self->{userid}')";
}
return "Contact Author $fullname <$email>";
} else {
# and do not want to
# provoke too many
# bugreports
- $self->{'CPAN_VERSION'};
+ $self->{'CPAN_VERSION'}; # %vd not needed
}
#-> sub CPAN::Module::force ;
Either the module has not yet been uploaded to CPAN, or it is
temporary unavailable. Please contact the author to find out
- more about the status. Try ``i %s''.
+ more about the status. Try 'i %s'.
},
$self->id,
$self->id,
}
my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
$pack->called_for($self->id);
- $pack->force if exists $self->{'force_update'};
+ $pack->force($meth) if exists $self->{'force_update'};
$pack->$meth();
+ $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
delete $self->{'force_update'};
}
#-> sub CPAN::Module::uptodate ;
sub uptodate {
my($self) = @_;
- my($latest) = $self->cpan_version;
+ my($latest) = $self->cpan_version; # %vd not needed
$latest ||= 0;
my($inst_file) = $self->inst_file;
my($have) = 0;
if (defined $inst_file) {
- $have = $self->inst_version;
+ $have = $self->inst_version; # %vd already applied
}
local($^W)=0;
if ($inst_file
&&
- $have >= $latest
+ ! CPAN::Version->vgt($latest, $have)
) {
return 1;
}
my($self) = @_;
my $parsefile = $self->inst_file or return;
local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
- # warn "HERE";
- my $have = MM->parse_version($parsefile) || "undef";
+ my $have;
+ # local($SIG{__WARN__}) = sub { warn "1. have[$have]"; };
+
+ # there was a bug in 5.6.0 that let lots of unini warnings out of
+ # parse_version. Fixed shortly after 5.6.0 by PMQS. We can remove
+ # the following workaround after 5.6.1 is out.
+ local($SIG{__WARN__}) = sub { my $w = shift;
+ return if $w =~ /uninitialized/i;
+ warn $w;
+ };
+
+ $have = MM->parse_version($parsefile) || "undef";
+ $have =~ s/^ //; # since the %vd hack these two lines here are needed
+ $have =~ s/ $//; # trailing whitespace happens all the time
+
+ # local($SIG{__WARN__}) = sub { warn "2. have[$have]"; };
+
+ # My thoughts about why %vd processing should happen here
+
+ # Alt1 maintain it as string with leading v:
+ # read index files do nothing
+ # compare it use utility for compare
+ # print it do nothing
+
+ # Alt2 maintain it as what is is
+ # read index files convert
+ # compare it use utility because there's still a ">" vs "gt" issue
+ # print it use CPAN::Version for print
+
+ # Seems cleaner to hold it in memory as a string starting with a "v"
+
+ # If the author of this module made a mistake and wrote a quoted
+ # "v1.13" instead of v1.13, we simply leave it at that with the
+ # effect that *we* will treat it like a v-tring while the rest of
+ # perl won't. Seems sensible when we consider that any action we
+ # could take now would just add complexity.
+
+ $have = CPAN::Version->readable($have);
+
$have =~ s/\s*//g; # stringify to float around floating point issues
- $have;
+ $have; # no stringify needed, \s* above matches always
}
package CPAN::Tarzip;
+# CPAN::Tarzip::gzip
sub gzip {
my($class,$read,$write) = @_;
if ($CPAN::META->has_inst("Compress::Zlib")) {
}
}
+
+# CPAN::Tarzip::gunzip
sub gunzip {
my($class,$read,$write) = @_;
if ($CPAN::META->has_inst("Compress::Zlib")) {
}
}
+
+# CPAN::Tarzip::gtest
sub gtest {
my($class,$read) = @_;
if ($CPAN::META->has_inst("Compress::Zlib")) {
my $gz = Compress::Zlib::gzopen($read, "rb")
or $CPAN::Frontend->mydie("Cannot open $read: $!\n");
1 while $gz->gzread($buffer) > 0 ;
- $CPAN::Frontend->mydie("Error reading from $read: $!\n")
- if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
- $gz->gzclose() ;
- return 1;
+ my $err = $gz->gzerror;
+ my $success = ! $err || $err == Compress::Zlib::Z_STREAM_END();
+ $gz->gzclose();
+ $class->debug("err[$err]success[$success]") if $CPAN::DEBUG;
+ return $success;
} else {
return system("$CPAN::Config->{'gzip'} -dt $read")==0;
}
}
+
+# CPAN::Tarzip::TIEHANDLE
sub TIEHANDLE {
my($class,$file) = @_;
my $ret;
$ret;
}
+
+# CPAN::Tarzip::READLINE
sub READLINE {
my($self) = @_;
if (exists $self->{GZ}) {
}
}
+
+# CPAN::Tarzip::READ
sub READ {
my($self,$ref,$length,$offset) = @_;
die "read with offset not implemented" if defined $offset;
}
}
+
+# CPAN::Tarzip::DESTROY
sub DESTROY {
my($self) = @_;
if (exists $self->{GZ}) {
undef $self;
}
+
+# CPAN::Tarzip::untar
sub untar {
my($class,$file) = @_;
- # had to disable, because version 0.07 seems to be buggy
- if (MM->maybe_command($CPAN::Config->{'gzip'})
+ if (0) { # makes changing order easier
+ } elsif ($CPAN::META->has_inst("Archive::Tar")
+ &&
+ $CPAN::META->has_inst("Compress::Zlib") ) {
+ my $tar = Archive::Tar->new($file,1);
+ my $af; # archive file
+ for $af ($tar->list_files) {
+ if ($af =~ m!^(/|\.\./)!) {
+ $CPAN::Frontend->mydie("ALERT: Archive contains illegal member [$af]");
+ }
+ $CPAN::Frontend->myprint("$af\n");
+ $tar->extract($af);
+ return if $CPAN::Signal;
+ }
+
+ ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1)
+ if ($^O eq 'MacOS');
+
+ return 1;
+ } elsif (MM->maybe_command($CPAN::Config->{'gzip'})
&&
MM->maybe_command($CPAN::Config->{'tar'})) {
my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
qq{Couldn\'t uncompress $file\n}
);
}
- $file =~ s/\.gz$//;
+ $file =~ s/\.gz(?!\n)\Z//;
$system = "$CPAN::Config->{tar} xvf $file";
$CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
if (system($system)==0) {
} else {
return 1;
}
- } elsif ($CPAN::META->has_inst("Archive::Tar")
- &&
- $CPAN::META->has_inst("Compress::Zlib") ) {
- my $tar = Archive::Tar->new($file,1);
- $tar->extract($tar->list_files); # I'm pretty sure we have nothing
- # that isn't compressed
-
- ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1)
- if ($^O eq 'MacOS');
-
- return 1;
} else {
$CPAN::Frontend->mydie(qq{
CPAN.pm needs either both external programs tar and gzip installed or
}
}
+sub unzip {
+ my($class,$file) = @_;
+ if ($CPAN::META->has_inst("Archive::Zip")) {
+ # blueprint of the code from Archive::Zip::Tree::extractTree();
+ my $zip = Archive::Zip->new();
+ my $status;
+ $status = $zip->read($file);
+ die "Read of file[$file] failed\n" if $status != Archive::Zip::AZ_OK();
+ $CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG;
+ my @members = $zip->members();
+ for my $member ( @members ) {
+ my $af = $member->fileName();
+ if ($af =~ m!^(/|\.\./)!) {
+ $CPAN::Frontend->mydie("ALERT: Archive contains illegal member [$af]");
+ }
+ my $status = $member->extractToFileNamed( $af );
+ $CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG;
+ die "Extracting of file[$af] from zipfile[$file] failed\n" if
+ $status != Archive::Zip::AZ_OK();
+ return if $CPAN::Signal;
+ }
+ return 1;
+ } else {
+ my $unzip = $CPAN::Config->{unzip} or
+ $CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
+ my @system = ($unzip, $file);
+ return system(@system) == 0;
+ }
+}
+
+
+package CPAN::Version;
+# CPAN::Version::vcmp courtesy Jost Krieger
+sub vcmp {
+ my($self,$l,$r) = @_;
+ local($^W) = 0;
+ CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
+
+ return 0 if $l eq $r; # short circuit for quicker success
+
+ if ($l=~/^v/ <=> $r=~/^v/) {
+ for ($l,$r) {
+ next if /^v/;
+ $_ = $self->float2vv($_);
+ }
+ }
+
+ return
+ ($l ne "undef") <=> ($r ne "undef") ||
+ ($] >= 5.006 &&
+ $l =~ /^v/ &&
+ $r =~ /^v/ &&
+ $self->vstring($l) cmp $self->vstring($r)) ||
+ $l <=> $r ||
+ $l cmp $r;
+}
+
+sub vgt {
+ my($self,$l,$r) = @_;
+ $self->vcmp($l,$r) > 0;
+}
+
+sub vstring {
+ my($self,$n) = @_;
+ $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid argument [$n]";
+ pack "U*", split /\./, $n;
+}
+
+# vv => visible vstring
+sub float2vv {
+ my($self,$n) = @_;
+ my($rev) = int($n);
+ $rev ||= 0;
+ my($mantissa) = $n =~ /\.(\d{1,12})/; # limit to 12 digits so that
+ # architecture cannot
+ # influnce
+ $mantissa ||= 0;
+ $mantissa .= "0" while length($mantissa)%3;
+ my $ret = "v" . $rev;
+ while ($mantissa) {
+ $mantissa =~ s/(\d{1,3})// or
+ die "Panic: length>0 but not a digit? mantissa[$mantissa]";
+ $ret .= ".".int($1);
+ }
+ # warn "n[$n]ret[$ret]";
+ $ret;
+}
+
+sub readable {
+ my($self,$n) = @_;
+ $n =~ /^([\w\-\+\.]+)/;
+
+ return $1 if defined $1 && length($1)>0;
+ # if the first user reaches version v43, he will be treated as "+".
+ # We'll have to decide about a new rule here then, depending on what
+ # will be the prevailing versioning behavior then.
+
+ if ($] < 5.006) { # or whenever v-strings were introduced
+ # we get them wrong anyway, whatever we do, because 5.005 will
+ # have already interpreted 0.2.4 to be "0.24". So even if he
+ # indexer sends us something like "v0.2.4" we compare wrongly.
+
+ # And if they say v1.2, then the old perl takes it as "v12"
+
+ $CPAN::Frontend->mywarn("Suspicious version string seen [$n]");
+ return $n;
+ }
+ my $better = sprintf "v%vd", $n;
+ CPAN->debug("n[$n] better[$better]") if $CPAN::DEBUG;
+ return $better;
+}
+
package CPAN;
1;
CPAN checks if an install is actually needed for it and prints
I<module up to date> in the case that the distribution file containing
-the module doesnE<39>t need to be updated.
+the module doesn't need to be updated.
CPAN also keeps track of what it has done within the current session
-and doesnE<39>t try to build a package a second time regardless if it
+and doesn't try to build a package a second time regardless if it
succeeded or not. The C<force> command takes as a first argument the
method to invoke (currently: C<make>, C<test>, or C<install>) and executes the
command from scratch.
file produced earlier. CPAN installs the whole Bundle for you, but
when you try to repeat the job on the second architecture, CPAN
responds with a C<"Foo up to date"> message for all modules. So you
-invoke CPAN's recompile on the second architecture and youE<39>re done.
+invoke CPAN's recompile on the second architecture and you're done.
Another popular use for C<recompile> is to act as a rescue in case your
perl breaks binary compatibility. If one of the modules that CPAN uses
The first example will be driven by an object of the class
CPAN::Module, the second by an object of class CPAN::Distribution.
-=head2 ProgrammerE<39>s interface
+=head2 Programmer's interface
If you do not enter the shell, the available shell commands are both
available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
print "No VERSION in ", $mod->id, "\n";
}
+ # find out which distribution on CPAN contains a module:
+ print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
+
Or if you want to write a cronjob to watch The CPAN, you could list
-all modules that need updating:
+all modules that need updating. First a quick and dirty way:
perl -e 'use CPAN; CPAN::Shell->r;'
build_cache size of cache for directories to build modules
build_dir locally accessible directory to build modules
index_expire after this many days refetch index files
+ cache_metadata use serializer to cache metadata
cpan_home local directory reserved for this package
+ dontload_hash anonymous hash: modules in the keys will not be
+ loaded by the CPAN::has_inst() routine
gzip location of external program gzip
inactivity_timeout breaks interactive Makefile.PLs after this
many seconds inactivity. Set to 0 to never break.
=head2 Note on urllist parameter's format
urllist parameters are URLs according to RFC 1738. We do a little
-guessing if your URL is not compliant, but if you have problems with file URLs, please try the correct format. Either:
+guessing if your URL is not compliant, but if you have problems with
+file URLs, please try the correct format. Either:
file://localhost/whatever/ftp/pub/CPAN/
=head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
Thanks to Graham Barr for contributing the following paragraphs about
-the interaction between perl, and various firewall configurations.
+the interaction between perl, and various firewall configurations. For
+further informations on firewalls, it is recommended to consult the
+documentation that comes with the ncftp program. If you are unable to
+go through the firewall with a simple Perl setup, it is very likely
+that you can configure ncftp so that it works for your firewall.
+
+=head2 Three basic types of firewalls
Firewalls can be categorized into three basic types.
=item SOCKS
If you are using a SOCKS firewall you will need to compile perl and link
-it with the SOCKS library, this is what is normally called a ``socksified''
+it with the SOCKS library, this is what is normally called a 'socksified'
perl. With this executable you will be able to connect to servers outside
the firewall as if it is not there.
=back
+=head2 Configuring lynx or ncftp for going through a firewall
+
+If you can go through your firewall with e.g. lynx, presumably with a
+command such as
+
+ /usr/local/bin/lynx -pscott:tiger
+
+then you would configure CPAN.pm with the command
+
+ o conf lynx "/usr/local/bin/lynx -pscott:tiger"
+
+That's all. Similarly for ncftp or ftp, you would configure something
+like
+
+ o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
+
+Your milage may vary...
+
+=head1 FAQ
+
+=over
+
+=item I installed a new version of module X but CPAN keeps saying, I
+ have the old version installed
+
+Most probably you B<do> have the old version installed. This can
+happen if a module installs itself into a different directory in the
+@INC path than it was previously installed. This is not really a
+CPAN.pm problem, you would have the same problem when installing the
+module manually. The easiest way to prevent this behaviour is to add
+the argument C<UNINST=1> to the C<make install> call, and that is why
+many people add this argument permanently by configuring
+
+ o conf make_install_arg UNINST=1
+
+=item So why is UNINST=1 not the default?
+
+Because there are people who have their precise expectations about who
+may install where in the @INC path and who uses which @INC array. In
+fine tuned environments C<UNINST=1> can cause damage.
+
+=item When I install bundles or multiple modules with one command
+ there is too much output to keep track of
+
+You may want to configure something like
+
+ o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
+ o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
+
+so that STDOUT is captured in a file for later inspection.
+
+
+=item I am not root, how can I install a module in a personal directory?
+
+You will most probably like something like this:
+
+ o conf makepl_arg "LIB=~/myperl/lib \
+ INSTALLMAN1DIR=~/myperl/man/man1 \
+ INSTALLMAN3DIR=~/myperl/man/man3"
+ install Sybase::Sybperl
+
+You can make this setting permanent like all C<o conf> settings with
+C<o conf commit>.
+
+You will have to add ~/myperl/man to the MANPATH environment variable
+and also tell your perl programs to look into ~/myperl/lib, e.g. by
+including
+
+ use lib "$ENV{HOME}/myperl/lib";
+
+or setting the PERL5LIB environment variable.
+
+Another thing you should bear in mind is that the UNINST parameter
+should never be set if you are not root.
+
+=item How to get a package, unwrap it, and make a change before building it?
+
+ look Sybase::Sybperl
+
+=item I installed a Bundle and had a couple of fails. When I retried,
+ everything resolved nicely. Can this be fixed to work on first
+ try?
+
+The reason for this is that CPAN does not know the dependencies of all
+modules when it starts out. To decide about the additional items to
+install, it just uses data found in the generated Makefile. An
+undetected missing piece breaks the process. But it may well be that
+your Bundle installs some prerequisite later than some depending item
+and thus your second try is able to resolve everything. Please note,
+CPAN.pm does not know the dependency tree in advance and cannot sort
+the queue of things to install in a topologically correct sequence.
+For bundles which you need to install often, it is recommended to do
+the sorting manually. It is planned to improve the metadata situation
+for dependencies on CPAN in general, but this will still take some
+time.
+
+=back
+
=head1 BUGS
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/ and modules/. CPAN is PAUSE plus
-the clpa/, doc/, misc/, ports/, src/, scripts/.
+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
the other parts.