# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
package CPAN;
-$VERSION = '1.59_56';
-# $Id: CPAN.pm,v 1.385 2001/02/09 21:37:57 k Exp $
-
-# only used during development:
-$Revision = "";
-# $Revision = "[".substr(q$Revision: 1.385 $, 10)."]";
+$VERSION = '1.80';
+$VERSION = eval $VERSION;
+use CPAN::Version;
use Carp ();
use Config ();
use Cwd ();
use File::Copy ();
use File::Find;
use File::Path ();
+use File::Spec;
+use File::Temp ();
use FileHandle ();
use Safe ();
+use Sys::Hostname;
use Text::ParseWords ();
use Text::Wrap;
-use File::Spec;
no lib "."; # we need to run chdir all over and we would get at wrong
# libraries there
$CPAN::Signal ||= 0;
$CPAN::Frontend ||= "CPAN::Shell";
$CPAN::Defaultsite ||= "ftp://ftp.perl.org/pub/CPAN";
+$CPAN::Perl ||= CPAN::find_perl();
+$CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
+$CPAN::Defaultrecent ||= "http://search.cpan.org/recent";
+
package CPAN;
-use strict qw(vars);
+use strict;
use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term
- $Revision $Signal $End $Suppress_readline $Frontend
- $Defaultsite $Have_warned);
+ $Signal $End $Suppress_readline $Frontend
+ $Defaultsite $Have_warned $Defaultdocs $Defaultrecent
+ $Be_Silent );
@CPAN::ISA = qw(CPAN::Debug Exporter);
@EXPORT = qw(
- autobundle bundle expand force get cvs_import
+ autobundle bundle expand force notest get cvs_import
install make readme recompile shell test clean
+ perldoc recent
);
#-> sub CPAN::AUTOLOAD ;
if (exists $EXPORT{$l}){
CPAN::Shell->$l(@_);
} else {
- $CPAN::Frontend->mywarn(qq{Unknown command "$AUTOLOAD". }.
+ $CPAN::Frontend->mywarn(qq{Unknown CPAN command "$AUTOLOAD". }.
qq{Type ? for help.
});
}
}
+
#-> sub CPAN::shell ;
sub shell {
my($self) = @_;
$readline::rl_completion_function =
$readline::rl_completion_function = 'CPAN::Complete::cpl';
}
+ if (my $histfile = $CPAN::Config->{'histfile'}) {{
+ unless ($term->can("AddHistory")) {
+ $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
+ last;
+ }
+ my($fh) = FileHandle->new;
+ open $fh, "<$histfile" or last;
+ local $/ = "\n";
+ while (<$fh>) {
+ chomp;
+ $term->AddHistory($_);
+ }
+ close $fh;
+ }}
# $term->OUT is autoflushed anyway
my $odef = select STDERR;
$| = 1;
$CPAN::Frontend->myprint(
sprintf qq{
-cpan shell -- CPAN exploration and modules installation (v%s%s)
+cpan shell -- CPAN exploration and modules installation (v%s)
ReadLine support %s
},
$CPAN::VERSION,
- $CPAN::Revision,
$rl_avail
)
unless $CPAN::Config->{'inhibit_startup_message'} ;
use File::Find;
package CPAN::Config;
-use vars qw(%can $dot_cpan);
+use vars qw(%can %keys $dot_cpan);
%can = (
'commit' => "Commit changes to disk",
'init' => "Interactive setting of all options",
);
+%keys = map { $_ => undef } qw(
+ build_cache build_dir
+ cache_metadata cpan_home curl
+ dontload_hash
+ ftp ftp_proxy
+ getcwd gpg gzip
+ histfile histsize http_proxy
+ inactivity_timeout index_expire inhibit_startup_message
+ keep_source_where
+ lynx
+ make make_arg make_install_arg make_install_make_command makepl_arg
+ ncftp ncftpget no_proxy pager
+ prerequisites_policy
+ scan_cache shell show_upload_date
+ tar term_is_latin
+ unzip urllist
+ wait_list wget
+);
+
package CPAN::FTP;
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
+# we delay requiring LWP::UserAgent and setting up inheritance until we need it
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
+ cvs_import ls perldoc recent
) unless @CPAN::Complete::COMMANDS;
package CPAN::Index;
package CPAN::Module;
@CPAN::Module::ISA = qw(CPAN::InfoObj);
+package CPAN::Exception::RecursiveDependency;
+use overload '""' => "as_string";
+
+sub new {
+ my($class) = shift;
+ my($deps) = shift;
+ my @deps;
+ my %seen;
+ for my $dep (@$deps) {
+ push @deps, $dep;
+ last if $seen{$dep}++;
+ }
+ bless { deps => \@deps }, $class;
+}
+
+sub as_string {
+ my($self) = shift;
+ "\nRecursive dependency detected:\n " .
+ join("\n => ", @{$self->{deps}}) .
+ ".\nCannot continue.\n";
+}
+
package CPAN::Shell;
use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY $PRINT_ORNAMENTING);
@CPAN::Shell::ISA = qw(CPAN::Debug);
});
}
} else {
- $CPAN::Frontend->mywarn(qq{Unknown command '$autoload'. }.
+ $CPAN::Frontend->mywarn(qq{Unknown shell command '$autoload'. }.
qq{Type ? for help.
});
}
#-> 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 {
#-> sub CPAN::getcwd ;
sub getcwd {Cwd::getcwd();}
+#-> sub CPAN::find_perl ;
+sub find_perl {
+ my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
+ my $pwd = CPAN::anycwd();
+ 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 (File::Spec->path(),
+ $Config::Config{'binexp'}) {
+ next unless defined($component) && $component;
+ my($abs) = File::Spec->catfile($component,$perl_name);
+ if (MM->maybe_command($abs)) {
+ $perl = $abs;
+ last DIST_PERLNAME;
+ }
+ }
+ }
+ }
+
+ return $perl;
+}
+
+
#-> sub CPAN::exists ;
sub exists {
my($mgr,$class,$id) = @_;
sub {require HTTP::Request},
sub {require URI::URL},
],
- Net::FTP => [
+ 'Net::FTP' => [
sub {require Net::FTP},
sub {require Net::Config},
]
my $file = $mod;
my $obj;
$file =~ s|::|/|g;
- $file =~ s|/|\\|g if $^O eq 'MSWin32';
$file .= ".pm";
if ($INC{$file}) {
# checking %INC is wrong, because $INC{LWP} may be true
$CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
if ($mod eq "CPAN::WAIT") {
- push @CPAN::Shell::ISA, CPAN::WAIT;
+ push @CPAN::Shell::ISA, 'CPAN::WAIT';
}
return 1;
} elsif ($mod eq "Net::FTP") {
});
sleep 2;
+ } elsif ($mod eq "Module::Signature"){
+ unless ($Have_warned->{"Module::Signature"}++) {
+ # No point in complaining unless the user can
+ # reasonably install and use it.
+ if (eval { require Crypt::OpenPGP; 1 } ||
+ defined $CPAN::Config->{'gpg'}) {
+ $CPAN::Frontend->myprint(qq{
+ CPAN: Module::Signature security checks disabled because Module::Signature
+ not installed. Please consider installing the Module::Signature module.
+ You may also need to be able to connect over the Internet to the public
+ keyservers like pgp.mit.edu (port 11371).
+
+});
+ sleep 2;
+ }
+ }
} else {
delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
}
my($message) = @_;
my $i = 0;
my $ineval = 0;
- if (
- 0 && # disabled, try reload cpan with it
- $] > 5.004_60 # thereabouts
- ) {
- $ineval = $^S;
- } else {
- my($subroutine);
- while ((undef,undef,undef,$subroutine) = caller(++$i)) {
+ my($subroutine);
+ while ((undef,undef,undef,$subroutine) = caller(++$i)) {
$ineval = 1, last if
$subroutine eq '(eval)';
- }
}
return if $ineval && !$End;
- return unless defined $META->{LOCK}; # unsafe meta access, ok
- return unless -f $META->{LOCK}; # unsafe meta access, ok
- unlink $META->{LOCK}; # unsafe meta access, ok
+ return unless defined $META->{LOCK};
+ return unless -f $META->{LOCK};
+ $META->savehist;
+ unlink $META->{LOCK};
# require Carp;
# Carp::cluck("DEBUGGING");
$CPAN::Frontend->mywarn("Lockfile removed.\n");
}
+#-> sub CPAN::savehist
+sub savehist {
+ my($self) = @_;
+ my($histfile,$histsize);
+ unless ($histfile = $CPAN::Config->{'histfile'}){
+ $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
+ return;
+ }
+ $histsize = $CPAN::Config->{'histsize'} || 100;
+ if ($CPAN::term){
+ unless ($CPAN::term->can("GetHistory")) {
+ $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
+ return;
+ }
+ } else {
+ return;
+ }
+ my @h = $CPAN::term->GetHistory;
+ splice @h, 0, @h-$histsize if @h>$histsize;
+ my($fh) = FileHandle->new;
+ open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
+ local $\ = local $, = "\n";
+ print $fh @h;
+ close $fh;
+}
+
+sub is_tested {
+ my($self,$what) = @_;
+ $self->{is_tested}{$what} = 1;
+}
+
+sub is_installed {
+ my($self,$what) = @_;
+ delete $self->{is_tested}{$what};
+}
+
+sub set_perl5lib {
+ my($self) = @_;
+ $self->{is_tested} ||= {};
+ return unless %{$self->{is_tested}};
+ my $env = $ENV{PERL5LIB};
+ $env = $ENV{PERLLIB} unless defined $env;
+ my @env;
+ push @env, $env if defined $env and length $env;
+ my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
+ $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
+ $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
+}
+
package CPAN::CacheMgr;
#-> sub CPAN::CacheMgr::as_string ;
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");
}
return 1;
} else {
CPAN->debug("o[$o]") if $CPAN::DEBUG;
+ unless (exists $keys{$o}) {
+ $CPAN::Frontend->mywarn("Warning: unknown configuration variable '$o'\n");
+ }
if ($o =~ /list$/) {
$func = shift @args;
$func ||= "";
if (ref $v) {
my(@report) = ref $v eq "ARRAY" ?
@$v :
- map { sprintf(" %-18s => %s\n",
- $_,
+ map { sprintf(" %-18s => [%s]\n",
+ map { "[$_]" } $_,
defined $v->{$_} ? $v->{$_} : "UNDEFINED"
)} keys %$v;
$CPAN::Frontend->myprint(
" %-18s\n",
$k
),
- map {"\t$_\n"} @report
+ map {"\t[$_]\n"} @report
)
);
} elsif (defined $v) {
- $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
+ $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
} else {
- $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, "UNDEFINED");
+ $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, "UNDEFINED");
}
}
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;
+ my($self, %args) = @_;
+ $CPAN::Be_Silent++ if $args{be_silent};
+
my(@miss);
use Carp;
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 {
- Carp::confess(qq{WARNING: CPAN.pm is unable to }.
- qq{create a configuration file.});
+ $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm");
+ $configpm = _configpmtest($configpmdir,$configpmtest);
+ unless ($configpm) {
+ my $text = qq{WARNING: CPAN.pm is unable to } .
+ qq{create a configuration file.};
+ output($text, 'confess');
}
}
}
$CPAN::Frontend->myprint(qq{
$configpm initialized.
});
+
sleep 2;
- CPAN::FirstTime::init($configpm);
+ CPAN::FirstTime::init($configpm, %args);
}
#-> sub CPAN::Config::missing_config_data ;
} elsif (@words >= 4) {
return ();
}
- my(@o_conf) = (keys %CPAN::Config::can, keys %$CPAN::Config);
+ my %seen;
+ my(@o_conf) = sort grep { !$seen{$_}++ }
+ keys %CPAN::Config::can,
+ keys %$CPAN::Config,
+ keys %CPAN::Config::keys;
return grep /^\Q$word\E/, @o_conf;
}
Display Information
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
+ i WORD or /REGEXP/ about any of the above
+ r NONE report updatable modules
ls AUTHOR about files in the author's directory
+ (with WORD being a module, bundle or author name or a distribution
+ name of the form AUTHOR/DISTRIBUTION)
Download, Test, Make, Install...
- get download
- make make (implies get)
- 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
+ get download clean make clean
+ make make (implies get) look open subshell in dist directory
+ test make test (implies make) readme display these README files
+ install make install (implies test) perldoc display POD documentation
+
+Pragmas
+ force COMMAND unconditionally do command
+ notest COMMAND skip testing
Other
h,? display this menu ! perl-code eval a perl command
o conf [opt] set and query options q quit the cpan shell
reload cpan load CPAN.pm again reload index load newer indices
- autobundle Snapshot force cmd unconditionally do cmd});
+ autobundle Snapshot recent latest CPAN uploads});
}
}
}
#-> sub CPAN::Shell::ls ;
-sub ls {
+sub ls {
my($self,@arg) = @_;
my @accept;
+ if ($arg[0] eq "*") {
+ @arg = map { $_->id } $self->expand('Author','/./');
+ }
for (@arg) {
- unless (/^[A-Z\-]+$/i) {
- $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author");
+ unless (/^[A-Z0-9\-]+$/i) {
+ $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
next;
}
push @accept, uc $_;
}
+ my $silent = @accept>1;
+ my $last_alpha = "";
for my $a (@accept){
my $author = $self->expand('Author',$a) or die "No author found for $a";
- $author->ls;
+ $author->ls($silent); # silent if more than one author
+ if ($silent) {
+ my $alphadot = substr $author->id, 0, 1;
+ my $ad;
+ if ($alphadot eq $last_alpha) {
+ $ad = ".";
+ } else {
+ $ad = $alphadot;
+ $last_alpha = $alphadot;
+ }
+ $CPAN::Frontend->myprint($ad);
+ }
}
}
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)){
+ if (-d File::Spec->catdir($bdir,$entry)){
push @bbase, "$bbase\::$entry";
} else {
next unless $entry =~ s/\.pm(?!\n)\Z//;
#-> sub CPAN::Shell::m ;
sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
- $CPAN::Frontend->myprint(shift->format_result('Module',@_));
+ my $self = shift;
+ $CPAN::Frontend->myprint($self->format_result('Module',@_));
}
#-> sub CPAN::Shell::i ;
sub i {
my($self) = shift;
my(@args) = @_;
- my(@type,$type,@m);
- @type = qw/Author Bundle Distribution Module/;
@args = '/./' unless @args;
my(@result);
- for $type (@type) {
+ for my $type (qw/Bundle Distribution Module/) {
push @result, $self->expand($type,@args);
}
+ # Authors are always uppercase.
+ push @result, $self->expand("Author", map { uc $_ } @args);
+
my $result = @result == 1 ?
$result[0]->as_string :
@result == 0 ?
$CPAN::Frontend->myprint(":\n");
for $k (sort keys %CPAN::Config::can) {
$v = $CPAN::Config::can{$k};
- $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
+ $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
}
$CPAN::Frontend->myprint("\n");
for $k (sort keys %$CPAN::Config) {
sub paintdots_onreload {
my($ref) = shift;
sub {
- if ( $_[0] =~ /[Ss]ubroutine (\w+) redefined/ ) {
+ if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
my($subr) = $1;
++$$ref;
local($|) = 1;
$command ||= "";
$self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
if ($command =~ /cpan/i) {
- CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
- my $fh = FileHandle->new($INC{'CPAN.pm'});
- local($/);
- my $redef = 0;
- local($SIG{__WARN__}) = paintdots_onreload(\$redef);
- eval <$fh>;
- warn $@ if $@;
- $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
+ for my $f (qw(CPAN.pm CPAN/FirstTime.pm)) {
+ next unless $INC{$f};
+ my $pwd = CPAN::anycwd();
+ CPAN->debug("reloading the whole '$f' from '$INC{$f}' while pwd='$pwd'")
+ if $CPAN::DEBUG;
+ my $fh = FileHandle->new($INC{$f});
+ local($/);
+ my $redef = 0;
+ local $^W = 1;
+ local($SIG{__WARN__}) = paintdots_onreload(\$redef);
+ my $eval = <$fh>;
+ CPAN->debug("evaling '$eval'")
+ if $CPAN::DEBUG;
+ eval $eval;
+ warn $@ if $@;
+ $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
+ }
} elsif ($command =~ /index/) {
CPAN::Index->force_reload;
} else {
# for metadata cache
$CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
}
- for $module (@expand) {
+ MODULE: for $module (@expand) {
my $file = $module->cpan_file;
- next unless defined $file; # ??
+ next MODULE unless defined $file; # ??
my($latest) = $module->cpan_version;
my($inst_file) = $module->inst_file;
my($have);
} elsif ($have == 0){
$version_zeroes++;
}
- next unless CPAN::Version->vgt($latest, $have);
+ next MODULE unless CPAN::Version->vgt($latest, $have);
# to be pedantic we should probably say:
# && !($have eq "undef" && $latest ne "undef" && $latest gt "");
# to catch the case where CPAN has a version 0 and we have a version undef
} elsif ($what eq "u") {
- next;
+ next MODULE;
}
} else {
if ($what eq "a") {
- next;
+ next MODULE;
} elsif ($what eq "r") {
- next;
+ next MODULE;
} elsif ($what eq "u") {
$have = "-";
}
push @result, sprintf "%s %s\n", $module->id, $have;
} elsif ($what eq "r") {
push @result, $module->id;
- next if $seen{$file}++;
+ next MODULE if $seen{$file}++;
} elsif ($what eq "u") {
push @result, $module->id;
- next if $seen{$file}++;
- next if $file =~ /^Contact/;
+ next MODULE if $seen{$file}++;
+ next MODULE if $file =~ /^Contact/;
}
unless ($headerdone++){
$CPAN::Frontend->myprint("\n");
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(
$result;
}
+#-> sub CPAN::Shell::report_fh ;
+{
+ my $installation_report_fh;
+ my $previously_noticed = 0;
+
+ sub report_fh {
+ return $installation_report_fh if $installation_report_fh;
+ $installation_report_fh = File::Temp->new(
+ template => 'cpan_install_XXXX',
+ suffix => '.txt',
+ unlink => 0,
+ );
+ unless ( $installation_report_fh ) {
+ warn("Couldn't open installation report file; " .
+ "no report file will be generated."
+ ) unless $previously_noticed++;
+ }
+ }
+}
+
+
# 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 ;-)
my $longest = 0;
return unless defined $what;
+ local $| = 1; # Flush immediately
+ if ( $CPAN::Be_Silent ) {
+ print {report_fh()} $what;
+ return;
+ }
+
if ($CPAN::Config->{term_is_latin}){
# courtesy jhi:
$what
print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
}
} else {
+ # chomp $what;
+ # $what .= "\n"; # newlines unless $PRINT_ORNAMENTING
print $what;
}
}
sub rematein {
shift;
my($meth,@some) = @_;
- my $pragma = "";
- if ($meth eq 'force') {
- $pragma = $meth;
+ my @pragma;
+ while($meth =~ /^(force|notest)$/) {
+ push @pragma, $meth;
$meth = shift @some;
}
setup_output();
- CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
+ CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
# Here is the place to set "test_count" on all involved parties to
# 0. We then can pass this counter on to the involved
$obj->color_cmd_tmps(0,1);
CPAN::Queue->new($obj->id);
push @qcopy, $obj;
- } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
- $obj = $CPAN::META->instance('CPAN::Author',$s);
- if ($meth eq "dump") {
- $obj->dump;
+ } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
+ $obj = $CPAN::META->instance('CPAN::Author',uc($s));
+ if ($meth =~ /^(dump|ls)$/) {
+ $obj->$meth();
} else {
$CPAN::Frontend->myprint(
join "",
} else {
$obj = CPAN::Shell->expandany($s);
}
- if ($pragma
- &&
- ($] < 5.00303 || $obj->can($pragma))){
- ### compatibility with 5.003
- $obj->$pragma($meth); # the pragma "force" in
- # "CPAN::Distribution" must know
- # what we are intending
+ for my $pragma (@pragma) {
+ if ($pragma
+ &&
+ ($] < 5.00303 || $obj->can($pragma))){
+ ### compatibility with 5.003
+ $obj->$pragma($meth); # the pragma "force" in
+ # "CPAN::Distribution" must know
+ # what we are intending
+ }
}
if ($]>=5.00303 && $obj->can('called_for')) {
$obj->called_for($s);
}
CPAN->debug(
- qq{pragma[$pragma]meth[$meth]obj[$obj]as_string\[}.
+ qq{pragma[@pragma]meth[$meth]obj[$obj]as_string\[}.
$obj->as_string.
qq{\]}
) if $CPAN::DEBUG;
}
}
-#-> sub CPAN::Shell::dump ;
-sub dump { shift->rematein('dump',@_); }
-#-> sub CPAN::Shell::force ;
-sub force { shift->rematein('force',@_); }
-#-> sub CPAN::Shell::get ;
-sub get { shift->rematein('get',@_); }
-#-> sub CPAN::Shell::readme ;
-sub readme { shift->rematein('readme',@_); }
-#-> sub CPAN::Shell::make ;
-sub make { shift->rematein('make',@_); }
-#-> sub CPAN::Shell::test ;
-sub test { shift->rematein('test',@_); }
-#-> sub CPAN::Shell::install ;
-sub install { shift->rematein('install',@_); }
-#-> sub CPAN::Shell::clean ;
-sub clean { shift->rematein('clean',@_); }
-#-> sub CPAN::Shell::look ;
-sub look { shift->rematein('look',@_); }
-#-> sub CPAN::Shell::cvs_import ;
-sub cvs_import { shift->rematein('cvs_import',@_); }
+#-> sub CPAN::Shell::recent ;
+sub recent {
+ my($self) = @_;
+
+ CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
+ return;
+}
+
+{
+ # set up the dispatching methods
+ no strict "refs";
+ for my $command (qw(
+ clean cvs_import dump force get install look
+ make notest perldoc readme test
+ )) {
+ *$command = sub { shift->rematein($command, @_); };
+ }
+}
package CPAN::LWP::UserAgent;
@ISA = qw(Exporter LWP::UserAgent);
$SETUPDONE++;
} else {
- $CPAN::Frontent->mywarn("LWP::UserAgent not available\n");
+ $CPAN::Frontend->mywarn("LWP::UserAgent not available\n");
}
}
return unless $proxy;
if ($USER && $PASSWD) {
} elsif (defined $CPAN::Config->{proxy_user} &&
- defined $CPAN::Config->{proxy_pass}) {
+ defined $CPAN::Config->{proxy_pass}) {
$USER = $CPAN::Config->{proxy_user};
$PASSWD = $CPAN::Config->{proxy_pass};
} else {
return($USER,$PASSWD);
}
+# mirror(): Its purpose is to deal with proxy authentication. When we
+# call SUPER::mirror, we relly call the mirror method in
+# LWP::UserAgent. LWP::UserAgent will then call
+# $self->get_basic_credentials or some equivalent and this will be
+# $self->dispatched to our own get_basic_credentials method.
+
+# Our own get_basic_credentials sets $USER and $PASSWD, two globals.
+
+# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
+# although we have gone through our get_basic_credentials, the proxy
+# server refuses to connect. This could be a case where the username or
+# password has changed in the meantime, so I'm trying once again without
+# $USER and $PASSWD to give the get_basic_credentials routine another
+# chance to set $USER and $PASSWD.
+
+# mirror(): Its purpose is to deal with proxy authentication. When we
+# call SUPER::mirror, we relly call the mirror method in
+# LWP::UserAgent. LWP::UserAgent will then call
+# $self->get_basic_credentials or some equivalent and this will be
+# $self->dispatched to our own get_basic_credentials method.
+
+# Our own get_basic_credentials sets $USER and $PASSWD, two globals.
+
+# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
+# although we have gone through our get_basic_credentials, the proxy
+# server refuses to connect. This could be a case where the username or
+# password has changed in the meantime, so I'm trying once again without
+# $USER and $PASSWD to give the get_basic_credentials routine another
+# chance to set $USER and $PASSWD.
+
sub mirror {
my($self,$url,$aslocal) = @_;
my $result = $self->SUPER::mirror($url,$aslocal);
CPAN::LWP::UserAgent->config;
eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
if ($@) {
- $CPAN::Frontent->mywarn("CPAN::LWP::UserAgent->new dies with $@")
+ $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
if $CPAN::DEBUG;
} else {
my($var);
}
}
}
- $ENV{ftp_proxy} = $CPAN::Config->{ftp_proxy} if $CPAN::Config->{ftp_proxy};
- $ENV{http_proxy} = $CPAN::Config->{http_proxy}
- if $CPAN::Config->{http_proxy};
- $ENV{no_proxy} = $CPAN::Config->{no_proxy} if $CPAN::Config->{no_proxy};
+ for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
+ $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
+ }
# Try the list of urls for each single object. We keep a record
# where we did get a file from
my(@reordered,$last);
$CPAN::Config->{urllist} ||= [];
+ unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
+ warn "Malformed urllist; ignoring. Configuration file corrupt?\n";
+ }
$last = $#{$CPAN::Config->{urllist}};
if ($force & 2) { # local cpans probably out of date, don't reorder
@reordered = (0..$last);
CPAN::LWP::UserAgent->config;
eval { $Ua = CPAN::LWP::UserAgent->new; };
if ($@) {
- $CPAN::Frontent->mywarn("CPAN::LWP::UserAgent->new dies with $@");
+ $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
}
}
my $res = $Ua->mirror($url, $aslocal);
# success above. Likely a bogus URL
$self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
- my($f,$funkyftp);
- for $f ('lynx','ncftpget','ncftp','wget') {
- next unless exists $CPAN::Config->{$f};
- $funkyftp = $CPAN::Config->{$f};
- next unless defined $funkyftp;
+
+ # Try the most capable first and leave ncftp* for last as it only
+ # does FTP.
+ for my $f (qw(curl wget lynx ncftpget ncftp)) {
+ my $funkyftp = $CPAN::Config->{$f};
+ next unless defined $funkyftp;
next if $funkyftp =~ /^\s*$/;
+
my($asl_ungz, $asl_gz);
($asl_ungz = $aslocal) =~ s/\.gz//;
$asl_gz = "$asl_ungz.gz";
+
my($src_switch) = "";
+ my($chdir) = "";
+ my($stdout_redir) = " > $asl_ungz";
if ($f eq "lynx"){
$src_switch = " -source";
} elsif ($f eq "ncftp"){
$src_switch = " -c";
- } elsif ($f eq "wget"){
- $src_switch = " -O -";
+ } elsif ($f eq "wget"){
+ $src_switch = " -O $asl_ungz";
+ $stdout_redir = "";
+ } elsif ($f eq 'curl'){
+ $src_switch = ' -L';
}
- my($chdir) = "";
- my($stdout_redir) = " > $asl_ungz";
+
if ($f eq "ncftpget"){
$chdir = "cd $aslocal_dir && ";
$stdout_redir = "";
$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
});
}
return if $CPAN::Signal;
- } # lynx,ncftpget,ncftp
+ } # transfer programs
} # host
}
my($i);
my($aslocal_dir) = File::Basename::dirname($aslocal);
File::Path::mkpath($aslocal_dir);
+ my $ftpbin = $CPAN::Config->{ftp};
HOSTHARDEST: for $i (@$host_seq) {
- unless (length $CPAN::Config->{'ftp'}) {
+ unless (length $ftpbin && MM->maybe_command($ftpbin)) {
$CPAN::Frontend->myprint("No external ftp command available\n\n");
last HOSTHARDEST;
}
@dialog,
"lcd $aslocal_dir",
"cd /",
- map("cd $_", split "/", $dir), # RFC 1738
+ map("cd $_", split /\//, $dir), # RFC 1738
"bin",
"get $getfile $targetfile",
"quit"
}
);
- $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose $host",
+ $self->talk_ftp("$ftpbin$verbose $host",
@dialog);
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
# OK, they don't have a valid ~/.netrc. Use 'ftp -n'
# then and login manually to host, using e-mail as
# password.
- $CPAN::Frontend->myprint(qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n});
+ $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
unshift(
@dialog,
"open $host",
"user anonymous $Config::Config{'cf_email'}"
);
- $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose -n", @dialog);
+ $self->talk_ftp("$ftpbin$verbose -n", @dialog);
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
$mtime ||= 0;
sub new {
my($class) = @_;
- my $file = MM->catfile($ENV{HOME},".netrc");
+ my $file = File::Spec->catfile($ENV{HOME},".netrc");
my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
} elsif ($line =~ /^d\s/) {
@return = cplx('CPAN::Distribution',$word);
} elsif ($line =~ m/^(
- [mru]|make|clean|dump|get|test|install|readme|look|cvs_import
+ [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
)\s/x ) {
if ($word =~ /^Bundle::/) {
CPAN::Shell->local_bundles;
} elsif ($words[1] eq 'conf') {
return CPAN::Config::cpl(@_);
} elsif ($words[1] eq 'debug') {
- return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
+ return sort grep /^\Q$word\E/,
+ sort keys %CPAN::DEBUG, 'all';
}
}
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'} &&
return unless defined $index_target;
$CPAN::Frontend->myprint("Going to read $index_target\n");
local(*FH);
- tie *FH, CPAN::Tarzip, $index_target;
+ tie *FH, 'CPAN::Tarzip', $index_target;
local($/) = "\n";
push @lines, split /\012/ while <FH>;
foreach (@lines) {
$last_updated);
$DATE_OF_02 = $last_updated;
- if ($CPAN::META->has_inst(HTTP::Date)) {
+ if ($CPAN::META->has_inst('HTTP::Date')) {
require HTTP::Date;
my($age) = (time - HTTP::Date::str2time($last_updated))/3600/24;
if ($age > 30) {
}
- if ($id->cpan_file ne $dist){ # update only if file is
- # different. CPAN prohibits same
- # name with different version
- $userid = $self->userid($dist);
+ # Although CPAN prohibits same name with different version the
+ # indexer may have changed the version for the same distro
+ # since the last time ("Force Reindexing" feature)
+ if ($id->cpan_file ne $dist
+ ||
+ $id->cpan_version ne $version
+ ){
+ $userid = $id->userid || $self->userid($dist);
$id->set(
'CPAN_USERID' => $userid,
'CPAN_VERSION' => $version,
CPAN::Distribution)) {
$cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
}
- my $metadata_file = MM->catfile($CPAN::Config->{cpan_home},"Metadata");
+ my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
$cache->{last_time} = $LAST_TIME;
$cache->{DATE_OF_02} = $DATE_OF_02;
$cache->{PROTOCOL} = PROTOCOL;
$CPAN::Frontend->myprint("Going to write $metadata_file\n");
eval { Storable::nstore($cache, $metadata_file) };
- $CPAN::Frontend->mywarn($@) if $@;
+ $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
}
#-> sub CPAN::Index::read_metadata_cache ;
my($self) = @_;
return unless $CPAN::Config->{'cache_metadata'};
return unless $CPAN::META->has_usable("Storable");
- my $metadata_file = MM->catfile($CPAN::Config->{cpan_home},"Metadata");
+ my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
return unless -r $metadata_file and -f $metadata_file;
$CPAN::Frontend->myprint("Going to read $metadata_file\n");
my $cache;
eval { $cache = Storable::retrieve($metadata_file) };
- $CPAN::Frontend->mywarn($@) if $@;
+ $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
if (!$cache || ref $cache ne 'HASH'){
$LAST_TIME = 0;
return;
if (exists $cache->{PROTOCOL}) {
if (PROTOCOL > $cache->{PROTOCOL}) {
$CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
- "with protocol v%s, requiring v%s",
+ "with protocol v%s, requiring v%s\n",
$cache->{PROTOCOL},
PROTOCOL)
);
}
} else {
$CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
- "with protocol v1.0");
+ "with protocol v1.0\n");
return;
}
my $clcnt = 0;
package CPAN::InfoObj;
# Accessors
-sub cpan_userid { shift->{RO}{CPAN_USERID} }
+sub cpan_userid {
+ my $self = shift;
+ $self->{RO}{CPAN_USERID}
+}
+
sub id { shift->{ID}; }
#-> sub CPAN::InfoObj::new ;
#-> sub CPAN::Author::ls ;
sub ls {
my $self = shift;
+ my $silent = shift || 0;
my $id = $self->id;
# adapted from CPAN::Distribution::verifyMD5 ;
my(@csf); # chksumfile
@csf = $self->id =~ /(.)(.)(.*)/;
$csf[1] = join "", @csf[0,1];
- $csf[2] = join "", @csf[1,2];
+ $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
my(@dl);
- @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0);
+ @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
unless (grep {$_->[2] eq $csf[1]} @dl) {
- $CPAN::Frontend->myprint("No files in the directory of $id\n");
+ $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
return;
}
- @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0);
+ @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
unless (grep {$_->[2] eq $csf[2]} @dl) {
- $CPAN::Frontend->myprint("No files in the directory of $id\n");
+ $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
return;
}
- @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1);
+ @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
$CPAN::Frontend->myprint(join "", map {
sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
- } sort { $a->[2] cmp $b->[2] } @dl);
+ } sort { $a->[2] cmp $b->[2] } @dl) unless $silent;
}
# returns an array of arrays, the latter contain (size,mtime,filename)
my $self = shift;
my $chksumfile = shift;
my $recursive = shift;
+ my $may_ftp = 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);
+
+ my $fh;
+
+ # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
+ # hazard. (Without GPG installed they are not that much better,
+ # though.)
+ $fh = FileHandle->new;
+ if (open($fh, $lc_want)) {
+ my $line = <$fh>; close $fh;
+ unlink($lc_want) unless $line =~ /PGP/;
+ }
+
local($") = "/";
# connect "force" argument with "index_expire".
my $force = 0;
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,$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);
- if ($lc_file) {
- $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
- CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file);
- } else {
- return;
- }
+ my $lc_file;
+ if ($may_ftp) {
+ $lc_file = CPAN::FTP->localize(
+ "authors/id/@$chksumfile",
+ $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);
+ if ($lc_file) {
+ $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
+ CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file);
+ } else {
+ return;
+ }
+ }
+ } else {
+ $lc_file = $lc_want;
+ # we *could* second-guess and if the user has a file: URL,
+ # then we could look there. But on the other hand, if they do
+ # have a file: URL, wy did they choose to set
+ # $CPAN::Config->{show_upload_date} to false?
}
# adapted from CPAN::Distribution::MD5_check_file ;
- my $fh = FileHandle->new;
+ $fh = FileHandle->new;
my($cksum);
if (open $fh, $lc_file){
local($/);
rename $lc_file, "$lc_file.bad";
Carp::confess($@) if $@;
}
+ } elsif ($may_ftp) {
+ Carp::carp "Could not open $lc_file for reading.";
} else {
- Carp::carp "Could not open $lc_file for reading";
+ # Maybe should warn: "You may want to set show_upload_date to a true value"
+ return;
}
my(@result,$f);
for $f (sort keys %$cksum) {
push @dir, $f, "CHECKSUMS";
push @result, map {
[$_->[0], $_->[1], "$f/$_->[2]"]
- } $self->dir_listing(\@dir,1);
+ } $self->dir_listing(\@dir,1,$may_ftp);
} else {
push @result, [ 0, "-", $f ];
}
) {
return $s if $s =~ m:^N/A|^Contact Author: ;
$s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
- $CPAN::Frontend->mywarn("Strange distribution name [$s]");
+ $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
CPAN->debug("s[$s]") if $CPAN::DEBUG;
}
$s;
my($self) = shift;
my($depth) = shift || 0;
my($color) = shift || 0;
+ my($ancestors) = shift || [];
# a distribution needs to recurse into its prereq_pms
return if exists $self->{incommandcolor}
&& $self->{incommandcolor}==$color;
- $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ".
- "color_cmd_tmps depth[%s] self[%s] id[%s]",
- $depth,
- $self,
- $self->id
- )) if $depth>=100;
- ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
+ if ($depth>=100){
+ $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
+ }
+ # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
my $prereq_pm = $self->prereq_pm;
if (defined $prereq_pm) {
for my $pre (keys %$prereq_pm) {
my $premo = CPAN::Shell->expand("Module",$pre);
- $premo->color_cmd_tmps($depth+1,$color);
+ $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
}
}
if ($color==0) {
sub as_string {
my $self = shift;
$self->containsmods;
+ $self->upload_date;
$self->SUPER::as_string(@_);
}
keys %{$self->{CONTAINSMODS}};
}
+#-> sub CPAN::Distribution::upload_date ;
+sub upload_date {
+ my $self = shift;
+ return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
+ my(@local_wanted) = split(/\//,$self->id);
+ my $filename = pop @local_wanted;
+ push @local_wanted, "CHECKSUMS";
+ my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
+ return unless $author;
+ my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
+ return unless @dl;
+ my($dirent) = grep { $_->[2] eq $filename } @dl;
+ # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
+ return unless $dirent->[1];
+ return $self->{UPLOAD_DATE} = $dirent->[1];
+}
+
#-> sub CPAN::Distribution::uptodate ;
sub uptodate {
my($self) = @_;
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;
unless ($local_file =
#
# Unpack the goods
#
+ $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
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/) {
+ } elsif ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/) {
$self->{was_uncompressed}++ unless CPAN::Tarzip->gtest($local_file);
+ $self->debug("calling pm2dir for local_file[$local_file]") if $CPAN::DEBUG;
$self->pm2dir_me($local_file);
} else {
$self->{archived} = "NO";
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 ".
"$packagedir\n");
File::Path::rmtree($packagedir);
- rename($distdir,$packagedir) or
- Carp::confess("Couldn't rename $distdir to $packagedir: $!");
- $self->debug(sprintf("renamed distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
+ File::Copy::move($distdir,$packagedir) or
+ Carp::confess("Couldn't move $distdir to $packagedir: $!");
+ $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
$distdir,
$packagedir,
-e $packagedir,
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);
- rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
+ my $to = File::Spec->catdir($packagedir,$f);
+ File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
}
}
if ($CPAN::Signal){
}
$self->{'build_dir'} = $packagedir;
- $self->safe_chdir(File::Spec->updir);
+ $self->safe_chdir($builddir);
File::Path::rmtree("tmp");
- my($mpl) = MM->catfile($packagedir,"Makefile.PL");
+ $self->safe_chdir($packagedir);
+ if ($CPAN::META->has_inst("Module::Signature")) {
+ if (-f "SIGNATURE") {
+ $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
+ my $rv = Module::Signature::verify();
+ if ($rv != Module::Signature::SIGNATURE_OK() and
+ $rv != Module::Signature::SIGNATURE_MISSING()) {
+ $CPAN::Frontend->myprint(
+ qq{\nSignature invalid for }.
+ qq{distribution file. }.
+ qq{Please investigate.\n\n}.
+ $self->as_string,
+ $CPAN::META->instance(
+ 'CPAN::Author',
+ $self->cpan_userid,
+ )->as_string
+ );
+
+ my $wrap = qq{I\'d recommend removing $self->{localfile}. Its signature
+is invalid. Maybe you have configured your 'urllist' with
+a bad URL. Please check this array with 'o conf urllist', and
+retry.};
+ $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
+ }
+ } else {
+ $CPAN::Frontend->myprint(qq{Package came without SIGNATURE\n\n});
+ }
+ } else {
+ $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
+ }
+ $self->safe_chdir($builddir);
+ return if $CPAN::Signal;
+
+
+
+ my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
my($mpl_exists) = -f $mpl;
unless ($mpl_exists) {
# NFS has been reported to have racing problems after the
$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,$local_file) = @_;
$self->{archived} = "pm";
my $to = File::Basename::basename($local_file);
- $to =~ s/\.(gz|Z)(?!\n)\Z//;
- if (CPAN::Tarzip->gunzip($local_file,$to)) {
- $self->{unwrapped} = "YES";
+ if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
+ if (CPAN::Tarzip->gunzip($local_file,$to)) {
+ $self->{unwrapped} = "YES";
+ } else {
+ $self->{unwrapped} = "NO";
+ }
} else {
- $self->{unwrapped} = "NO";
+ File::Copy::cp($local_file,".");
+ $self->{unwrapped} = "YES";
}
}
my $pwd = CPAN::anycwd();
$self->safe_chdir($dir);
$CPAN::Frontend->myprint(qq{Working directory is $dir\n});
- system($CPAN::Config->{'shell'}) == 0
- or $CPAN::Frontend->mydie("Subprocess shell error");
+ unless (system($CPAN::Config->{'shell'}) == 0) {
+ my $code = $? >> 8;
+ $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
+ }
$self->safe_chdir($pwd);
}
my $userid = $self->cpan_userid;
- my $cvs_dir = (split '/', $dir)[-1];
+ my $cvs_dir = (split /\//, $dir)[-1];
$cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
my $cvs_root =
$CPAN::Config->{cvsroot} || $ENV{CVSROOT};
$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)
});
sleep 2;
$fh_pager->print(<$fh_readme>);
+ $fh_pager->close;
}
#-> sub CPAN::Distribution::verifyMD5 ;
$CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
}
my($lc_want,$lc_file,@local,$basename);
- @local = split("/",$self->id);
+ @local = split(/\//,$self->id);
pop @local;
push @local, "CHECKSUMS";
$lc_want =
- MM->catfile($CPAN::Config->{keep_source_where},
- "authors", "id", @local);
+ File::Spec->catfile($CPAN::Config->{keep_source_where},
+ "authors", "id", @local);
local($") = "/";
if (
-s $lc_want
$self->MD5_check_file($lc_file);
}
+sub SIG_check_file {
+ my($self,$chk_file) = @_;
+ my $rv = eval { Module::Signature::_verify($chk_file) };
+
+ if ($rv == Module::Signature::SIGNATURE_OK()) {
+ $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
+ return $self->{SIG_STATUS} = "OK";
+ } else {
+ $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
+ qq{distribution file. }.
+ qq{Please investigate.\n\n}.
+ $self->as_string,
+ $CPAN::META->instance(
+ 'CPAN::Author',
+ $self->cpan_userid
+ )->as_string);
+
+ my $wrap = qq{I\'d recommend removing $chk_file. Its signature
+is invalid. Maybe you have configured your 'urllist' with
+a bad URL. Please check this array with 'o conf urllist', and
+retry.};
+
+ $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
+ }
+}
+
#-> sub CPAN::Distribution::MD5_check_file ;
sub MD5_check_file {
my($self,$chk_file) = @_;
my($cksum,$file,$basename);
+
+ if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) {
+ $self->debug("Module::Signature is installed, verifying");
+ $self->SIG_check_file($chk_file);
+ } else {
+ $self->debug("Module::Signature is NOT installed");
+ }
+
$file = $self->{localfile};
$basename = File::Basename::basename($file);
my $fh = FileHandle->new;
}
}
+sub notest {
+ my($self, $method) = @_;
+ # warn "XDEBUG: set notest for $self $method";
+ $self->{"notest"}++; # name should probably have been force_install
+}
+
+sub unnotest {
+ my($self) = @_;
+ # warn "XDEBUG: deleting notest";
+ delete $self->{'notest'};
+}
+
#-> sub CPAN::Distribution::unforce ;
sub unforce {
my($self) = @_;
}
}
+
#-> sub CPAN::Distribution::perl ;
sub perl {
- my($self) = @_;
- my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
- my $pwd = CPAN::anycwd();
- my $candidate = MM->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(),
- $Config::Config{'binexp'}) {
- next unless defined($component) && $component;
- my($abs) = MM->catfile($component,$perl_name);
- if (MM->maybe_command($abs)) {
- $perl = $abs;
- last DIST_PERLNAME;
- }
- }
- }
- }
- $perl;
+ return $CPAN::Perl;
}
+
#-> sub CPAN::Distribution::make ;
sub make {
my($self) = @_;
if ($follow) {
# color them as dirty
for my $p (@prereq) {
+ # warn "calling color_cmd_tmps(0,1)";
CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
}
CPAN::Queue->jumpqueue(@prereq,$id); # queue them and requeue yourself
delete $self->{force_update};
return;
}
+ # warn "XDEBUG: checking for notest: $self->{notest} $self";
+ if ($self->{notest}) {
+ $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
+ return 1;
+ }
+
$CPAN::Frontend->myprint("Running make test\n");
if (my @prereq = $self->unsat_prereq){
return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
return;
}
+ local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
+ ? $ENV{PERL5LIB}
+ : ($ENV{PERLLIB} || "");
+
+ $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";
return;
}
- my $system = join(" ", $CPAN::Config->{'make'},
- "install", $CPAN::Config->{make_install_arg});
+ my($make_install_make_command) = $CPAN::Config->{'make_install_make_command'} ||
+ $CPAN::Config->{'make'};
+
+ my($system) = join(" ",
+ $make_install_make_command,
+ "install",
+ $CPAN::Config->{make_install_arg},
+ );
my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 ";
my($pipe) = FileHandle->new("$system $stderr |");
my($makeout) = "";
$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";
$CPAN::Frontend->myprint(" $system -- NOT OK\n");
- if ($makeout =~ /permission/s && $> > 0) {
- $CPAN::Frontend->myprint(qq{ You may have to su }.
- qq{to root to install the package\n});
+ if (
+ $makeout =~ /permission/s
+ && $> > 0
+ && (
+ ! $CPAN::Config->{make_install_make_command}
+ || $CPAN::Config->{make_install_make_command} eq $CPAN::Config->{make}
+ )
+ ) {
+ $CPAN::Frontend->myprint(
+ qq{----\n}.
+ qq{ You may have to su }.
+ qq{to root to install the package\n}.
+ qq{ (Or you may want to run something like\n}.
+ qq{ o conf make_install_make_command 'sudo make'\n}.
+ qq{ to raise your permissions.}
+ );
}
}
delete $self->{force_update};
shift->{'build_dir'};
}
+#-> sub CPAN::Distribution::perldoc ;
+sub perldoc {
+ my($self) = @_;
+
+ my($dist) = $self->id;
+ my $package = $self->called_for;
+
+ $self->_display_url( $CPAN::Defaultdocs . $package );
+}
+
+#-> sub CPAN::Distribution::_check_binary ;
+sub _check_binary {
+ my ($dist,$shell,$binary) = @_;
+ my ($pid,$readme,$out);
+
+ $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
+ if $CPAN::DEBUG;
+
+ $pid = open $readme, "which $binary|"
+ or $CPAN::Frontend->mydie(qq{Could not fork 'which $binary': $!});
+ while (<$readme>) {
+ $out .= $_;
+ }
+ close $readme or die "Could not run 'which $binary': $!";
+
+ $CPAN::Frontend->myprint(qq{ + $out \n})
+ if $CPAN::DEBUG && $out;
+
+ return $out;
+}
+
+#-> sub CPAN::Distribution::_display_url ;
+sub _display_url {
+ my($self,$url) = @_;
+ my($res,$saved_file,$pid,$readme,$out);
+
+ $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
+ if $CPAN::DEBUG;
+
+ # should we define it in the config instead?
+ my $html_converter = "html2text";
+
+ my $web_browser = $CPAN::Config->{'lynx'} || undef;
+ my $web_browser_out = $web_browser
+ ? CPAN::Distribution->_check_binary($self,$web_browser)
+ : undef;
+
+ my ($tmpout,$tmperr);
+ if (not $web_browser_out) {
+ # web browser not found, let's try text only
+ my $html_converter_out =
+ CPAN::Distribution->_check_binary($self,$html_converter);
+
+ if ($html_converter_out ) {
+ # html2text found, run it
+ $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
+ $CPAN::Frontend->myprint(qq{ERROR: problems while getting $url, $!\n})
+ unless defined($saved_file);
+
+ $pid = open $readme, "$html_converter $saved_file |"
+ or $CPAN::Frontend->mydie(qq{
+Could not fork '$html_converter $saved_file': $!});
+ my $fh = File::Temp->new(
+ template => 'cpan_htmlconvert_XXXX',
+ suffix => '.txt',
+ unlink => 0,
+ );
+ while (<$readme>) {
+ $fh->print($_);
+ }
+ close $readme
+ or $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
+ my $tmpin = $fh->filename;
+ $CPAN::Frontend->myprint(sprintf(qq{
+Run '%s %s' and
+saved output to %s\n},
+ $html_converter,
+ $saved_file,
+ $tmpin,
+ )) if $CPAN::DEBUG;
+ close $fh; undef $fh;
+ open $fh, $tmpin
+ or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
+ my $fh_pager = FileHandle->new;
+ local($SIG{PIPE}) = "IGNORE";
+ $fh_pager->open("|$CPAN::Config->{'pager'}")
+ or $CPAN::Frontend->mydie(qq{
+Could not open pager $CPAN::Config->{'pager'}: $!});
+ $CPAN::Frontend->myprint(qq{
+Displaying URL
+ $url
+with pager "$CPAN::Config->{'pager'}"
+});
+ sleep 2;
+ $fh_pager->print(<$fh>);
+ $fh_pager->close;
+ } else {
+ # coldn't find the web browser or html converter
+ $CPAN::Frontend->myprint(qq{
+You need to install lynx or $html_converter to use this feature.});
+ }
+ } else {
+ # web browser found, run the action
+ my $browser = $CPAN::Config->{'lynx'};
+ $CPAN::Frontend->myprint(qq{system[$browser $url]})
+ if $CPAN::DEBUG;
+ $CPAN::Frontend->myprint(qq{
+Displaying URL
+ $url
+with browser $browser
+});
+ sleep 2;
+ system("$browser $url");
+ if ($saved_file) { 1 while unlink($saved_file) }
+ }
+}
+
+#-> sub CPAN::Distribution::_getsave_url ;
+sub _getsave_url {
+ my($dist, $shell, $url) = @_;
+
+ $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
+ if $CPAN::DEBUG;
+
+ my $fh = File::Temp->new(
+ template => "cpan_getsave_url_XXXX",
+ suffix => ".html",
+ unlink => 0,
+ );
+ my $tmpin = $fh->filename;
+ if ($CPAN::META->has_usable('LWP')) {
+ $CPAN::Frontend->myprint("Fetching with LWP:
+ $url
+");
+ my $Ua;
+ CPAN::LWP::UserAgent->config;
+ eval { $Ua = CPAN::LWP::UserAgent->new; };
+ if ($@) {
+ $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
+ return;
+ } else {
+ my($var);
+ $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};
+ }
+
+ my $req = HTTP::Request->new(GET => $url);
+ $req->header('Accept' => 'text/html');
+ my $res = $Ua->request($req);
+ if ($res->is_success) {
+ $CPAN::Frontend->myprint(" + request successful.\n")
+ if $CPAN::DEBUG;
+ print $fh $res->content;
+ close $fh;
+ $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
+ if $CPAN::DEBUG;
+ return $tmpin;
+ } else {
+ $CPAN::Frontend->myprint(sprintf(
+ "LWP failed with code[%s], message[%s]\n",
+ $res->code,
+ $res->message,
+ ));
+ return;
+ }
+ } else {
+ $CPAN::Frontend->myprint("LWP not available\n");
+ return;
+ }
+}
+
package CPAN::Bundle;
+sub look {
+ my $self = shift;
+ $CPAN::Frontend->myprint($self->as_string);
+}
+
sub undelay {
my $self = shift;
delete $self->{later};
my($self) = shift;
my($depth) = shift || 0;
my($color) = shift || 0;
+ my($ancestors) = shift || [];
# a module needs to recurse to its cpan_file, a distribution needs
# to recurse into its prereq_pms, a bundle needs to recurse into its modules
return if exists $self->{incommandcolor}
&& $self->{incommandcolor}==$color;
- $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ".
- "color_cmd_tmps depth[%s] self[%s] id[%s]",
- $depth,
- $self,
- $self->id
- )) if $depth>=100;
- ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
+ if ($depth>=100){
+ $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
+ }
+ # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
for my $c ( $self->contains ) {
my $obj = CPAN::Shell->expandany($c) or next;
CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
- $obj->color_cmd_tmps($depth+1,$color);
+ $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
}
if ($color==0) {
delete $self->{badtestcnt};
my(@me,$from,$to,$me);
@me = split /::/, $self->id;
$me[-1] .= ".pm";
- $me = MM->catfile(@me);
+ $me = File::Spec->catfile(@me);
$from = $self->find_bundle_file($dist->{'build_dir'},$me);
- $to = MM->catfile($todir,$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: $!");
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($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);
$self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
my $obj = $CPAN::META->instance($type,$s);
$obj->$meth();
- if ($obj->isa(CPAN::Bundle)
+ if ($obj->isa('CPAN::Bundle')
&&
exists $obj->{install_failed}
&&
#-> sub CPAN::Bundle::force ;
sub force { shift->rematein('force',@_); }
+#-> sub CPAN::Bundle::notest ;
+sub notest { shift->rematein('notest',@_); }
#-> sub CPAN::Bundle::get ;
sub get { shift->rematein('get',@_); }
#-> sub CPAN::Bundle::make ;
package CPAN::Module;
# Accessors
-# sub cpan_userid { shift->{RO}{CPAN_USERID} }
+# sub CPAN::Module::userid
sub userid {
my $self = shift;
return unless exists $self->{RO}; # should never happen
- return $self->{RO}{CPAN_USERID} || $self->{RO}{userid};
+ return $self->{RO}{userid} || $self->{RO}{CPAN_USERID};
}
+# sub CPAN::Module::description
sub description { shift->{RO}{description} }
sub undelay {
my($self) = shift;
my($depth) = shift || 0;
my($color) = shift || 0;
+ my($ancestors) = shift || [];
# a module needs to recurse to its cpan_file
return if exists $self->{incommandcolor}
&& $self->{incommandcolor}==$color;
- $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ".
- "color_cmd_tmps depth[%s] self[%s] id[%s]",
- $depth,
- $self,
- $self->id
- )) if $depth>=100;
- ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
+ if ($depth>=100){
+ $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
+ }
+ # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
- $dist->color_cmd_tmps($depth+1,$color);
+ $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
}
if ($color==0) {
delete $self->{badtestcnt};
sub as_string {
my($self) = @_;
my(@m);
- CPAN->debug($self) if $CPAN::DEBUG;
+ CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
my $class = ref($self);
$class =~ s/^CPAN:://;
local($^W) = 0;
if $self->description;
my $sprintf2 = " %-12s %s (%s)\n";
my($userid);
- if ($userid = $self->cpan_userid || $self->userid){
+ $userid = $self->userid;
+ if ( $userid ){
my $author;
if ($author = CPAN::Shell->expand('Author',$userid)) {
my $email = "";
}
push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
if $self->cpan_version;
- push @m, sprintf($sprintf, 'CPAN_FILE', $self->cpan_file)
- if $self->cpan_file;
+ if (my $cpan_file = $self->cpan_file){
+ push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
+ if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
+ my $upload_date = $dist->upload_date;
+ if ($upload_date) {
+ push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
+ }
+ }
+ }
my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
my(%statd,%stats,%statl,%stati);
@statd{qw,? i c a b R M S,} = qw,unknown idea
pre-alpha alpha beta released mature standard,;
- @stats{qw,? m d u n,} = qw,unknown mailing-list
- developer comp.lang.perl.* none,;
+ @stats{qw,? m d u n a,} = qw,unknown mailing-list
+ developer comp.lang.perl.* none abandoned,;
@statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,;
@stati{qw,? f r O h,} = qw,unknown functions
references+ties object-oriented hybrid,;
if (
$dist->{build_dir}
and
- (-f ($mff = MM->catfile($dist->{build_dir}, "MANIFEST")))
+ (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
and
$mfh = FileHandle->new($mff)
) {
}
$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+$/;
}
return "Contact Author $fullname <$email>";
} else {
- return "UserID $userid";
+ return "Contact Author $userid (Email address not available)";
}
} else {
return "N/A";
$self->{'force_update'}++;
}
+sub notest {
+ my($self) = @_;
+ # warn "XDEBUG: set notest for Module";
+ $self->{'notest'}++;
+}
+
#-> sub CPAN::Module::rematein ;
sub rematein {
my($self,$meth) = @_;
my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
$pack->called_for($self->id);
$pack->force($meth) if exists $self->{'force_update'};
- $pack->$meth();
+ $pack->notest($meth) if exists $self->{'notest'};
+ eval {
+ $pack->$meth();
+ };
+ my $err = $@;
$pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
+ $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
delete $self->{'force_update'};
+ delete $self->{'notest'};
+ if ($err) {
+ die $err;
+ }
}
+#-> sub CPAN::Module::perldoc ;
+sub perldoc { shift->rematein('perldoc') }
#-> sub CPAN::Module::readme ;
-sub readme { shift->rematein('readme') }
+sub readme { shift->rematein('readme') }
#-> sub CPAN::Module::look ;
-sub look { shift->rematein('look') }
+sub look { shift->rematein('look') }
#-> sub CPAN::Module::cvs_import ;
sub cvs_import { shift->rematein('cvs_import') }
#-> sub CPAN::Module::get ;
-sub get { shift->rematein('get',@_); }
+sub get { shift->rematein('get',@_) }
#-> sub CPAN::Module::make ;
-sub make {
- my $self = shift;
- $self->rematein('make');
-}
+sub make { shift->rematein('make') }
#-> sub CPAN::Module::test ;
sub test {
my $self = shift;
} else {
$doit = 1;
}
+ if ($self->{RO}{stats} && $self->{RO}{stats} eq "a") {
+ $CPAN::Frontend->mywarn(qq{
+\n\n\n ***WARNING***
+ The module $self->{ID} has no active maintainer.\n\n\n
+});
+ sleep 5;
+ }
$self->rematein('install') if $doit;
}
#-> sub CPAN::Module::clean ;
@packpath = split /::/, $self->{ID};
$packpath[-1] .= ".pm";
foreach $dir (@INC) {
- my $pmfile = MM->catfile($dir,@packpath);
+ my $pmfile = File::Spec->catfile($dir,@packpath);
if (-f $pmfile){
return $pmfile;
}
push @packpath, $packpath[-1];
$packpath[-1] .= "." . $Config::Config{'dlext'};
foreach $dir (@INC) {
- my $xsfile = MM->catfile($dir,'auto',@packpath);
+ my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
if (-f $xsfile){
return $xsfile;
}
# compare it use utility for compare
# print it do nothing
- # Alt2 maintain it as what is is
+ # Alt2 maintain it as what it is
# read index files convert
# compare it use utility because there's still a ">" vs "gt" issue
# print it use CPAN::Version for print
my($buffer,$fhw);
$fhw = FileHandle->new($read)
or $CPAN::Frontend->mydie("Could not open $read: $!");
+ my $cwd = `pwd`;
my $gz = Compress::Zlib::gzopen($write, "wb")
- or $CPAN::Frontend->mydie("Cannot gzopen $write: $!\n");
+ or $CPAN::Frontend->mydie("Cannot gzopen $write: $! (pwd is $cwd)\n");
$gz->gzwrite($buffer)
while read($fhw,$buffer,4096) > 0 ;
$gz->gzclose() ;
}
}
-
-package CPAN::Version;
-# CPAN::Version::vcmp courtesy Jost Krieger
-sub vcmp {
- my($self,$l,$r) = @_;
- local($^W) = 0;
- CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
-
- return 0 if $l eq $r; # short circuit for quicker success
-
- if ($l=~/^v/ <=> $r=~/^v/) {
- for ($l,$r) {
- next if /^v/;
- $_ = $self->float2vv($_);
- }
- }
-
- return
- ($l ne "undef") <=> ($r ne "undef") ||
- ($] >= 5.006 &&
- $l =~ /^v/ &&
- $r =~ /^v/ &&
- $self->vstring($l) cmp $self->vstring($r)) ||
- $l <=> $r ||
- $l cmp $r;
-}
-
-sub vgt {
- my($self,$l,$r) = @_;
- $self->vcmp($l,$r) > 0;
-}
-
-sub vstring {
- my($self,$n) = @_;
- $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid arg [$n]";
- pack "U*", split /\./, $n;
-}
-
-# vv => visible vstring
-sub float2vv {
- my($self,$n) = @_;
- my($rev) = int($n);
- $rev ||= 0;
- my($mantissa) = $n =~ /\.(\d{1,12})/; # limit to 12 digits to limit
- # architecture influence
- $mantissa ||= 0;
- $mantissa .= "0" while length($mantissa)%3;
- my $ret = "v" . $rev;
- while ($mantissa) {
- $mantissa =~ s/(\d{1,3})// or
- die "Panic: length>0 but not a digit? mantissa[$mantissa]";
- $ret .= ".".int($1);
- }
- # warn "n[$n]ret[$ret]";
- $ret;
-}
-
-sub readable {
- my($self,$n) = @_;
- $n =~ /^([\w\-\+\.]+)/;
-
- return $1 if defined $1 && length($1)>0;
- # if the first user reaches version v43, he will be treated as "+".
- # We'll have to decide about a new rule here then, depending on what
- # will be the prevailing versioning behavior then.
-
- if ($] < 5.006) { # or whenever v-strings were introduced
- # we get them wrong anyway, whatever we do, because 5.005 will
- # have already interpreted 0.2.4 to be "0.24". So even if he
- # indexer sends us something like "v0.2.4" we compare wrongly.
-
- # And if they say v1.2, then the old perl takes it as "v12"
-
- $CPAN::Frontend->mywarn("Suspicious version string seen [$n]");
- return $n;
- }
- my $better = sprintf "v%vd", $n;
- CPAN->debug("n[$n] better[$better]") if $CPAN::DEBUG;
- return $better;
-}
-
package CPAN;
1;
autobundle, clean, install, make, recompile, test
+=head1 STATUS
+
+This module will eventually be replaced by CPANPLUS. CPANPLUS is kind
+of a modern rewrite from ground up with greater extensibility and more
+features but no full compatibility. If you're new to CPAN.pm, you
+probably should investigate if CPANPLUS is the better choice for you.
+If you're already used to CPAN.pm you're welcome to continue using it,
+if you accept that its development is mostly (though not completely)
+stalled.
+
=head1 DESCRIPTION
The CPAN module is designed to automate the make and install of perl
-modules and extensions. It includes some searching capabilities and
+modules and extensions. It includes some primitive searching capabilities and
knows how to use Net::FTP or LWP (or lynx or an external ftp client)
to fetch the raw data from the net.
CPAN also keeps track of what it has done within the current session
and doesn't try to build a package a second time regardless if it
-succeeded or not. The C<force> command takes as a first argument the
-method to invoke (currently: C<make>, C<test>, or C<install>) and executes the
+succeeded or not. The C<force> pragma may precede another command
+(currently: C<make>, C<test>, or C<install>) and executes the
command from scratch.
Example:
OpenGL-0.4/COPYRIGHT
[...]
+The C<notest> pragma may be set to skip the test part in the build
+process.
+
+Example:
+
+ cpan> notest install Tk
+
A C<clean> command results in a
make clean
being executed within the distribution file's working directory.
-=item get, readme, look module or distribution
+=item get, readme, perldoc, look module or distribution
C<get> downloads a distribution file without further action. C<readme>
displays the README file of the associated distribution. C<Look> gets
and untars (if not yet done) the distribution file, changes to the
appropriate directory and opens a subshell process in that directory.
+C<perldoc> displays the pod documentation of the module in html or
+plain text format.
=item ls author
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.
Downloads the README file associated with a distribution and runs it
through the pager specified in C<$CPAN::Config->{pager}>.
+=item CPAN::Distribution::perldoc()
+
+Downloads the pod documentation of the file associated with a
+distribution (in html format) and runs it through the external
+command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
+isn't available, it converts it to plain text with external
+command html2text 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
=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.
Runs a C<readme> on the distribution associated with this module.
+=item CPAN::Module::perldoc()
+
+Runs a C<perldoc> on this module.
+
=item CPAN::Module::test()
Runs a C<test> on the distribution associated with this module.
"file:" URLs, then you only need a perl better than perl5.003 to run
this module. Otherwise Net::FTP is strongly recommended. LWP may be
required for non-UNIX systems or if your nearest CPAN site is
-associated with an URL that is not C<ftp:>.
+associated with a URL that is not C<ftp:>.
If you have neither Net::FTP nor LWP, there is a fallback mechanism
implemented for an external ftp command or for an external lynx
=head1 CONFIGURATION
-When the CPAN module is installed, a site wide configuration file is
-created as CPAN/Config.pm. The default values defined there can be
-overridden in another configuration file: CPAN/MyConfig.pm. You can
-store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
-$HOME/.cpan is added to the search path of the CPAN module before the
-use() or require() statements.
+When the CPAN module is used for the first time, a configuration
+dialog tries to determine a couple of site specific options. The
+result of the dialog is stored in a hash reference C< $CPAN::Config >
+in a file CPAN/Config.pm.
+
+The default values defined in the CPAN/Config.pm file can be
+overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
+best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
+added to the search path of the CPAN module before the use() or
+require() statements.
+
+The configuration dialog can be started any time later again by
+issuing the command C< o conf init > in the CPAN shell.
Currently the following keys in the hash reference $CPAN::Config are
defined:
dontload_hash anonymous hash: modules in the keys will not be
loaded by the CPAN::has_inst() routine
gzip location of external program gzip
+ histfile file to maintain history between sessions
+ histsize maximum number of lines to keep in histfile
inactivity_timeout breaks interactive Makefile.PLs after this
many seconds inactivity. Set to 0 to never break.
inhibit_startup_message
keep_source_where directory in which to keep the source (if we do)
make location of external make program
make_arg arguments that should always be passed to 'make'
+ make_install_make_command
+ the make command for running 'make install', for
+ example 'sudo make'
make_install_arg same as make_arg for 'make install'
makepl_arg arguments passed to 'perl Makefile.PL'
pager location of external program more (or any pager)
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
Thanks to Graham Barr for contributing the following paragraphs about
the interaction between perl, and various firewall configurations. For
-further informations on firewalls, it is recommended to consult the
+further information on firewalls, it is recommended to consult the
documentation that comes with the ncftp program. If you are unable to
go through the firewall with a simple Perl setup, it is very likely
that you can configure ncftp so that it works for your firewall.
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
hide a complete network behind one IP address. With this firewall no
special compiling is needed as you can access hosts directly.
+For accessing ftp servers behind such firewalls you may need to set
+the environment variable C<FTP_PASSIVE> to a true value, e.g.
+
+ env FTP_PASSIVE=1 perl -MCPAN -eshell
+
+or
+
+ perl -MCPAN -e '$ENV{FTP_PASSIVE} = 1; shell'
+
+
=back
=back
o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
-Your milage may vary...
+Your mileage may vary...
+
+=head1 Cryptographically signed modules
+
+Since release 1.77 CPAN.pm has been able to verify cryptographically
+signed module distributions using Module::Signature. The CPAN modules
+can be signed by their authors, thus giving more security. The simple
+unsigned MD5 checksums that were used before by CPAN protect mainly
+against accidental file corruption.
+
+You will need to have Module::Signature installed, which in turn
+requires that you have at least one of Crypt::OpenPGP module or the
+command-line F<gpg> tool installed.
+
+You will also need to be able to connect over the Internet to the public
+keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
=head1 FAQ
I am not root, how can I install a module in a personal directory?
+First of all, you will want to use your own configuration, not the one
+that your root user installed. The following command sequence is a
+possible approach:
+
+ % mkdir -p $HOME/.cpan/CPAN
+ % echo '$CPAN::Config={ };' > $HOME/.cpan/CPAN/MyConfig.pm
+ % cpan
+ [...answer all questions...]
+
You will most probably like something like this:
o conf makepl_arg "LIB=~/myperl/lib \
INSTALLMAN1DIR=~/myperl/man/man1 \
INSTALLMAN3DIR=~/myperl/man/man3"
- install Sybase::Sybperl
You can make this setting permanent like all C<o conf> settings with
C<o conf commit>.
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
+fail and you need to install often, it is recommended to 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.
Extended support for converters will be made available as soon as perl
becomes stable with regard to charset issues.
+=item 11)
+
+When an install fails for some reason and then I correct the error
+condition and retry, CPAN.pm refuses to install the module, saying
+C<Already tried without success>.
+
+Use the force pragma like so
+
+ force install Foo::Bar
+
+This does a bit more than really needed because it untars the
+distribution again and runs make and test and only then install.
+
+Or you can use
+
+ look Foo::Bar
+
+and then 'make install' directly in the subshell.
+
+Or you leave the CPAN shell and start it again.
+
+Or, if you're not really sure and just want to run some make, test or
+install command without this pesky error message, say C<force get
+Foo::Bar> first and then continue as always. C<Force get> I<forgets>
+previous error conditions.
+
+For the really curious, by accessing internals directly, you I<could>
+
+ ! delete CPAN::Shell->expand("Distribution", \
+ CPAN::Shell->expand("Module","Foo::Bar") \
+ ->{RO}{CPAN_FILE})->{install}
+
+but this is neither guaranteed to work in the future nor is it a
+decent command.
+
=back
=head1 BUGS
projects / p5sagit/p5-mst-13.2.git / blobdiff