# -*- 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.61';
+# $Id: CPAN.pm,v 1.390 2002/05/07 10:04:58 k Exp $
# only used during development:
$Revision = "";
-# $Revision = "[".substr(q$Revision: 1.381 $, 10)."]";
+# $Revision = "[".substr(q$Revision: 1.390 $, 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[
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 }
#-> 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;
$CPAN::Frontend->mywarn("Lockfile removed.\n");
}
+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");
+ 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//;
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(
}
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);
#-> 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);
+}
+
+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 $@")
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};
}
# 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 $@");
+ }
}
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
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");
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) };
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 $@;
if (!$cache || ref $cache ne 'HASH'){
- $last_time = 0;
+ $LAST_TIME = 0;
return;
}
if (exists $cache->{PROTOCOL}) {
$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 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->debug("s[$s]") if $CPAN::DEBUG;
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->safe_chdir(File::Spec->updir);
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": $!});
+ $self->safe_chdir($pwd);
}
# CPAN::Distribution::cvs_import ;
$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;
}
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 $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(
+ qq{ look() commmand on bundles not}.
+ qq{ implemented (What should it do?)}
+ );
+}
+
sub undelay {
my $self = shift;
delete $self->{later};
#-> 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);
# 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}) {
@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
$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 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
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
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)