summaryrefslogtreecommitdiff
path: root/lib/CPAN.pm
diff options
context:
space:
mode:
authorSteve Peters <steve@fisharerojo.org>2006-02-24 13:55:23 +0000
committerSteve Peters <steve@fisharerojo.org>2006-02-24 13:55:23 +0000
commitb96578bbbdd04614cada6e526896b2fa8f332c8a (patch)
tree22353e1aeb11318f587f877677ded3006149a6da /lib/CPAN.pm
parent9994ed7c9a8f3f1f092069779eeb61c285795c41 (diff)
downloadperl-b96578bbbdd04614cada6e526896b2fa8f332c8a.tar.gz
Upgrade to CPAN-1.86
p4raw-id: //depot/perl@27311
Diffstat (limited to 'lib/CPAN.pm')
-rw-r--r--lib/CPAN.pm244
1 files changed, 136 insertions, 108 deletions
diff --git a/lib/CPAN.pm b/lib/CPAN.pm
index ca4715d42c..6f1fed6b6d 100644
--- a/lib/CPAN.pm
+++ b/lib/CPAN.pm
@@ -1,6 +1,6 @@
# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
package CPAN;
-$VERSION = '1.84';
+$VERSION = '1.86';
$VERSION = eval $VERSION;
use strict;
@@ -13,7 +13,9 @@ use Config ();
use Cwd ();
use DirHandle ();
use Exporter ();
-use ExtUtils::MakeMaker (); # $SelfLoader::DEBUG=1;
+use ExtUtils::MakeMaker qw(prompt); # for some unknown reason,
+ # 5.005_04 does not work without
+ # this
use File::Basename ();
use File::Copy ();
use File::Find;
@@ -85,9 +87,8 @@ sub AUTOLOAD {
if (exists $EXPORT{$l}){
CPAN::Shell->$l(@_);
} else {
- $CPAN::Frontend->mywarn(qq{Unknown CPAN command "$AUTOLOAD". }.
- qq{Type ? for help.
-});
+ die(qq{Unknown CPAN command "$AUTOLOAD". }.
+ qq{Type ? for help.\n});
}
}
@@ -354,13 +355,6 @@ package CPAN::Prompt; use overload '""' => "as_string";
use vars qw($prompt);
$prompt = "cpan> ";
$CPAN::CurrentCommandId ||= 0;
-sub as_randomly_capitalized_string {
- # pure fun variant
- substr($prompt,$_,1)=rand()<0.5 ?
- uc(substr($prompt,$_,1)) :
- lc(substr($prompt,$_,1)) for 0..3;
- $prompt;
-}
sub new {
bless {}, shift;
}
@@ -1338,6 +1332,7 @@ sub local_bundles {
my($entry);
for $entry ($dh->read) {
next if $entry =~ /^\./;
+ next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
if (-d File::Spec->catdir($bdir,$entry)){
push @bbase, "$bbase\::$entry";
} else {
@@ -2131,9 +2126,16 @@ sub mywarn {
# Carp::confess "died";
#}
+# only to be used for shell commands
sub mydie {
my($self,$what) = @_;
$self->print_ornamented($what, 'bold red on_white');
+
+ # If it is the shell, we want that the following die to be silent,
+ # but if it is not the shell, we would need a 'die $what'. We need
+ # to take care that only shell commands use mydie. Is this
+ # possible?
+
die "\n";
}
@@ -2159,7 +2161,6 @@ sub unrecoverable_error {
}
unshift @lines, "\n";
$self->mydie(join "", @lines);
- die "\n";
}
sub mysleep {
@@ -2279,9 +2280,7 @@ to find objects with matching identifiers.
$obj->called_for($s);
}
CPAN->debug(
- qq{pragma[@pragma]meth[$meth]obj[$obj]as_string\[}.
- $obj->as_string.
- qq{\]}
+ qq{pragma[@pragma]meth[$meth]obj[$obj]as_string[$obj->{ID}]}
) if $CPAN::DEBUG;
if ($obj->$meth()){
@@ -2352,7 +2351,6 @@ sub get_basic_credentials {
$USER = $CPAN::Config->{proxy_user};
$PASSWD = $CPAN::Config->{proxy_pass};
} else {
- require ExtUtils::MakeMaker;
ExtUtils::MakeMaker->import(qw(prompt));
$USER = prompt("Proxy authentication needed!
(Note: to permanently configure username and password run
@@ -2515,13 +2513,15 @@ sub localize {
}
if (-f $aslocal && -r _ && !($force & 1)){
- if (-s $aslocal) {
- return $aslocal;
- } else {
- # empty file from a previous unsuccessful attempt to download it
- unlink $aslocal or
- $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I could not remove.");
- }
+ my $size;
+ if ($size = -s $aslocal) {
+ $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
+ return $aslocal;
+ } else {
+ # empty file from a previous unsuccessful attempt to download it
+ unlink $aslocal or
+ $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I could not remove.");
+ }
}
my($restore) = 0;
if (-f $aslocal){
@@ -3583,7 +3583,7 @@ happen.\a
There's a new CPAN.pm version (v$version) available!
[Current version is v$CPAN::VERSION]
You might want to try
- install Bundle::CPAN
+ install CPAN
reload cpan
without quitting the current session. It should be a seamless upgrade
while we are running...
@@ -3813,6 +3813,42 @@ sub new {
# must not touch the hash under the RO attribute. The reason is that
# the RO hash gets written to Metadata file and is thus persistent.
+#-> sub CPAN::InfoObj::safe_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 {
+ if (-e $todir) {
+ unless (-x $todir) {
+ unless (chmod 0755, $todir) {
+ my $cwd = CPAN::anycwd();
+ $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
+ "permission to change the permission; cannot ".
+ "chdir to '$todir'\n");
+ $CPAN::Frontend->mysleep(5);
+ $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
+ qq{to todir[$todir]: $!});
+ }
+ }
+ } else {
+ $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
+ }
+ 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] (a chmod has been issued): $!});
+ }
+ }
+}
+
#-> sub CPAN::InfoObj::set ;
sub set {
my($self,%att) = @_;
@@ -3855,7 +3891,7 @@ sub as_string {
push @m, $class, " id = $self->{ID}\n";
my $ro;
unless ($ro = $self->ro) {
- $CPAN::Frontend->mydie("Unknown distribution $self->{ID}");
+ $CPAN::Frontend->mydie("Unknown object $self->{ID}");
}
for (sort keys %$ro) {
# next if m/^(ID|RO)$/;
@@ -4002,6 +4038,7 @@ sub dir_listing {
my $chksumfile = shift;
my $recursive = shift;
my $may_ftp = shift;
+
my $lc_want =
File::Spec->catfile($CPAN::Config->{keep_source_where},
"authors", "id", @$chksumfile);
@@ -4065,7 +4102,7 @@ sub dir_listing {
Carp::confess($@) if $@;
}
} elsif ($may_ftp) {
- Carp::carp "Could not open $lc_file for reading.";
+ Carp::carp "Could not open '$lc_file' for reading.";
} else {
# Maybe should warn: "You may want to set show_upload_date to a true value"
return;
@@ -4265,42 +4302,6 @@ sub called_for {
return $self->{CALLED_FOR};
}
-#-> sub CPAN::Distribution::safe_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 {
- if (-e $todir) {
- unless (-x $todir) {
- unless (chmod 0755, $todir) {
- my $cwd = CPAN::anycwd();
- $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
- "permission to change the permission; cannot ".
- "chdir to '$todir'\n");
- $CPAN::Frontend->mysleep(5);
- $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
- qq{to todir[$todir]: $!});
- }
- }
- } else {
- $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
- }
- 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] (a chmod has been issued): $!});
- }
- }
-}
-
#-> sub CPAN::Distribution::get ;
sub get {
my($self) = @_;
@@ -4766,12 +4767,11 @@ sub verifyCHECKSUM {
File::Spec->catfile($CPAN::Config->{keep_source_where},
"authors", "id", @local);
local($") = "/";
- if (
- -s $lc_want
- &&
- $self->CHECKSUM_check_file($lc_want)
- ) {
- return $self->{CHECKSUM_STATUS} = "OK";
+ if (my $size = -s $lc_want) {
+ $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
+ if ($self->CHECKSUM_check_file($lc_want,1)) {
+ return $self->{CHECKSUM_STATUS} = "OK";
+ }
}
$lc_file = CPAN::FTP->localize("authors/id/@local",
$lc_want,1);
@@ -4787,7 +4787,9 @@ sub verifyCHECKSUM {
return;
}
}
- $self->CHECKSUM_check_file($lc_file);
+ if ($self->CHECKSUM_check_file($lc_file)) {
+ return $self->{CHECKSUM_STATUS} = "OK";
+ }
}
#-> sub CPAN::Distribution::SIG_check_file ;
@@ -4818,10 +4820,16 @@ retry.};
}
#-> sub CPAN::Distribution::CHECKSUM_check_file ;
+
+# sloppy is 1 when we have an old checksums file that maybe is good
+# enough
+
sub CHECKSUM_check_file {
- my($self,$chk_file) = @_;
+ my($self,$chk_file,$sloppy) = @_;
my($cksum,$file,$basename);
+ $sloppy ||= 0;
+ $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
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);
@@ -4855,8 +4863,8 @@ When trying to read that file I expected to get a hash reference
for further processing, but got garbage instead.
});
my $answer = ExtUtils::MakeMaker::prompt("Proceed nonetheless?", "no");
- $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.");
- $self->{CHECKSUM_STATUS} = "NIL -- chk_file broken";
+ $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
+ $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
return;
} elsif (exists $cksum->{$basename}{sha256}) {
$self->debug("Found checksum for $basename:" .
@@ -4908,8 +4916,8 @@ retry.};
}
# close $fh if fileno($fh);
} else {
- $self->{CHECKSUM_STATUS} ||= "";
- if ($self->{CHECKSUM_STATUS} eq "NIL") {
+ return if $sloppy;
+ unless ($self->{CHECKSUM_STATUS}) {
$CPAN::Frontend->mywarn(qq{
Warning: No checksum for $basename in $chk_file.
@@ -4918,9 +4926,9 @@ has not yet been calculated, but it may also be that something is
going awry right now.
});
my $answer = ExtUtils::MakeMaker::prompt("Proceed?", "yes");
- $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.");
+ $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
}
- $self->{CHECKSUM_STATUS} = "NIL -- distro not in chk_file";
+ $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
return;
}
}
@@ -5084,7 +5092,7 @@ or
push @e, $err;
}
- defined $self->{'make'} and push @e,
+ defined $self->{make} and push @e,
"Has already been processed within this session";
if (exists $self->{later} and length($self->{later})) {
@@ -5103,7 +5111,7 @@ or
}
$CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
my $builddir = $self->dir or
- $CPAN::Frontend->mydie("PANIC: Cannot determine build directory");
+ $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
$self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
@@ -5193,16 +5201,16 @@ or
}
if (system($system) == 0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
- $self->{'make'} = CPAN::Distrostatus->new("YES");
+ $self->{make} = CPAN::Distrostatus->new("YES");
} else {
$self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
- $self->{'make'} = CPAN::Distrostatus->new("NO");
+ $self->{make} = CPAN::Distrostatus->new("NO");
$CPAN::Frontend->myprint(" $system -- NOT OK\n");
}
}
sub _make_command {
- return $CPAN::Config->{'make'} || $Config::Config{make} || 'make';
+ return $CPAN::Config->{make} || $Config::Config{make} || 'make';
}
#-> sub CPAN::Distribution::follow_prereqs ;
@@ -5221,7 +5229,6 @@ sub follow_prereqs {
if ($CPAN::Config->{prerequisites_policy} eq "follow") {
$follow = 1;
} elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
- require ExtUtils::MakeMaker;
my $answer = ExtUtils::MakeMaker::prompt(
"Shall I follow them and prepend them to the queue
of modules we are processing right now?", "yes");
@@ -5664,7 +5671,7 @@ sub install {
$CPAN::Config->{mbuild_install_arg},
);
} else {
- my($make_install_make_command) = $CPAN::Config->{'make_install_make_command'} ||
+ my($make_install_make_command) = $CPAN::Config->{make_install_make_command} ||
_make_command();
$system = sprintf("%s install %s",
$make_install_make_command,
@@ -5975,6 +5982,9 @@ sub contains {
my($inst_file) = $self->inst_file || "";
my($id) = $self->id;
$self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
+ if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
+ undef $inst_file;
+ }
unless ($inst_file) {
# Try to get at it in the cpan directory
$self->debug("no inst_file") if $CPAN::DEBUG;
@@ -5988,13 +5998,13 @@ sub contains {
my $dist = $CPAN::META->instance('CPAN::Distribution',
$self->cpan_file);
$dist->get;
- $self->debug($dist->as_string) if $CPAN::DEBUG;
+ $self->debug("id[$dist->{ID}]") if $CPAN::DEBUG;
my($todir) = $CPAN::Config->{'cpan_home'};
my(@me,$from,$to,$me);
@me = split /::/, $self->id;
$me[-1] .= ".pm";
$me = File::Spec->catfile(@me);
- $from = $self->find_bundle_file($dist->{'build_dir'},$me);
+ $from = $self->find_bundle_file($dist->{'build_dir'},join('/',@me));
$to = File::Spec->catfile($todir,$me);
File::Path::mkpath(File::Basename::dirname($to));
File::Copy::copy($from, $to)
@@ -6033,6 +6043,7 @@ Sorry for the inconvenience.
}
#-> sub CPAN::Bundle::find_bundle_file
+# $where is in local format, $what is in unix format
sub find_bundle_file {
my($self,$where,$what) = @_;
$self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
@@ -6043,37 +6054,29 @@ sub find_bundle_file {
unless (-f $manifest) {
require ExtUtils::Manifest;
my $cwd = CPAN::anycwd();
- chdir $where or $CPAN::Frontend->mydie(qq{Could not chdir to "$where": $!});
+ $self->safe_chdir($where);
ExtUtils::Manifest::mkmanifest();
- chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
+ $self->safe_chdir($cwd);
}
my $fh = FileHandle->new($manifest)
or Carp::croak("Couldn't open $manifest: $!");
local($/) = "\n";
- my $what2 = $what;
- if ($^O eq 'MacOS') {
- $what =~ s/^://;
- $what =~ tr|:|/|;
- $what2 =~ s/:Bundle://;
- $what2 =~ tr|:|/|;
- } else {
- $what2 =~ s|Bundle[/\\]||;
- }
- my $bu;
+ my $bundle_filename = $what;
+ $bundle_filename =~ s|Bundle.*/||;
+ my $bundle_unixpath;
while (<$fh>) {
next if /^\s*\#/;
my($file) = /(\S+)/;
if ($file =~ m|\Q$what\E$|) {
- $bu = $file;
- # return File::Spec->catfile($where,$bu); # bad
+ $bundle_unixpath = $file;
+ # return File::Spec->catfile($where,$bundle_unixpath); # bad
last;
}
- # retry if she managed to
- # have no Bundle directory
- $bu = $file if $file =~ m|\Q$what2\E$|;
+ # retry if she managed to have no Bundle directory
+ $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
}
- $bu =~ tr|/|:| if $^O eq 'MacOS';
- return File::Spec->catfile($where, $bu) if $bu;
+ return File::Spec->catfile($where, split /\//, $bundle_unixpath)
+ if $bundle_unixpath;
Carp::croak("Couldn't find a Bundle file in $where");
}
@@ -6763,9 +6766,23 @@ 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.
+
+If you're already used to CPAN.pm you're welcome to continue using it.
+I intend to support it until somebody convinces me that there is a
+both superior and sufficiently compatible drop-in replacement.
+
+=head1 COMPATIBILITY
+
+CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
+newer versions. It is getting more and more difficult to get the
+minimal prerequisites working on older perls. It is close to
+impossible to get the whole Bundle::CPAN working there. If you're in
+the position to have only these old versions, be advised that CPAN is
+designed to work fine without the Bundle::CPAN installed.
+
+To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
+compatible with ancient perls and that File::Temp is listed as a
+prerequisite but CPAN has reasonable workarounds if it is missing.
=head1 DESCRIPTION
@@ -8085,6 +8102,17 @@ nice about obeying that variable as well):
% PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
+=item 14)
+
+I only know the usual options for ExtUtils::MakeMaker(Module::Build),
+how do I find out the corresponding options in
+Module::Build(ExtUtils::MakeMaker)?
+
+http://search.cpan.org/search?query=Module::Build::Convert
+
+http://accognoscere.org/papers/perl-module-build-convert/module-build-convert.html
+
+
=back
=head1 BUGS