# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
package CPAN;
-$VERSION = '1.57_65';
-
-# $Id: CPAN.pm,v 1.351 2000/09/10 08:02:42 k Exp $
+$VERSION = '1.59_51';
+# $Id: CPAN.pm,v 1.381 2000/12/01 08:13:05 k Exp $
# only used during development:
$Revision = "";
-# $Revision = "[".substr(q$Revision: 1.351 $, 10)."]";
+# $Revision = "[".substr(q$Revision: 1.381 $, 10)."]";
use Carp ();
use Config ();
use strict qw(vars);
use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term
- $Revision $Signal $Cwd $End $Suppress_readline $Frontend
- $Defaultsite );
+ $Revision $Signal $End $Suppress_readline $Frontend
+ $Defaultsite $Have_warned);
@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 $oprompt = shift || "cpan> ";
+ my $prompt = $oprompt;
+ my $commandline = shift || "";
- my $prompt = "cpan> ";
local($^W) = 1;
unless ($Suppress_readline) {
require Term::ReadLine;
-# import Term::ReadLine;
- $term = Term::ReadLine->new('CPAN Monitor');
+ if (! $term
+ or
+ $term->ReadLine eq "Term::ReadLine::Stub"
+ ) {
+ $term = Term::ReadLine->new('CPAN Monitor');
+ }
if ($term->ReadLine eq "Term::ReadLine::Gnu") {
my $attribs = $term->Attribs;
-# $attribs->{completion_entry_function} =
-# $attribs->{'list_completion_function'};
$attribs->{attempted_completion_function} = sub {
&CPAN::Complete::gnu_cpl;
}
-# $attribs->{completion_word} =
-# [qw(help me somebody to find out how
-# to use completion with GNU)];
} else {
$readline::rl_completion_function =
$readline::rl_completion_function = 'CPAN::Complete::cpl';
# no strict; # I do not recall why no strict was here (2000-09-03)
$META->checklock();
- my $getcwd;
- $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
- my $cwd = CPAN->$getcwd();
+ my $cwd = CPAN::anycwd();
my $try_detect_readline;
$try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
my $rl_avail = $Suppress_readline ? "suppressed" :
)
unless $CPAN::Config->{'inhibit_startup_message'} ;
my($continuation) = "";
- while () {
+ SHELLCOMMAND: while () {
if ($Suppress_readline) {
print $prompt;
- last unless defined ($_ = <> );
+ last SHELLCOMMAND unless defined ($_ = <> );
chomp;
} else {
- last unless defined ($_ = $term->readline($prompt));
+ last SHELLCOMMAND unless
+ defined ($_ = $term->readline($prompt, $commandline));
}
$_ = "$continuation$_" if $continuation;
s/^\s+//;
- next if /^$/;
+ next SHELLCOMMAND if /^$/;
$_ = 'h' if /^\s*\?/;
if (/^(?:q(?:uit)?|bye|exit)$/i) {
- last;
+ last SHELLCOMMAND;
} elsif (s/\\$//s) {
chomp;
$continuation = $_;
eval($eval);
warn $@ if $@;
$continuation = "";
- $prompt = "cpan> ";
+ $prompt = $oprompt;
} elsif (/./) {
my(@line);
if ($] < 5.00322) { # parsewords had a bug until recently
@line = split;
} else {
eval { @line = Text::ParseWords::shellwords($_) };
- warn($@), next if $@;
+ warn($@), next SHELLCOMMAND if $@;
+ warn("Text::Parsewords could not parse the line [$_]"),
+ next SHELLCOMMAND unless @line;
}
$CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
my $command = shift @line;
chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
$CPAN::Frontend->myprint("\n");
$continuation = "";
- $prompt = "cpan> ";
+ $prompt = $oprompt;
}
} continue {
+ $commandline = ""; # I do want to be able to pass a default to
+ # shell, but on the second command I see no
+ # use in that
$Signal=0;
CPAN::Queue->nullify_queue;
if ($try_detect_readline) {
require Term::ReadLine;
$CPAN::Frontend->myprint("\n$redef subroutines in ".
"Term::ReadLine redefined\n");
+ @_ = ($oprompt,"");
goto &shell;
}
}
}
+ chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
}
package CPAN::CacheMgr;
package CPAN::Complete;
@CPAN::Complete::ISA = qw(CPAN::Debug);
+@CPAN::Complete::COMMANDS = sort qw(
+ ! a b d h i m o q r u autobundle clean dump
+ make test install force readme reload look
+ cvs_import ls
+) unless @CPAN::Complete::COMMANDS;
package CPAN::Index;
use vars qw($last_time $date_of_03);
@CPAN::Module::ISA = qw(CPAN::InfoObj);
package CPAN::Shell;
-use vars qw($AUTOLOAD @ISA);
+use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY $PRINT_ORNAMENTING);
@CPAN::Shell::ISA = qw(CPAN::Debug);
+$COLOR_REGISTERED ||= 0;
+$PRINT_ORNAMENTING ||= 0;
#-> sub CPAN::Shell::AUTOLOAD ;
sub AUTOLOAD {
}
package CPAN::Tarzip;
-use vars qw($AUTOLOAD @ISA);
+use vars qw($AUTOLOAD @ISA $BUGHUNTING);
@CPAN::Tarzip::ISA = qw(CPAN::Debug);
+$BUGHUNTING = 0; # released code must have turned off
package CPAN::Queue;
&cleanup; # need an eval?
}
+#-> sub CPAN::anycwd ;
+sub anycwd () {
+ my $getcwd;
+ $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
+ CPAN->$getcwd();
+}
+
#-> sub CPAN::cwd ;
sub cwd {Cwd::cwd();}
#-> sub CPAN::exists ;
sub exists {
my($mgr,$class,$id) = @_;
+ CPAN::Config->load unless $CPAN::Config_loaded++;
CPAN::Index->reload;
### Carp::croak "exists called without class argument" unless $class;
$id ||= "";
if you just type
install Bundle::libnet
-});
- sleep 2;
+}) unless $Have_warned->{"Net::FTP"}++;
+ sleep 3;
} elsif ($mod eq "MD5"){
$CPAN::Frontend->myprint(qq{
CPAN: MD5 security checks disabled because MD5 not installed.
return unless defined $dir;
$self->debug("reading dir[$dir]") if $CPAN::DEBUG;
$dir ||= $self->{ID};
- my $getcwd;
- $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
- my($cwd) = CPAN->$getcwd();
+ my($cwd) = CPAN::anycwd();
chdir $dir or Carp::croak("Can't chdir to $dir: $!");
my $dh = DirHandle->new(File::Spec->curdir)
or Carp::croak("Couldn't opendir $dir: $!");
my($fh) = FileHandle->new;
rename $configpm, "$configpm~" if -f $configpm;
open $fh, ">$configpm" or
- $CPAN::Frontend->mywarn("Couldn't open >$configpm: $!");
+ $CPAN::Frontend->mydie("Couldn't open >$configpm: $!");
$fh->print(qq[$msg\$CPAN::Config = \{\n]);
foreach (sort keys %$CPAN::Config) {
$fh->print(
my(@miss);
for (
"cpan_home", "keep_source_where", "build_dir", "build_cache",
- "scan_cache", "index_expire", "gzip", "tar", "unzip", "make", "pager",
+ "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
-
+ "cache_metadata",
) {
push @miss, $_ unless defined $CPAN::Config->{$_};
}
$CPAN::Frontend->myprint($self->format_result('Author',@arg));
}
-#-> sub CPAN::Shell::local_bundles ;
+#-> sub CPAN::Shell::ls ;
+sub ls {
+ my($self,@arg) = @_;
+ for (@arg) {
+ $_ = uc $_;
+ }
+ for my $a (@arg){
+ my $author = $self->expand('Author',$a) or die "No author found for $a";
+ $author->ls;
+ }
+}
+#-> sub CPAN::Shell::local_bundles ;
sub local_bundles {
my($self,@which) = @_;
my($incdir,$bdir,$dh);
foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
- $bdir = MM->catdir($incdir,"Bundle");
- if ($dh = DirHandle->new($bdir)) { # may fail
- my($entry);
- for $entry ($dh->read) {
- next if -d MM->catdir($bdir,$entry);
- next unless $entry =~ s/\.pm(?!\n)\Z//;
- $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
- }
- }
+ my @bbase = "Bundle";
+ while (my $bbase = shift @bbase) {
+ $bdir = MM->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)){
+ push @bbase, "$bbase\::$entry";
+ } else {
+ next unless $entry =~ s/\.pm(?!\n)\Z//;
+ $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
+ }
+ }
+ }
+ }
}
}
for $type (@type) {
push @result, $self->expand($type,@args);
}
- my $result = @result == 1 ?
+ my $result = @result == 1 ?
$result[0]->as_string :
- join "", map {$_->as_glimpse} @result;
- $result ||= "No objects found of any type for argument @args\n";
+ @result == 0 ?
+ "No objects found of any type for argument @args\n" :
+ join("",
+ (map {$_->as_glimpse} @result),
+ scalar @result, " items found\n",
+ );
$CPAN::Frontend->myprint($result);
}
if (@o_what) {
while (@o_what) {
my($what) = shift @o_what;
+ if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
+ $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
+ next;
+ }
if ( exists $CPAN::DEBUG{$what} ) {
$CPAN::DEBUG |= $CPAN::DEBUG{$what};
} elsif ($what =~ /^\d/) {
my(@result,$module,%seen,%need,$headerdone,
$version_undefs,$version_zeroes);
$version_undefs = $version_zeroes = 0;
- my $sprintf = "%-25s %9s %9s %s\n";
+ my $sprintf = "%s%-25s%s %9s %9s %s\n";
my @expand = $self->expand('Module',@args);
my $expand = scalar @expand;
if (0) { # Looks like noise to me, was very useful for debugging
unless ($headerdone++){
$CPAN::Frontend->myprint("\n");
$CPAN::Frontend->myprint(sprintf(
- $sprintf,
- "Package namespace",
- "installed",
- "latest",
- "in CPAN file"
- ));
+ $sprintf,
+ "",
+ "Package namespace",
+ "",
+ "installed",
+ "latest",
+ "in CPAN file"
+ ));
}
+ my $color_on = "";
+ my $color_off = "";
+ if (
+ $COLOR_REGISTERED
+ &&
+ $CPAN::META->has_inst("Term::ANSIColor")
+ &&
+ $module->{RO}{description}
+ ) {
+ $color_on = Term::ANSIColor::color("green");
+ $color_off = Term::ANSIColor::color("reset");
+ }
$CPAN::Frontend->myprint(sprintf $sprintf,
+ $color_on,
$module->id,
+ $color_off,
$have,
$latest,
$file);
my($self,$s) = @_;
CPAN->debug("s[$s]") if $CPAN::DEBUG;
if ($s =~ m|/|) { # looks like a file
+ $s = CPAN::Distribution->normalize($s);
return $CPAN::META->instance('CPAN::Distribution',$s);
# Distributions spring into existence, not expand
} elsif ($s =~ m|^Bundle::|) {
shift;
my($type,@args) = @_;
my($arg,@m);
+ CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
for $arg (@args) {
my($regex,$command);
if ($arg =~ m|^/(.*)/$|) {
$regex = $1;
- } elsif ($arg =~ m/^=/) {
- $command = substr($arg,1);
+ } elsif ($arg =~ m/=/) {
+ $command = 1;
}
my $class = "CPAN::$type";
my $obj;
+ CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
+ $class,
+ defined $regex ? $regex : "UNDEFINED",
+ $command || "UNDEFINED",
+ ) if $CPAN::DEBUG;
if (defined $regex) {
for $obj (
sort
) {
unless ($obj->id){
# BUG, we got an empty object somewhere
+ require Data::Dumper;
CPAN->debug(sprintf(
- "Empty id on obj[%s]%%[%s]",
+ "Bug in CPAN: Empty id on obj[%s][%s]",
$obj,
- join(":", %$obj)
+ Data::Dumper::Dumper($obj)
)) if $CPAN::DEBUG;
next;
}
);
}
} elsif ($command) {
- die "leading equal sign in command disabled, ".
- "please edit CPAN.pm to enable eval() or ".
- "do not use = on argument list";
+ die "equal sign in command disabled (immature interface), ".
+ "you can set
+ ! \$CPAN::Shell::ADVANCED_QUERY=1
+to enable it. But please note, this is HIGHLY EXPERIMENTAL code
+that may go away anytime.\n"
+ unless $ADVANCED_QUERY;
+ my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
+ my($matchcrit) = $criterion =~ m/^~(.+)/;
for my $self (
sort
{$a->id cmp $b->id}
$CPAN::META->all_objects($class)
) {
- push @m, $self if eval $command;
+ my $lhs = $self->$method() or next; # () for 5.00503
+ if ($matchcrit) {
+ push @m, $self if $lhs =~ m/$matchcrit/;
+ } else {
+ push @m, $self if $lhs eq $criterion;
+ }
}
} else {
my($xarg) = $arg;
if ( $type eq 'Bundle' ) {
$xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
- }
+ } elsif ($type eq "Distribution") {
+ $xarg = CPAN::Distribution->normalize($arg);
+ }
if ($CPAN::META->exists($class,$xarg)) {
$obj = $CPAN::META->instance($class,$xarg);
} elsif ($CPAN::META->exists($class,$arg)) {
my($type,@args) = @_;
@args = '/./' unless @args;
my(@result) = $self->expand($type,@args);
- my $result = @result == 1 ?
+ my $result = @result == 1 ?
$result[0]->as_string :
- join "", map {$_->as_glimpse} @result;
- $result ||= "No objects of type $type found for argument @args\n";
+ @result == 0 ?
+ "No objects of type $type found for argument @args\n" :
+ join("",
+ (map {$_->as_glimpse} @result),
+ scalar @result, " items found\n",
+ );
$result;
}
# The only reason for this method is currently to have a reliable
# debugging utility that reveals which output is going through which
# channel. No, I don't like the colors ;-)
+
+#-> sub CPAN::Shell::print_ornameted ;
sub print_ornamented {
my($self,$what,$ornament) = @_;
my $longest = 0;
- my $ornamenting = 0; # turn the colors on
+ return unless defined $what;
- if ($ornamenting) {
+ if ($CPAN::Config->{term_is_latin}){
+ # courtesy jhi:
+ $what
+ =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
+ }
+ if ($PRINT_ORNAMENTING) {
unless (defined &color) {
if ($CPAN::META->has_inst("Term::ANSIColor")) {
import Term::ANSIColor "color";
sub myprint {
my($self,$what) = @_;
+
$self->print_ornamented($what, 'bold blue on_yellow');
}
push @qcopy, $obj;
} elsif ($CPAN::META->exists('CPAN::Author',$s)) {
$obj = $CPAN::META->instance('CPAN::Author',$s);
- $CPAN::Frontend->myprint(
- join "",
- "Don't be silly, you can't $meth ",
- $obj->fullname,
- " ;-)\n"
- );
- sleep 2;
+ if ($meth eq "dump") {
+ $obj->dump;
+ } else {
+ $CPAN::Frontend->myprint(
+ join "",
+ "Don't be silly, you can't $meth ",
+ $obj->fullname,
+ " ;-)\n"
+ );
+ sleep 2;
+ }
} else {
$CPAN::Frontend
->myprint(qq{Warning: Cannot $meth $s, }.
# > my $p;
-# this is quite optimistic and returns one on several occasions where
-# inappropriate. But this does no harm. It would do harm if we were
-# too pessimistic (as I was before the http_proxy
-sub is_reachable {
- my($self,$url) = @_;
- return 1; # we can't simply roll our own, firewalls may break ping
- return 0 unless $url;
- return 1 if substr($url,0,4) eq "file";
- return 1 unless $url =~ m|^(\w+)://([^/]+)|;
- my $proxytype = $1 . "_proxy"; # ftp_proxy or http_proxy
- my $host = $2;
- return 1 if $CPAN::Config->{$proxytype} || $ENV{$proxytype};
- require Net::Ping;
- return 1 unless $Net::Ping::VERSION >= 2;
- my $p;
- # 1.3101 had it different: only if the first eval raised an
- # exception we tried it with TCP. Now we are happy if icmp wins
- # the order and return, we don't even check for $@. Thanks to
- # thayer@uis.edu for the suggestion.
- eval {$p = Net::Ping->new("icmp");};
- return 1 if $p && ref($p) && $p->ping($host, 10);
- eval {$p = Net::Ping->new("tcp");};
- $CPAN::Frontend->mydie($@) if $@;
- return $p->ping($host, 10);
-}
-
#-> sub CPAN::FTP::localize ;
sub localize {
my($self,$file,$aslocal,$force) = @_;
# Inheritance is not easier to manage than a few if/else branches
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};
- $Ua->proxy('http', $var)
- if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
- $Ua->no_proxy($var)
- if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
+ eval {$Ua = LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
+ if ($@) {
+ $CPAN::Frontent->mywarn("LWP::UserAgent->new dies with $@")
+ if $CPAN::DEBUG;
+ } else {
+ my($var);
+ $Ua->proxy('ftp', $var)
+ if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
+ $Ua->proxy('http', $var)
+ if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
+ $Ua->no_proxy($var)
+ if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
+ }
}
}
$ENV{ftp_proxy} = $CPAN::Config->{ftp_proxy} if $CPAN::Config->{ftp_proxy};
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");
+ $CPAN::Frontend->myprint("Could not fetch $file\n");
}
if ($restore) {
rename "$aslocal.bak", $aslocal;
my($i);
HOSTEASY: for $i (@$host_seq) {
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;
- next;
- }
$url .= "/" unless substr($url,-1) eq "/";
$url .= $file;
$self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
File::Path::mkpath($aslocal_dir);
HOSTHARD: for $i (@$host_seq) {
my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
- unless ($self->is_reachable($url)) {
- $CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
- next;
- }
$url .= "/" unless substr($url,-1) eq "/";
$url .= $file;
my($proto,$host,$dir,$getfile);
} else {
next HOSTHARD; # who said, we could ftp anything except ftp?
}
+ next HOSTHARD if $proto eq "file"; # file URLs would have had
+ # success above. Likely a bogus URL
$self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
my($f,$funkyftp);
- for $f ('lynx','ncftpget','ncftp') {
+ for $f ('lynx','ncftpget','ncftp','wget') {
next unless exists $CPAN::Config->{$f};
$funkyftp = $CPAN::Config->{$f};
next unless defined $funkyftp;
$src_switch = " -source";
} elsif ($f eq "ncftp"){
$src_switch = " -c";
+ } elsif ($f eq "wget"){
+ $src_switch = " -O -";
}
my($chdir) = "";
my($stdout_redir) = " > $asl_ungz";
if (($wstatus = system($system)) == 0
&&
($f eq "lynx" ?
- -s $asl_ungz # lynx returns 0 on my
- # system even if it fails
+ -s $asl_ungz # lynx returns 0 when it fails somewhere
: 1
)
) {
# Looks good
} elsif ($asl_ungz ne $aslocal) {
# test gzip integrity
- if (
- CPAN::Tarzip->gtest($asl_ungz)
- ) {
- rename $asl_ungz, $aslocal;
+ if (CPAN::Tarzip->gtest($asl_ungz)) {
+ # e.g. foo.tar is gzipped --> foo.tar.gz
+ rename $asl_ungz, $aslocal;
} else {
- CPAN::Tarzip->gzip($asl_ungz,$asl_gz);
+ CPAN::Tarzip->gzip($asl_ungz,$asl_gz);
}
}
$Thesite = $i;
) {
# test gzip integrity
if (CPAN::Tarzip->gtest($asl_gz)) {
- CPAN::Tarzip->gunzip($asl_gz,$aslocal);
+ CPAN::Tarzip->gunzip($asl_gz,$aslocal);
} else {
- rename $asl_ungz, $aslocal;
+ # somebody uncompressed file for us?
+ rename $asl_ungz, $aslocal;
}
$Thesite = $i;
return $aslocal;
last HOSTHARDEST;
}
my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
- unless ($self->is_reachable($url)) {
- $CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
- next;
- }
$url .= "/" unless substr($url,-1) eq "/";
$url .= $file;
$self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
}, $class;
}
+# CPAN::FTP::hasdefault;
sub hasdefault { shift->{'hasdefault'} }
sub netrc { shift->{'netrc'} }
sub protected { shift->{'protected'} }
}
my @return;
if ($pos == 0) {
- @return = grep(
- /^$word/,
- sort qw(
- ! a b d h i m o q r u autobundle clean dump
- make test install force readme reload look cvs_import
- )
- );
+ @return = grep /^$word/, @CPAN::Complete::COMMANDS;
} elsif ( $line !~ /^[\!abcdhimorutl]/ ) {
@return = ();
- } elsif ($line =~ /^a\s/) {
- @return = cplx('CPAN::Author',$word);
+ } elsif ($line =~ /^(a|ls)\s/) {
+ @return = cplx('CPAN::Author',uc($word));
} elsif ($line =~ /^b\s/) {
+ CPAN::Shell->local_bundles;
@return = cplx('CPAN::Bundle',$word);
} elsif ($line =~ /^d\s/) {
@return = cplx('CPAN::Distribution',$word);
} elsif ($line =~ m/^(
[mru]|make|clean|dump|test|install|readme|look|cvs_import
)\s/x ) {
+ if ($word =~ /^Bundle::/) {
+ CPAN::Shell->local_bundles;
+ }
@return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
} elsif ($line =~ /^i\s/) {
@return = cpl_any($word);
@return = cpl_reload($word,$line,$pos);
} elsif ($line =~ /^o\s/) {
@return = cpl_option($word,$line,$pos);
+ } elsif ($line =~ m/^\S+\s/ ) {
+ # fallback for future commands and what we have forgotten above
+ @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
} else {
@return = ();
}
for ($CPAN::Config->{index_expire}) {
$_ = 0.001 unless $_ && $_ > 0.001;
}
- $CPAN::META->{PROTOCOL} ||= "1.0";
+ unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
+ # debug here when CPAN doesn't seem to read the Metadata
+ require Carp;
+ Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
+ }
+ unless ($CPAN::META->{PROTOCOL}) {
+ $cl->read_metadata_cache;
+ $CPAN::META->{PROTOCOL} ||= "1.0";
+ }
if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
# warn "Setting last_time to 0";
$last_time = 0; # No warning necessary
my @lines;
return unless defined $index_target;
$CPAN::Frontend->myprint("Going to read $index_target\n");
-# my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
-# while ($_ = $fh->READLINE) {
- # no strict 'refs';
local(*FH);
tie *FH, CPAN::Tarzip, $index_target;
local($/) = "\n";
Carp::confess($@) if $@;
return if $CPAN::Signal;
for (keys %$ret) {
- my $obj = $CPAN::META->instance(CPAN::Module,$_);
+ my $obj = $CPAN::META->instance("CPAN::Module",$_);
delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
$obj->set(%{$ret->{$_}});
return if $CPAN::Signal;
# because of a typo, we do not like it that they are written into
# the readonly area and made permanent (at least for a while) and
# that is why we do not "allow" other places to call ->set.
+ unless ($self->id) {
+ CPAN->debug("Bug? Empty ID, rejecting");
+ return;
+ }
my $ro = $self->{RO} =
$CPAN::META->{readonly}{$class}{$self->id} ||= {};
# next if m/^(ID|RO)$/;
my $extra = "";
if ($_ eq "CPAN_USERID") {
- $extra .= " (".$self->author;
- my $email; # old perls!
- if ($email = $CPAN::META->instance(CPAN::Author,
- $self->cpan_userid
- )->email) {
- $extra .= " <$email>";
- } else {
- $extra .= " <no email>";
- }
- $extra .= ")";
- }
+ $extra .= " (".$self->author;
+ my $email; # old perls!
+ if ($email = $CPAN::META->instance("CPAN::Author",
+ $self->cpan_userid
+ )->email) {
+ $extra .= " <$email>";
+ } else {
+ $extra .= " <no email>";
+ }
+ $extra .= ")";
+ } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
+ push @m, sprintf " %-12s %s\n", $_, $self->fullname;
+ next;
+ }
next unless defined $self->{RO}{$_};
push @m, sprintf " %-12s %s%s\n", $_, $self->{RO}{$_}, $extra;
}
#-> sub CPAN::InfoObj::author ;
sub author {
my($self) = @_;
- $CPAN::META->instance(CPAN::Author,$self->cpan_userid)->fullname;
+ $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
}
#-> sub CPAN::InfoObj::dump ;
}
#-> sub CPAN::Author::fullname ;
-sub fullname { shift->{RO}{FULLNAME} }
+sub fullname {
+ shift->{RO}{FULLNAME};
+}
*name = \&fullname;
#-> sub CPAN::Author::email ;
-sub email { shift->{RO}{EMAIL} }
+sub email { shift->{RO}{EMAIL}; }
+
+#-> sub CPAN::Author::ls ;
+sub ls {
+ my $self = shift;
+ 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 {
+ sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
+ } sort { $a->[2] cmp $b->[2] } $self->dir_listing(\@chksumfile);
+}
+
+#-> sub CPAN::Author::dir_listing ;
+sub dir_listing {
+ my $self = shift;
+ my $chksumfile = shift;
+ my $lc_want =
+ MM->catfile($CPAN::Config->{keep_source_where},
+ "authors", "id", @$chksumfile);
+ local($") = "/";
+ my $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
+ $lc_want,1);
+ 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);
+ if ($lc_file) {
+ $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
+ CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file);
+ } else {
+ return;
+ }
+ }
+
+ # adapted from CPAN::Distribution::MD5_check_file ;
+ my $fh = FileHandle->new;
+ my($cksum);
+ if (open $fh, $lc_file){
+ local($/);
+ my $eval = <$fh>;
+ $eval =~ s/\015?\012/\n/g;
+ close $fh;
+ my($comp) = Safe->new();
+ $cksum = $comp->reval($eval);
+ if ($@) {
+ rename $lc_file, "$lc_file.bad";
+ Carp::confess($@) if $@;
+ }
+ } else {
+ Carp::carp "Could not open $lc_file for reading";
+ }
+ 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);
+ } else {
+ push @result, [
+ ($cksum->{$f}{"size"}||0),
+ $cksum->{$f}{"mtime"}||"---",
+ $f
+ ];
+ }
+ }
+ @result;
+}
package CPAN::Distribution;
delete $self->{later};
}
+# CPAN::Distribution::normalize
+sub normalize {
+ my($self,$s) = @_;
+ $s = $self->id unless defined $s;
+ if ($s =~ tr|/|| == 1) {
+ return $s if $s =~ m|^N/A|;
+ $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
+ $CPAN::Frontend->mywarn("Strange distribution name [$s]");
+ CPAN->debug("s[$s]") if $CPAN::DEBUG;
+ }
+ $s;
+}
+
#-> sub CPAN::Distribution::color_cmd_tmps ;
sub color_cmd_tmps {
my($self) = shift;
#-> sub CPAN::Distribution::containsmods ;
sub containsmods {
my $self = shift;
- return if exists $self->{CONTAINSMODS};
+ return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
+ my $dist_id = $self->{ID};
for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
my $mod_file = $mod->cpan_file or next;
- my $dist_id = $self->{ID} or next;
my $mod_id = $mod->{ID} or next;
# warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
# sleep 1;
$self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
}
+ keys %{$self->{CONTAINSMODS}};
+}
+
+#-> sub CPAN::Distribution::uptodate ;
+sub uptodate {
+ my($self) = @_;
+ my $c;
+ foreach $c ($self->containsmods) {
+ my $obj = CPAN::Shell->expandany($c);
+ return 0 unless $obj->uptodate;
+ }
+ return 1;
}
#-> sub CPAN::Distribution::called_for ;
return $self->{CALLED_FOR};
}
+#-> sub CPAN::Distribution::my_chdir ;
+sub safe_chdir {
+ my($self,$todir) = @_;
+ # we die if we cannot chdir and we are debuggable
+ Carp::confess("safe_chdir called without todir argument")
+ unless defined $todir and length $todir;
+ if (chdir $todir) {
+ $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
+ if $CPAN::DEBUG;
+ } else {
+ my $cwd = CPAN::anycwd();
+ $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
+ qq{to todir[$todir]: $!});
+ }
+}
+
#-> sub CPAN::Distribution::get ;
sub get {
my($self) = @_;
"Is already unwrapped into directory $self->{'build_dir'}";
$CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
}
+ my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
+
+ #
+ # Get the file on local disk
+ #
+
my($local_file);
my($local_wanted) =
- MM->catfile(
- $CPAN::Config->{keep_source_where},
- "authors",
- "id",
- split("/",$self->{ID})
- );
+ MM->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");
- return if $CPAN::Signal;
+ or $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n");
+ $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
$self->{localfile} = $local_file;
- $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
- my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
- $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
- chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
- my $packagedir;
+ return if $CPAN::Signal;
- $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
+ #
+ # Check integrity
+ #
if ($CPAN::META->has_inst("MD5")) {
$self->debug("MD5 is installed, verifying");
$self->verifyMD5;
} else {
$self->debug("MD5 is NOT installed");
}
+ return if $CPAN::Signal;
+
+ #
+ # Create a clean room and go there
+ #
+ $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
+ my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
+ $self->safe_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" 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)(?!\n)\Z/i){
+ if ($CPAN::Signal){
+ $self->safe_chdir($sub_wd);
+ return;
+ }
+ $self->safe_chdir("tmp");
+
+ #
+ # Unpack the goods
+ #
+ if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)(?!\n)\Z/i){
+ $self->{was_uncompressed}++ unless CPAN::Tarzip->gtest($local_file);
$self->untar_me($local_file);
} elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
$self->unzip_me($local_file);
} elsif ( $local_file =~ /\.pm\.(gz|Z)(?!\n)\Z/) {
+ $self->{was_uncompressed}++ unless CPAN::Tarzip->gtest($local_file);
$self->pm2dir_me($local_file);
} else {
$self->{archived} = "NO";
+ $self->safe_chdir($sub_wd);
+ return;
}
- my $cwd = File::Spec->updir;
- chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "": $!});
- if ($self->{archived} ne 'NO') {
- $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]) {
+
+ # we are still in the tmp directory!
+ # 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);
+ $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
+ if $CPAN::DEBUG;
-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';
+ $self->debug(sprintf("renamed distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
+ $distdir,
+ $packagedir,
+ -e $packagedir,
+ -d $packagedir,
+ )) if $CPAN::DEBUG;
+ } else {
+ my $userid = $self->cpan_userid;
+ unless ($userid) {
+ CPAN->debug("no userid? self[$self]");
+ $userid = "anon";
+ }
+ my $pragmatic_dir = $userid . '000';
$pragmatic_dir =~ s/\W_//g;
$pragmatic_dir++ while -d "../$pragmatic_dir";
$packagedir = MM->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);
- rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
+ 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[$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) {
+ }
+ if ($CPAN::Signal){
+ $self->safe_chdir($sub_wd);
+ return;
+ }
+
+ $self->{'build_dir'} = $packagedir;
+ $self->safe_chdir(File::Spec->updir);
+ File::Path::rmtree("tmp");
+
+ my($mpl) = MM->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)
+ or Carp::croak("Couldn't opendir $packagedir: $!");
+ $mpl_exists = grep /^Makefile\.PL$/, $dh->read;
+ }
+ unless ($mpl_exists) {
+ $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
+ $mpl,
+ CPAN::anycwd(),
+ )) if $CPAN::DEBUG;
my($configure) = MM->catfile($packagedir,"Configure");
if (-f $configure) {
- # do we have anything to do?
- $self->{'configure'} = $configure;
+ # do we have anything to do?
+ $self->{'configure'} = $configure;
} elsif (-f MM->catfile($packagedir,"Makefile")) {
- $CPAN::Frontend->myprint(qq{
+ $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;
+ $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(
+ my $cf = $self->called_for || "unknown";
+ if ($cf =~ m|/|) {
+ $cf =~ s|.*/||;
+ $cf =~ s|\W.*||;
+ }
+ $cf =~ s|[/\\:]||g; # risk of filesystem damage
+ $cf = "unknown" unless length($cf);
+ $CPAN::Frontend->myprint(qq{Package seems to come without Makefile.PL.
+ (The test -f "$mpl" returned false.)
+ Writing one on our own (setting NAME to $cf)\a\n});
+ $self->{had_no_makefile_pl}++;
+ sleep 3;
+
+ # Writing our own Makefile.PL
+
+ my $fh = FileHandle->new;
+ $fh->open(">$mpl")
+ or Carp::croak("Could not open >$mpl: $!");
+ $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.
- Writing one on our own (calling it $cf)\n});
+ $fh->close;
}
- }
}
+
return $self;
}
my $dist = $self->id;
my $dir = $self->dir or $self->get;
$dir = $self->dir;
- my $getcwd;
- $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
- my $pwd = CPAN->$getcwd();
+ my $pwd = CPAN::anycwd();
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
my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
"$cvs_dir", $userid, "v$version");
- my $getcwd;
- $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
- my $pwd = CPAN->$getcwd();
+ my $pwd = CPAN::anycwd();
chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
$CPAN::Frontend->myprint(qq{Working directory is $dir\n});
$CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
}
my($lc_want,$lc_file,@local,$basename);
- @local = split("/",$self->{ID});
+ @local = split("/",$self->id);
pop @local;
push @local, "CHECKSUMS";
$lc_want =
$lc_file = CPAN::FTP->localize("authors/id/@local",
$lc_want,1);
unless ($lc_file) {
+ $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
$local[-1] .= ".gz";
$lc_file = CPAN::FTP->localize("authors/id/@local",
"$lc_want.gz",1);
} else {
$self->{MD5_STATUS} ||= "";
if ($self->{MD5_STATUS} eq "NIL") {
- $CPAN::Frontend->myprint(qq{
-No md5 checksum for $basename in local $chk_file.
-Removing $chk_file
+ $CPAN::Frontend->mywarn(qq{
+Warning: No md5 checksum for $basename in $chk_file.
+
+The cause for this may be that the file is very new and the checksum
+has not yet been calculated, but it may also be that something is
+going awry right now.
});
- unlink $chk_file or $CPAN::Frontend->myprint("Could not unlink: $!");
- sleep 1;
+ my $answer = ExtUtils::MakeMaker::prompt("Proceed?", "yes");
+ $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.");
}
$self->{MD5_STATUS} = "NIL";
return;
sub perl {
my($self) = @_;
my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
- my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
- my $pwd = CPAN->$getcwd();
+ my $pwd = CPAN::anycwd();
my $candidate = MM->catfile($pwd,$^X);
$perl ||= $candidate if MM->maybe_command($candidate);
unless ($perl) {
#-> sub CPAN::Bundle::contains ;
sub contains {
my($self) = @_;
- my($parsefile) = $self->inst_file;
+ my($parsefile) = $self->inst_file || "";
my($id) = $self->id;
$self->debug("parsefile[$parsefile]id[$id]") if $CPAN::DEBUG;
unless ($parsefile) {
my $manifest = MM->catfile($where,"MANIFEST");
unless (-f $manifest) {
require ExtUtils::Manifest;
- my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
- my $cwd = CPAN->$getcwd();
+ my $cwd = CPAN::anycwd();
chdir $where or $CPAN::Frontend->mydie(qq{Could not chdir to "$where": $!});
ExtUtils::Manifest::mkmanifest();
chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
Carp::croak("Couldn't find a Bundle file in $where");
}
-# needs to work slightly different from Module::inst_file because of
-# cpan_home/Bundle/ directory.
+# needs to work quite differently from Module::inst_file because of
+# cpan_home/Bundle/ directory and the possibility that we have
+# shadowing effect. As it makes no sense to take the first in @INC for
+# Bundles, we parse them all for $VERSION and take the newest.
#-> sub CPAN::Bundle::inst_file ;
sub inst_file {
my($self) = @_;
- return $self->{INST_FILE} if
- exists $self->{INST_FILE} && $self->{INST_FILE};
my($inst_file);
my(@me);
@me = split /::/, $self->id;
$me[-1] .= ".pm";
- $inst_file = MM->catfile($CPAN::Config->{'cpan_home'}, @me);
- return $self->{INST_FILE} = $inst_file if -f $inst_file;
- $self->SUPER::inst_file;
+ my($incdir,$bestv);
+ foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
+ my $bfile = MM->catfile($incdir, @me);
+ CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
+ next unless -f $bfile;
+ my $foundv = MM->parse_version($bfile);
+ if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
+ $self->{INST_FILE} = $bfile;
+ $self->{INST_VERSION} = $bestv = $foundv;
+ }
+ }
+ $self->{INST_FILE};
+}
+
+#-> sub CPAN::Bundle::inst_version ;
+sub inst_version {
+ my($self) = @_;
+ $self->inst_file; # finds INST_VERSION as side effect
+ $self->{INST_VERSION};
}
#-> sub CPAN::Bundle::rematein ;
#-> sub CPAN::Bundle::clean ;
sub clean { shift->rematein('clean',@_); }
+#-> sub CPAN::Bundle::uptodate ;
+sub uptodate {
+ my($self) = @_;
+ return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
+ my $c;
+ foreach $c ($self->contains) {
+ my $obj = CPAN::Shell->expandany($c);
+ return 0 unless $obj->uptodate;
+ }
+ return 1;
+}
+
#-> sub CPAN::Bundle::readme ;
sub readme {
my($self) = @_;
# sub cpan_userid { shift->{RO}{CPAN_USERID} }
sub userid {
my $self = shift;
- return unless exists $self->{RO}{userid};
- $self->{RO}{userid};
+ return unless exists $self->{RO}; # should never happen
+ return $self->{RO}{CPAN_USERID} || $self->{RO}{userid};
}
sub description { shift->{RO}{description} }
my(@m);
my $class = ref($self);
$class =~ s/^CPAN:://;
- push @m, sprintf("%-15s %-15s (%s)\n", $class, $self->{ID},
+ my $color_on = "";
+ my $color_off = "";
+ if (
+ $CPAN::Shell::COLOR_REGISTERED
+ &&
+ $CPAN::META->has_inst("Term::ANSIColor")
+ &&
+ $self->{RO}{description}
+ ) {
+ $color_on = Term::ANSIColor::color("green");
+ $color_off = Term::ANSIColor::color("reset");
+ }
+ push @m, sprintf("%-15s %s%-15s%s (%s)\n",
+ $class,
+ $color_on,
+ $self->id,
+ $color_off,
$self->cpan_file);
join "", @m;
}
$stati{$self->{RO}{stati}}
) if $self->{RO}{statd};
my $local_file = $self->inst_file;
- if ($local_file) {
- $self->{MANPAGE} ||= $self->manpage_headline($local_file);
+ unless ($self->{MANPAGE}) {
+ if ($local_file) {
+ $self->{MANPAGE} = $self->manpage_headline($local_file);
+ } else {
+ # If we have already untarred it, we should look there
+ my $dist = $CPAN::META->instance('CPAN::Distribution',
+ $self->cpan_file);
+ # 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
+ $mfh = FileHandle->new($mff)
+ ) {
+ CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
+ my $lfre = $self->id; # local file RE
+ $lfre =~ s/::/./g;
+ $lfre .= "\\.pm\$";
+ my($lfl); # local file file
+ local $/ = "\n";
+ my(@mflines) = <$mfh>;
+ for (@mflines) {
+ s/^\s+//;
+ s/\s.*//s;
+ }
+ while (length($lfre)>5 and !$lfl) {
+ ($lfl) = grep /$lfre/, @mflines;
+ CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
+ $lfre =~ s/.+?\.//;
+ }
+ $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);
+ # warn "lfl_abs[$lfl_abs]";
+ if (-f $lfl_abs) {
+ $self->{MANPAGE} = $self->manpage_headline($lfl_abs);
+ }
+ }
+ }
}
my($item);
for $item (qw/MANPAGE/) {
}
if (exists $self->{RO}{CPAN_FILE} && defined $self->{RO}{CPAN_FILE}){
return $self->{RO}{CPAN_FILE};
- } elsif ( defined $self->userid ) {
- my $fullname = $CPAN::META->instance("CPAN::Author",
- $self->userid)->fullname;
- my $email = $CPAN::META->instance("CPAN::Author",
- $self->userid)->email;
- unless (defined $fullname && defined $email) {
- my $userid = $self->userid;
- return sprintf("Contact Author %s (Try 'a %s')",
- $userid,
- $userid,
- );
- }
- return "Contact Author $fullname <$email>";
} else {
- return "N/A";
+ my $userid = $self->userid;
+ if ( $userid ) {
+ if ($CPAN::META->exists("CPAN::Author",$userid)) {
+ my $author = $CPAN::META->instance("CPAN::Author",
+ $userid);
+ my $fullname = $author->fullname;
+ my $email = $author->email;
+ unless (defined $fullname && defined $email) {
+ return sprintf("Contact Author %s",
+ $userid,
+ );
+ }
+ return "Contact Author $fullname <$email>";
+ } else {
+ return "UserID $userid";
+ }
+ } else {
+ return "N/A";
+ }
}
}
-*name = \&cpan_file;
-
#-> sub CPAN::Module::cpan_version ;
sub cpan_version {
my $self = shift;
$fhw->close;
return 1;
} else {
- system("$CPAN::Config->{'gzip'} -c $read > $write")==0;
+ system("$CPAN::Config->{gzip} -c $read > $write")==0;
}
}
$fhw->close;
return 1;
} else {
- system("$CPAN::Config->{'gzip'} -dc $read > $write")==0;
+ system("$CPAN::Config->{gzip} -dc $read > $write")==0;
}
}
# CPAN::Tarzip::gtest
sub gtest {
my($class,$read) = @_;
- if ($CPAN::META->has_inst("Compress::Zlib")) {
- my($buffer);
+ # After I had reread the documentation in zlib.h, I discovered that
+ # uncompressed files do not lead to an gzerror (anymore?).
+ if ( $CPAN::META->has_inst("Compress::Zlib") ) {
+ my($buffer,$len);
+ $len = 0;
my $gz = Compress::Zlib::gzopen($read, "rb")
- or $CPAN::Frontend->mydie("Cannot open $read: $!\n");
- 1 while $gz->gzread($buffer) > 0 ;
+ or $CPAN::Frontend->mydie(sprintf("Cannot gzopen %s: %s\n",
+ $read,
+ $Compress::Zlib::gzerrno));
+ while ($gz->gzread($buffer) > 0 ){
+ $len += length($buffer);
+ $buffer = "";
+ }
my $err = $gz->gzerror;
my $success = ! $err || $err == Compress::Zlib::Z_STREAM_END();
+ if ($len == -s $read){
+ $success = 0;
+ CPAN->debug("hit an uncompressed file") if $CPAN::DEBUG;
+ }
$gz->gzclose();
- $class->debug("err[$err]success[$success]") if $CPAN::DEBUG;
+ CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG;
return $success;
} else {
- return system("$CPAN::Config->{'gzip'} -dt $read")==0;
+ return system("$CPAN::Config->{gzip} -dt $read")==0;
}
}
die "Could not gzopen $file";
$ret = bless {GZ => $gz}, $class;
} else {
- my $pipe = "$CPAN::Config->{'gzip'} --decompress --stdout $file |";
+ my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $file |";
my $fh = FileHandle->new($pipe) or die "Could pipe[$pipe]: $!";
binmode $fh;
$ret = bless {FH => $fh}, $class;
# CPAN::Tarzip::DESTROY
sub DESTROY {
- my($self) = @_;
- if (exists $self->{GZ}) {
- my $gz = $self->{GZ};
- $gz->gzclose();
- } else {
- my $fh = $self->{FH};
- $fh->close if defined $fh;
- }
- undef $self;
+ my($self) = @_;
+ if (exists $self->{GZ}) {
+ my $gz = $self->{GZ};
+ $gz->gzclose() if defined $gz; # hard to say if it is allowed
+ # to be undef ever. AK, 2000-09
+ } else {
+ my $fh = $self->{FH};
+ $fh->close if defined $fh;
+ }
+ undef $self;
}
# CPAN::Tarzip::untar
sub untar {
my($class,$file) = @_;
+ my($prefer) = 0;
+
if (0) { # makes changing order easier
- } elsif (MM->maybe_command($CPAN::Config->{'gzip'})
- &&
- MM->maybe_command($CPAN::Config->{'tar'})) {
- my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
- "< $file | $CPAN::Config->{tar} xvf -";
+ } elsif ($BUGHUNTING){
+ $prefer=2;
+ } elsif (MM->maybe_command($CPAN::Config->{gzip})
+ &&
+ MM->maybe_command($CPAN::Config->{'tar'})) {
+ # should be default until Archive::Tar is fixed
+ $prefer = 1;
+ } elsif (
+ $CPAN::META->has_inst("Archive::Tar")
+ &&
+ $CPAN::META->has_inst("Compress::Zlib") ) {
+ $prefer = 2;
+ } else {
+ $CPAN::Frontend->mydie(qq{
+CPAN.pm needs either both external programs tar and gzip installed or
+both the modules Archive::Tar and Compress::Zlib. Neither prerequisite
+is available. Can\'t continue.
+});
+ }
+ if ($prefer==1) { # 1 => external gzip+tar
+ my($system);
+ my $is_compressed = $class->gtest($file);
+ if ($is_compressed) {
+ $system = "$CPAN::Config->{gzip} --decompress --stdout " .
+ "< $file | $CPAN::Config->{tar} xvf -";
+ } else {
+ $system = "$CPAN::Config->{tar} xvf $file";
+ }
if (system($system) != 0) {
- # people find the most curious tar binaries that cannot handle
- # pipes
- my $system = "$CPAN::Config->{'gzip'} --decompress $file";
- if (system($system)==0) {
- $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
- } else {
- $CPAN::Frontend->mydie(
- qq{Couldn\'t uncompress $file\n}
- );
- }
- $file =~ s/\.gz(?!\n)\Z//;
- $system = "$CPAN::Config->{tar} xvf $file";
- $CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
- if (system($system)==0) {
- $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
- } else {
- $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
- }
- return 1;
+ # people find the most curious tar binaries that cannot handle
+ # pipes
+ if ($is_compressed) {
+ (my $ungzf = $file) =~ s/\.gz(?!\n)\Z//;
+ if (CPAN::Tarzip->gunzip($file, $ungzf)) {
+ $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
+ } else {
+ $CPAN::Frontend->mydie(qq{Couldn\'t uncompress $file\n});
+ }
+ $file = $ungzf;
+ }
+ $system = "$CPAN::Config->{tar} xvf $file";
+ $CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
+ if (system($system)==0) {
+ $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
+ } else {
+ $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
+ }
+ return 1;
} else {
- return 1;
+ return 1;
}
- } elsif ($CPAN::META->has_inst("Archive::Tar")
- &&
- $CPAN::META->has_inst("Compress::Zlib") ) {
+ } elsif ($prefer==2) { # 2 => modules
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]");
+ my @af;
+ if ($BUGHUNTING) {
+ # RCS 1.337 had this code, it turned out unacceptable slow but
+ # it revealed a bug in Archive::Tar. Code is only here to hunt
+ # the bug again. It should never be enabled in published code.
+ # GDGraph3d-0.53 was an interesting case according to Larry
+ # Virden.
+ warn(">>>Bughunting code enabled<<< " x 20);
+ 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); # slow but effective for finding the bug
+ return if $CPAN::Signal;
}
- $CPAN::Frontend->myprint("$af\n");
- $tar->extract($af);
- return if $CPAN::Signal;
+ } else {
+ for $af ($tar->list_files) {
+ if ($af =~ m!^(/|\.\./)!) {
+ $CPAN::Frontend->mydie("ALERT: Archive contains ".
+ "illegal member [$af]");
+ }
+ $CPAN::Frontend->myprint("$af\n");
+ push @af, $af;
+ return if $CPAN::Signal;
+ }
+ $tar->extract(@af);
}
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
-both the modules Archive::Tar and Compress::Zlib. Neither prerequisite
-is available. Can\'t continue.
-});
}
}
my($self,$n) = @_;
my($rev) = int($n);
$rev ||= 0;
- my($mantissa) = $n =~ /\.(\d{1,12})/; # limit to 12 digits so that
- # architecture cannot
- # influnce
+ my($mantissa) = $n =~ /\.(\d{1,12})/; # limit to 12 digits to limit
+ # architecture influence
$mantissa ||= 0;
$mantissa .= "0" while length($mantissa)%3;
my $ret = "v" . $rev;
mechanism.
For extended searching capabilities there's a plugin for CPAN available,
-L<CPAN::WAIT>. C<CPAN::WAIT> is a full-text search engine that indexes
-all documents available in CPAN authors directories. If C<CPAN::WAIT>
-is installed on your system, the interactive shell of <CPAN.pm> will
-enable the C<wq>, C<wr>, C<wd>, C<wl>, and C<wh> commands which send
-queries to the WAIT server that has been configured for your
+L<C<CPAN::WAIT>|CPAN::WAIT>. C<CPAN::WAIT> is a full-text search engine
+that indexes all documents available in CPAN authors directories. If
+C<CPAN::WAIT> is installed on your system, the interactive shell of
+CPAN.pm will enable the C<wq>, C<wr>, C<wd>, C<wl>, and C<wh> commands
+which send queries to the WAIT server that has been configured for your
installation.
All other methods provided are accessible in a programmer style and in an
Once you are on the command line, type 'h' and the rest should be
self-explanatory.
+The function call C<shell> takes two optional arguments, one is the
+prompt, the second is the default initial command line (the latter
+only works if a real ReadLine interface module is installed).
+
The most common uses of the interactive modes are
=over 2
given. In scalar context it only returns the first element of the
list.
+=item expandany(@things)
+
+Like expand, but returns objects of the appropriate type, i.e.
+CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
+CPAN::Distribution objects fro distributions.
+
=item Programming Examples
This enables the programmer to do operations that combine
perl -e 'use CPAN; CPAN::Shell->r;'
-If you don't want to get any output if all modules are up to date, you
-can parse the output of above command for the regular expression
-//modules are up to date// and decide to mail the output only if it
-doesn't match. Ick?
+If you don't want to get any output in the case that all modules are
+up to date, you can parse the output of above command for the regular
+expression //modules are up to date// and decide to mail the output
+only if it doesn't match. Ick?
If you prefer to do it more in a programmer style in one single
-process, maybe something like this suites you better:
+process, maybe something like this suits you better:
# list all modules on my disk that have newer versions on CPAN
for $mod (CPAN::Shell->expand("Module","/./")){
=back
-=head2 Methods in the four Classes
+=head2 Methods in the other Classes
+
+The programming interface for the classes CPAN::Module,
+CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered
+beta and partially even alpha. In the following paragraphs only those
+methods are documented that have proven useful over a longer time and
+thus are unlikely to change.
+
+=over
+
+=item CPAN::Author::as_glimpse()
+
+Returns a one-line description of the author
+
+=item CPAN::Author::as_string()
+
+Returns a multi-line description of the author
+
+=item CPAN::Author::email()
+
+Returns the author's email address
+
+=item CPAN::Author::fullname()
+
+Returns the author's name
+
+=item CPAN::Author::name()
+
+An alias for fullname
+
+=item CPAN::Bundle::as_glimpse()
+
+Returns a one-line description of the bundle
+
+=item CPAN::Bundle::as_string()
+
+Returns a multi-line description of the bundle
+
+=item CPAN::Bundle::clean()
+
+Recursively runs the C<clean> method on all items contained in the bundle.
+
+=item CPAN::Bundle::contains()
+
+Returns a list of objects' IDs contained in a bundle. The associated
+objects may be bundles, modules or distributions.
+
+=item CPAN::Bundle::force($method,@args)
+
+Forces CPAN to perform a task that normally would have failed. Force
+takes as arguments a method name to be called and any number of
+additional arguments that should be passed to the called method. The
+internals of the object get the needed changes so that CPAN.pm does
+not refuse to take the action. The C<force> is passed recursively to
+all contained objects.
+
+=item CPAN::Bundle::get()
+
+Recursively runs the C<get> method on all items contained in the bundle
+
+=item CPAN::Bundle::inst_file()
+
+Returns the highest installed version of the bundle in either @INC or
+C<$CPAN::Config->{cpan_home}>. Note that this is different from
+CPAN::Module::inst_file.
+
+=item CPAN::Bundle::inst_version()
+
+Like CPAN::Bundle::inst_file, but returns the $VERSION
+
+=item CPAN::Bundle::uptodate()
+
+Returns 1 if the bundle itself and all its members are uptodate.
+
+=item CPAN::Bundle::install()
+
+Recursively runs the C<install> method on all items contained in the bundle
+
+=item CPAN::Bundle::make()
+
+Recursively runs the C<make> method on all items contained in the bundle
+
+=item CPAN::Bundle::readme()
+
+Recursively runs the C<readme> method on all items contained in the bundle
+
+=item CPAN::Bundle::test()
+
+Recursively runs the C<test> method on all items contained in the bundle
+
+=item CPAN::Distribution::as_glimpse()
+
+Returns a one-line description of the distribution
+
+=item CPAN::Distribution::as_string()
+
+Returns a multi-line description of the distribution
+
+=item CPAN::Distribution::clean()
+
+Changes to the directory where the distribution has been unpacked and
+runs C<make clean> there.
+
+=item CPAN::Distribution::containsmods()
+
+Returns a list of IDs of modules contained in a distribution file.
+Only works for distributions listed in the 02packages.details.txt.gz
+file. This typically means that only the most recent version of a
+distribution is covered.
+
+=item CPAN::Distribution::cvs_import()
+
+Changes to the directory where the distribution has been unpacked and
+runs something like
+
+ cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
+
+there.
+
+=item CPAN::Distribution::dir()
+
+Returns the directory into which this distribution has been unpacked.
+
+=item CPAN::Distribution::force($method,@args)
+
+Forces CPAN to perform a task that normally would have failed. Force
+takes as arguments a method name to be called and any number of
+additional arguments that should be passed to the called method. The
+internals of the object get the needed changes so that CPAN.pm does
+not refuse to take the action.
+
+=item CPAN::Distribution::get()
+
+Downloads the distribution from CPAN and unpacks it. Does nothing if
+the distribution has already been downloaded and unpacked within the
+current session.
+
+=item CPAN::Distribution::install()
+
+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
+cancellation can be avoided by letting C<force> run the C<install> for
+you.
+
+=item CPAN::Distribution::isa_perl()
+
+Returns 1 if this distribution file seems to be a perl distribution.
+Normally this is derived from the file name only, but the index from
+CPAN can contain a hint to achieve a return value of true for other
+filenames too.
+
+=item CPAN::Distribution::look()
+
+Changes to the directory where the distribution has been unpacked and
+opens a subshell there. Exiting the subshell returns.
+
+=item CPAN::Distribution::make()
+
+First runs the C<get> method to make sure the distribution is
+downloaded and unpacked. Changes to the directory where the
+distribution has been unpacked and runs the external commands C<perl
+Makefile.PL> and C<make> there.
+
+=item CPAN::Distribution::prereq_pm()
+
+Returns the hash reference that has been announced by a distribution
+as the PREREQ_PM hash in the Makefile.PL. Note: works only after an
+attempt has been made to C<make> the distribution. Returns undef
+otherwise.
+
+=item CPAN::Distribution::readme()
+
+Downloads the README file associated with a distribution and runs it
+through the pager specified in C<$CPAN::Config->{pager}>.
+
+=item CPAN::Distribution::test()
+
+Changes to the directory where the distribution has been unpacked and
+runs C<make test> there.
+
+=item CPAN::Distribution::uptodate()
+
+Returns 1 if all the modules contained in the distribution are
+uptodate. Relies on containsmods.
+
+=item CPAN::Index::force_reload()
+
+Forces a reload of all indices.
+
+=item CPAN::Index::reload()
+
+Reloads all indices if they have been read more than
+C<$CPAN::Config->{index_expire}> days.
+
+=item CPAN::InfoObj::dump()
+
+CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
+inherit this method. It prints the data structure associated with an
+object. Useful for debugging. Note: the data structure is considered
+internal and thus subject to change without notice.
+
+=item CPAN::Module::as_glimpse()
+
+Returns a one-line description of the module
+
+=item CPAN::Module::as_string()
+
+Returns a multi-line description of the module
+
+=item CPAN::Module::clean()
+
+Runs a clean on the distribution associated with this module.
+
+=item CPAN::Module::cpan_file()
+
+Returns the filename on CPAN that is associated with the module.
+
+=item CPAN::Module::cpan_version()
+
+Returns the latest version of this module available on CPAN.
+
+=item CPAN::Module::cvs_import()
+
+Runs a cvs_import on the distribution associated with this module.
+
+=item CPAN::Module::description()
+
+Returns a 44 chracter 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::force($method,@args)
+
+Forces CPAN to perform a task that normally would have failed. Force
+takes as arguments a method name to be called and any number of
+additional arguments that should be passed to the called method. The
+internals of the object get the needed changes so that CPAN.pm does
+not refuse to take the action.
+
+=item CPAN::Module::get()
+
+Runs a get on the distribution associated with this module.
+
+=item CPAN::Module::inst_file()
+
+Returns the filename of the module found in @INC. The first file found
+is reported just like perl itself stops searching @INC when it finds a
+module.
+
+=item CPAN::Module::inst_version()
+
+Returns the version number of the module in readable format.
+
+=item CPAN::Module::install()
+
+Runs an C<install> on the distribution associated with this module.
+
+=item CPAN::Module::look()
+
+Changes to the directory where the distribution assoicated with this
+module has been unpacked and opens a subshell there. Exiting the
+subshell returns.
+
+=item CPAN::Module::make()
+
+Runs a C<make> on the distribution associated with this module.
+
+=item CPAN::Module::manpage_headline()
+
+If module is installed, peeks into the module's manpage, reads the
+headline and returns it. Moreover, if the module has been downloaded
+within this session, does the equivalent on the downloaded module even
+if it is not installed.
+
+=item CPAN::Module::readme()
+
+Runs a C<readme> on the distribution associated with this module.
+
+=item CPAN::Module::test()
+
+Runs a C<test> on the distribution associated with this module.
+
+=item CPAN::Module::uptodate()
+
+Returns 1 if the module is installed and up-to-date.
+
+=item CPAN::Module::userid()
+
+Returns the author's ID of the module.
+
+=item
+
+=back
=head2 Cache Manager
('follow' automatically, 'ask' me, or 'ignore')
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
+ (and nonsense for characters outside latin range)
unzip location of external program unzip
urllist arrayref to nearby CPAN sites (or equivalent locations)
wait_list arrayref to a wait server to try (See CPAN::WAIT)
=head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
-To populate a freshly installed perl with my favorite modules is pretty
-easiest by maintaining a private bundle definition file. To get a useful
+Populating a freshly installed perl with my favorite modules is pretty
+easy if you maintain a private bundle definition file. To get a useful
blueprint of a bundle definition file, the command autobundle can be used
on the CPAN shell command line. This command writes a bundle definition
file for all modules that are installed for the currently running perl
then answer a few questions and then go out for a coffee.
-Maintaining a bundle definition file means to keep track of two
+Maintaining a bundle definition file means keeping track of two
things: dependencies and interactivity. CPAN.pm sometimes fails on
calculating dependencies because not all modules define all MakeMaker
attributes correctly, so a bundle definition file should specify
what I try to accomplish in my private bundle file is to have the
packages that need to be configured early in the file and the gentle
ones later, so I can go out after a few minutes and leave CPAN.pm
-unattained.
+untended.
=head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
This is the firewall implemented in the Linux kernel, it allows you to
hide a complete network behind one IP address. With this firewall no
-special compiling is need as you can access hosts directly.
+special compiling is needed as you can access hosts directly.
=back
=over
-=item I installed a new version of module X but CPAN keeps saying, I
- have the old version installed
+=item 1) 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
o conf make_install_arg UNINST=1
-=item So why is UNINST=1 not the default?
+=item 2) 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
+=item 3) I want to clean up my mess, and install a new perl along with
+ all modules I have. How do I go about it?
+
+Run the autobundle command for your old perl and optionally rename the
+resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
+with the Configure option prefix, e.g.
+
+ ./Configure -Dprefix=/usr/local/perl-5.6.78.9
+
+Install the bundle file you produced in the first step with something like
+
+ cpan> install Bundle::mybundle
+
+and you're done.
+
+=item 4) 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
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?
+=item 5) I am not root, how can I install a module in a personal
+ directory?
You will most probably like something like this:
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?
+=item 6) 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?
+=item 7) 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
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 order.
-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.
+the queue of things to install in a topologically correct order. It
+resolves perfectly well IFF all modules declare the prerequisites
+correctly with the PREREQ_PM attribute to MakeMaker. For bundles which
+fail and you need to install often, it is recommended sort the Bundle
+definition file manually. It is planned to improve the metadata
+situation for dependencies on CPAN in general, but this will still
+take some time.
+
+=item 8) In our intranet we have many modules for internal use. How
+ can I integrate these modules with CPAN.pm but without uploading
+ the modules to CPAN?
+
+Have a look at the CPAN::Site module.
+
+=item 9) When I run CPAN's shell, I get error msg about line 1 to 4,
+ setting meta input/output via the /etc/inputrc file.
+
+Some versions of readline are picky about capitalization in the
+/etc/inputrc file and specifically RedHat 6.2 comes with a
+/etc/inputrc that contains the word C<on> in lowercase. Change the
+occurrences of C<on> to C<On> and the bug should disappear.
+
+=item 10) Some authors have strange characters in their names.
+
+Internally CPAN.pm uses the UTF-8 charset. If your terminal is
+expecting ISO-8859-1 charset, a converter can be activated by setting
+term_is_latin to a true value in your config file. One way of doing so
+would be
+
+ cpan> ! $CPAN::Config->{term_is_latin}=1
+
+Extended support for converters will be made available as soon as perl
+becomes stable with regard to charset issues.
=back
projects / p5sagit/p5-mst-13.2.git / blobdiff