summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSteve Peters <steve@fisharerojo.org>2008-10-29 19:21:49 +0000
committerSteve Peters <steve@fisharerojo.org>2008-10-29 19:21:49 +0000
commit5254b38efe447cab6b380b613825d484abf7a3f2 (patch)
treeb449c991a916c4df2fc4154dbd44767e0b683645
parent2f9d49b43d1c801578ee4512eb0a96fefec97604 (diff)
downloadperl-5254b38efe447cab6b380b613825d484abf7a3f2.tar.gz
Upgrade to CPAN-1.9301.
p4raw-id: //depot/perl@34638
Diffstat
-rw-r--r--MANIFEST3
-rw-r--r--lib/CPAN.pm1511
-rw-r--r--lib/CPAN/API/HOWTO.pod (renamed from lib/CPAN/API/HOWTO.pm)0
-rw-r--r--lib/CPAN/Debug.pm2
-rw-r--r--lib/CPAN/Distroprefs.pm413
-rw-r--r--lib/CPAN/FirstTime.pm109
-rw-r--r--lib/CPAN/HandleConfig.pm53
-rw-r--r--lib/CPAN/Kwalify.pm16
-rw-r--r--lib/CPAN/Kwalify/distroprefs.dd29
-rw-r--r--lib/CPAN/Kwalify/distroprefs.yml8
-rw-r--r--lib/CPAN/Nox.pm2
-rw-r--r--lib/CPAN/Queue.pm7
-rw-r--r--lib/CPAN/Tarzip.pm82
-rw-r--r--lib/CPAN/bin/cpan2
-rw-r--r--lib/CPAN/t/02nox.t2
-rw-r--r--lib/CPAN/t/03pkgs.t11
-rw-r--r--lib/CPAN/t/11mirroredby.t12
17 files changed, 1730 insertions, 532 deletions
diff --git a/MANIFEST b/MANIFEST
index 224474c030..2992de2891 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1786,10 +1786,11 @@ lib/Config.t See if Config works
lib/constant.pm For "use constant"
lib/constant.t See if compile-time constants work
lib/CORE.pod document the CORE namespace
-lib/CPAN/API/HOWTO.pm recipe book for programming with CPAN.pm
+lib/CPAN/API/HOWTO.pod recipe book for programming with CPAN.pm
lib/CPAN/bin/cpan easily interact with CPAN from the command line
lib/CPAN/Debug.pm helper package for CPAN.pm
lib/CPAN/DeferedCode.pm helper package for CPAN.pm
+lib/CPAN/Distroprefs.pm helper package for CPAN.pm
lib/CPAN/FirstTime.pm Utility for creating CPAN config files
lib/CPAN/HandleConfig.pm helper package for CPAN.pm
lib/CPAN/Kwalify/distroprefs.dd helper file for validating config files
diff --git a/lib/CPAN.pm b/lib/CPAN.pm
index edb854190c..fa3f920430 100644
--- a/lib/CPAN.pm
+++ b/lib/CPAN.pm
@@ -1,9 +1,20 @@
# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
use strict;
package CPAN;
-$CPAN::VERSION = '1.9205';
-$CPAN::VERSION = eval $CPAN::VERSION if $CPAN::VERSION =~ /_/;
+$CPAN::VERSION = '1.9301';
+$CPAN::VERSION =~ s/_//;
+# we need to run chdir all over and we would get at wrong libraries
+# there
+use File::Spec ();
+BEGIN {
+ if (File::Spec->can("rel2abs")) {
+ for my $inc (@INC) {
+ $inc = File::Spec->rel2abs($inc) unless ref $inc;
+ }
+ }
+}
use CPAN::HandleConfig;
use CPAN::Version;
use CPAN::Debug;
@@ -12,7 +23,7 @@ use CPAN::Tarzip;
use CPAN::DeferedCode;
use Carp ();
use Config ();
-use Cwd ();
+use Cwd qw(chdir);
use DirHandle ();
use Exporter ();
use ExtUtils::MakeMaker qw(prompt); # for some unknown reason,
@@ -22,7 +33,6 @@ use File::Basename ();
use File::Copy ();
use File::Find;
use File::Path ();
-use File::Spec ();
use FileHandle ();
use Fcntl qw(:flock);
use Safe ();
@@ -30,20 +40,42 @@ use Sys::Hostname qw(hostname);
use Text::ParseWords ();
use Text::Wrap ();
+# protect against "called too early"
sub find_perl ();
+sub anycwd ();
-# we need to run chdir all over and we would get at wrong libraries
-# there
-BEGIN {
- if (File::Spec->can("rel2abs")) {
- for my $inc (@INC) {
- $inc = File::Spec->rel2abs($inc) unless ref $inc;
- }
- }
-}
no lib ".";
require Mac::BuildTools if $^O eq 'MacOS';
+if ($ENV{PERL5_CPAN_IS_RUNNING} && $$ != $ENV{PERL5_CPAN_IS_RUNNING}) {
+ $ENV{PERL5_CPAN_IS_RUNNING_IN_RECURSION} ||= $ENV{PERL5_CPAN_IS_RUNNING};
+ my $rec = $ENV{PERL5_CPAN_IS_RUNNING_IN_RECURSION} .= ",$$";
+ my @rec = split /,/, $rec;
+ # warn "# Note: Recursive call of CPAN.pm detected\n";
+ my $w = sprintf "# Note: CPAN.pm is running in process %d now", pop @rec;
+ my %sleep = (
+ 5 => 30,
+ 6 => 60,
+ 7 => 120,
+ );
+ my $sleep = @rec > 7 ? 300 : ($sleep{scalar @rec}||0);
+ my $verbose = @rec >= 4;
+ while (@rec) {
+ $w .= sprintf " which has been called by process %d", pop @rec;
+ }
+ if ($sleep) {
+ $w .= ".\n\n# Sleeping $sleep seconds to protect other processes\n";
+ }
+ if ($verbose) {
+ warn $w;
+ }
+ local $| = 1;
+ while ($sleep > 0) {
+ printf "\r#%5d", --$sleep;
+ sleep 1;
+ }
+ print "\n";
+}
$ENV{PERL5_CPAN_IS_RUNNING}=$$;
$ENV{PERL5_CPANPLUS_IS_RUNNING}=$$; # https://rt.cpan.org/Ticket/Display.html?id=23735
@@ -58,7 +90,8 @@ unless (@CPAN::Defaultsites) {
"http://www.perl.org/CPAN/",
"ftp://ftp.perl.org/pub/CPAN/";
}
-# $CPAN::iCwd (i for initial) is going to be initialized during find_perl
+# $CPAN::iCwd (i for initial)
+$CPAN::iCwd ||= CPAN::anycwd();
$CPAN::Perl ||= CPAN::find_perl();
$CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
$CPAN::Defaultrecent ||= "http://search.cpan.org/uploads.rdf";
@@ -154,6 +187,46 @@ sub soft_chdir_with_alternatives ($);
}
}
+{
+ my $x = *SAVEOUT; # avoid warning
+ open($x,">&STDOUT") or die "dup failed";
+ my $redir = 0;
+ sub _redirect(@) {
+ #die if $redir;
+ local $_;
+ push(@_,undef);
+ while(defined($_=shift)) {
+ if (s/^\s*>//){
+ my ($m) = s/^>// ? ">" : "";
+ s/\s+//;
+ $_=shift unless length;
+ die "no dest" unless defined;
+ open(STDOUT,">$m$_") or die "open:$_:$!\n";
+ $redir=1;
+ } elsif ( s/^\s*\|\s*// ) {
+ my $pipe="| $_";
+ while(defined($_[0])){
+ $pipe .= ' ' . shift;
+ }
+ open(STDOUT,$pipe) or die "open:$pipe:$!\n";
+ $redir=1;
+ } else {
+ push(@_,$_);
+ }
+ }
+ return @_;
+ }
+ sub _unredirect {
+ return unless $redir;
+ $redir = 0;
+ ## redirect: unredirect and propagate errors. explicit close to wait for pipe.
+ close(STDOUT);
+ open(STDOUT,">&SAVEOUT");
+ die "$@" if "$@";
+ ## redirect: done
+ }
+}
+
#-> sub CPAN::shell ;
sub shell {
my($self) = @_;
@@ -271,13 +344,18 @@ ReadLine support %s
next SHELLCOMMAND unless @line;
$CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
my $command = shift @line;
- eval { CPAN::Shell->$command(@line) };
+ eval {
+ local (*STDOUT)=*STDOUT;
+ @line = _redirect(@line);
+ CPAN::Shell->$command(@line)
+ };
+ _unredirect;
if ($@) {
my $err = "$@";
if ($err =~ /\S/) {
require Carp;
require Dumpvalue;
- my $dv = Dumpvalue->new();
+ my $dv = Dumpvalue->new(tick => '"');
Carp::cluck(sprintf "Catching error: %s", $dv->stringify($err));
}
}
@@ -387,10 +465,10 @@ Trying to chdir to "$cwd->[1]" instead.
sub _flock {
my($fh,$mode) = @_;
- if ($Config::Config{d_flock}) {
+ if ( $Config::Config{d_flock} || $Config::Config{d_fcntl_can_lock} ) {
return flock $fh, $mode;
} elsif (!$Have_warned->{"d_flock"}++) {
- $CPAN::Frontend->mywarn("Your OS does not support locking; continuing and ignoring all locking issues\n");
+ $CPAN::Frontend->mywarn("Your OS does not seem to support locking; continuing and ignoring all locking issues\n");
$CPAN::Frontend->mysleep(5);
return 1;
} else {
@@ -433,32 +511,30 @@ sub _yaml_loadfile {
# temporarly enable yaml code deserialisation
no strict 'refs';
# 5.6.2 could not do the local() with the reference
- local $YAML::LoadCode;
- local $YAML::Syck::LoadCode;
+ # so we do it manually instead
+ my $old_loadcode = ${"$yaml_module\::LoadCode"};
${ "$yaml_module\::LoadCode" } = $CPAN::Config->{yaml_load_code} || 0;
- my $code;
+ my ($code, @yaml);
if ($code = UNIVERSAL::can($yaml_module, "LoadFile")) {
- my @yaml;
eval { @yaml = $code->($local_file); };
if ($@) {
# this shall not be done by the frontend
die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
}
- return \@yaml;
} elsif ($code = UNIVERSAL::can($yaml_module, "Load")) {
local *FH;
open FH, $local_file or die "Could not open '$local_file': $!";
local $/;
my $ystream = <FH>;
- my @yaml;
eval { @yaml = $code->($ystream); };
if ($@) {
# this shall not be done by the frontend
die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
}
- return \@yaml;
}
+ ${"$yaml_module\::LoadCode"} = $old_loadcode;
+ return \@yaml;
} else {
# this shall not be done by the frontend
die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "parse");
@@ -523,6 +599,7 @@ sub _init_sqlite () {
package CPAN::CacheMgr;
use strict;
@CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
+use Cwd qw(chdir);
use File::Find;
package CPAN::FTP;
@@ -696,10 +773,13 @@ use overload '""' => "as_string";
sub new {
my($class,$module,$file,$during,$error) = @_;
+ # my $at = Carp::longmess(""); # XXX find something more beautiful
bless { module => $module,
file => $file,
during => $during,
- error => $error }, $class;
+ error => $error,
+ # at => $at,
+ }, $class;
}
sub as_string {
@@ -774,15 +854,24 @@ sub text {
package CPAN::Distrostatus;
use overload '""' => "as_string",
fallback => 1;
+use vars qw($something_has_failed_at);
sub new {
my($class,$arg) = @_;
+ my $failed = substr($arg,0,2) eq "NO";
+ if ($failed) {
+ $something_has_failed_at = $CPAN::CurrentCommandId;
+ }
bless {
TEXT => $arg,
- FAILED => substr($arg,0,2) eq "NO",
+ FAILED => $failed,
COMMANDID => $CPAN::CurrentCommandId,
TIME => time,
}, $class;
}
+sub something_has_just_failed () {
+ defined $something_has_failed_at &&
+ $something_has_failed_at == $CPAN::CurrentCommandId;
+}
sub commandid { shift->{COMMANDID} }
sub failed { shift->{FAILED} }
sub text {
@@ -807,8 +896,28 @@ use vars qw(
$autoload_recursion
$reload
@ISA
+ @relo
);
+@relo = (
+ "CPAN.pm",
+ "CPAN/Debug.pm",
+ "CPAN/Distroprefs.pm",
+ "CPAN/FirstTime.pm",
+ "CPAN/HandleConfig.pm",
+ "CPAN/Kwalify.pm",
+ "CPAN/Queue.pm",
+ "CPAN/Reporter/Config.pm",
+ "CPAN/Reporter/History.pm",
+ "CPAN/Reporter/PrereqCheck.pm",
+ "CPAN/Reporter.pm",
+ "CPAN/SQLite.pm",
+ "CPAN/Tarzip.pm",
+ "CPAN/Version.pm",
+ );
+# record the initial timestamp for reload.
+$reload = { map {$INC{$_} ? ($_,(stat $INC{$_})[9]) : ()} @relo };
@CPAN::Shell::ISA = qw(CPAN::Debug);
+use Cwd qw(chdir);
$COLOR_REGISTERED ||= 0;
$Help = {
'?' => \"help",
@@ -995,7 +1104,7 @@ sub checklock {
qq{
There seems to be running another CPAN process (pid $otherpid). Contacting...
});
- if (kill 0, $otherpid) {
+ if (kill 0, $otherpid or $!{EPERM}) {
$CPAN::Frontend->mywarn(qq{Other job is running.\n});
my($ans) =
CPAN::Shell::colorable_makemaker_prompt
@@ -1189,10 +1298,10 @@ sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
#-> sub CPAN::find_perl ;
sub find_perl () {
my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
- my $pwd = $CPAN::iCwd = CPAN::anycwd();
- my $candidate = File::Spec->catfile($pwd,$^X);
- $perl ||= $candidate if MM->maybe_command($candidate);
-
+ unless ($perl) {
+ my $candidate = File::Spec->catfile($CPAN::iCwd,$^X);
+ $^X = $perl = $candidate if MM->maybe_command($candidate);
+ }
unless ($perl) {
my ($component,$perl_name);
DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
@@ -1201,13 +1310,12 @@ sub find_perl () {
next unless defined($component) && $component;
my($abs) = File::Spec->catfile($component,$perl_name);
if (MM->maybe_command($abs)) {
- $perl = $abs;
+ $^X = $perl = $abs;
last DIST_PERLNAME;
}
}
}
}
-
return $perl;
}
@@ -1446,8 +1554,10 @@ sub cleanup {
#-> sub CPAN::readhist
sub readhist {
my($self,$term,$histfile) = @_;
+ my $histsize = $CPAN::Config->{'histsize'} || 100;
+ $term->Attribs->{'MaxHistorySize'} = $histsize if (defined($term->Attribs->{'MaxHistorySize'}));
my($fh) = FileHandle->new;
- open $fh, "<$histfile" or last;
+ open $fh, "<$histfile" or return;
local $/ = "\n";
while (<$fh>) {
chomp;
@@ -1492,6 +1602,13 @@ sub is_tested {
$self->{is_tested}{$what} = $when;
}
+#-> sub CPAN::reset_tested
+# forget all distributions tested -- resets what gets included in PERL5LIB
+sub reset_tested {
+ my ($self) = @_;
+ $self->{is_tested} = {};
+}
+
#-> sub CPAN::is_installed
# unsets the is_tested flag: as soon as the thing is installed, it is
# not needed in set_perl5lib anymore
@@ -1508,6 +1625,10 @@ sub _list_sorted_descending_is_tested {
}
#-> sub CPAN::set_perl5lib
+# Notes on max environment variable length:
+# - Win32 : XP or later, 8191; Win2000 or NT4, 2047
+{
+my $fh;
sub set_perl5lib {
my($self,$for) = @_;
unless ($for) {
@@ -1519,32 +1640,35 @@ sub set_perl5lib {
my $env = $ENV{PERL5LIB};
$env = $ENV{PERLLIB} unless defined $env;
my @env;
- push @env, $env if defined $env and length $env;
+ push @env, split /\Q$Config::Config{path_sep}\E/, $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");
my @dirs = map {("$_/blib/arch", "$_/blib/lib")} $self->_list_sorted_descending_is_tested;
+ return if !@dirs;
+
if (@dirs < 12) {
- $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB for '$for'\n");
- } elsif (@dirs < 24) {
+ $CPAN::Frontend->optprint('perl5lib', "Prepending @dirs to PERL5LIB for '$for'\n");
+ $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
+ } elsif (@dirs < 24 ) {
my @d = map {my $cp = $_;
$cp =~ s/^\Q$CPAN::Config->{build_dir}\E/%BUILDDIR%/;
$cp
} @dirs;
- $CPAN::Frontend->myprint("Prepending @d to PERL5LIB; ".
+ $CPAN::Frontend->optprint('perl5lib', "Prepending @d to PERL5LIB; ".
"%BUILDDIR%=$CPAN::Config->{build_dir} ".
"for '$for'\n"
);
+ $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
} else {
my $cnt = keys %{$self->{is_tested}};
- $CPAN::Frontend->myprint("Prepending blib/arch and blib/lib of ".
+ $CPAN::Frontend->optprint('perl5lib', "Prepending blib/arch and blib/lib of ".
"$cnt build dirs to PERL5LIB; ".
"for '$for'\n"
);
+ $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
}
-
- $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
-}
+}}
package CPAN::CacheMgr;
use strict;
@@ -2188,6 +2312,7 @@ sub hosts {
$CPAN::Frontend->myprint($R);
}
+# here is where 'reload cpan' is done
#-> sub CPAN::Shell::reload ;
sub reload {
my($self,$command,@arg) = @_;
@@ -2197,20 +2322,6 @@ sub reload {
my $redef = 0;
chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
my $failed;
- my @relo = (
- "CPAN.pm",
- "CPAN/Debug.pm",
- "CPAN/FirstTime.pm",
- "CPAN/HandleConfig.pm",
- "CPAN/Kwalify.pm",
- "CPAN/Queue.pm",
- "CPAN/Reporter/Config.pm",
- "CPAN/Reporter/History.pm",
- "CPAN/Reporter.pm",
- "CPAN/SQLite.pm",
- "CPAN/Tarzip.pm",
- "CPAN/Version.pm",
- );
MFILE: for my $f (@relo) {
next unless exists $INC{$f};
my $p = $f;
@@ -2269,13 +2380,7 @@ sub _reload_this {
return;
}
my $mtime = (stat $file)[9];
- if ($reload->{$f}) {
- } elsif ($^T < $mtime) {
- # since we started the file has changed, force it to be reloaded
- $reload->{$f} = -1;
- } else {
- $reload->{$f} = $mtime;
- }
+ $reload->{$f} ||= -1;
my $must_reload = $mtime != $reload->{$f};
$args ||= {};
$must_reload ||= $args->{reloforce}; # o conf defaults needs this
@@ -2514,47 +2619,90 @@ sub _u_r_common {
$version_undefs = $version_zeroes = 0;
my $sprintf = "%s%-25s%s %9s %9s %s\n";
my @expand = $self->expand('Module',@args);
- my $expand = scalar @expand;
- if (0) { # Looks like noise to me, was very useful for debugging
+ if ($CPAN::DEBUG) { # Looks like noise to me, was very useful for debugging
# for metadata cache
- $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
- }
- MODULE: for $module (@expand) {
+ my $expand = scalar @expand;
+ $CPAN::Frontend->myprint(sprintf "%d matches in the database, time[%d]\n", $expand, time);
+ }
+ my @sexpand;
+ if ($] < 5.008) {
+ # hard to believe that the more complex sorting can lead to
+ # stack curruptions on older perl
+ @sexpand = sort {$a->id cmp $b->id} @expand;
+ } else {
+ @sexpand = map {
+ $_->[1]
+ } sort {
+ $b->[0] <=> $a->[0]
+ ||
+ $a->[1]{ID} cmp $b->[1]{ID},
+ } map {
+ [$_->_is_representative_module,
+ $_
+ ]
+ } @expand;
+ }
+ if ($CPAN::DEBUG) {
+ $CPAN::Frontend->myprint(sprintf "sorted at time[%d]\n", time);
+ sleep 1;
+ }
+ MODULE: for $module (@sexpand) {
my $file = $module->cpan_file;
next MODULE unless defined $file; # ??
$file =~ s!^./../!!;
my($latest) = $module->cpan_version;
my($inst_file) = $module->inst_file;
+ CPAN->debug("file[$file]latest[$latest]") if $CPAN::DEBUG;
my($have);
return if $CPAN::Signal;
- if ($inst_file) {
- if ($what eq "a") {
- $have = $module->inst_version;
- } elsif ($what eq "r") {
- $have = $module->inst_version;
- local($^W) = 0;
- if ($have eq "undef") {
- $version_undefs++;
- push @version_undefs, $module->as_glimpse;
- } elsif (CPAN::Version->vcmp($have,0)==0) {
- $version_zeroes++;
- push @version_zeroes, $module->as_glimpse;
+ my($next_MODULE);
+ eval { # version.pm involved!
+ if ($inst_file) {
+ if ($what eq "a") {
+ $have = $module->inst_version;
+ } elsif ($what eq "r") {
+ $have = $module->inst_version;
+ local($^W) = 0;
+ if ($have eq "undef") {
+ $version_undefs++;
+ push @version_undefs, $module->as_glimpse;
+ } elsif (CPAN::Version->vcmp($have,0)==0) {
+ $version_zeroes++;
+ push @version_zeroes, $module->as_glimpse;
+ }
+ ++$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_MODULE;
+ }
+ } else {
+ if ($what eq "a") {
+ ++$next_MODULE;
+ } elsif ($what eq "r") {
+ ++$next_MODULE;
+ } elsif ($what eq "u") {
+ $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 MODULE;
- }
- } else {
- if ($what eq "a") {
- next MODULE;
- } elsif ($what eq "r") {
- next MODULE;
- } elsif ($what eq "u") {
- $have = "-";
}
+ };
+ next MODULE if $next_MODULE;
+ if ($@) {
+ $CPAN::Frontend->mywarn
+ (sprintf("Error while comparing cpan/installed versions of '%s':
+INST_FILE: %s
+INST_VERSION: %s %s
+CPAN_VERSION: %s %s
+",
+ $module->id,
+ $inst_file || "",
+ (defined $have ? $have : "[UNDEFINED]"),
+ (ref $have ? ref $have : ""),
+ $latest,
+ (ref $latest ? ref $latest : ""),
+ ));
+ next MODULE;
}
return if $CPAN::Signal; # this is sometimes lengthy
$seen{$file} ||= 0;
@@ -2894,6 +3042,7 @@ sub expand_by_method {
) if $CPAN::DEBUG;
if (defined $regex) {
if (CPAN::_sqlite_running) {
+ CPAN::Index->reload;
$CPAN::SQLite->search($class, $regex);
}
for $obj (
@@ -2965,7 +3114,9 @@ that may go away anytime.\n"
if ( $CPAN::DEBUG ) {
my $wantarray = wantarray;
my $join_m = join ",", map {$_->id} @m;
- $self->debug("wantarray[$wantarray]join_m[$join_m]");
+ # $self->debug("wantarray[$wantarray]join_m[$join_m]");
+ my $count = scalar @m;
+ $self->debug("class[$class]wantarray[$wantarray]count m[$count]");
}
return wantarray ? @m : $m[0];
}
@@ -3019,7 +3170,7 @@ sub format_result {
# to turn colordebugging on, write
# cpan> o conf colorize_output 1
-#-> sub CPAN::Shell::print_ornamented ;
+#-> sub CPAN::Shell::colorize_output ;
{
my $print_ornamented_have_warned = 0;
sub colorize_output {
@@ -3064,7 +3215,7 @@ sub print_ornamented {
print "Term::ANSIColor rejects color[$ornament]: $@\n
Please choose a different color (Hint: try 'o conf init /color/')\n";
}
- # GGOLDBACH/Test-GreaterVersion-0.008 broke wthout this
+ # GGOLDBACH/Test-GreaterVersion-0.008 broke without this
# $trailer construct. We want the newline be the last thing if
# there is a newline at the end ensuring that the next line is
# empty for other players
@@ -3301,7 +3452,7 @@ to find objects with matching identifiers.
# queuerunner (please be warned: when I started to change the
# queue to hold objects instead of names, I made one or two
# mistakes and never found which. I reverted back instead)
- while (my $q = CPAN::Queue->first) {
+ QITEM: while (my $q = CPAN::Queue->first) {
my $obj;
my $s = $q->as_string;
my $reqtype = $q->reqtype || "";
@@ -3314,7 +3465,7 @@ to find objects with matching identifiers.
"to an object. Skipping.\n");
$CPAN::Frontend->mysleep(5);
CPAN::Queue->delete_first($s);
- next;
+ next QITEM;
}
$obj->{reqtype} ||= "";
{
@@ -3393,6 +3544,14 @@ to find objects with matching identifiers.
$obj->$unpragma();
}
}
+ if ($CPAN::Config->{halt_on_failure}
+ &&
+ CPAN::Distrostatus::something_has_just_failed()
+ ) {
+ $CPAN::Frontend->mywarn("Stopping: '$meth' failed for '$s'.\n");
+ CPAN::Queue->nullify_queue;
+ last QITEM;
+ }
CPAN::Queue->delete_first($s);
}
if ($meth =~ /^($needs_recursion_protection)$/) {
@@ -3438,7 +3597,7 @@ sub recent {
$distro =~ s|.*?/authors/id/./../||;
my $size = $eitem->findvalue("enclosure/\@length");
my $desc = $eitem->findvalue("description");
-
+ $desc =~ s/.+? - //;
$CPAN::Frontend->myprint("$distro [$size b]\n $desc\n");
push @distros, $distro;
}
@@ -3494,6 +3653,7 @@ sub smoke {
my($self) = @_;
my $distros = $self->recent;
DISTRO: for my $distro (@$distros) {
+ next if $distro =~ m|/Bundle-|; # XXX crude heuristic to skip bundles
$CPAN::Frontend->myprint(sprintf "Going to download and test '$distro'\n");
{
my $skip = 0;
@@ -3566,10 +3726,9 @@ sub get_basic_credentials {
sub get_proxy_credentials {
my $self = shift;
my ($user, $password);
- if ( defined $CPAN::Config->{proxy_user} &&
- defined $CPAN::Config->{proxy_pass}) {
+ if ( defined $CPAN::Config->{proxy_user} ) {
$user = $CPAN::Config->{proxy_user};
- $password = $CPAN::Config->{proxy_pass};
+ $password = $CPAN::Config->{proxy_pass} || "";
return ($user, $password);
}
my $username_prompt = "\nProxy authentication needed!
@@ -3585,10 +3744,9 @@ sub get_proxy_credentials {
sub get_non_proxy_credentials {
my $self = shift;
my ($user,$password);
- if ( defined $CPAN::Config->{username} &&
- defined $CPAN::Config->{password}) {
+ if ( defined $CPAN::Config->{username} ) {
$user = $CPAN::Config->{username};
- $password = $CPAN::Config->{password};
+ $password = $CPAN::Config->{password} || "";
return ($user, $password);
}
my $username_prompt = "\nAuthentication needed!
@@ -3734,11 +3892,7 @@ sub _add_to_statistics {
$self->debug("yaml_module[$yaml_module]") if $CPAN::DEBUG;
if ($CPAN::META->has_inst($yaml_module)) {
$stats->{thesiteurl} = $ThesiteURL;
- if (CPAN->has_inst("Time::HiRes")) {
- $stats->{end} = Time::HiRes::time();
- } else {
- $stats->{end} = time;
- }
+ $stats->{end} = CPAN::FTP::_mytime();
my $fh = FileHandle->new;
my $time = time;
my $sdebug = 0;
@@ -3750,12 +3904,13 @@ sub _add_to_statistics {
push @debug, scalar @{$fullstats->{history}} if $sdebug;
push @debug, time if $sdebug;
push @{$fullstats->{history}}, $stats;
- # arbitrary hardcoded constants until somebody demands to have
- # them settable; YAML.pm 0.62 is unacceptably slow with 999;
+ # YAML.pm 0.62 is unacceptably slow with 999;
# YAML::Syck 0.82 has no noticable performance problem with 999;
+ my $ftpstats_size = $CPAN::Config->{ftpstats_size} || 99;
+ my $ftpstats_period = $CPAN::Config->{ftpstats_period} || 14;
while (
- @{$fullstats->{history}} > 99
- || $time - $fullstats->{history}[0]{start} > 14*86400
+ @{$fullstats->{history}} > $ftpstats_size
+ || $time - $fullstats->{history}[0]{start} > 86400*$ftpstats_period
) {
shift @{$fullstats->{history}}
}
@@ -3775,11 +3930,42 @@ sub _add_to_statistics {
}
# Win32 cannot rename a file to an existing filename
unlink($sfile) if ($^O eq 'MSWin32');
+ _copy_stat($sfile, "$sfile.$$") if -e $sfile;
rename "$sfile.$$", $sfile
or $CPAN::Frontend->mydie("Could not rename '$sfile.$$' to '$sfile': $!\n");
}
}
+# Copy some stat information (owner, group, mode and) from one file to
+# another.
+# This is a utility function which might be moved to a utility repository.
+#-> sub CPAN::FTP::_copy_stat
+sub _copy_stat {
+ my($src, $dest) = @_;
+ my @stat = stat($src);
+ if (!@stat) {
+ $CPAN::Frontend->mywarn("Can't stat '$src': $!\n");
+ return;
+ }
+
+ eval {
+ chmod $stat[2], $dest
+ or $CPAN::Frontend->mywarn("Can't chmod '$dest' to " . sprintf("0%o", $stat[2]) . ": $!\n");
+ };
+ warn $@ if $@;
+ eval {
+ chown $stat[4], $stat[5], $dest
+ or do {
+ my $save_err = $!; # otherwise it's lost in the get... calls
+ $CPAN::Frontend->mywarn("Can't chown '$dest' to " .
+ (getpwuid($stat[4]))[0] . "/" .
+ (getgrgid($stat[5]))[0] . ": $save_err\n"
+ );
+ };
+ };
+ warn $@ if $@;
+}
+
# if file is CHECKSUMS, suggest the place where we got the file to be
# checked from, maybe only for young files?
#-> sub CPAN::FTP::_recommend_url_for
@@ -3832,7 +4018,7 @@ sub ftp_get {
my($class,$host,$dir,$file,$target) = @_;
$class->debug(
qq[Going to fetch file [$file] from dir [$dir]
- on host [$host] as local [$target]\n]
+ on host [$host] as local [$target]\n]
) if $CPAN::DEBUG;
my $ftp = Net::FTP->new($host);
unless ($ftp) {
@@ -3865,8 +4051,8 @@ sub ftp_get {
# If more accuracy is wanted/needed, Chris Leach sent me this patch...
- # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
- # > --- /tmp/cp Wed Sep 24 13:26:40 1997
+ # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
+ # > --- /tmp/cp Wed Sep 24 13:26:40 1997
# > ***************
# > *** 1562,1567 ****
# > --- 1562,1580 ----
@@ -4015,6 +4201,9 @@ sub localize {
$CPAN::Config->{ftp_passive} : 1;
my $ret;
my $stats = $self->_new_stats($file);
+ for ($CPAN::Config->{connect_to_internet_ok}) {
+ $connect_to_internet_ok = $_ if not defined $connect_to_internet_ok and defined $_;
+ }
LEVEL: for $levelno (0..$#levels) {
my $level_tuple = $levels[$levelno];
my($level,$scheme,$sitetag) = @$level_tuple;
@@ -4318,6 +4507,7 @@ sub hostdlhard {
# Try the most capable first and leave ncftp* for last as it only
# does FTP.
+ my $proxy_vars = $self->_proxy_vars($ro_url);
DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
next unless defined $funkyftp;
@@ -4339,6 +4529,9 @@ sub hostdlhard {
$stdout_redir = "";
} elsif ($f eq 'curl') {
$src_switch = ' -L -f -s -S --netrc-optional';
+ if ($proxy_vars->{http_proxy}) {
+ $src_switch .= qq{ -U "$proxy_vars->{proxy_user}:$proxy_vars->{proxy_pass}" -x "$proxy_vars->{http_proxy}"};
+ }
}
if ($f eq "ncftpget") {
@@ -4435,6 +4628,39 @@ No success, the file that lynx has downloaded is an empty file.
} # host
}
+#-> CPAN::FTP::_proxy_vars
+sub _proxy_vars {
+ my($self,$url) = @_;
+ my $ret = +{};
+ my $http_proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
+ if ($http_proxy) {
+ my($host) = $url =~ m|://([^/:]+)|;
+ my $want_proxy = 1;
+ my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'} || "";
+ my @noproxy = split /\s*,\s*/, $noproxy;
+ if ($host) {
+ DOMAIN: for my $domain (@noproxy) {
+ if ($host =~ /\Q$domain\E$/) { # cf. LWP::UserAgent
+ $want_proxy = 0;
+ last DOMAIN;
+ }
+ }
+ } else {
+ $CPAN::Frontend->mywarn(" Could not determine host from http_proxy '$http_proxy'\n");
+ }
+ if ($want_proxy) {
+ my($user, $pass) =
+ &CPAN::LWP::UserAgent::get_proxy_credentials();
+ $ret = {
+ proxy_user => $user,
+ proxy_pass => $pass,
+ http_proxy => $http_proxy
+ };
+ }
+ }
+ return $ret;
+}
+
# package CPAN::FTP;
sub hostdlhardest {
my($self,$host_seq,$file,$aslocal,$stats) = @_;
@@ -4938,11 +5164,21 @@ sub reanimate_build_dir {
my $i = 0;
my $painted = 0;
my $restored = 0;
- $CPAN::Frontend->myprint("Going to read $CPAN::Config->{build_dir}/\n");
my @candidates = map { $_->[0] }
sort { $b->[1] <=> $a->[1] }
map { [ $_, -M File::Spec->catfile($d,$_) ] }
grep {/\.yml$/} readdir $dh;
+ unless (@candidates) {
+ $CPAN::Frontend->myprint("Build_dir empty, nothing to restore\n");
+ return;
+ }
+ $CPAN::Frontend->myprint
+ (sprintf("Going to read %d yaml file%s from %s/\n",
+ scalar @candidates,
+ @candidates==1 ? "" : "s",
+ $CPAN::Config->{build_dir}
+ ));
+ my $start = CPAN::FTP::_mytime;
DISTRO: for $i (0..$#candidates) {
my $dirent = $candidates[$i];
my $y = eval {CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))};
@@ -4977,22 +5213,13 @@ sub reanimate_build_dir {
notest
should_report
sponsored_mods
+ prefs
+ negative_prefs_cache
)) {
delete $do->{$skipper};
}
# $DB::single = 1;
- if ($do->{make_test}
- && $do->{build_dir}
- && !(UNIVERSAL::can($do->{make_test},"failed") ?
- $do->{make_test}->failed :
- $do->{make_test} =~ /^YES/
- )
- && (
- !$do->{install}
- ||
- $do->{install}->failed
- )
- ) {
+ if ($do->tested_ok_but_not_installed) {
$CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
}
$restored++;
@@ -5003,11 +5230,11 @@ sub reanimate_build_dir {
$painted++;
}
}
+ my $took = CPAN::FTP::_mytime - $start;
$CPAN::Frontend->myprint(sprintf(
- "DONE\nFound %s old build%s, restored the state of %s\n",
- @candidates ? sprintf("%d",scalar @candidates) : "no",
- @candidates==1 ? "" : "s",
+ "DONE\nRestored the state of %s (in %.4f secs)\n",
$restored || "none",
+ $took,
));
}
@@ -5187,6 +5414,10 @@ happen.\a
# 1.57 we assign remaining text to $comment thus allowing to
# influence isa_perl
my($mod,$version,$dist,$comment) = split " ", $_, 4;
+ unless ($mod && defined $version && $dist) {
+ $CPAN::Frontend->mywarn("Could not split line[$_]\n");
+ next;
+ }
my($bundle,$id,$userid);
if ($mod eq 'CPAN' &&
@@ -5318,10 +5549,10 @@ sub rd_modlist {
}
push @eval2, q{CPAN::Modulelist->data;};
local($^W) = 0;
- my($comp) = Safe->new("CPAN::Safe1");
+ my($compmt) = Safe->new("CPAN::Safe1");
my($eval2) = join("\n", @eval2);
CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
- my $ret = $comp->reval($eval2);
+ my $ret = $compmt->reval($eval2);
Carp::confess($@) if $@;
return if $CPAN::Signal;
my $i = 0;
@@ -5425,6 +5656,7 @@ sub read_metadata_cache {
package CPAN::InfoObj;
use strict;
+use Cwd qw(chdir);
sub ro {
my $self = shift;
@@ -5784,8 +6016,8 @@ sub dir_listing {
my $eval = <$fh>;
$eval =~ s/\015?\012/\n/g;
close $fh;
- my($comp) = Safe->new();
- $cksum = $comp->reval($eval);
+ my($compmt) = Safe->new();
+ $cksum = $compmt->reval($eval);
if ($@) {
rename $lc_file, "$lc_file.bad";
Carp::confess($@) if $@;
@@ -5828,6 +6060,8 @@ Please file a bugreport if you need this.\n");
package CPAN::Distribution;
use strict;
+use Cwd qw(chdir);
+use CPAN::Distroprefs;
# Accessors
sub cpan_comment {
@@ -5892,8 +6126,7 @@ sub normalize {
$s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
) {
return $s if $s =~ m:^N/A|^Contact Author: ;
- $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
- $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
+ $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4|;
CPAN->debug("s[$s]") if $CPAN::DEBUG;
}
$s;
@@ -5963,6 +6196,25 @@ sub base_id {
return $base_id;
}
+#-> sub CPAN::Distribution::tested_ok_but_not_installed
+sub tested_ok_but_not_installed {
+ my $self = shift;
+ return (
+ $self->{make_test}
+ && $self->{build_dir}
+ && (UNIVERSAL::can($self->{make_test},"failed") ?
+ ! $self->{make_test}->failed :
+ $self->{make_test} =~ /^YES/
+ )
+ && (
+ !$self->{install}
+ ||
+ $self->{install}->failed
+ )
+ );
+}
+
+
# mark as dirty/clean for the sake of recursion detection. $color=1
# means "in use", $color=0 means "not in use anymore". $color=2 means
# we have determined prereqs now and thus insist on passing this
@@ -6092,7 +6344,7 @@ sub get {
local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
? $ENV{PERL5LIB}
: ($ENV{PERLLIB} || "");
-
+ local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
$CPAN::META->set_perl5lib;
local $ENV{MAKEFLAGS}; # protect us from outer make calls
@@ -6100,7 +6352,7 @@ sub get {
my @e;
my $goodbye_message;
$self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG;
- if ($self->prefs->{disabled}) {
+ if ($self->prefs->{disabled} && ! $self->{force_update}) {
my $why = sprintf(
"Disabled via prefs file '%s' doc %d",
$self->{prefs_file},
@@ -6149,6 +6401,11 @@ sub get {
$self->check_integrity;
return if $CPAN::Signal;
(my $packagedir,$local_file) = $self->run_preps_on_packagedir;
+ if (exists $self->{writemakefile} && ref $self->{writemakefile}
+ && $self->{writemakefile}->can("failed") &&
+ $self->{writemakefile}->failed) {
+ return;
+ }
$packagedir ||= $self->{build_dir};
$self->{build_dir} = $packagedir;
}
@@ -6157,7 +6414,7 @@ sub get {
$self->safe_chdir($sub_wd);
return;
}
- return $self->run_MM_or_MB($local_file);
+ return $self->choose_MM_or_MB($local_file);
}
#-> CPAN::Distribution::get_file_onto_local_disk
@@ -6255,6 +6512,15 @@ EOF
my $dh = DirHandle->new(File::Spec->curdir)
or Carp::croak("Couldn't opendir .: $!");
my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
+ if (grep { $_ eq "pax_global_header" } @readdir) {
+ $CPAN::Frontend->mywarn("Your (un)tar seems to have extracted a file named 'pax_global_header'
+from the tarball '$local_file'.
+This is almost certainly an error. Please upgrade your tar.
+I'll ignore this file for now.
+See also http://rt.cpan.org/Ticket/Display.html?id=38932\n");
+ $CPAN::Frontend->mysleep(5);
+ @readdir = grep { $_ ne "pax_global_header" } @readdir;
+ }
$dh->close;
my ($packagedir);
# XXX here we want in each branch File::Temp to protect all build_dir directories
@@ -6265,8 +6531,20 @@ EOF
if (@readdir == 1 && -d $readdir[0]) {
$tdir_base = $readdir[0];
$from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]);
- my $dh2 = DirHandle->new($from_dir)
- or Carp::croak("Couldn't opendir $from_dir: $!");
+ my $dh2;
+ unless ($dh2 = DirHandle->new($from_dir)) {
+ my($mode) = (stat $from_dir)[2];
+ my $why = sprintf
+ (
+ "Couldn't opendir '%s', mode '%o': %s",
+ $from_dir,
+ $mode,
+ $!,
+ );
+ $CPAN::Frontend->mywarn("$why\n");
+ $self->{writemakefile} = CPAN::Distrostatus->new("NO -- $why");
+ return;
+ }
@dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC??
} else {
my $userid = $self->cpan_userid;
@@ -6372,6 +6650,31 @@ sub parse_meta_yml {
return $early_yaml;
}
+#-> sub CPAN::Distribution::satisfy_requires ;
+sub satisfy_requires {
+ my ($self) = @_;
+ if (my @prereq = $self->unsat_prereq("later")) {
+ if ($prereq[0][0] eq "perl") {
+ my $need = "requires perl '$prereq[0][1]'";
+ my $id = $self->pretty_id;
+ $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
+ $self->{make} = CPAN::Distrostatus->new("NO $need");
+ $self->store_persistent_state;
+ die "[prereq] -- NOT OK\n";
+ } else {
+ my $follow = eval { $self->follow_prereqs("later",@prereq); };
+ if (0) {
+ } elsif ($follow) {
+ # signal success to the queuerunner
+ return 1;
+ } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
+ $CPAN::Frontend->mywarn($@);
+ die "[depend] -- NOT OK\n";
+ }
+ }
+ }
+}
+
#-> sub CPAN::Distribution::satisfy_configure_requires ;
sub satisfy_configure_requires {
my($self) = @_;
@@ -6419,8 +6722,8 @@ sub satisfy_configure_requires {
die "never reached";
}
-#-> sub CPAN::Distribution::run_MM_or_MB ;
-sub run_MM_or_MB {
+#-> sub CPAN::Distribution::choose_MM_or_MB ;
+sub choose_MM_or_MB {
my($self,$local_file) = @_;
$self->satisfy_configure_requires() or return;
my($mpl) = File::Spec->catfile($self->{build_dir},"Makefile.PL");
@@ -6659,6 +6962,12 @@ We\'ll try to build it with that Makefile then.
}
$cf =~ s|[/\\:]||g; # risk of filesystem damage
$cf = "unknown" unless length($cf);
+ if (my $crap = $self->_contains_crap($build_dir)) {
+ my $why = qq{Package contains $crap; not recognized as a perl package, giving up};
+ $CPAN::Frontend->mywarn("$why\n");
+ $self->{writemakefile} = CPAN::Distrostatus->new(qq{NO -- $why});
+ return;
+ }
$CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
(The test -f "$mpl" returned false.)
Writing one on our own (setting NAME to $cf)\a\n});
@@ -6667,8 +6976,55 @@ We\'ll try to build it with that Makefile then.
# Writing our own Makefile.PL
- my $script = "";
+ my $exefile_stanza = "";
if ($self->{archived} eq "maybe_pl") {
+ $exefile_stanza = $self->_exefile_stanza($build_dir,$local_file);
+ }
+
+ my $fh = FileHandle->new;
+ $fh->open(">$mpl")
+ or Carp::croak("Could not open >$mpl: $!");
+ $fh->print(
+ qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
+# because there was no Makefile.PL supplied.
+# Autogenerated on: }.scalar localtime().qq{
+
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ NAME => q[$cf],$exefile_stanza
+ );
+});
+ $fh->close;
+ }
+}
+
+#-> CPAN;:Distribution::_contains_crap
+sub _contains_crap {
+ my($self,$dir) = @_;
+ my(@dirs, $dh, @files);
+ opendir $dh, $dir or return;
+ my $dirent;
+ for $dirent (readdir $dh) {
+ next if $dirent =~ /^\.\.?$/;
+ my $path = File::Spec->catdir($dir,$dirent);
+ if (-d $path) {
+ push @dirs, $dirent;
+ } elsif (-f $path) {
+ push @files, $dirent;
+ }
+ }
+ if (@dirs && @files) {
+ return "both files[@files] and directories[@dirs]";
+ } elsif (@files > 2) {
+ return "several files[@files] but no Makefile.PL or Build.PL";
+ }
+ return;
+}
+
+#-> CPAN;:Distribution::_exefile_stanza
+sub _exefile_stanza {
+ my($self,$build_dir,$local_file) = @_;
+
my $fh = FileHandle->new;
my $script_file = File::Spec->catfile($build_dir,$local_file);
$fh->open($script_file)
@@ -6719,34 +7075,18 @@ We\'ll try to build it with that Makefile then.
}
} split /\s*,\s*/, $prereq);
- $script = "
- EXE_FILES => ['$name'],
- PREREQ_PM => {
-$PREREQ_PM
- },
-";
if ($name) {
my $to_file = File::Spec->catfile($build_dir, $name);
rename $script_file, $to_file
or die "Can't rename $script_file to $to_file: $!";
}
- }
-
- my $fh = FileHandle->new;
- $fh->open(">$mpl")
- or Carp::croak("Could not open >$mpl: $!");
- $fh->print(
- qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
-# because there was no Makefile.PL supplied.
-# Autogenerated on: }.scalar localtime().qq{
-use ExtUtils::MakeMaker;
-WriteMakefile(
- NAME => q[$cf],$script
- );
-});
- $fh->close;
- }
+ return "
+ EXE_FILES => ['$name'],
+ PREREQ_PM => {
+$PREREQ_PM
+ },
+";
}
#-> CPAN::Distribution::_signature_business
@@ -6801,7 +7141,8 @@ and run
sub untar_me {
my($self,$ct) = @_;
$self->{archived} = "tar";
- if ($ct->untar()) {
+ my $result = eval { $ct->untar() };
+ if ($result) {
$self->{unwrapped} = CPAN::Distrostatus->new("YES");
} else {
$self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed");
@@ -6896,6 +7237,15 @@ Could not determine which directory to use for looking at $dist.
local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
$ENV{CPAN_SHELL_LEVEL} += 1;
my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
+
+ local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
+ ? $ENV{PERL5LIB}
+ : ($ENV{PERLLIB} || "");
+
+ local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
+ $CPAN::META->set_perl5lib;
+ local $ENV{MAKEFLAGS}; # protect us from outer make calls
+
unless (system($shell) == 0) {
my $code = $? >> 8;
$CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
@@ -7083,8 +7433,8 @@ sub CHECKSUM_check_file {
my $eval = <$fh>;
$eval =~ s/\015?\012/\n/g;
close $fh;
- my($comp) = Safe->new();
- $cksum = $comp->reval($eval);
+ my($compmt) = Safe->new();
+ $cksum = $compmt->reval($eval);
if ($@) {
rename $chk_file, "$chk_file.bad";
Carp::confess($@) if $@;
@@ -7374,12 +7724,14 @@ is part of the perl-%s distribution. To install that, you need to run
}
$CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
$self->get;
+ return if $self->prefs->{disabled} && ! $self->{force_update};
if ($self->{configure_requires_later}) {
return;
}
local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
? $ENV{PERL5LIB}
: ($ENV{PERLLIB} || "");
+ local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
$CPAN::META->set_perl5lib;
local $ENV{MAKEFLAGS}; # protect us from outer make calls
@@ -7424,7 +7776,7 @@ is part of the perl-%s distribution. To install that, you need to run
my $err = UNIVERSAL::can($self->{writemakefile},"text") ?
$self->{writemakefile}->text :
$self->{writemakefile};
- $err =~ s/^NO\s*//;
+ $err =~ s/^NO\s*(--\s+)?//;
$err ||= "Had some problem writing Makefile";
$err .= ", won't make";
push @e, $err;
@@ -7446,6 +7798,9 @@ is part of the perl-%s distribution. To install that, you need to run
}
} else {
push @e, "Has already been made";
+ my $wait_for_prereqs = eval { $self->satisfy_requires };
+ return 1 if $wait_for_prereqs; # tells queuerunner to continue
+ return $self->goodbye($@) if $@; # tells queuerunner to stop
}
}
@@ -7483,8 +7838,12 @@ is part of the perl-%s distribution. To install that, you need to run
}
local %ENV = %env;
my $system;
- if (my $commandline = $self->prefs->{pl}{commandline}) {
- $system = $commandline;
+ my $pl_commandline;
+ if ($self->prefs->{pl}) {
+ $pl_commandline = $self->prefs->{pl}{commandline};
+ }
+ if ($pl_commandline) {
+ $system = $pl_commandline;
$ENV{PERL} = $^X;
} elsif ($self->{'configure'}) {
$system = $self->{'configure'};
@@ -7498,7 +7857,7 @@ is part of the perl-%s distribution. To install that, you need to run
# $switch = "-MExtUtils::MakeMaker ".
# "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
# if $] > 5.00310;
- my $makepl_arg = $self->make_x_arg("pl");
+ my $makepl_arg = $self->_make_phase_arg("pl");
$ENV{PERL5_CPAN_IS_EXECUTING} = File::Spec->catfile($self->{build_dir},
"Makefile.PL");
$system = sprintf("%s%s Makefile.PL%s",
@@ -7507,9 +7866,13 @@ is part of the perl-%s distribution. To install that, you need to run
$makepl_arg ? " $makepl_arg" : "",
);
}
- if (my $env = $self->prefs->{pl}{env}) {
- for my $e (keys %$env) {
- $ENV{$e} = $env->{$e};
+ my $pl_env;
+ if ($self->prefs->{pl}) {
+ $pl_env = $self->prefs->{pl}{env};
+ }
+ if ($pl_env) {
+ for my $e (keys %$pl_env) {
+ $ENV{$e} = $pl_env->{$e};
}
}
if (exists $self->{writemakefile}) {
@@ -7580,7 +7943,7 @@ is part of the perl-%s distribution. To install that, you need to run
if (my $expect_model = $self->_prefs_with_expect("pl")) {
# XXX probably want to check _should_report here and warn
# about not being able to use CPAN::Reporter with expect
- $ret = $self->_run_via_expect($system,$expect_model);
+ $ret = $self->_run_via_expect($system,'writemakefile',$expect_model);
if (! defined $ret
&& $self->{writemakefile}
&& $self->{writemakefile}->failed) {
@@ -7608,42 +7971,31 @@ is part of the perl-%s distribution. To install that, you need to run
delete $self->{make_clean}; # if cleaned before, enable next
} else {
my $makefile = $self->{modulebuild} ? "Build" : "Makefile";
+ my $why = "No '$makefile' created";
+ $CPAN::Frontend->mywarn($why);
$self->{writemakefile} = CPAN::Distrostatus
- ->new(qq{NO -- No $makefile created});
+ ->new(qq{NO -- $why\n});
$self->store_persistent_state;
- return $self->goodbye("$system -- NO $makefile created");
+ return $self->goodbye("$system -- NOT OK");
}
}
if ($CPAN::Signal) {
delete $self->{force_update};
return;
}
- if (my @prereq = $self->unsat_prereq("later")) {
- if ($prereq[0][0] eq "perl") {
- my $need = "requires perl '$prereq[0][1]'";
- my $id = $self->pretty_id;
- $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
- $self->{make} = CPAN::Distrostatus->new("NO $need");
- $self->store_persistent_state;
- return $self->goodbye("[prereq] -- NOT OK");
- } else {
- my $follow = eval { $self->follow_prereqs("later",@prereq); };
- if (0) {
- } elsif ($follow) {
- # signal success to the queuerunner
- return 1;
- } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
- $CPAN::Frontend->mywarn($@);
- return $self->goodbye("[depend] -- NOT OK");
- }
- }
- }
+ my $wait_for_prereqs = eval { $self->satisfy_requires };
+ return 1 if $wait_for_prereqs; # tells queuerunner to continue
+ return $self->goodbye($@) if $@; # tells queuerunner to stop
if ($CPAN::Signal) {
delete $self->{force_update};
return;
}
- if (my $commandline = $self->prefs->{make}{commandline}) {
- $system = $commandline;
+ my $make_commandline;
+ if ($self->prefs->{make}) {
+ $make_commandline = $self->prefs->{make}{commandline};
+ }
+ if ($make_commandline) {
+ $system = $make_commandline;
$ENV{PERL} = CPAN::find_perl;
} else {
if ($self->{modulebuild}) {
@@ -7658,18 +8010,20 @@ is part of the perl-%s distribution. To install that, you need to run
$system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
}
$system =~ s/\s+$//;
- my $make_arg = $self->make_x_arg("make");
+ my $make_arg = $self->_make_phase_arg("make");
$system = sprintf("%s%s",
$system,
$make_arg ? " $make_arg" : "",
);
}
- if (my $env = $self->prefs->{make}{env}) { # overriding the local
- # ENV of PL, not the
- # outer ENV, but
- # unlikely to be a risk
- for my $e (keys %$env) {
- $ENV{$e} = $env->{$e};
+ my $make_env;
+ if ($self->prefs->{make}) {
+ $make_env = $self->prefs->{make}{env};
+ }
+ if ($make_env) { # overriding the local ENV of PL, not the outer
+ # ENV, but unlikely to be a risk
+ for my $e (keys %$make_env) {
+ $ENV{$e} = $make_env->{$e};
}
}
my $expect_model = $self->_prefs_with_expect("make");
@@ -7687,7 +8041,7 @@ is part of the perl-%s distribution. To install that, you need to run
if ($want_expect) {
# XXX probably want to check _should_report here and
# warn about not being able to use CPAN::Reporter with expect
- $system_ok = $self->_run_via_expect($system,$expect_model) == 0;
+ $system_ok = $self->_run_via_expect($system,'make',$expect_model) == 0;
}
elsif ( $self->_should_report('make') ) {
my ($output, $ret) = CPAN::Reporter::record_command($system);
@@ -7719,16 +8073,16 @@ sub goodbye {
# CPAN::Distribution::_run_via_expect ;
sub _run_via_expect {
- my($self,$system,$expect_model) = @_;
+ my($self,$system,$phase,$expect_model) = @_;
CPAN->debug("system[$system]expect_model[$expect_model]") if $CPAN::DEBUG;
if ($CPAN::META->has_inst("Expect")) {
my $expo = Expect->new; # expo Expect object;
$expo->spawn($system);
$expect_model->{mode} ||= "deterministic";
if ($expect_model->{mode} eq "deterministic") {
- return $self->_run_via_expect_deterministic($expo,$expect_model);
+ return $self->_run_via_expect_deterministic($expo,$phase,$expect_model);
} elsif ($expect_model->{mode} eq "anyorder") {
- return $self->_run_via_expect_anyorder($expo,$expect_model);
+ return $self->_run_via_expect_anyorder($expo,$phase,$expect_model);
} else {
die "Panic: Illegal expect mode: $expect_model->{mode}";
}
@@ -7739,14 +8093,20 @@ sub _run_via_expect {
}
sub _run_via_expect_anyorder {
- my($self,$expo,$expect_model) = @_;
+ my($self,$expo,$phase,$expect_model) = @_;
my $timeout = $expect_model->{timeout} || 5;
my $reuse = $expect_model->{reuse};
my @expectacopy = @{$expect_model->{talk}}; # we trash it!
my $but = "";
+ my $timeout_start = time;
EXPECT: while () {
my($eof,$ran_into_timeout);
- my @match = $expo->expect($timeout,
+ # XXX not up to the full power of expect. one could certainly
+ # wrap all of the talk pairs into a single expect call and on
+ # success tweak it and step ahead to the next question. The
+ # current implementation unnecessarily limits itself to a
+ # single match.
+ my @match = $expo->expect(1,
[ eof => sub {
$eof++;
} ],
@@ -7776,18 +8136,24 @@ sub _run_via_expect_anyorder {
next EXPECT;
}
}
+ my $have_waited = time - $timeout_start;
+ if ($have_waited < $timeout) {
+ # warn "DEBUG: have_waited[$have_waited]timeout[$timeout]";
+ next EXPECT;
+ }
my $why = "could not answer a question during the dialog";
$CPAN::Frontend->mywarn("Failing: $why\n");
- $self->{writemakefile} =
+ $self->{$phase} =
CPAN::Distrostatus->new("NO $why");
- return;
+ return 0;
}
}
}
sub _run_via_expect_deterministic {
- my($self,$expo,$expect_model) = @_;
+ my($self,$expo,$phase,$expect_model) = @_;
my $ran_into_timeout;
+ my $ran_into_eof;
my $timeout = $expect_model->{timeout} || 15; # currently unsettable
my $expecta = $expect_model->{talk};
EXPECT: for (my $i = 0; $i <= $#$expecta; $i+=2) {
@@ -7799,7 +8165,7 @@ sub _run_via_expect_deterministic {
my $but = $expo->clear_accum;
$CPAN::Frontend->mywarn("EOF (maybe harmless)
expected[$regex]\nbut[$but]\n\n");
- last EXPECT;
+ $ran_into_eof++;
} ],
[ timeout => sub {
my $but = $expo->clear_accum;
@@ -7810,9 +8176,11 @@ expected[$regex]\nbut[$but]\n\n");
-re => $regex);
if ($ran_into_timeout) {
# note that the caller expects 0 for success
- $self->{writemakefile} =
+ $self->{$phase} =
CPAN::Distrostatus->new("NO timeout during expect dialog");
- return;
+ return 0;
+ } elsif ($ran_into_eof) {
+ last EXPECT;
}
$expo->send($send);
}
@@ -7849,18 +8217,17 @@ sub _find_prefs {
$CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
}
my $yaml_module = CPAN::_yaml_module;
+ my $ext_map = {};
my @extensions;
if ($CPAN::META->has_inst($yaml_module)) {
- push @extensions, "yml";
+ $ext_map->{yml} = 'CPAN';
} else {
my @fallbacks;
if ($CPAN::META->has_inst("Data::Dumper")) {
- push @extensions, "dd";
- push @fallbacks, "Data::Dumper";
+ push @fallbacks, $ext_map->{dd} = 'Data::Dumper';
}
if ($CPAN::META->has_inst("Storable")) {
- push @extensions, "st";
- push @fallbacks, "Storable";
+ push @fallbacks, $ext_map->{st} = 'Storable';
}
if (@fallbacks) {
local $" = " and ";
@@ -7875,118 +8242,55 @@ sub _find_prefs {
}
}
}
- if (@extensions) {
- my $dh = DirHandle->new($prefs_dir)
- or die Carp::croak("Couldn't open '$prefs_dir': $!");
- DIRENT: for (sort $dh->read) {
- next if $_ eq "." || $_ eq "..";
- my $exte = join "|", @extensions;
- next unless /\.($exte)$/;
- my $thisexte = $1;
- my $abs = File::Spec->catfile($prefs_dir, $_);
- if (-f $abs) {
- #CPAN->debug(sprintf "abs[%s]", $abs) if $CPAN::DEBUG;
- my @distropref;
- if ($thisexte eq "yml") {
- # need no eval because if we have no YAML we do not try to read *.yml
- #CPAN->debug(sprintf "before yaml load abs[%s]", $abs) if $CPAN::DEBUG;
- @distropref = @{CPAN->_yaml_loadfile($abs)};
- #CPAN->debug(sprintf "after yaml load abs[%s]", $abs) if $CPAN::DEBUG;
- } elsif ($thisexte eq "dd") {
- package CPAN::Eval;
- no strict;
- open FH, "<$abs" or $CPAN::Frontend->mydie("Could not open '$abs': $!");
- local $/;
- my $eval = <FH>;
- close FH;
- eval $eval;
- if ($@) {
- $CPAN::Frontend->mydie("Error in distroprefs file $_\: $@");
- }
- my $i = 1;
- while (${"VAR".$i}) {
- push @distropref, ${"VAR".$i};
- $i++;
- }
- } elsif ($thisexte eq "st") {
- # eval because Storable is never forward compatible
- eval { @distropref = @{scalar Storable::retrieve($abs)}; };
- if ($@) {
- $CPAN::Frontend->mywarn("Error reading distroprefs file ".
- "$_, skipping\: $@");
- $CPAN::Frontend->mysleep(4);
- next DIRENT;
- }
- }
- # $DB::single=1;
- #CPAN->debug(sprintf "#distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
- ELEMENT: for my $y (0..$#distropref) {
- my $distropref = $distropref[$y];
- $self->_validate_distropref($distropref,$abs,$y);
- my $match = $distropref->{match};
- unless ($match) {
- #CPAN->debug("no 'match' in abs[$abs], skipping") if $CPAN::DEBUG;
- next ELEMENT;
- }
- my $ok = 1;
- # do not take the order of C<keys %$match> because
- # "module" is by far the slowest
- my $saw_valid_subkeys = 0;
- for my $sub_attribute (qw(distribution perl perlconfig module)) {
- next unless exists $match->{$sub_attribute};
- $saw_valid_subkeys++;
- my $qr = eval "qr{$distropref->{match}{$sub_attribute}}";
- if ($sub_attribute eq "module") {
- my $okm = 0;
- #CPAN->debug(sprintf "distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
- my @modules = $self->containsmods;
- #CPAN->debug(sprintf "modules[%s]", join(",",@modules)) if $CPAN::DEBUG;
- MODULE: for my $module (@modules) {
- $okm ||= $module =~ /$qr/;
- last MODULE if $okm;
- }
- $ok &&= $okm;
- } elsif ($sub_attribute eq "distribution") {
- my $okd = $distroid =~ /$qr/;
- $ok &&= $okd;
- } elsif ($sub_attribute eq "perl") {
- my $okp = CPAN::find_perl =~ /$qr/;
- $ok &&= $okp;
- } elsif ($sub_attribute eq "perlconfig") {
- for my $perlconfigkey (keys %{$match->{perlconfig}}) {
- my $perlconfigval = $match->{perlconfig}->{$perlconfigkey};
- # XXX should probably warn if Config does not exist
- my $okpc = $Config::Config{$perlconfigkey} =~ /$perlconfigval/;
- $ok &&= $okpc;
- last if $ok == 0;
- }
- } else {
- $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
- "unknown sub_attribut '$sub_attribute'. ".
- "Please ".
- "remove, cannot continue.");
- }
- last if $ok == 0; # short circuit
- }
- unless ($saw_valid_subkeys) {
- $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
- "missing match/* subattribute. ".
- "Please ".
- "remove, cannot continue.");
- }
- #CPAN->debug(sprintf "ok[%d]", $ok) if $CPAN::DEBUG;
- if ($ok) {
- return {
- prefs => $distropref,
- prefs_file => $abs,
- prefs_file_doc => $y,
- };
- }
+ my $finder = CPAN::Distroprefs->find($prefs_dir, $ext_map);
+ DIRENT: while (my $result = $finder->next) {
+ if ($result->is_warning) {
+ $CPAN::Frontend->mywarn($result->as_string);
+ $CPAN::Frontend->mysleep(1);
+ next DIRENT;
+ } elsif ($result->is_fatal) {
+ $CPAN::Frontend->mydie($result->as_string);
+ }
- }
+ my @prefs = @{ $result->prefs };
+
+ ELEMENT: for my $y (0..$#prefs) {
+ my $pref = $prefs[$y];
+ $self->_validate_distropref($pref->data, $result->abs, $y);
+
+ # I don't know why we silently skip when there's no match, but
+ # complain if there's an empty match hashref, and there's no
+ # comment explaining why -- hdp, 2008-03-18
+ unless ($pref->has_any_match) {
+ next ELEMENT;
+ }
+
+ unless ($pref->has_valid_subkeys) {
+ $CPAN::Frontend->mydie(sprintf
+ "Nonconforming .%s file '%s': " .
+ "missing match/* subattribute. " .
+ "Please remove, cannot continue.",
+ $result->ext, $result->abs,
+ );
+ }
+
+ my $arg = {
+ env => \%ENV,
+ distribution => $distroid,
+ perl => \&CPAN::find_perl,
+ perlconfig => \%Config::Config,
+ module => sub { [ $self->containsmods ] },
+ };
+
+ if ($pref->matches($arg)) {
+ return {
+ prefs => $pref->data,
+ prefs_file => $result->abs,
+ prefs_file_doc => $y,
+ };
}
+
}
- $dh->close;
}
return;
}
@@ -8034,25 +8338,50 @@ $filler2 $bs $filler2
return $self->{prefs} = +{};
}
-# CPAN::Distribution::make_x_arg
-sub make_x_arg {
- my($self, $whixh) = @_;
- my $make_x_arg;
+# CPAN::Distribution::_make_phase_arg
+sub _make_phase_arg {
+ my($self, $phase) = @_;
+ my $_make_phase_arg;
my $prefs = $self->prefs;
if (
$prefs
- && exists $prefs->{$whixh}
- && exists $prefs->{$whixh}{args}
- && $prefs->{$whixh}{args}
+ && exists $prefs->{$phase}
+ && exists $prefs->{$phase}{args}
+ && $prefs->{$phase}{args}
) {
- $make_x_arg = join(" ",
+ $_make_phase_arg = join(" ",
map {CPAN::HandleConfig
- ->safe_quote($_)} @{$prefs->{$whixh}{args}},
+ ->safe_quote($_)} @{$prefs->{$phase}{args}},
);
}
- my $what = sprintf "make%s_arg", $whixh eq "make" ? "" : $whixh;
- $make_x_arg ||= $CPAN::Config->{$what};
- return $make_x_arg;
+
+# cpan[2]> o conf make[TAB]
+# make make_install_make_command
+# make_arg makepl_arg
+# make_install_arg
+# cpan[2]> o conf mbuild[TAB]
+# mbuild_arg mbuild_install_build_command
+# mbuild_install_arg mbuildpl_arg
+
+ my $mantra; # must switch make/mbuild here
+ if ($self->{modulebuild}) {
+ $mantra = "mbuild";
+ } else {
+ $mantra = "make";
+ }
+ my %map = (
+ pl => "pl_arg",
+ make => "_arg",
+ test => "_test_arg", # does not really exist but maybe
+ # will some day and now protects
+ # us from unini warnings
+ install => "_install_arg",
+ );
+ my $phase_underscore_meshup = $map{$phase};
+ my $what = sprintf "%s%s", $mantra, $phase_underscore_meshup;
+
+ $_make_phase_arg ||= $CPAN::Config->{$what};
+ return $_make_phase_arg;
}
# CPAN::Distribution::_make_command
@@ -8085,7 +8414,12 @@ sub follow_prereqs {
my($slot) = shift;
my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
return unless @prereq_tuples;
- my @prereq = map { $_->[0] } @prereq_tuples;
+ my(@good_prereq_tuples);
+ for my $p (@prereq_tuples) {
+ # XXX watch out for foul ones
+ # $DB::single++;
+ push @good_prereq_tuples, $p;
+ }
my $pretty_id = $self->pretty_id;
my %map = (
b => "build_requires",
@@ -8093,7 +8427,6 @@ sub follow_prereqs {
c => "commandline",
);
my($filler1,$filler2,$filler3,$filler4);
- # $DB::single=1;
my $unsat = "Unsatisfied dependencies detected during";
my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id);
{
@@ -8111,7 +8444,7 @@ sub follow_prereqs {
$CPAN::Frontend->
myprint("$filler1 $unsat $filler2".
"$filler3 $pretty_id $filler4".
- join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @prereq_tuples),
+ join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @good_prereq_tuples),
);
my $follow = 0;
if ($CPAN::Config->{prerequisites_policy} eq "follow") {
@@ -8122,6 +8455,7 @@ sub follow_prereqs {
of modules we are processing right now?", "yes");
$follow = $answer =~ /^\s*y/i;
} else {
+ my @prereq = map { $_=>[0] } @good_prereq_tuples;
local($") = ", ";
$CPAN::Frontend->
myprint(" Ignoring dependencies on modules @prereq\n");
@@ -8129,8 +8463,9 @@ of modules we are processing right now?", "yes");
if ($follow) {
my $id = $self->id;
# color them as dirty
- for my $p (@prereq) {
+ for my $gp (@good_prereq_tuples) {
# warn "calling color_cmd_tmps(0,1)";
+ my $p = $gp->[0];
my $any = CPAN::Shell->expandany($p);
$self->{$slot . "_for"}{$any->id}++;
if ($any) {
@@ -8142,31 +8477,80 @@ of modules we are processing right now?", "yes");
}
# queue them and re-queue yourself
CPAN::Queue->jumpqueue({qmod => $id, reqtype => $self->{reqtype}},
- map {+{qmod=>$_->[0],reqtype=>$_->[1]}} reverse @prereq_tuples);
+ map {+{qmod=>$_->[0],reqtype=>$_->[1]}} reverse @good_prereq_tuples);
$self->{$slot} = "Delayed until after prerequisites";
return 1; # signal success to the queuerunner
}
return;
}
+sub _feature_depends {
+ my($self) = @_;
+ my $meta_yml = $self->parse_meta_yml();
+ my $optf = $meta_yml->{optional_features} or return;
+ if (!ref $optf or ref $optf ne "HASH"){
+ $CPAN::Frontend->mywarn("The content of optional_features is not a HASH reference. Cannot use it.\n");
+ $optf = {};
+ }
+ my $wantf = $self->prefs->{features} or return;
+ if (!ref $wantf or ref $wantf ne "ARRAY"){
+ $CPAN::Frontend->mywarn("The content of 'features' is not an ARRAY reference. Cannot use it.\n");
+ $wantf = [];
+ }
+ my $dep = +{};
+ for my $wf (@$wantf) {
+ if (my $f = $optf->{$wf}) {
+ $CPAN::Frontend->myprint("Found the demanded feature '$wf' that ".
+ "is accompanied by this description:\n".
+ $f->{description}.
+ "\n\n"
+ );
+ # configure_requires currently not in the spec, unlikely to be useful anyway
+ for my $reqtype (qw(configure_requires build_requires requires)) {
+ my $reqhash = $f->{$reqtype} or next;
+ while (my($k,$v) = each %$reqhash) {
+ $dep->{$reqtype}{$k} = $v;
+ }
+ }
+ } else {
+ $CPAN::Frontend->mywarn("The demanded feature '$wf' was not ".
+ "found in the META.yml file".
+ "\n\n"
+ );
+ }
+ }
+ $dep;
+}
+
#-> sub CPAN::Distribution::unsat_prereq ;
-# return ([Foo=>1],[Bar=>1.2]) for normal modules
+# return ([Foo,"r"],[Bar,"b"]) for normal modules
# return ([perl=>5.008]) if we need a newer perl than we are running under
+# (sorry for the inconsistency, it was an accident)
sub unsat_prereq {
my($self,$slot) = @_;
my(%merged,$prereq_pm);
my $prefs_depends = $self->prefs->{depends}||{};
+ my $feature_depends = $self->_feature_depends();
if ($slot eq "configure_requires_later") {
my $meta_yml = $self->parse_meta_yml();
- %merged = (%{$meta_yml->{configure_requires}||{}},
- %{$prefs_depends->{configure_requires}||{}});
+ if (defined $meta_yml && (! ref $meta_yml || ref $meta_yml ne "HASH")) {
+ $CPAN::Frontend->mywarn("The content of META.yml is defined but not a HASH reference. Cannot use it.\n");
+ $meta_yml = +{};
+ }
+ %merged = (
+ %{$meta_yml->{configure_requires}||{}},
+ %{$prefs_depends->{configure_requires}||{}},
+ %{$feature_depends->{configure_requires}||{}},
+ );
$prereq_pm = {}; # configure_requires defined as "b"
} elsif ($slot eq "later") {
my $prereq_pm_0 = $self->prereq_pm || {};
for my $reqtype (qw(requires build_requires)) {
$prereq_pm->{$reqtype} = {%{$prereq_pm_0->{$reqtype}||{}}}; # copy to not pollute it
- for my $k (keys %{$prefs_depends->{$reqtype}||{}}) {
- $prereq_pm->{$reqtype}{$k} = $prefs_depends->{$reqtype}{$k};
+ for my $dep ($prefs_depends,$feature_depends) {
+ for my $k (keys %{$dep->{$reqtype}||{}}) {
+ $prereq_pm->{$reqtype}{$k} = $dep->{$reqtype}{$k};
+ }
}
}
%merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
@@ -8203,44 +8587,9 @@ sub unsat_prereq {
# or if the installed version is too old. We cannot omit this
# check, because if 'force' is in effect, nobody else will check.
if (defined $available_file) {
- my(@all_requirements) = split /\s*,\s*/, $need_version;
- local($^W) = 0;
- my $ok = 0;
- RQ: for my $rq (@all_requirements) {
- if ($rq =~ s|>=\s*||) {
- } elsif ($rq =~ s|>\s*||) {
- # 2005-12: one user
- if (CPAN::Version->vgt($available_version,$rq)) {
- $ok++;
- }
- next RQ;
- } elsif ($rq =~ s|!=\s*||) {
- # 2005-12: no user
- if (CPAN::Version->vcmp($available_version,$rq)) {
- $ok++;
- next RQ;
- } else {
- last RQ;
- }
- } elsif ($rq =~ m|<=?\s*|) {
- # 2005-12: no user
- $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])\n");
- $ok++;
- next RQ;
- }
- if (! CPAN::Version->vgt($rq, $available_version)) {
- $ok++;
- }
- CPAN->debug(sprintf("need_module[%s]available_file[%s]".
- "available_version[%s]rq[%s]ok[%d]",
- $need_module,
- $available_file,
- $available_version,
- CPAN::Version->readable($rq),
- $ok,
- )) if $CPAN::DEBUG;
- }
- next NEED if $ok == @all_requirements;
+ my $fulfills_all_version_rqs = $self->_fulfills_all_version_rqs
+ ($need_module,$available_file,$available_version,$need_version);
+ next NEED if $fulfills_all_version_rqs;
}
if ($need_module eq "perl") {
@@ -8248,7 +8597,7 @@ sub unsat_prereq {
}
$self->{sponsored_mods}{$need_module} ||= 0;
CPAN->debug("need_module[$need_module]s/s/n[$self->{sponsored_mods}{$need_module}]") if $CPAN::DEBUG;
- if ($self->{sponsored_mods}{$need_module}++) {
+ if (my $sponsoring = $self->{sponsored_mods}{$need_module}++) {
# We have already sponsored it and for some reason it's still
# not available. So we do ... what??
@@ -8297,6 +8646,8 @@ sub unsat_prereq {
"make_clean",
) {
if ($do->{$nosayer}) {
+ my $selfid = $self->pretty_id;
+ my $did = $do->pretty_id;
if (UNIVERSAL::can($do->{$nosayer},"failed") ?
$do->{$nosayer}->failed :
$do->{$nosayer} =~ /^NO/) {
@@ -8308,22 +8659,24 @@ sub unsat_prereq {
}
$CPAN::Frontend->mywarn("Warning: Prerequisite ".
"'$need_module => $need_version' ".
- "for '$self->{ID}' failed when ".
- "processing '$do->{ID}' with ".
+ "for '$selfid' failed when ".
+ "processing '$did' with ".
"'$nosayer => $do->{$nosayer}'. Continuing, ".
"but chances to succeed are limited.\n"
);
+ $CPAN::Frontend->mysleep($sponsoring/10);
next NEED;
} else { # the other guy succeeded
- if ($nosayer eq "install") {
+ if ($nosayer =~ /^(install|make_test)$/) {
# we had this with
# DMAKI/DateTime-Calendar-Chinese-0.05.tar.gz
- # 2007-03
+ # in 2007-03 for 'make install'
+ # and 2008-04: #30464 (for 'make test')
$CPAN::Frontend->mywarn("Warning: Prerequisite ".
"'$need_module => $need_version' ".
- "for '$self->{ID}' already installed ".
- "but installation looks suspicious. ".
- "Skipping another installation attempt, ".
+ "for '$selfid' already built ".
+ "but the result looks suspicious. ".
+ "Skipping another build attempt, ".
"to prevent looping endlessly.\n"
);
next NEED;
@@ -8340,11 +8693,58 @@ sub unsat_prereq {
@need;
}
+sub _fulfills_all_version_rqs {
+ my($self,$need_module,$available_file,$available_version,$need_version) = @_;
+ my(@all_requirements) = split /\s*,\s*/, $need_version;
+ local($^W) = 0;
+ my $ok = 0;
+ RQ: for my $rq (@all_requirements) {
+ if ($rq =~ s|>=\s*||) {
+ } elsif ($rq =~ s|>\s*||) {
+ # 2005-12: one user
+ if (CPAN::Version->vgt($available_version,$rq)) {
+ $ok++;
+ }
+ next RQ;
+ } elsif ($rq =~ s|!=\s*||) {
+ # 2005-12: no user
+ if (CPAN::Version->vcmp($available_version,$rq)) {
+ $ok++;
+ next RQ;
+ } else {
+ last RQ;
+ }
+ } elsif ($rq =~ m|<=?\s*|) {
+ # 2005-12: no user
+ $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])\n");
+ $ok++;
+ next RQ;
+ }
+ if (! CPAN::Version->vgt($rq, $available_version)) {
+ $ok++;
+ }
+ CPAN->debug(sprintf("need_module[%s]available_file[%s]".
+ "available_version[%s]rq[%s]ok[%d]",
+ $need_module,
+ $available_file,
+ $available_version,
+ CPAN::Version->readable($rq),
+ $ok,
+ )) if $CPAN::DEBUG;
+ }
+ return $ok == @all_requirements;
+}
+
#-> sub CPAN::Distribution::read_yaml ;
sub read_yaml {
my($self) = @_;
return $self->{yaml_content} if exists $self->{yaml_content};
- my $build_dir = $self->{build_dir};
+ my $build_dir;
+ unless ($build_dir = $self->{build_dir}) {
+ # maybe permission on build_dir was missing
+ $CPAN::Frontend->mywarn("Warning: cannot determine META.yml without a build_dir.\n");
+ return;
+ }
my $yaml = File::Spec->catfile($build_dir,"META.yml");
$self->debug("yaml[$yaml]") if $CPAN::DEBUG;
return unless -f $yaml;
@@ -8358,6 +8758,12 @@ sub read_yaml {
# META.yml
}
# not "authoritative"
+ for ($self->{yaml_content}) {
+ if (defined $_ && (! ref $_ || ref $_ ne "HASH")) {
+ $CPAN::Frontend->mywarn("META.yml does not seem to be conforming, cannot use it.\n");
+ $self->{yaml_content} = +{};
+ }
+ }
if (not exists $self->{yaml_content}{dynamic_config}
or $self->{yaml_content}{dynamic_config}
) {
@@ -8377,6 +8783,9 @@ sub prereq_pm {
return unless $self->{writemakefile} # no need to have succeeded
# but we must have run it
|| $self->{modulebuild};
+ unless ($self->{build_dir}) {
+ return;
+ }
CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]",
$self->{writemakefile}||"",
$self->{modulebuild}||"",
@@ -8419,7 +8828,10 @@ sub prereq_pm {
}
}
unless ($req || $breq) {
- my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
+ my $build_dir;
+ unless ( $build_dir = $self->{build_dir} ) {
+ return;
+ }
my $makefile = File::Spec->catfile($build_dir,"Makefile");
my $fh;
if (-f $makefile
@@ -8502,6 +8914,7 @@ sub test {
return $self->goto($goto);
}
$self->make;
+ return if $self->prefs->{disabled} && ! $self->{force_update};
if ($CPAN::Signal) {
delete $self->{force_update};
return;
@@ -8518,6 +8931,7 @@ sub test {
? $ENV{PERL5LIB}
: ($ENV{PERLLIB} || "");
+ local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
$CPAN::META->set_perl5lib;
local $ENV{MAKEFLAGS}; # protect us from outer make calls
@@ -8564,6 +8978,11 @@ sub test {
}
} else {
push @e, "Has already been tested successfully";
+ # if global "is_tested" has been cleared, we need to mark this to
+ # be added to PERL5LIB if not already installed
+ if ($self->tested_ok_but_not_installed) {
+ $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
+ }
}
}
} elsif (!@e) {
@@ -8584,12 +9003,46 @@ sub test {
}
if ($self->{modulebuild}) {
- my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version;
+ my $thm = CPAN::Shell->expand("Module","Test::Harness");
+ my $v = $thm->inst_version;
if (CPAN::Version->vlt($v,2.62)) {
- $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
+ # XXX Eric Wilhelm reported this as a bug: klapperl:
+ # Test::Harness 3.0 self-tests, so that should be 'unless
+ # installing Test::Harness'
+ unless ($self->id eq $thm->distribution->id) {
+ $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
'$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
- $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
- return;
+ $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
+ return;
+ }
+ }
+ }
+
+ if ( ! $self->{force_update} ) {
+ # bypass actual tests if "trust_test_report_history" and have a report
+ my $have_tested_fcn;
+ if ( $CPAN::Config->{trust_test_report_history}
+ && $CPAN::META->has_inst("CPAN::Reporter::History")
+ && ( $have_tested_fcn = CPAN::Reporter::History->can("have_tested" ))) {
+ if ( my @reports = $have_tested_fcn->( dist => $self->base_id ) ) {
+ # Do nothing if grade was DISCARD
+ if ( $reports[-1]->{grade} =~ /^(?:PASS|UNKNOWN)$/ ) {
+ $self->{make_test} = CPAN::Distrostatus->new("YES");
+ # if global "is_tested" has been cleared, we need to mark this to
+ # be added to PERL5LIB if not already installed
+ if ($self->tested_ok_but_not_installed) {
+ $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
+ }
+ $CPAN::Frontend->myprint("Found prior test report -- OK\n");
+ return;
+ }
+ elsif ( $reports[-1]->{grade} =~ /^(?:FAIL|NA)$/ ) {
+ $self->{make_test} = CPAN::Distrostatus->new("NO");
+ $self->{badtestcnt}++;
+ $CPAN::Frontend->mywarn("Found prior test report -- NOT OK\n");
+ return;
+ }
+ }
}
}
@@ -8601,10 +9054,14 @@ sub test {
$ENV{PERL} = CPAN::find_perl;
} elsif ($self->{modulebuild}) {
$system = sprintf "%s test", $self->_build_command();
+ unless (-e "Build") {
+ my $id = $self->pretty_id;
+ $CPAN::Frontend->mywarn("Alert: no 'Build' file found while trying to test '$id'");
+ }
} else {
$system = join " ", $self->_make_command(), "test";
}
- my $make_test_arg = $self->make_x_arg("test");
+ my $make_test_arg = $self->_make_phase_arg("test");
$system = sprintf("%s%s",
$system,
$make_test_arg ? " $make_test_arg" : "",
@@ -8616,9 +9073,13 @@ sub test {
$env{$k} = $v;
}
local %ENV = %env;
- if (my $env = $self->prefs->{test}{env}) {
- for my $e (keys %$env) {
- $ENV{$e} = $env->{$e};
+ my $test_env;
+ if ($self->prefs->{test}) {
+ $test_env = $self->prefs->{test}{env};
+ }
+ if ($test_env) {
+ for my $e (keys %$test_env) {
+ $ENV{$e} = $test_env->{$e};
}
}
my $expect_model = $self->_prefs_with_expect("test");
@@ -8638,7 +9099,7 @@ sub test {
"not supported when distroprefs specify ".
"an interactive test\n");
}
- $tests_ok = $self->_run_via_expect($system,$expect_model) == 0;
+ $tests_ok = $self->_run_via_expect($system,'test',$expect_model) == 0;
} elsif ( $self->_should_report('test') ) {
$tests_ok = CPAN::Reporter::test($self, $system);
} else {
@@ -8975,8 +9436,10 @@ sub install {
? $ENV{PERL5LIB}
: ($ENV{PERLLIB} || "");
+ local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
$CPAN::META->set_perl5lib;
- my($pipe) = FileHandle->new("$system $stderr |");
+ my($pipe) = FileHandle->new("$system $stderr |") || Carp::croak
+("Can't execute $system: $!");
my($makeout) = "";
while (<$pipe>) {
print $_; # intentionally NOT use Frontend->myprint because it
@@ -9259,6 +9722,14 @@ sub _should_report {
return $self->{should_report}
if exists $self->{should_report};
+ # don't report if we generated a Makefile.PL
+ if ( $self->{had_no_makefile_pl} ) {
+ $CPAN::Frontend->mywarn(
+ "Will not send CPAN Testers report with generated Makefile.PL.\n"
+ );
+ return $self->{should_report} = 0;
+ }
+
# available
if ( ! $CPAN::META->has_inst("CPAN::Reporter")) {
$CPAN::Frontend->mywarn(
@@ -9489,8 +9960,8 @@ sub contains {
my $in_cont = 0;
$self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
while (<$fh>) {
- $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
- m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
+ $in_cont = m/^=(?!head1\s+(?i-xsm:CONTENTS))/ ? 0 :
+ m/^=head1\s+(?i-xsm:CONTENTS)/ ? 1 : $in_cont;
next unless $in_cont;
next if /^=/;
s/\#.*//;
@@ -9565,13 +10036,16 @@ sub inst_file {
$me[-1] .= ".pm";
my($incdir,$bestv);
foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
- my $bfile = File::Spec->catfile($incdir, @me);
- CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
- next unless -f $bfile;
- my $foundv = MM->parse_version($bfile);
- if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
- $self->{INST_FILE} = $bfile;
- $self->{INST_VERSION} = $bestv = $foundv;
+ my $parsefile = File::Spec->catfile($incdir, @me);
+ CPAN->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
+ next unless -f $parsefile;
+ my $have = eval { MM->parse_version($parsefile); };
+ if ($@) {
+ $CPAN::Frontend->mywarn("Error while parsing version number in file '$parsefile'\n");
+ }
+ if (!$bestv || CPAN::Version->vgt($have,$bestv)) {
+ $self->{INST_FILE} = $parsefile;
+ $self->{INST_VERSION} = $bestv = $have;
}
}
$self->{INST_FILE};
@@ -9687,6 +10161,21 @@ sub distribution {
CPAN::Shell->expand("Distribution",$self->cpan_file);
}
+#-> sub CPAN::Module::_is_representative_module
+sub _is_representative_module {
+ my($self) = @_;
+ return $self->{_is_representative_module} if defined $self->{_is_representative_module};
+ my $pm = $self->cpan_file or return $self->{_is_representative_module} = 0;
+ $pm =~ s|.+/||;
+ $pm =~ s{\.(?:tar\.(bz2|gz|Z)|t(?:gz|bz)|zip)$}{}i; # see base_id
+ $pm =~ s|-\d+\.\d+.+$||;
+ $pm =~ s|-[\d\.]+$||;
+ $pm =~ s/-/::/g;
+ $self->{_is_representative_module} = $pm eq $self->{ID} ? 1 : 0;
+ # warn "DEBUG: $pm eq $self->{ID} => $self->{_is_representative_module}";
+ $self->{_is_representative_module};
+}
+
#-> sub CPAN::Module::undelay
sub undelay {
my $self = shift;
@@ -9948,6 +10437,13 @@ sub as_string {
$local_file || "(not installed)");
push @m, sprintf($sprintf, 'INST_VERSION',
$self->inst_version) if $local_file;
+ if (%{$CPAN::META->{is_tested}||{}}) { # XXX needs to be methodified somehow
+ my $available_file = $self->available_file;
+ if ($available_file && $available_file ne $local_file) {
+ push @m, sprintf($sprintf, 'AVAILABLE_FILE', $available_file);
+ push @m, sprintf($sprintf, 'AVAILABLE_VERSION', $self->available_version);
+ }
+ }
join "", @m, "\n";
}
@@ -10176,7 +10672,7 @@ sub install {
});
$CPAN::Frontend->mysleep(5);
}
- $self->rematein('install') if $doit;
+ return $doit ? $self->rematein('install') : 1;
}
#-> sub CPAN::Module::clean ;
sub clean { shift->rematein('clean') }
@@ -10194,7 +10690,12 @@ sub available_file {
my $perllib = $ENV{PERL5LIB};
$perllib = $ENV{PERLLIB} unless defined $perllib;
my @perllib = split(/$sep/,$perllib) if defined $perllib;
- $self->_file_in_path([@perllib,@INC]);
+ my @cpan_perl5inc;
+ if ($CPAN::Perl5lib_tempfile) {
+ my $yaml = CPAN->_yaml_loadfile($CPAN::Perl5lib_tempfile);
+ @cpan_perl5inc = @{$yaml->[0]{inc} || []};
+ }
+ $self->_file_in_path([@cpan_perl5inc,@perllib,@INC]);
}
#-> sub CPAN::Module::file_in_path ;
@@ -10250,8 +10751,12 @@ sub available_version {
#-> sub CPAN::Module::parse_version ;
sub parse_version {
my($self,$parsefile) = @_;
- my $have = MM->parse_version($parsefile);
- $have = "undef" unless defined $have && length $have;
+ my $have = eval { MM->parse_version($parsefile); };
+ if ($@) {
+ $CPAN::Frontend->mywarn("Error while parsing version number in file '$parsefile'\n");
+ }
+ my $leastsanity = eval { defined $have && length $have; };
+ $have = "undef" unless $leastsanity;
$have =~ s/^ //; # since the %vd hack these two lines here are needed
$have =~ s/ $//; # trailing whitespace happens all the time
@@ -10383,6 +10888,44 @@ displayed with the rather verbose method C<as_string>, but if we find
more than one, we display each object with the terse method
C<as_glimpse>.
+Examples:
+
+ cpan> m Acme::MetaSyntactic
+ Module id = Acme::MetaSyntactic
+ CPAN_USERID BOOK (Philippe Bruhat (BooK) <[...]>)
+ CPAN_VERSION 0.99
+ CPAN_FILE B/BO/BOOK/Acme-MetaSyntactic-0.99.tar.gz
+ UPLOAD_DATE 2006-11-06
+ MANPAGE Acme::MetaSyntactic - Themed metasyntactic variables names
+ INST_FILE /usr/local/lib/perl/5.10.0/Acme/MetaSyntactic.pm
+ INST_VERSION 0.99
+ cpan> a BOOK
+ Author id = BOOK
+ EMAIL [...]
+ FULLNAME Philippe Bruhat (BooK)
+ cpan> d BOOK/Acme-MetaSyntactic-0.99.tar.gz
+ Distribution id = B/BO/BOOK/Acme-MetaSyntactic-0.99.tar.gz
+ CPAN_USERID BOOK (Philippe Bruhat (BooK) <[...]>)
+ CONTAINSMODS Acme::MetaSyntactic Acme::MetaSyntactic::Alias [...]
+ UPLOAD_DATE 2006-11-06
+ cpan> m /lorem/
+ Module = Acme::MetaSyntactic::loremipsum (BOOK/Acme-MetaSyntactic-0.99.tar.gz)
+ Module Text::Lorem (ADEOLA/Text-Lorem-0.3.tar.gz)
+ Module Text::Lorem::More (RKRIMEN/Text-Lorem-More-0.12.tar.gz)
+ Module Text::Lorem::More::Source (RKRIMEN/Text-Lorem-More-0.12.tar.gz)
+ cpan> i /berlin/
+ Distribution BEATNIK/Filter-NumberLines-0.02.tar.gz
+ Module = DateTime::TimeZone::Europe::Berlin (DROLSKY/DateTime-TimeZone-0.7904.tar.gz)
+ Module Filter::NumberLines (BEATNIK/Filter-NumberLines-0.02.tar.gz)
+ Author [...]
+
+The examples illustrate several aspects: the first three queries
+target modules, authors, or distros directly and yield exactly one
+result. The last two use regular expressions and yield several
+results. The last one targets all of bundles, modules, authors, and
+distros simultaneously. When more than one result is available, they
+are printed in one-line format.
+
=item C<get>, C<make>, C<test>, C<install>, C<clean> modules or distributions
These commands take any number of arguments and investigate what is
@@ -10574,7 +11117,7 @@ current item.
B<Note>: This command requires XML::LibXML installed.
-B<Note>: This whole command currently is a bit klunky and will
+B<Note>: This whole command currently is just a hack and will
probably change in future versions of CPAN.pm but the general
approach will likely stay.
@@ -10618,7 +11161,7 @@ provided by the C<recent> command and tests them all. While the
command is running $SIG{INT} is defined to mean that the current item
shall be skipped.
-B<Note>: This whole command currently is a bit klunky and will
+B<Note>: This whole command currently is just a hack and will
probably change in future versions of CPAN.pm but the general
approach will likely stay.
@@ -10699,6 +11242,13 @@ module or not.
The typical usage case is for private modules or working copies of
projects from remote repositories on the local disk.
+=head2 Redirection
+
+The usual shell redirection symbols C< | > and C<< > >> are recognized
+by the cpan shell when surrounded by whitespace. So piping into a
+pager and redirecting output into a file works quite similar to any
+shell.
+
=head1 CONFIGURATION
When the CPAN module is used for the first time, a configuration
@@ -10803,10 +11353,6 @@ defined:
only needed for building. yes|no|ask/yes|ask/no
bzip2 path to external prg
cache_metadata use serializer to cache metadata
- commands_quote prefered character to use for quoting external
- commands when running them. Defaults to double
- quote on Windows, single tick everywhere else;
- can be set to space to disable quoting
check_sigs if signatures should be verified
colorize_debug Term::ANSIColor attributes for debugging output
colorize_output boolean if Term::ANSIColor should colorize output
@@ -10814,6 +11360,13 @@ defined:
colorize_warn Term::ANSIColor attributes for warnings
commandnumber_in_prompt
boolean if you want to see current command number
+ commands_quote prefered character to use for quoting external
+ commands when running them. Defaults to double
+ quote on Windows, single tick everywhere else;
+ can be set to space to disable quoting
+ connect_to_internet_ok
+ if we shall ask if opening a connection is ok before
+ urllist is specified
cpan_home local directory reserved for this package
curl path to external prg
dontload_hash DEPRECATED
@@ -10822,9 +11375,13 @@ defined:
ftp path to external prg
ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
ftp_proxy proxy host for ftp requests
+ ftpstats_period max number of days to keep download statistics
+ ftpstats_size max number of items to keep in the download statistics
getcwd see below
gpg path to external prg
gzip location of external program gzip
+ halt_on_failure stop processing after the first failure of queued
+ items or dependencies
histfile file to maintain history between sessions
histsize maximum number of lines to keep in histfile
http_proxy proxy host for http requests
@@ -10857,6 +11414,7 @@ defined:
pager location of external program more (or any pager)
password your password if you CPAN server wants one
patch path to external prg
+ perl5lib_verbosity verbosity level for PERL5LIB additions
prefer_installer legal values are MB and EUMM: if a module comes
with both a Makefile.PL and a Build.PL, use the
former (EUMM) or the latter (MB); if the module
@@ -10881,13 +11439,16 @@ defined:
(and nonsense for characters outside latin range)
term_ornaments boolean to turn ReadLine ornamenting on/off
test_report email test reports (if CPAN::Reporter is installed)
+ trust_test_report_history
+ skip testing when previously tested ok (according to
+ CPAN::Reporter history)
unzip location of external program unzip
urllist arrayref to nearby CPAN sites (or equivalent locations)
use_sqlite use CPAN::SQLite for metadata storage (fast and lean)
username your username if you CPAN server wants one
wait_list arrayref to a wait server to try (See CPAN::WAIT)
wget path to external prg
- yaml_load_code enable YAML code deserialisation
+ yaml_load_code enable YAML code deserialisation via CPAN::DeferedCode
yaml_module which module to use to read/write YAML files
You can set and query each of these options interactively in the cpan
@@ -11137,6 +11698,8 @@ C<expect>.
perl: "/usr/local/cariba-perl/bin/perl"
perlconfig:
archname: "freebsd"
+ env:
+ DANCING_FLOOR: "Shubiduh"
disabled: 1
cpanconfig:
make: gmake
@@ -11223,6 +11786,13 @@ declaration.
Specifies that this distribution shall not be processed at all.
+=item features [array] *** EXPERIMENTAL FEATURE ***
+
+Experimental implementation to deal with optional_features from
+META.yml. Still needs coordination with installer software and
+currently only works for META.yml declaring C<dynamic_config=0>. Use
+with caution.
+
=item goto [string]
The canonical name of a delegate distribution that shall be installed
@@ -11233,18 +11803,18 @@ uploaded that is better than the last released version.
=item install [hash]
Processing instructions for the C<make install> or C<./Build install>
-phase of the CPAN mantra. See below under I<Processiong Instructions>.
+phase of the CPAN mantra. See below under I<Processing Instructions>.
=item make [hash]
Processing instructions for the C<make> or C<./Build> phase of the
-CPAN mantra. See below under I<Processiong Instructions>.
+CPAN mantra. See below under I<Processing Instructions>.
=item match [hash]
A hashref with one or more of the keys C<distribution>, C<modules>,
-C<perl>, and C<perlconfig> that specify if a document is targeted at a
-specific CPAN distribution or installation.
+C<perl>, C<perlconfig>, and C<env> that specify if a document is
+targeted at a specific CPAN distribution or installation.
The corresponding values are interpreted as regular expressions. The
C<distribution> related one will be matched against the canonical
@@ -11258,13 +11828,16 @@ absolute path).
The value associated with C<perlconfig> is itself a hashref that is
matched against corresponding values in the C<%Config::Config> hash
-living in the C< Config.pm > module.
+living in the C<Config.pm> module.
-If more than one restriction of C<module>, C<distribution>, and
-C<perl> is specified, the results of the separately computed match
-values must all match. If this is the case then the hashref
-represented by the YAML document is returned as the preference
-structure for the current distribution.
+The value associated with C<env> is itself a hashref that is
+matched against corresponding values in the C<%ENV> hash.
+
+If more than one restriction of C<module>, C<distribution>, etc. is
+specified, the results of the separately computed match values must
+all match. If this is the case then the hashref represented by the
+YAML document is returned as the preference structure for the current
+distribution.
=item patches [array]
@@ -11282,13 +11855,13 @@ distribution.
=item pl [hash]
Processing instructions for the C<perl Makefile.PL> or C<perl
-Build.PL> phase of the CPAN mantra. See below under I<Processiong
+Build.PL> phase of the CPAN mantra. See below under I<Processing
Instructions>.
=item test [hash]
Processing instructions for the C<make test> or C<./Build test> phase
-of the CPAN mantra. See below under I<Processiong Instructions>.
+of the CPAN mantra. See below under I<Processing Instructions>.
=back
@@ -11645,11 +12218,6 @@ Normally this is derived from the file name only, but the index from
CPAN can contain a hint to achieve a return value of true for other
filenames too.
-=item CPAN::Distribution::is_tested()
-
-List all the distributions that have been tested sucessfully but not
-yet installed. See also C<install_tested>.
-
=item CPAN::Distribution::look()
Changes to the directory where the distribution has been unpacked and
@@ -12498,7 +13066,8 @@ http://www.refcnt.org/papers/module-build-convert
=item 15)
-What's the best CPAN site for me?
+I'm frequently irritated with the CPAN shell's inability to help me
+select a good mirror.
The urllist config parameter is yours. You can add and remove sites at
will. You should find out which sites have the best uptodateness,
@@ -12510,6 +13079,14 @@ Henk P. Penning maintains a site that collects data about CPAN sites:
http://www.cs.uu.nl/people/henkp/mirmon/cpan.html
+Also, feel free to play with experimental features. Run
+
+ o conf init randomize_urllist ftpstats_period ftpstats_size
+
+and choose your favorite parameters. After a few downloads running the
+C<hosts> command will probably assist you in choosing the best mirror
+sites.
+
=item 16)
Why do I get asked the same questions every time I start the shell?
@@ -12519,6 +13096,26 @@ command C<o conf commit>. Alternatively set the C<auto_commit>
variable to true by running C<o conf init auto_commit> and answering
the following question with yes.
+=item 17)
+
+Older versions of CPAN.pm had the original root directory of all
+tarballs in the build directory. Now there are always random
+characters appended to these directory names. Why was this done?
+
+The random characters are provided by File::Temp and ensure that each
+module's individual build directory is unique. This makes running
+CPAN.pm in concurrent processes simultaneously safe.
+
+=item 18)
+
+Speaking of the build directory. Do I have to clean it up myself?
+
+You have the choice to set the config variable C<scan_cache> to
+C<never>. Then you must clean it up yourself. The other possible
+value, C<atstart> only cleans up the build directory when you start
+the CPAN shell. If you never start up the CPAN shell, you probably
+also have to clean up the build directory yourself.
+
=back
=head1 COMPATIBILITY
diff --git a/lib/CPAN/API/HOWTO.pm b/lib/CPAN/API/HOWTO.pod
index e65a4bc931..e65a4bc931 100644
--- a/lib/CPAN/API/HOWTO.pm
+++ b/lib/CPAN/API/HOWTO.pod
diff --git a/lib/CPAN/Debug.pm b/lib/CPAN/Debug.pm
index 086b623852..926b0d79b4 100644
--- a/lib/CPAN/Debug.pm
+++ b/lib/CPAN/Debug.pm
@@ -3,7 +3,7 @@ package CPAN::Debug;
use strict;
use vars qw($VERSION);
-$VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
+$VERSION = "5.5";
# module is internal to CPAN.pm
%CPAN::DEBUG = qw[
diff --git a/lib/CPAN/Distroprefs.pm b/lib/CPAN/Distroprefs.pm
new file mode 100644
index 0000000000..664ddb7622
--- /dev/null
+++ b/lib/CPAN/Distroprefs.pm
@@ -0,0 +1,413 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
+
+use strict;
+package CPAN::Distroprefs;
+
+use vars qw($VERSION);
+$VERSION = '6';
+
+package CPAN::Distroprefs::Result;
+
+use File::Spec;
+
+sub new { bless $_[1] || {} => $_[0] }
+
+sub abs { File::Spec->catfile($_[0]->dir, $_[0]->file) }
+
+sub __cloner {
+ my ($class, $name, $newclass) = @_;
+ $newclass = 'CPAN::Distroprefs::Result::' . $newclass;
+ no strict 'refs';
+ *{$class . '::' . $name} = sub {
+ $newclass->new({
+ %{ $_[0] },
+ %{ $_[1] },
+ });
+ };
+}
+BEGIN { __PACKAGE__->__cloner(as_warning => 'Warning') }
+BEGIN { __PACKAGE__->__cloner(as_fatal => 'Fatal') }
+BEGIN { __PACKAGE__->__cloner(as_success => 'Success') }
+
+sub __accessor {
+ my ($class, $key) = @_;
+ no strict 'refs';
+ *{$class . '::' . $key} = sub { $_[0]->{$key} };
+}
+BEGIN { __PACKAGE__->__accessor($_) for qw(type file ext dir) }
+
+sub is_warning { 0 }
+sub is_fatal { 0 }
+sub is_success { 0 }
+
+package CPAN::Distroprefs::Result::Error;
+use vars qw(@ISA);
+BEGIN { @ISA = 'CPAN::Distroprefs::Result' }
+BEGIN { __PACKAGE__->__accessor($_) for qw(msg) }
+
+sub as_string {
+ my ($self) = @_;
+ if ($self->msg) {
+ return sprintf $self->fmt_reason, $self->file, $self->msg;
+ } else {
+ return sprintf $self->fmt_unknown, $self->file;
+ }
+}
+
+package CPAN::Distroprefs::Result::Warning;
+use vars qw(@ISA);
+BEGIN { @ISA = 'CPAN::Distroprefs::Result::Error' }
+sub is_warning { 1 }
+sub fmt_reason { "Error reading distroprefs file %s, skipping: %s" }
+sub fmt_unknown { "Unknown error reading distroprefs file %s, skipping." }
+
+package CPAN::Distroprefs::Result::Fatal;
+use vars qw(@ISA);
+BEGIN { @ISA = 'CPAN::Distroprefs::Result::Error' }
+sub is_fatal { 1 }
+sub fmt_reason { "Error reading distroprefs file %s: %s" }
+sub fmt_unknown { "Unknown error reading distroprefs file %s." }
+
+package CPAN::Distroprefs::Result::Success;
+use vars qw(@ISA);
+BEGIN { @ISA = 'CPAN::Distroprefs::Result' }
+BEGIN { __PACKAGE__->__accessor($_) for qw(prefs extension) }
+sub is_success { 1 }
+
+package CPAN::Distroprefs::Iterator;
+
+sub new { bless $_[1] => $_[0] }
+
+sub next { $_[0]->() }
+
+package CPAN::Distroprefs;
+
+use Carp ();
+use DirHandle;
+
+sub _load_method {
+ my ($self, $loader, $result) = @_;
+ return '_load_yaml' if $loader eq 'CPAN' or $loader =~ /^YAML(::|$)/;
+ return '_load_' . $result->ext;
+}
+
+sub _load_yaml {
+ my ($self, $loader, $result) = @_;
+ my $data = eval {
+ $loader eq 'CPAN'
+ ? $loader->_yaml_loadfile($result->abs)
+ : [ $loader->can('LoadFile')->($result->abs) ]
+ };
+ if (my $err = $@) {
+ die $result->as_warning({
+ msg => $err,
+ });
+ } elsif (!$data) {
+ die $result->as_warning;
+ } else {
+ return @$data;
+ }
+}
+
+sub _load_dd {
+ my ($self, $loader, $result) = @_;
+ my @data;
+ {
+ package CPAN::Eval;
+ # this caused a die in CPAN.pm, and I am leaving it 'fatal', though I'm
+ # not sure why we wouldn't just skip the file as we do for all other
+ # errors. -- hdp
+ my $abs = $result->abs;
+ open FH, "<$abs" or die $result->as_fatal(msg => "$!");
+ local $/;
+ my $eval = <FH>;
+ close FH;
+ no strict;
+ eval $eval;
+ if (my $err = $@) {
+ die $result->as_warning({ msg => $err });
+ }
+ my $i = 1;
+ while (${"VAR$i"}) {
+ push @data, ${"VAR$i"};
+ $i++;
+ }
+ }
+ return @data;
+}
+
+sub _load_st {
+ my ($self, $loader, $result) = @_;
+ # eval because Storable is never forward compatible
+ my @data = eval { @{scalar $loader->can('retrieve')->($result->abs) } };
+ if (my $err = $@) {
+ die $result->as_warning({ msg => $err });
+ }
+ return @data;
+}
+
+sub find {
+ my ($self, $dir, $ext_map) = @_;
+
+ my $dh = DirHandle->new($dir) or Carp::croak("Couldn't open '$dir': $!");
+ my @files = sort $dh->read;
+
+ # label the block so that we can use redo in the middle
+ return CPAN::Distroprefs::Iterator->new(sub { LOOP: {
+ return unless %$ext_map;
+
+ local $_ = shift @files;
+ return unless defined;
+ redo if $_ eq '.' || $_ eq '..';
+
+ my $possible_ext = join "|", map { quotemeta } keys %$ext_map;
+ my ($ext) = /\.($possible_ext)$/ or redo;
+ my $loader = $ext_map->{$ext};
+
+ my $result = CPAN::Distroprefs::Result->new({
+ file => $_, ext => $ext, dir => $dir
+ });
+ # copied from CPAN.pm; is this ever actually possible?
+ redo unless -f $result->abs;
+
+ my $load_method = $self->_load_method($loader, $result);
+ my @prefs = eval { $self->$load_method($loader, $result) };
+ if (my $err = $@) {
+ if (ref($err) && eval { $err->isa('CPAN::Distroprefs::Result') }) {
+ return $err;
+ }
+ # rethrow any exceptions that we did not generate
+ die $err;
+ } elsif (!@prefs) {
+ # the loader should have handled this, but just in case:
+ return $result->as_warning;
+ }
+ return $result->as_success({
+ prefs => [
+ map { CPAN::Distroprefs::Pref->new({ data => $_ }) } @prefs
+ ],
+ });
+ } });
+}
+
+package CPAN::Distroprefs::Pref;
+
+use Carp ();
+
+sub new { bless $_[1] => $_[0] }
+
+sub data { shift->{data} }
+
+sub has_any_match { $_[0]->data->{match} ? 1 : 0 }
+
+sub has_match { exists $_[0]->data->{match}{$_[1]} }
+
+sub has_valid_subkeys {
+ grep { exists $_[0]->data->{match}{$_} }
+ $_[0]->match_attributes
+}
+
+sub _pattern {
+ my ($self, $key) = @_;
+ return eval sprintf 'qr{%s}', $self->data->{match}{$key};
+}
+
+sub _scalar_match {
+ my ($self, $key, $data) = @_;
+ my $qr = $self->_pattern($key);
+ return $data =~ /$qr/ ? 1 : 0;
+}
+
+sub _hash_match {
+ my ($self, $key, $data) = @_;
+ my $match = $self->data->{match}{$key};
+ for my $mkey (keys %$match) {
+ my $val = defined $data->{$mkey} ? $data->{$mkey} : '';
+ my $qr = eval sprintf 'qr{%s}', $match->{$mkey};
+ return 0 unless $val =~ /$qr/;
+ }
+ return 1;
+}
+
+# do not take the order of C<keys %$match> because "module" is by far the
+# slowest
+sub match_attributes { qw(env distribution perl perlconfig module) }
+
+sub match_module {
+ my ($self, $modules) = @_;
+ my $qr = $self->_pattern('module');
+ for my $module (@$modules) {
+ return 1 if $module =~ /$qr/;
+ }
+ return 0;
+}
+
+sub match_distribution { shift->_scalar_match(distribution => @_) }
+sub match_perl { shift->_scalar_match(perl => @_) }
+
+sub match_perlconfig { shift->_hash_match(perlconfig => @_) }
+sub match_env { shift->_hash_match(env => @_) }
+
+sub matches {
+ my ($self, $arg) = @_;
+
+ my $default_match = 0;
+ for my $key (grep { $self->has_match($_) } $self->match_attributes) {
+ unless (exists $arg->{$key}) {
+ Carp::croak "Can't match pref: missing argument key $key";
+ }
+ $default_match = 1;
+ my $val = $arg->{$key};
+ # make it possible to avoid computing things until we have to
+ if (ref($val) eq 'CODE') { $val = $val->() }
+ my $meth = "match_$key";
+ return 0 unless $self->$meth($val);
+ }
+
+ return $default_match;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+CPAN::Distroprefs -- read and match distroprefs
+
+=head1 SYNOPSIS
+
+ use CPAN::Distroprefs;
+
+ my %info = (... distribution/environment info ...);
+
+ my $finder = CPAN::Distroprefs->find($prefs_dir, \%ext_map);
+
+ while (my $result = $finder->next) {
+
+ die $result->as_string if $result->is_fatal;
+
+ warn $result->as_string, next if $result->is_warning;
+
+ for my $pref (@{ $result->prefs }) {
+ if ($pref->matches(\%info)) {
+ return $pref;
+ }
+ }
+ }
+
+
+=head1 DESCRIPTION
+
+This module encapsulates reading L<Distroprefs|CPAN> and matching them against CPAN distributions.
+
+=head1 INTERFACE
+
+ my $finder = CPAN::Distroprefs->find($dir, \%ext_map);
+
+ while (my $result = $finder->next) { ... }
+
+Build an iterator which finds distroprefs files in the given directory.
+
+C<%ext_map> is a hashref whose keys are file extensions and whose values are
+modules used to load matching files:
+
+ {
+ 'yml' => 'YAML::Syck',
+ 'dd' => 'Data::Dumper',
+ ...
+ }
+
+Each time C<< $finder->next >> is called, the iterator returns one of two
+possible values:
+
+=over
+
+=item * a CPAN::Distroprefs::Result object
+
+=item * C<undef>, indicating that no prefs files remain to be found
+
+=back
+
+=head1 RESULTS
+
+L<C<find()>|/INTERFACE> returns CPAN::Distroprefs::Result objects to
+indicate success or failure when reading a prefs file.
+
+=head2 Common
+
+All results share some common attributes:
+
+=head3 type
+
+C<success>, C<warning>, or C<fatal>
+
+=head3 file
+
+the file from which these prefs were read, or to which this error refers (relative filename)
+
+=head3 ext
+
+the file's extension, which determines how to load it
+
+=head3 dir
+
+the directory the file was read from
+
+=head3 abs
+
+the absolute path to the file
+
+=head2 Errors
+
+Error results (warning and fatal) contain:
+
+=head3 msg
+
+the error message (usually either C<$!> or a YAML error)
+
+=head2 Successes
+
+Success results contain:
+
+=head3 prefs
+
+an arrayref of CPAN::Distroprefs::Pref objects
+
+=head1 PREFS
+
+CPAN::Distroprefs::Pref objects represent individual distroprefs documents.
+They are constructed automatically as part of C<success> results from C<find()>.
+
+=head3 data
+
+the pref information as a hashref, suitable for e.g. passing to Kwalify
+
+=head3 match_attributes
+
+returns a list of the valid match attributes (see the Distroprefs section in L<CPAN>)
+
+currently: C<env perl perlconfig distribution module>
+
+=head3 has_any_match
+
+true if this pref has a 'match' attribute at all
+
+=head3 has_valid_subkeys
+
+true if this pref has a 'match' attribute and at least one valid match attribute
+
+=head3 matches
+
+ if ($pref->matches(\%arg)) { ... }
+
+true if this pref matches the passed-in hashref, which must have a value for
+each of the C<match_attributes> (above)
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm
index d5d3e21763..9a79b5a741 100644
--- a/lib/CPAN/FirstTime.pm
+++ b/lib/CPAN/FirstTime.pm
@@ -19,7 +19,7 @@ use File::Basename ();
use File::Path ();
use File::Spec ();
use vars qw($VERSION $urllist);
-$VERSION = sprintf "%.6f", substr(q$Rev: 2229 $,4)/1000000 + 5.4;
+$VERSION = "5.5";
=head1 NAME
@@ -160,11 +160,38 @@ for easier tracking of the session or be a plain string.
Do you want the command number in the prompt (yes/no)?
+=item connect_to_internet_ok
+
+If you have never defined your own C<urllist> in your configuration
+then C<CPAN.pm> will be hesitant to use the built in default sites for
+downloading. It will ask you once per session if a connection to the
+internet is OK and only if you say yes, it will try to connect. But to
+avoid this question, you can choose your favorite download sites once
+and get away with it. Or, if you have no favorite download sites
+answer yes to the following question.
+
+If no urllist has been chosen yet, would you prefer CPAN.pm to connect
+to the built-in default sites without asking? (yes/no)?
+
=item ftp_passive
Shall we always set the FTP_PASSIVE environment variable when dealing
with ftp download (yes/no)?
+=item ftpstats_period
+
+Statistics about downloads are truncated by size and period
+simultaneously.
+
+How many days shall we keep statistics about downloads?
+
+=item ftpstats_size
+
+Statistics about downloads are truncated by size and period
+simultaneously.
+
+How many items shall we keep in the statistics about downloads?
+
=item getcwd
CPAN.pm changes the current working directory often and needs to
@@ -179,6 +206,14 @@ alternatives can be configured according to the following table:
Preferred method for determining the current working directory?
+=item halt_on_failure
+
+Normaly, CPAN.pm continues processing the full list of targets and
+dependencies, even if one of them fails. However, you can specify
+that CPAN should halt after the first failure.
+
+Do you want to halt on failure (yes/no)?
+
=item histfile
If you have one of the readline packages (Term::ReadLine::Perl,
@@ -244,7 +279,7 @@ Verbosity level for loading modules (none or v)?
Every Makefile.PL is run by perl in a separate process. Likewise we
run 'make' and 'make install' in separate processes. If you have
-any parameters (e.g. PREFIX, LIB, UNINST or the like) you want to
+any parameters (e.g. PREFIX, UNINST or the like) you want to
pass to the calls, please specify them here.
If you don't understand this question, just press ENTER.
@@ -475,6 +510,26 @@ you will need to configure CPAN::Reporter before sending reports.
Email test reports if CPAN::Reporter is installed (yes/no)?
+=item perl5lib_verbosity
+
+When CPAN.pm extends @INC via PERL5LIB, it prints a list of
+directories added (or a summary of how many directories are
+added). Choose 'v' to get this message, 'none' to suppress it.
+
+Verbosity level for PERL5LIB changes (none or v)?
+
+=item trust_test_report_history
+
+When a distribution has already been tested by CPAN::Reporter on
+this machine, CPAN can skip the test phase and just rely on the
+test report history instead.
+
+Note that this will not apply to distributions that failed tests
+because of missing dependencies. Also, tests can be run
+regardless of the history using "force".
+
+Do you want to rely on the test report history (yes/no)?
+
=item use_sqlite
CPAN::SQLite is a layer between the index files that are downloaded
@@ -485,9 +540,10 @@ Use CPAN::SQLite if available? (yes/no)?
=item yaml_load_code
-Both YAML.pm and YAML::Syck are capable of deserialising code. As this requires
-a string eval, which might be a security risk, you can use this option to
-enable or disable the deserialisation of code.
+Both YAML.pm and YAML::Syck are capable of deserialising code. As this
+requires a string eval, which might be a security risk, you can use
+this option to enable or disable the deserialisation of code via
+CPAN::DeferedCode. (Note: This does not work under perl 5.6)
Do you want to enable code deserialisation (yes/no)?
@@ -631,7 +687,7 @@ sub init {
if (!$matcher or 'cpan_home' =~ /$matcher/) {
my $cpan_home = $CPAN::Config->{cpan_home}
- || File::Spec->catdir($ENV{HOME}, ".cpan");
+ || File::Spec->catdir(CPAN::HandleConfig::home(), ".cpan");
if (-d $cpan_home) {
$CPAN::Frontend->myprint(qq{
@@ -708,7 +764,7 @@ Shall we use it as the general CPAN build and cache directory?
}
if (!$matcher or 'build_dir_reuse' =~ /$matcher/) {
- my_yn_prompt(build_dir_reuse => 1, $matcher);
+ my_yn_prompt(build_dir_reuse => 0, $matcher);
}
if (!$matcher or 'prefs_dir' =~ /$matcher/) {
@@ -786,6 +842,10 @@ Shall we use it as the general CPAN build and cache directory?
}
}
+ if (!$matcher or 'trust_test_report_history' =~ /$matcher/) {
+ my_yn_prompt(trust_test_report_history => 0, $matcher);
+ }
+
#
#= YAML vs. YAML::Syck
#
@@ -929,6 +989,11 @@ substitute. You can then revisit this dialog with
'none|v');
}
+ if (!$matcher or 'perl5lib_verbosity' =~ /$matcher/) {
+ my_prompt_loop(perl5lib_verbosity => 'v', $matcher,
+ 'none|v');
+ }
+
my_yn_prompt(inhibit_startup_message => 0, $matcher);
#
@@ -942,6 +1007,13 @@ substitute. You can then revisit this dialog with
if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/) {
my_dflt_prompt(makepl_arg => "", $matcher);
my_dflt_prompt(make_arg => "", $matcher);
+ if ( $CPAN::Config->{makepl_arg} =~ /LIBS=|INC=/ ) {
+ $CPAN::Frontend->mywarn(
+ "Warning: Using LIBS or INC in makepl_arg will likely break distributions\n" .
+ "that specify their own LIBS or INC options in Makefile.PL.\n"
+ );
+ }
+
}
require CPAN::HandleConfig;
@@ -958,7 +1030,8 @@ substitute. You can then revisit this dialog with
my_dflt_prompt(mbuildpl_arg => "", $matcher);
my_dflt_prompt(mbuild_arg => "", $matcher);
- if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command}) {
+ if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command}
+ and $^O ne "MSWin32") {
# as long as Windows needs $self->_build_command, we cannot
# support sudo on windows :-)
my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher);
@@ -973,6 +1046,13 @@ substitute. You can then revisit this dialog with
my_dflt_prompt(inactivity_timeout => 0, $matcher);
#
+ #== halt_on_failure
+ #
+ if (!$matcher or 'halt_on_failure' =~ /$matcher/) {
+ my_yn_prompt(halt_on_failure => 0, $matcher);
+ }
+
+ #
#= Proxies
#
@@ -1118,6 +1198,7 @@ substitute. You can then revisit this dialog with
#= MIRRORED.BY and conf_sites()
#
+ my_yn_prompt("connect_to_internet_ok" => 0, $matcher);
if ($matcher) {
if ("urllist" =~ $matcher) {
# conf_sites would go into endless loop with the smash prompt
@@ -1128,10 +1209,16 @@ substitute. You can then revisit this dialog with
if ("randomize_urllist" =~ $matcher) {
my_dflt_prompt(randomize_urllist => 0, $matcher);
}
+ if ("ftpstats_size" =~ $matcher) {
+ my_dflt_prompt(ftpstats_size => 99, $matcher);
+ }
+ if ("ftpstats_period" =~ $matcher) {
+ my_dflt_prompt(ftpstats_period => 14, $matcher);
+ }
} elsif ($fastread) {
$CPAN::Frontend->myprint("Autoconfigured everything but 'urllist'.\n".
"Please call 'o conf init urllist' to configure ".
- "your CPAN server(s) now!");
+ "your CPAN server(s) now!\n\n");
} else {
conf_sites();
}
@@ -1523,7 +1610,9 @@ config_intro => qq{
The following questions are intended to help you with the
configuration. The CPAN module needs a directory of its own to cache
important index files and maybe keep a temporary mirror of CPAN files.
-This may be a site-wide or a personal directory.},
+This may be a site-wide or a personal directory.
+
+},
# cpan_home => qq{ },
diff --git a/lib/CPAN/HandleConfig.pm b/lib/CPAN/HandleConfig.pm
index ec0aefdab9..ce68f9093f 100644
--- a/lib/CPAN/HandleConfig.pm
+++ b/lib/CPAN/HandleConfig.pm
@@ -2,7 +2,7 @@ package CPAN::HandleConfig;
use strict;
use vars qw(%can %keys $loading $VERSION);
-$VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
+$VERSION = "5.5";
%can = (
commit => "Commit changes to disk",
@@ -14,6 +14,13 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
# Q: where is the "How do I add a new config option" HOWTO?
# A1: svn diff -r 757:758 # where dagolden added test_report
# A2: svn diff -r 985:986 # where andk added yaml_module
+# A3: 1. add new config option to %keys below
+# 2. add a Pod description in CPAN::FirstTime; it should include a
+# prompt line; see others for examples
+# 3. add a "matcher" section in CPAN::FirstTime::init that includes
+# a prompt function; see others for examples
+# 4. add config option to documentation section in CPAN.pm
+
%keys = map { $_ => undef }
(
"applypatch",
@@ -31,6 +38,7 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
"colorize_warn",
"commandnumber_in_prompt",
"commands_quote",
+ "connect_to_internet_ok",
"cpan_home",
"curl",
"dontload_hash", # deprecated after 1.83_68 (rev. 581)
@@ -38,9 +46,12 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
"ftp",
"ftp_passive",
"ftp_proxy",
+ "ftpstats_size",
+ "ftpstats_period",
"getcwd",
"gpg",
"gzip",
+ "halt_on_failure",
"histfile",
"histsize",
"http_proxy",
@@ -65,6 +76,7 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
"pager",
"password",
"patch",
+ "perl5lib_verbosity",
"prefer_installer",
"prefs_dir",
"prerequisites_policy",
@@ -81,6 +93,7 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
"term_is_latin",
"term_ornaments",
"test_report",
+ "trust_test_report_history",
"unzip",
"urllist",
"use_sqlite",
@@ -101,21 +114,6 @@ my %prefssupport = map { $_ => 1 }
"test_report",
);
-if ($^O eq "MSWin32") {
- for my $k (qw(
- mbuild_install_build_command
- make_install_make_command
- )) {
- delete $keys{$k};
- if (exists $CPAN::Config->{$k}) {
- for ("deleting previously set config variable '$k' => '$CPAN::Config->{$k}'") {
- $CPAN::Frontend ? $CPAN::Frontend->mywarn($_) : warn $_;
- }
- delete $CPAN::Config->{$k};
- }
- }
-}
-
# returns true on successful action
sub edit {
my($self,@args) = @_;
@@ -123,7 +121,6 @@ sub edit {
CPAN->debug("self[$self]args[".join(" | ",@args)."]");
my($o,$str,$func,$args,$key_exists);
$o = shift @args;
- $DB::single = 1;
if($can{$o}) {
$self->$o(args => \@args); # o conf init => sub init => sub load
return 1;
@@ -289,12 +286,13 @@ Please specify a filename where to save the configuration or try
}
my $msg;
+ my $home = home();
$msg = <<EOF unless $configpm =~ /MyConfig/;
# This is CPAN.pm's systemwide configuration file. This file provides
# defaults for users, and the values can be changed in a per-user
# configuration file. The user-config file is being looked for as
-# ~/.cpan/CPAN/MyConfig.pm.
+# $home/.cpan/CPAN/MyConfig.pm.
EOF
$msg ||= "\n";
@@ -491,8 +489,20 @@ sub require_myconfig_or_config () {
sub home () {
my $home;
+ # Suppress load messages until we load the config and know whether
+ # load messages are desired. Otherwise, it's unexpected and odd
+ # why one load message pops up even when verbosity is turned off.
+ # This means File::HomeDir load messages are never seen, but I
+ # think that's probably OK -- DAGOLDEN
+
+ # 5.6.2 seemed to segfault localizing a value in a hashref
+ # so do it manually instead
+ my $old_v = $CPAN::Config->{load_module_verbosity};
+ $CPAN::Config->{load_module_verbosity} = q[none];
if ($CPAN::META->has_usable("File::HomeDir")) {
- $home = File::HomeDir->my_data;
+ $home = File::HomeDir->can('my_dot_config')
+ ? File::HomeDir->my_dot_config
+ : File::HomeDir->my_data;
unless (defined $home) {
$home = File::HomeDir->my_home
}
@@ -500,6 +510,7 @@ sub home () {
unless (defined $home) {
$home = $ENV{HOME};
}
+ $CPAN::Config->{load_module_verbosity} = $old_v;
$home;
}
@@ -586,7 +597,7 @@ sub missing_config_data {
"makepl_arg",
"mbuild_arg",
"mbuild_install_arg",
- "mbuild_install_build_command",
+ ($^O eq "MSWin32" ? "" : "mbuild_install_build_command"),
"mbuildpl_arg",
"no_proxy",
#"pager",
@@ -690,7 +701,7 @@ sub prefs_lookup {
use strict;
use vars qw($AUTOLOAD $VERSION);
- $VERSION = sprintf "%.2f", substr(q$Rev: 2212 $,4)/100;
+ $VERSION = "5.5";
# formerly CPAN::HandleConfig was known as CPAN::Config
sub AUTOLOAD {
diff --git a/lib/CPAN/Kwalify.pm b/lib/CPAN/Kwalify.pm
index 77564cb7fc..3cade90b91 100644
--- a/lib/CPAN/Kwalify.pm
+++ b/lib/CPAN/Kwalify.pm
@@ -49,7 +49,7 @@ use strict;
package CPAN::Kwalify;
use vars qw($VERSION $VAR1);
-$VERSION = sprintf "%.6f", substr(q$Rev: 1418 $,4)/1000000 + 5.4;
+$VERSION = "5.50";
use File::Spec ();
@@ -85,7 +85,9 @@ sub _validate {
};
$VAR1 = undef;
eval $content;
- die "parsing of '$schema_name.dd' failed: $@" if $@;
+ if (my $err = $@) {
+ die "parsing of '$schema_name.dd' failed: $err";
+ }
$schema_loaded->{$schema_name} = $VAR1;
}
}
@@ -97,8 +99,9 @@ sub _validate {
}
return if $vcache{$abs}{$mtime}{$y}++;
eval { Kwalify::validate($schema, $data) };
- if ($@) {
- die "validation of distropref '$abs'[$y] failed: $@";
+ if (my $err = $@) {
+ my $info = {}; yaml($schema_name, info => $info);
+ die "validation of distropref '$abs'[$y] against schema '$info->{path}' failed: $err";
}
}
}
@@ -108,11 +111,14 @@ sub _clear_cache {
}
sub yaml {
- my($schema_name) = @_;
+ my($schema_name, %opt) = @_;
my $content = do {
my $path = __FILE__;
$path =~ s/\.pm$//;
$path = File::Spec->catfile($path, "$schema_name.yml");
+ if ($opt{info}) {
+ $opt{info}{path} = $path;
+ }
local *FH;
open FH, $path or die "Could not open '$path': $!";
local $/;
diff --git a/lib/CPAN/Kwalify/distroprefs.dd b/lib/CPAN/Kwalify/distroprefs.dd
index 52118e5a98..fd046271b8 100644
--- a/lib/CPAN/Kwalify/distroprefs.dd
+++ b/lib/CPAN/Kwalify/distroprefs.dd
@@ -33,6 +33,14 @@ $VAR1 = {
],
"type" => "int"
},
+ "features" => {
+ "sequence" => [
+ {
+ "type" => "text"
+ }
+ ],
+ "type" => "seq"
+ },
"goto" => {
"type" => "text"
},
@@ -100,20 +108,21 @@ $VAR1 = {
"distribution" => {
"type" => "text"
},
- "module" => {
- "type" => "text"
- },
- "perl" => {
- "type" => "text"
- },
- "perlconfig" => {
+ "env" => {
"mapping" => {
"=" => {
"type" => "text"
}
},
"type" => "map"
- }
+ },
+ "module" => {
+ "type" => "text"
+ },
+ "perl" => {
+ "type" => "text"
+ },
+ "perlconfig" => {}
},
"type" => "map"
},
@@ -126,6 +135,9 @@ $VAR1 = {
"type" => "seq"
},
"pl" => {},
+ "reminder" => {
+ "type" => "text"
+ },
"test" => {}
},
"type" => "map"
@@ -133,5 +145,6 @@ $VAR1 = {
$VAR1->{"mapping"}{"depends"}{"mapping"}{"configure_requires"} = $VAR1->{"mapping"}{"depends"}{"mapping"}{"build_requires"};
$VAR1->{"mapping"}{"depends"}{"mapping"}{"requires"} = $VAR1->{"mapping"}{"depends"}{"mapping"}{"build_requires"};
$VAR1->{"mapping"}{"make"} = $VAR1->{"mapping"}{"install"};
+$VAR1->{"mapping"}{"match"}{"mapping"}{"perlconfig"} = $VAR1->{"mapping"}{"match"}{"mapping"}{"env"};
$VAR1->{"mapping"}{"pl"} = $VAR1->{"mapping"}{"install"};
$VAR1->{"mapping"}{"test"} = $VAR1->{"mapping"}{"install"};
diff --git a/lib/CPAN/Kwalify/distroprefs.yml b/lib/CPAN/Kwalify/distroprefs.yml
index 68ff72b5be..431f174276 100644
--- a/lib/CPAN/Kwalify/distroprefs.yml
+++ b/lib/CPAN/Kwalify/distroprefs.yml
@@ -24,10 +24,12 @@ mapping:
perl:
type: text
perlconfig:
+ &matchhash_common
type: map
mapping:
=:
type: text
+ env: *matchhash_common
install:
&args_env_expect
type: map
@@ -82,3 +84,9 @@ mapping:
mapping:
=:
type: text
+ features:
+ type: seq
+ sequence:
+ - type: text
+ reminder:
+ type: text
diff --git a/lib/CPAN/Nox.pm b/lib/CPAN/Nox.pm
index d968f96d94..5fe5a25ae6 100644
--- a/lib/CPAN/Nox.pm
+++ b/lib/CPAN/Nox.pm
@@ -9,7 +9,7 @@ BEGIN{
use base 'Exporter';
use CPAN;
-$VERSION = sprintf "%.6f", substr(q$Rev: 2411 $,4)/1000000 + 5.4;
+$VERSION = "5.50";
$CPAN::META->has_inst('Digest::MD5','no');
$CPAN::META->has_inst('LWP','no');
$CPAN::META->has_inst('Compress::Zlib','no');
diff --git a/lib/CPAN/Queue.pm b/lib/CPAN/Queue.pm
index f01ab5133d..b60f57c1cf 100644
--- a/lib/CPAN/Queue.pm
+++ b/lib/CPAN/Queue.pm
@@ -67,7 +67,7 @@ package CPAN::Queue;
# in CPAN::Distribution::rematein.
use vars qw{ @All $VERSION };
-$VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
+$VERSION = "5.5";
# CPAN::Queue::queue_item ;
sub queue_item {
@@ -181,6 +181,11 @@ sub nullify_queue {
@All = ();
}
+# CPAN::Queue::size ;
+sub size {
+ return scalar @All;
+}
+
1;
__END__
diff --git a/lib/CPAN/Tarzip.pm b/lib/CPAN/Tarzip.pm
index a9cad24727..73986bf150 100644
--- a/lib/CPAN/Tarzip.pm
+++ b/lib/CPAN/Tarzip.pm
@@ -3,8 +3,8 @@ package CPAN::Tarzip;
use strict;
use vars qw($VERSION @ISA $BUGHUNTING);
use CPAN::Debug;
-use File::Basename ();
-$VERSION = sprintf "%.6f", substr(q$Rev: 2213 $,4)/1000000 + 5.4;
+use File::Basename qw(basename);
+$VERSION = "5.5";
# module is internal to CPAN.pm
@ISA = qw(CPAN::Debug);
@@ -23,12 +23,9 @@ sub new {
if (0) {
} elsif ($file =~ /\.bz2$/i) {
unless ($me->{UNGZIPPRG} = $CPAN::Config->{bzip2}) {
- my $bzip2;
- if ($CPAN::META->has_inst("File::Which")) {
- $bzip2 = File::Which::which("bzip2");
- }
+ my $bzip2 = _my_which("bzip2");
if ($bzip2) {
- $me->{UNGZIPPRG} = $bzip2 || "bzip2";
+ $me->{UNGZIPPRG} = $bzip2;
} else {
$CPAN::Frontend->mydie(qq{
CPAN.pm needs the external program bzip2 in order to handle '$file'.
@@ -38,12 +35,34 @@ program.
}
}
} else {
- # yes, we let gzip figure it out in *any* other case
- $me->{UNGZIPPRG} = $CPAN::Config->{gzip} || "gzip";
+ $me->{UNGZIPPRG} = _my_which("gzip");
}
+ $me->{TARPRG} = _my_which("tar") || _my_which("gtar");
bless $me, $class;
}
+sub _my_which {
+ my($what) = @_;
+ if ($CPAN::Config->{$what}) {
+ return $CPAN::Config->{$what};
+ }
+ if ($CPAN::META->has_inst("File::Which")) {
+ return File::Which::which($what);
+ }
+ my @cand = MM->maybe_command($what);
+ return $cand[0] if @cand;
+ require File::Spec;
+ my $component;
+ PATH_COMPONENT: foreach $component (File::Spec->path()) {
+ next unless defined($component) && $component;
+ my($abs) = File::Spec->catfile($component,$what);
+ if (MM->maybe_command($abs)) {
+ return $abs;
+ }
+ }
+ return;
+}
+
sub gzip {
my($self,$read) = @_;
my $write = $self->{FILE};
@@ -195,18 +214,19 @@ sub DESTROY {
undef $self;
}
-
sub untar {
my($self) = @_;
my $file = $self->{FILE};
my($prefer) = 0;
+ my $exttar = $self->{TARPRG} || "";
+ $exttar = "" if $exttar =~ /^\s+$/; # user refuses to use it
+ my $extgzip = $self->{UNGZIPPRG} || "";
+ $extgzip = "" if $extgzip =~ /^\s+$/; # user refuses to use it
if (0) { # makes changing order easier
} elsif ($BUGHUNTING) {
$prefer=2;
- } elsif (MM->maybe_command($self->{UNGZIPPRG})
- &&
- MM->maybe_command($CPAN::Config->{tar})) {
+ } elsif ($exttar && $extgzip) {
# should be default until Archive::Tar handles bzip2
$prefer = 1;
} elsif (
@@ -215,9 +235,32 @@ sub untar {
$CPAN::META->has_inst("Compress::Zlib") ) {
$prefer = 2;
} else {
+ my $foundtar = $exttar ? "'$exttar'" : "nothing";
+ my $foundzip = $extgzip ? "'$extgzip'" : $foundtar ? "nothing" : "also nothing";
+ my $foundAT;
+ if ($CPAN::META->has_usable("Archive::Tar")) {
+ $foundAT = sprintf "'%s'", "Archive::Tar::"->VERSION;
+ } else {
+ $foundAT = "nothing";
+ }
+ my $foundCZ;
+ if ($CPAN::META->has_inst("Compress::Zlib")) {
+ $foundCZ = sprintf "'%s'", "Compress::Zlib::"->VERSION;
+ } elsif ($foundAT) {
+ $foundCZ = "nothing";
+ } else {
+ $foundCZ = "also nothing";
+ }
$CPAN::Frontend->mydie(qq{
-CPAN.pm needs either the external programs tar, gzip and bzip2
-installed. Can't continue.
+
+CPAN.pm needs either the external programs tar and gzip -or- both
+modules Archive::Tar and Compress::Zlib installed.
+
+For tar I found $foundtar, for gzip $foundzip.
+
+For Archive::Tar I found $foundAT, for Compress::Zlib $foundCZ;
+
+Can't continue cutting file '$file'.
});
}
my $tar_verb = "v";
@@ -228,9 +271,9 @@ installed. Can't continue.
if ($prefer==1) { # 1 => external gzip+tar
my($system);
my $is_compressed = $self->gtest();
- my $tarcommand = CPAN::HandleConfig->safe_quote($CPAN::Config->{tar}) || "tar";
+ my $tarcommand = CPAN::HandleConfig->safe_quote($exttar);
if ($is_compressed) {
- my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ my $command = CPAN::HandleConfig->safe_quote($extgzip);
$system = qq{$command -dc }.
qq{< "$file" | $tarcommand x${tar_verb}f -};
} else {
@@ -241,7 +284,7 @@ installed. Can't continue.
# pipes
if ($is_compressed) {
(my $ungzf = $file) =~ s/\.gz(?!\n)\Z//;
- $ungzf = File::Basename::basename($ungzf);
+ $ungzf = basename $ungzf;
my $ct = CPAN::Tarzip->new($file);
if ($ct->gunzip($ungzf)) {
$CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
@@ -265,6 +308,9 @@ installed. Can't continue.
unless ($CPAN::META->has_usable("Archive::Tar")) {
$CPAN::Frontend->mydie("Archive::Tar not installed, please install it to continue");
}
+ # Make sure AT does not use permissions in the archive
+ # This leaves it to the user's umask instead
+ local $Archive::Tar::CHMOD = 0;
my $tar = Archive::Tar->new($file,1);
my $af; # archive file
my @af;
diff --git a/lib/CPAN/bin/cpan b/lib/CPAN/bin/cpan
index 861d90fc8a..52a1b20f22 100644
--- a/lib/CPAN/bin/cpan
+++ b/lib/CPAN/bin/cpan
@@ -338,7 +338,7 @@ sub _create_autobundle
CPAN::Shell->autobundle;
}
-sub _recompile
+sub _recompiling
{
print "Recompiling dynamically-loaded extensions\n";
diff --git a/lib/CPAN/t/02nox.t b/lib/CPAN/t/02nox.t
index 90c1b3e063..15eae05fa8 100644
--- a/lib/CPAN/t/02nox.t
+++ b/lib/CPAN/t/02nox.t
@@ -23,7 +23,7 @@ is( $CPAN::Suppress_readline, 1, 'should set suppress readline flag' );
# all of these modules have XS components, should be marked unavailable
my $mod;
for $mod (qw( Digest::MD5 LWP Compress::Zlib )) {
- is( $CPAN::META->has_inst($mod), 0, "$mod should be marked unavailable" );
+ is( $CPAN::META->has_inst($mod), 0, "$mod should be marked unavailable" );
}
# and these will be set to those in CPAN
diff --git a/lib/CPAN/t/03pkgs.t b/lib/CPAN/t/03pkgs.t
index 5abb96c071..1264bc81fd 100644
--- a/lib/CPAN/t/03pkgs.t
+++ b/lib/CPAN/t/03pkgs.t
@@ -6,7 +6,16 @@ use lib "lib";
my @m;
if ($ENV{PERL_CORE}){
- @m = ("CPAN", map { "CPAN::$_" } qw(Debug DeferedCode FirstTime Nox Queue Tarzip Version));
+ @m = ("CPAN", map { "CPAN::$_" } qw(Debug
+ DeferedCode
+ Distroprefs
+ FirstTime
+ Kwalify
+ Nox
+ Queue
+ Tarzip
+ Version
+ ));
} else {
opendir DH, "lib/CPAN" or die;
@m = ("CPAN", map { "CPAN::$_" } grep { s/\.pm$// } readdir DH);
diff --git a/lib/CPAN/t/11mirroredby.t b/lib/CPAN/t/11mirroredby.t
index 8d5ee6ec45..840dfa3a51 100644
--- a/lib/CPAN/t/11mirroredby.t
+++ b/lib/CPAN/t/11mirroredby.t
@@ -1,10 +1,10 @@
#!/usr/bin/perl -w
BEGIN {
- if ($ENV{PERL_CORE}) {
- chdir 't' if -d 't';
- unshift @INC, '../lib';
- }
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+ }
}
use strict;
@@ -18,12 +18,12 @@ isa_ok( $cmb, 'CPAN::Mirrored::By' );
@$cmb = qw( continent country url );
is( $cmb->continent(), 'continent',
- 'continent() should return continent entry' );
+ 'continent() should return continent entry' );
is( $cmb->country(), 'country', 'country() should return country entry' );
is( $cmb->url(), 'url', 'url() should return url entry' );
__END__
# Local Variables:
# mode: cperl
-# cperl-indent-level: 2
+# cperl-indent-level: 4
# End:
View Lorry Controller Status