summaryrefslogtreecommitdiff
path: root/cpan
diff options
context:
space:
mode:
authorDavid Golden <dagolden@cpan.org>2011-01-16 21:32:21 -0500
committerDavid Golden <dagolden@cpan.org>2011-01-16 21:40:02 -0500
commita52237f3a547cdefddd4c4be6224bfdf67c84263 (patch)
tree60f7ecb80f2f3db31d26dc1e57aeb67093e0139c /cpan
parentd7b56a3c145ee2307fba4f16c043bd72433f1d69 (diff)
downloadperl-a52237f3a547cdefddd4c4be6224bfdf67c84263.tar.gz
Update CPAN to CPAN version 1.94_63
[DELTA] 2011-01-16 Andreas J. Koenig <andk@cpan.org> * release 1.94_63 * address #63357: use Dumpvalue when dumping potential crap (Andreas Koenig) * address #62986: new config option use_file_homedir (Andreas Koenig) * address #64037: new config option prefer_external_tar (Andreas Koenig) * add support for bootstrapping local::lib when the user does not have write access to perl's site library directories (David Golden) * add support for (and prerequisite on) HTTP::Tiny; also adds prerequisites for MIME::Base64 and Digest::MD5 to support proxy authentication (David Golden) * automatic mirror selection now returns only http mirrors (David Golden) * add 'atexit' option for cache scanning and cleanup (David Golden) * now with 421 distroprefs files (but a good portion of them seems outdated)
Diffstat (limited to 'cpan')
-rw-r--r--cpan/CPAN/Changes26
-rw-r--r--cpan/CPAN/lib/CPAN.pm81
-rw-r--r--cpan/CPAN/lib/CPAN/CacheMgr.pm14
-rw-r--r--cpan/CPAN/lib/CPAN/Distribution.pm66
-rw-r--r--cpan/CPAN/lib/CPAN/FTP.pm44
-rw-r--r--cpan/CPAN/lib/CPAN/FirstTime.pm547
-rw-r--r--cpan/CPAN/lib/CPAN/HTTP/Client.pm254
-rw-r--r--cpan/CPAN/lib/CPAN/HTTP/Credentials.pm91
-rw-r--r--cpan/CPAN/lib/CPAN/HandleConfig.pm11
-rw-r--r--cpan/CPAN/lib/CPAN/Index.pm16
-rw-r--r--cpan/CPAN/lib/CPAN/LWP/UserAgent.pm76
-rw-r--r--cpan/CPAN/lib/CPAN/Mirrors.pm34
-rw-r--r--cpan/CPAN/lib/CPAN/Tarzip.pm13
-rw-r--r--cpan/CPAN/t/11mirroredby.t2
14 files changed, 1005 insertions, 270 deletions
diff --git a/cpan/CPAN/Changes b/cpan/CPAN/Changes
index 50c73ca188..e8bce6773d 100644
--- a/cpan/CPAN/Changes
+++ b/cpan/CPAN/Changes
@@ -1,3 +1,29 @@
+2011-01-16 Andreas J. Koenig <andk@cpan.org>
+
+ * release 1.94_63
+
+ * address #63357: use Dumpvalue when dumping potential crap (Andreas
+ Koenig)
+
+ * address #62986: new config option use_file_homedir (Andreas Koenig)
+
+ * address #64037: new config option prefer_external_tar (Andreas Koenig)
+
+ * add support for bootstrapping local::lib when the user does not have
+ write access to perl's site library directories (David Golden)
+
+ * add support for (and prerequisite on) HTTP::Tiny; also adds
+ prerequisites for MIME::Base64 and Digest::MD5 to support proxy
+ authentication (David Golden)
+
+ * automatic mirror selection now returns only http mirrors (David
+ Golden)
+
+ * add 'atexit' option for cache scanning and cleanup (David Golden)
+
+ * now with 421 distroprefs files (but a good portion of them seems
+ outdated)
+
2010-10-26 Andreas J. Koenig <andk@cpan.org>
* release 1.94_62
diff --git a/cpan/CPAN/lib/CPAN.pm b/cpan/CPAN/lib/CPAN.pm
index 793d4a4ec8..9e7385e403 100644
--- a/cpan/CPAN/lib/CPAN.pm
+++ b/cpan/CPAN/lib/CPAN.pm
@@ -2,7 +2,7 @@
# vim: ts=4 sts=4 sw=4:
use strict;
package CPAN;
-$CPAN::VERSION = '1.94_62';
+$CPAN::VERSION = '1.94_63';
$CPAN::VERSION =~ s/_//;
# we need to run chdir all over and we would get at wrong libraries
@@ -515,6 +515,27 @@ sub _flock {
}
}
+sub _use_file_homedir () {
+ my $use_file_homedir = $CPAN::Config->{use_file_homedir};
+ unless (defined $use_file_homedir) {
+ if ($^O =~ /^(MSWin32|darwin)$/) {
+ $use_file_homedir = 1;
+ } else {
+ $use_file_homedir = 0;
+ }
+ }
+ if ($use_file_homedir
+ and not $CPAN::META->has_usable("File::HomeDir")) {
+ my $v = $File::HomeDir::VERSION;
+ if (CPAN::Version->vgt($v,0)) {
+ $CPAN::Frontend->mydie("Version of File::HomeDir ($v) is insufficient. Please upgrade or try 'o conf init use_file_homedir'");
+ } else {
+ $CPAN::Frontend->mydie("File::HomeDir not installed. Please install it or try 'o conf init use_file_homedir'");
+ }
+ }
+ return $use_file_homedir;
+}
+
sub _yaml_module () {
my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
if (
@@ -1027,10 +1048,21 @@ sub has_usable {
sub {require Net::FTP},
sub {require Net::Config},
],
+ 'HTTP::Tiny' => [
+ sub {
+ require HTTP::Tiny;
+ unless (CPAN::Version->vge(HTTP::Tiny->VERSION, 0.005)) {
+ for ("Will not use HTTP::Tiny, need version 0.005\n") {
+ $CPAN::Frontend->mywarn($_);
+ die $_;
+ }
+ }
+ },
+ ],
'File::HomeDir' => [
sub {require File::HomeDir;
- unless (CPAN::Version->vge(File::HomeDir::->VERSION, 0.52)) {
- for ("Will not use File::HomeDir, need 0.52\n") {
+ unless (CPAN::Version->vge(File::HomeDir::->VERSION, 0.65)) {
+ for ("Will not use File::HomeDir, need 0.65\n") {
$CPAN::Frontend->mywarn($_);
die $_;
}
@@ -1189,6 +1221,12 @@ sub new {
bless {}, shift;
}
+#-> sub CPAN::_exit_messages ;
+sub _exit_messages {
+ my ($self) = @_;
+ $self->{exit_messages} ||= [];
+}
+
#-> sub CPAN::cleanup ;
sub cleanup {
# warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
@@ -1205,6 +1243,7 @@ sub cleanup {
return unless defined $META->{LOCK};
return unless -f $META->{LOCK};
$META->savehist;
+ $META->{cachemgr} ||= CPAN::CacheMgr->new('atexit');
close $META->{LOCKFH};
unlink $META->{LOCK};
# require Carp;
@@ -1213,6 +1252,9 @@ sub cleanup {
$CPAN::Frontend->mywarn("Warning: Configuration not saved.\n");
}
$CPAN::Frontend->myprint("Lockfile removed.\n");
+ for my $msg ( @{ $META->_exit_messages } ) {
+ $CPAN::Frontend->myprint($msg);
+ }
}
#-> sub CPAN::readhist
@@ -1385,8 +1427,8 @@ Basic commands:
The CPAN module automates or at least simplifies the make and install
of perl modules and extensions. It includes some primitive searching
-capabilities and knows how to use Net::FTP, LWP, and certain external
-download clients to fetch distributions from the net.
+capabilities and knows how to use LWP, HTTP::Tiny, Net::FTP and certain
+external download clients to fetch distributions from the net.
These are fetched from one or more mirrored CPAN (Comprehensive
Perl Archive Network) sites and unpacked in a dedicated directory.
@@ -1993,6 +2035,10 @@ currently defined:
patch path to external prg
patches_dir local directory containing patch files
perl5lib_verbosity verbosity level for PERL5LIB additions
+ prefer_external_tar
+ per default all untar operations are done with
+ Archive::Tar; by setting this variable to true
+ the external tar command is used if available
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
@@ -2008,7 +2054,7 @@ currently defined:
proxy_user username for accessing an authenticating proxy
proxy_pass password for accessing an authenticating proxy
randomize_urllist add some randomness to the sequence of the urllist
- scan_cache controls scanning of cache ('atstart' or 'never')
+ scan_cache controls scanning of cache ('atstart', 'atexit' or 'never')
shell your favorite shell
show_unparsable_versions
boolean if r command tells which modules are versionless
@@ -2025,6 +2071,8 @@ currently defined:
CPAN::Reporter history)
unzip location of external program unzip
urllist arrayref to nearby CPAN sites (or equivalent locations)
+ use_file_homedir use File::HomeDir to determine home directory and storage
+ locations
use_sqlite use CPAN::SQLite for metadata storage (fast and lean)
username your username if you CPAN server wants one
version_timeout stops version parsing after this many seconds.
@@ -3381,7 +3429,7 @@ or in your web browser you've proxy information set, then you know
you are running behind an http firewall.
To access servers outside these types of firewalls with perl (even for
-ftp), you need LWP.
+ftp), you need LWP or HTTP::Tiny.
=item ftp firewall
@@ -3553,8 +3601,9 @@ including
or setting the PERL5LIB environment variable.
While we're speaking about $ENV{HOME}, it might be worth mentioning,
-that for Windows we use the File::HomeDir module that provides an
-equivalent to the concept of the home directory on Unix.
+that for Windows and Darwin (and when use_file_homedir is turned on)
+we use the File::HomeDir module that provides an equivalent to the
+concept of the home directory on Unix.
Another thing you should bear in mind is that the UNINST parameter can
be dangerous when you are installing into a private area because you
@@ -3679,11 +3728,15 @@ http://search.cpan.org/dist/Module-Build-Convert/
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,
-bandwidth, reliability, etc. and are topologically close to you. Some
-people prefer fast downloads, others uptodateness, others reliability.
-You decide which to try in which order.
+CPAN can now help you select a "good" mirror, based on which ones have the
+lowest 'ping' round-trip times. From the shell, use the command 'o conf init
+urllist' and allow CPAN to automatically select mirrors for you.
+
+Beyond that help, the urllist config parameter is yours. You can add and remove
+sites at will. You should find out which sites have the best uptodateness,
+bandwidth, reliability, etc. and are topologically close to you. Some people
+prefer fast downloads, others uptodateness, others reliability. You decide
+which to try in which order.
Henk P. Penning maintains a site that collects data about CPAN sites:
diff --git a/cpan/CPAN/lib/CPAN/CacheMgr.pm b/cpan/CPAN/lib/CPAN/CacheMgr.pm
index 827baeaefd..04daea69a5 100644
--- a/cpan/CPAN/lib/CPAN/CacheMgr.pm
+++ b/cpan/CPAN/lib/CPAN/CacheMgr.pm
@@ -189,7 +189,8 @@ sub _clean_cache {
#-> sub CPAN::CacheMgr::new ;
sub new {
- my $class = shift;
+ my($class,$phase) = @_;
+ $phase ||= "atstart";
my $time = time;
my($debug,$t2);
$debug = "";
@@ -199,10 +200,12 @@ sub new {
SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
DU => 0
};
+ $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
+ unless $self->{SCAN} =~ /never|atstart|atexit/;
File::Path::mkpath($self->{ID});
my $dh = DirHandle->new($self->{ID});
bless $self, $class;
- $self->scan_cache;
+ $self->scan_cache($phase);
$t2 = time;
$debug .= "timing of CacheMgr->new: ".($t2 - $time);
$time = $t2;
@@ -212,10 +215,9 @@ sub new {
#-> sub CPAN::CacheMgr::scan_cache ;
sub scan_cache {
- my $self = shift;
- return if $self->{SCAN} eq 'never';
- $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
- unless $self->{SCAN} eq 'atstart';
+ my ($self, $phase) = @_;
+ $phase = '' unless defined $phase;
+ return unless $phase eq $self->{SCAN};
return unless $CPAN::META->{LOCK};
$CPAN::Frontend->myprint(
sprintf("Scanning cache %s for sizes\n",
diff --git a/cpan/CPAN/lib/CPAN/Distribution.pm b/cpan/CPAN/lib/CPAN/Distribution.pm
index 8d6fd10ce9..e031b692c2 100644
--- a/cpan/CPAN/lib/CPAN/Distribution.pm
+++ b/cpan/CPAN/lib/CPAN/Distribution.pm
@@ -189,7 +189,7 @@ sub color_cmd_tmps {
my $premo;
unless ($premo = CPAN::Shell->expand("Module",$pre)) {
$CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
- $CPAN::Frontend->mysleep(2);
+ $CPAN::Frontend->mysleep(0.2);
next PREREQ;
}
$premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
@@ -3181,8 +3181,42 @@ sub test {
$tests_ok = system($system) == 0;
}
$self->introduce_myself;
+ my $but = $self->_make_test_illuminate_prereqs();
if ( $tests_ok ) {
- {
+ if ($but) {
+ $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
+ $self->{make_test} = CPAN::Distrostatus->new("NO $but");
+ $self->store_persistent_state;
+ return $self->goodbye("[dependencies] -- NA");
+ }
+ $CPAN::Frontend->myprint(" $system -- OK\n");
+ $self->{make_test} = CPAN::Distrostatus->new("YES");
+ $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
+ # probably impossible to need the next line because badtestcnt
+ # has a lifespan of one command
+ delete $self->{badtestcnt};
+ } else {
+ if ($but) {
+ $but .= "; additionally test harness failed";
+ $CPAN::Frontend->mywarn("$but\n");
+ $self->{make_test} = CPAN::Distrostatus->new("NO $but");
+ } else {
+ $self->{make_test} = CPAN::Distrostatus->new("NO");
+ }
+ $self->{badtestcnt}++;
+ $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
+ CPAN::Shell->optprint
+ ("hint",
+ sprintf
+ ("//hint// to see the cpan-testers results for installing this module, try:
+ reports %s\n",
+ $self->pretty_id));
+ }
+ $self->store_persistent_state;
+}
+
+sub _make_test_illuminate_prereqs {
+ my($self) = @_;
my @prereq;
# local $CPAN::DEBUG = 16; # Distribution
@@ -3213,36 +3247,14 @@ sub test {
push @prereq, $m;
}
}
+ my $but;
if (@prereq) {
my $cnt = @prereq;
my $which = join ",", @prereq;
- my $but = $cnt == 1 ? "one dependency not OK ($which)" :
+ $but = $cnt == 1 ? "one dependency not OK ($which)" :
"$cnt dependencies missing ($which)";
- $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
- $self->{make_test} = CPAN::Distrostatus->new("NO $but");
- $self->store_persistent_state;
- return $self->goodbye("[dependencies] -- NA");
}
- }
-
- $CPAN::Frontend->myprint(" $system -- OK\n");
- $self->{make_test} = CPAN::Distrostatus->new("YES");
- $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
- # probably impossible to need the next line because badtestcnt
- # has a lifespan of one command
- delete $self->{badtestcnt};
- } else {
- $self->{make_test} = CPAN::Distrostatus->new("NO");
- $self->{badtestcnt}++;
- $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
- CPAN::Shell->optprint
- ("hint",
- sprintf
- ("//hint// to see the cpan-testers results for installing this module, try:
- reports %s\n",
- $self->pretty_id));
- }
- $self->store_persistent_state;
+ $but;
}
sub _prefs_with_expect {
diff --git a/cpan/CPAN/lib/CPAN/FTP.pm b/cpan/CPAN/lib/CPAN/FTP.pm
index c1b7b20101..4f233814e5 100644
--- a/cpan/CPAN/lib/CPAN/FTP.pm
+++ b/cpan/CPAN/lib/CPAN/FTP.pm
@@ -652,8 +652,46 @@ sub hostdleasy { #called from hostdlxxx
# Net::FTP can still succeed where LWP fails. So we do not
# skip Net::FTP anymore when LWP is available.
}
- } else {
- $CPAN::Frontend->mywarn(" LWP not available\n");
+ } elsif ($url =~ /^http:/ && $CPAN::META->has_usable('HTTP::Tiny')) {
+ require CPAN::HTTP::Client;
+ my $chc = CPAN::HTTP::Client->new(
+ proxy => $CPAN::Config->{http_proxy} || $ENV{http_proxy},
+ no_proxy => $CPAN::Config->{no_proxy} || $ENV{no_proxy},
+ );
+ for my $try ( $url, ( $url !~ /\.gz(?!\n)\Z/ ? "$url.gz" : () ) ) {
+ $CPAN::Frontend->myprint("Fetching with HTTP::Tiny:\n$try\n");
+ my $res = eval { $chc->mirror($try, $aslocal) };
+ if ( $res && $res->{success} ) {
+ $ThesiteURL = $ro_url;
+ my $now = time;
+ utime $now, $now, $aslocal; # download time is more
+ # important than upload
+ # time
+ return $aslocal;
+ }
+ elsif ( $res && $res->{status} ne '599') {
+ $CPAN::Frontend->myprint(sprintf(
+ "HTTP::Tiny failed with code[%s] message[%s]\n",
+ $res->{status},
+ $res->{reason},
+ )
+ );
+ }
+ elsif ( $res && $res->{status} eq '599') {
+ $CPAN::Frontend->myprint(sprintf(
+ "HTTP::Tiny failed with an internal error: %s\n",
+ $res->{content},
+ )
+ );
+ }
+ else {
+ my $err = $@ || 'Unknown error';
+ $CPAN::Frontend->myprint(sprintf(
+ "Error downloading with HTTP::Tiny: %s\n", $err
+ )
+ );
+ }
+ }
}
return if $CPAN::Signal;
if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
@@ -852,7 +890,7 @@ sub _proxy_vars {
}
if ($want_proxy) {
my($user, $pass) =
- &CPAN::LWP::UserAgent::get_proxy_credentials();
+ CPAN::HTTP::Credentials->get_proxy_credentials();
$ret = {
proxy_user => $user,
proxy_pass => $pass,
diff --git a/cpan/CPAN/lib/CPAN/FirstTime.pm b/cpan/CPAN/lib/CPAN/FirstTime.pm
index b7a258ec7b..4339b739af 100644
--- a/cpan/CPAN/lib/CPAN/FirstTime.pm
+++ b/cpan/CPAN/lib/CPAN/FirstTime.pm
@@ -1,4 +1,5 @@
# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
package CPAN::FirstTime;
use strict;
@@ -8,7 +9,7 @@ use File::Basename ();
use File::Path ();
use File::Spec ();
use CPAN::Mirrors ();
-use vars qw($VERSION $silent);
+use vars qw($VERSION $auto_config);
$VERSION = "5.5301";
=head1 NAME
@@ -212,7 +213,7 @@ If you have one of the readline packages (Term::ReadLine::Perl,
Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN
shell will have history support. The next two questions deal with the
filename of the history file and with its size. If you do not want to
-set this variable, please hit SPACE RETURN to the following question.
+set this variable, please hit SPACE ENTER to the following question.
File to save your history?
@@ -296,6 +297,7 @@ Parameters for the 'make install' command?
Typical frequently used setting:
UNINST=1 # to always uninstall potentially conflicting files
+ # (but do NOT use with local::lib or INSTALL_BASE)
Your choice:
@@ -338,6 +340,7 @@ Parameters for the './Build install' command? Typical frequently used
setting:
--uninst 1 # uninstall conflicting files
+ # (but do NOT use with local::lib or INSTALL_BASE)
Your choice:
@@ -420,10 +423,11 @@ Randomize parameter
=item scan_cache
By default, each time the CPAN module is started, cache scanning is
-performed to keep the cache size in sync. To prevent this, answer
-'never'.
+performed to keep the cache size in sync ('atstart'). Alternatively,
+scanning and cleanup can happen when CPAN exits ('atexit'). To prevent
+any cache cleanup, answer 'never'.
-Perform cache scanning (atstart or never)?
+Perform cache scanning ('atstart', 'atexit' or 'never')?
=item shell
@@ -513,6 +517,15 @@ added). Choose 'v' to get this message, 'none' to suppress it.
Verbosity level for PERL5LIB changes (none or v)?
+=item prefer_external_tar
+
+Per default all untar operations are done with the perl module
+Archive::Tar; by setting this variable to true the external tar
+command is used if available; on Unix this is usually preferred
+because they have a reliable and fast gnutar implementation.
+
+Use the external tar program instead of Archive::Tar?
+
=item trust_test_report_history
When a distribution has already been tested by CPAN::Reporter on
@@ -525,6 +538,17 @@ regardless of the history using "force".
Do you want to rely on the test report history (yes/no)?
+=item use_file_homedir
+
+Windows and Darwin have no tradition of providing a home directory for
+their users, so it has been requested to support the use of
+File::HomeDir. But after so many years of using File::HomeDir, this
+module started to bother people because it didn't fulfil their
+expectations. By setting this variable you can choose whether you want
+to let File::HomeDir decide about your storage locations.
+
+Use File::HomeDir to determine home directory and storage locations?
+
=item use_sqlite
CPAN::SQLite is a layer between the index files that are downloaded
@@ -595,9 +619,8 @@ conf init' at the cpan prompt.)
],
auto_pick => qq{
-Would you like me to automatically choose the best CPAN mirror
-sites for you? (This means connecting to the Internet and could
-take a couple minutes)},
+Would you like me to automatically choose some CPAN mirror
+sites for you? (This means connecting to the Internet)},
config_intro => qq{
@@ -636,7 +659,7 @@ the \$CPAN::Config takes precedence.
proxy_user => qq{
If your proxy is an authenticating proxy, you can store your username
-permanently. If you do not want that, just press RETURN. You will then
+permanently. If you do not want that, just press ENTER. You will then
be asked for your username in every future session.
},
@@ -645,7 +668,7 @@ proxy_pass => qq{
Your password for the authenticating proxy can also be stored
permanently on disk. If this violates your security policy, just press
-RETURN. You will then be asked for the password in every future
+ENTER. You will then be asked for the password in every future
session.
},
@@ -675,6 +698,24 @@ be echoed to the terminal!
},
+install_help => qq{
+Warning: You do not have write permission for Perl library directories.
+
+To install modules, you need to configure a local Perl library directory or
+escalate your privileges. CPAN can help you by bootstrapping the local::lib
+module or by configuring itself to use 'sudo' (if available). You may also
+resolve this problem manually if you need to customize your setup.
+
+What approach do you want? (Choose 'local::lib', 'sudo' or 'manual')
+},
+
+local_lib_installed => qq{
+local::lib is installed. You must now add the following environment variables
+to your shell configuration files (or registry, if you are on Windows) and
+then restart your command line shell and CPAN before installing modules:
+
+},
+
);
die "Coding error in \@prompts declaration. Odd number of elements, above"
@@ -773,16 +814,12 @@ sub init {
$manual_conf = ($_conf and $_conf =~ /^y/i) ? "no" : "yes";
}
CPAN->debug("manual_conf[$manual_conf]") if $CPAN::DEBUG;
- my $fastread;
+ $auto_config = 0;
{
if ($manual_conf =~ /^y/i) {
- $fastread = 0;
+ $auto_config = 0;
} else {
- $fastread = 1;
- $silent = 1;
- $CPAN::Config->{urllist} ||= [];
- $CPAN::Config->{connect_to_internet_ok} ||= 1;
-
+ $auto_config = 1;
local $^W = 0;
# prototype should match that of &MakeMaker::prompt
my $current_second = time;
@@ -793,6 +830,19 @@ sub init {
}
}
+ #
+ # bootstrap local::lib or sudo
+ #
+ unless ( $matcher
+ || _can_write_to_libdirs() || _using_installbase() || _using_sudo()
+ ) {
+ local $auto_config = 0; # We *must* ask, even under autoconfig
+ local *_real_prompt; # We *must* show prompt
+ my_prompt_loop(install_help => 'local::lib', $matcher,
+ 'local::lib|sudo|manual');
+ }
+ $CPAN::Config->{install_help} ||= ''; # Temporary to suppress warnings
+
if (!$matcher or q{
build_dir
build_dir_reuse
@@ -800,7 +850,7 @@ sub init {
keep_source_where
prefs_dir
} =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{config_intro}) unless $silent;
+ $CPAN::Frontend->myprint($prompts{config_intro}) unless $auto_config;
init_cpan_home($matcher);
@@ -831,7 +881,7 @@ sub init {
my_dflt_prompt(build_cache => 100, $matcher);
my_dflt_prompt(index_expire => 1, $matcher);
- my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
+ my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|atexit|never');
#
#= cache_metadata
@@ -866,7 +916,7 @@ sub init {
) {
local *_real_prompt;
*_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
- my $_conf = prompt("Would you like me configure CPAN::Reporter now?", $silent ? "no" : "yes");
+ my $_conf = prompt("Would you like me configure CPAN::Reporter now?", $auto_config ? "no" : "yes");
if ($_conf =~ /^y/i) {
$CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n");
CPAN::Reporter::configure();
@@ -884,7 +934,7 @@ sub init {
my_dflt_prompt(yaml_module => "YAML", $matcher);
my $old_v = $CPAN::Config->{load_module_verbosity};
$CPAN::Config->{load_module_verbosity} = q[none];
- if (!$silent && !$CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
+ if (!$auto_config && !$CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
$CPAN::Frontend->mywarn
("Warning (maybe harmless): '$CPAN::Config->{yaml_module}' not installed.\n");
$CPAN::Frontend->mysleep(3);
@@ -901,7 +951,18 @@ sub init {
#= External programs
#
my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
- _init_external_progs($matcher,\@path);
+ $CPAN::Frontend->myprint($prompts{external_progs})
+ if !$matcher && !$auto_config;
+ _init_external_progs($matcher, {
+ path => \@path,
+ progs => [ qw/make bzip2 gzip tar unzip gpg patch applypatch/ ],
+ shortcut => 0
+ });
+ _init_external_progs($matcher, {
+ path => \@path,
+ progs => [ qw/wget curl lynx ncftpget ncftp ftp/ ],
+ shortcut => 1
+ });
{
my $path = $CPAN::Config->{'pager'} ||
@@ -928,6 +989,22 @@ sub init {
}
}
+ {
+ my $tar = $CPAN::Config->{tar};
+ my $prefer_external_tar = $CPAN::Config->{prefer_external_tar}; # XXX not yet supported
+ unless (defined $prefer_external_tar) {
+ if ($^O =~ /(MSWin32|solaris)/) {
+ # both have a record of broken tars
+ $prefer_external_tar = 0;
+ } elsif ($tar) {
+ $prefer_external_tar = 1;
+ } else {
+ $prefer_external_tar = 0;
+ }
+ }
+ my_yn_prompt(prefer_external_tar => $prefer_external_tar, $matcher);
+ }
+
#
# verbosity
#
@@ -962,8 +1039,18 @@ sub init {
if (exists $CPAN::HandleConfig::keys{make_install_make_command}) {
# as long as Windows needs $self->_build_command, we cannot
# support sudo on windows :-)
- my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "",
- $matcher);
+ my $default = $CPAN::Config->{make} || "";
+ if ( $default && $CPAN::Config->{install_help} eq 'sudo' ) {
+ if ( find_exe('sudo') ) {
+ $default = "sudo $default";
+ delete $CPAN::Config->{make_install_make_command}
+ unless $CPAN::Config->{make_install_make_command} =~ /sudo/;
+ }
+ else {
+ $CPAN::Frontend->mywarnonce("Could not find 'sudo' in PATH\n");
+ }
+ }
+ my_dflt_prompt(make_install_make_command => $default, $matcher);
}
my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "",
@@ -976,7 +1063,18 @@ sub init {
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);
+ my $default = "./Build";
+ if ( $CPAN::Config->{install_help} eq 'sudo' ) {
+ if ( find_exe('sudo') ) {
+ $default = "sudo $default";
+ delete $CPAN::Config->{mbuild_install_build_command}
+ unless $CPAN::Config->{mbuild_install_build_command} =~ /sudo/;
+ }
+ else {
+ $CPAN::Frontend->mywarnonce("Could not find 'sudo' in PATH\n");
+ }
+ }
+ my_dflt_prompt(mbuild_install_build_command => $default, $matcher);
}
my_dflt_prompt(mbuild_install_arg => "", $matcher);
@@ -1000,7 +1098,7 @@ sub init {
my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/;
my @proxy_user_vars = qw/proxy_user proxy_pass/;
if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{proxy_intro}) unless $silent;
+ $CPAN::Frontend->myprint($prompts{proxy_intro}) unless $auto_config;
for (@proxy_vars) {
$prompts{$_} = "Your $_?";
@@ -1012,21 +1110,21 @@ sub init {
$default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || "";
- $CPAN::Frontend->myprint($prompts{proxy_user}) unless $silent;
+ $CPAN::Frontend->myprint($prompts{proxy_user}) unless $auto_config;
if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
- $CPAN::Frontend->myprint($prompts{proxy_pass}) unless $silent;
+ $CPAN::Frontend->myprint($prompts{proxy_pass}) unless $auto_config;
if ($CPAN::META->has_inst("Term::ReadKey")) {
Term::ReadKey::ReadMode("noecho");
} else {
- $CPAN::Frontend->myprint($prompts{password_warn}) unless $silent;
+ $CPAN::Frontend->myprint($prompts{password_warn}) unless $auto_config;
}
$CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
if ($CPAN::META->has_inst("Term::ReadKey")) {
Term::ReadKey::ReadMode("restore");
}
- $CPAN::Frontend->myprint("\n\n") unless $silent;
+ $CPAN::Frontend->myprint("\n\n") unless $auto_config;
}
}
}
@@ -1056,24 +1154,24 @@ sub init {
if ($CPAN::META->has_inst("Term::ANSIColor")) {
my $T="gYw";
$CPAN::Frontend->myprint( " on_ on_y ".
- " on_ma on_\n") unless $silent;
+ " on_ma on_\n") unless $auto_config;
$CPAN::Frontend->myprint( " on_black on_red green ellow ".
- "on_blue genta on_cyan white\n") unless $silent;
+ "on_blue genta on_cyan white\n") unless $auto_config;
for my $FG ("", "bold",
map {$_,"bold $_"} "black","red","green",
"yellow","blue",
"magenta",
"cyan","white") {
- $CPAN::Frontend->myprint(sprintf( "%12s ", $FG)) unless $silent;
+ $CPAN::Frontend->myprint(sprintf( "%12s ", $FG)) unless $auto_config;
for my $BG ("",map {"on_$_"} qw(black red green yellow
blue magenta cyan white)) {
$CPAN::Frontend->myprint( $FG||$BG ?
- Term::ANSIColor::colored(" $T ","$FG $BG") : " $T ") unless $silent;
+ Term::ANSIColor::colored(" $T ","$FG $BG") : " $T ") unless $auto_config;
}
- $CPAN::Frontend->myprint( "\n" ) unless $silent;
+ $CPAN::Frontend->myprint( "\n" ) unless $auto_config;
}
- $CPAN::Frontend->myprint( "\n" ) unless $silent;
+ $CPAN::Frontend->myprint( "\n" ) unless $auto_config;
}
for my $tuple (
["colorize_print", "bold blue on_white"],
@@ -1103,7 +1201,7 @@ sub init {
#
if (!$matcher or 'histfile histsize' =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{histfile_intro}) unless $silent;
+ $CPAN::Frontend->myprint($prompts{histfile_intro}) unless $auto_config;
defined($default = $CPAN::Config->{histfile}) or
$default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
my_dflt_prompt(histfile => $default, $matcher);
@@ -1135,35 +1233,12 @@ sub init {
#= MIRRORED.BY and conf_sites()
#
- # remember, this is only triggered if no urllist is given, so 0 is
- # fair and protects the default site from being overloaded and
- # gives the user more chances to select his own urllist.
- my_yn_prompt("connect_to_internet_ok" => $fastread ? 1 : 0, $matcher);
- $CPAN::Config->{urllist} ||= [];
- if ($matcher) {
- if ("urllist" =~ $matcher) {
- $CPAN::Frontend->myprint($prompts{urls_intro});
+ # Let's assume they want to use the internet and make them turn it
+ # off if they really don't.
+ my_yn_prompt("connect_to_internet_ok" => 1, $matcher);
- # conf_sites would go into endless loop with the smash prompt
- local *_real_prompt;
- *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
- my $_conf = prompt($prompts{auto_pick}, "yes");
-
- if ( $_conf =~ /^y/i ) {
- conf_sites( auto_pick => 1 ) or bring_your_own();
- }
- else {
- my $_conf = prompt(
- "Would you like to pick from the CPAN mirror list?", "yes"
- );
-
- if ( $_conf =~ /^y/i ) {
- conf_sites();
- }
- bring_your_own();
- }
- _print_urllist();
- }
+ # Allow matching but don't show during manual config
+ if ($matcher) {
if ("randomize_urllist" =~ $matcher) {
my_dflt_prompt(randomize_urllist => 0, $matcher);
}
@@ -1173,45 +1248,76 @@ sub init {
if ("ftpstats_period" =~ $matcher) {
my_dflt_prompt(ftpstats_period => 14, $matcher);
}
- } elsif ($fastread) {
- $silent = 0;
- local *_real_prompt;
- *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
- if ( @{ $CPAN::Config->{urllist} } ) {
+ }
+
+ $CPAN::Config->{urllist} ||= [];
+
+ if ($auto_config) {
+ if(@{ $CPAN::Config->{urllist} }) {
$CPAN::Frontend->myprint(
- "\nYour 'urllist' is already configured. Type 'o conf init urllist' to change it.\n"
+ "Your 'urllist' is already configured. Type 'o conf init urllist' to change it.\n"
);
}
else {
$CPAN::Frontend->myprint(
"Autoconfigured everything but 'urllist'.\n"
);
+ _do_pick_mirrors();
+ }
+ }
+ elsif (!$matcher || "urllist" =~ $matcher) {
+ _do_pick_mirrors();
+ }
- $CPAN::Frontend->myprint($prompts{urls_intro});
+ if ($auto_config) {
+ $CPAN::Frontend->myprint(
+ "\nAutoconfiguration complete.\n"
+ );
+ $auto_config = 0; # reset
+ }
- my $_conf = prompt($prompts{auto_pick}, "yes");
+ if (!$matcher || "use_file_homedir" =~ $matcher) {
+ my $use_file_homedir = CPAN::_use_file_homedir();
+ my_yn_prompt("use_file_homedir" => $use_file_homedir, $matcher);
+ }
- if ( $_conf =~ /^y/i ) {
- conf_sites( auto_pick => 1 ) or bring_your_own();
+ # bootstrap local::lib now if requested
+ if ( $CPAN::Config->{install_help} eq 'local::lib' ) {
+ if ( ! @{ $CPAN::Config->{urllist} } ) {
+ $CPAN::Frontend->myprint(
+ "Skipping local::lib bootstrap because 'urllist' is not configured.\n"
+ );
}
else {
- my $_conf = prompt(
- "Would you like to pick from the CPAN mirror list?", "yes"
+ $CPAN::Frontend->myprint("\nAttempting to boostrap local::lib...\n");
+ $CPAN::Frontend->myprint("\nWriting $configpm for bootstrap...\n");
+ delete $CPAN::Config->{install_help}; # temporary only
+ CPAN::HandleConfig->commit($configpm);
+ my $dist;
+ if ( $dist = CPAN::Shell->expand('Module', 'local::lib')->distribution ) {
+ # this is a hack to force bootstrapping
+ $dist->{prefs}{pl}{commandline} = "$^X Makefile.PL --bootstrap";
+ # Set @INC for this process so we find things as they bootstrap
+ require lib;
+ lib->import(_local_lib_inc_path());
+ eval { $dist->install };
+ }
+ if ( ! $dist || (my $err = $@) ) {
+ $err ||= 'Could not locate local::lib in the CPAN index';
+ $CPAN::Frontend->mywarn("Error bootstrapping local::lib: $@\n");
+ $CPAN::Frontend->myprint("From the CPAN Shell, you might try 'look local::lib' and \n"
+ . "run 'perl Makefile --bootstrap' and see if that is successful. Then\n"
+ . "restart your CPAN client\n"
);
-
- if ( $_conf =~ /^y/i ) {
- conf_sites();
}
- bring_your_own();
+ else {
+ _local_lib_config();
}
- _print_urllist();
}
- $CPAN::Frontend->myprint(
- "\nAutoconfiguration complete.\n"
- );
}
- $silent = 0; # reset
+ # install_help is temporary for configuration and not saved
+ delete $CPAN::Config->{install_help};
$CPAN::Frontend->myprint("\n");
if ($matcher && !$CPAN::Config->{auto_commit}) {
@@ -1222,21 +1328,131 @@ sub init {
}
}
-sub _init_external_progs {
- my($matcher,$PATH) = @_;
- my @external_progs = qw/bzip2 gzip tar unzip
+sub _local_lib_config {
+ # Set environment stuff for this process
+ require local::lib;
+ my %env = local::lib->build_environment_vars_for(_local_lib_path(), 1);
+ while ( my ($k, $v) = each %env ) {
+ $ENV{$k} = $v;
+ }
- make
+ # Tell user about environment vars to set
+ $CPAN::Frontend->myprint($prompts{local_lib_installed});
+ local $ENV{SHELL} = $CPAN::Config->{shell} || $ENV{SHELL};
+ my $shellvars = local::lib->environment_vars_string_for(_local_lib_path());
+ $CPAN::Frontend->myprint($shellvars);
+
+ # Offer to mangle the shell config
+ my $munged_rc;
+ if ( my $rc = _find_shell_config() ) {
+ local $auto_config = 0; # We *must* ask, even under autoconfig
+ local *_real_prompt; # We *must* show prompt
+ my $_conf = prompt(
+ "\nWould you like me to append that to $rc now?", "yes"
+ );
+ if ($_conf =~ /^y/i) {
+ open my $fh, ">>", $rc;
+ print {$fh} "\n$shellvars";
+ close $fh;
+ $munged_rc++;
+ }
+ }
- curl lynx wget ncftpget ncftp ftp
+ # Warn at exit time
+ if ($munged_rc) {
+ push @{$CPAN::META->_exit_messages}, << "HERE";
- gpg
+*** Remember to restart your shell before running cpan again ***
+HERE
+ }
+ else {
+ push @{$CPAN::META->_exit_messages}, << "HERE";
- patch applypatch
- /;
- if (!$matcher or "@external_progs" =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{external_progs}) unless $silent;
+*** Remember to add these environment variables to your shell config
+ and restart your shell before running cpan again ***
+$shellvars
+HERE
+ }
+}
+
+{
+ my %shell_rc_map = (
+ map { $_ => ".${_}rc" } qw/ bash tcsh csh /,
+ map { $_ => ".profile" } qw/dash ash sh/,
+ zsh => ".zshenv",
+ );
+
+ sub _find_shell_config {
+ my $shell = File::Basename::basename($CPAN::Config->{shell});
+ if ( my $rc = $shell_rc_map{$shell} ) {
+ my $path = File::Spec->catfile($ENV{HOME}, $rc);
+ return $path if -w $path;
+ }
+ }
+}
+
+
+sub _local_lib_inc_path {
+ return File::Spec->catdir(_local_lib_path(), qw/lib perl5/);
+}
+
+sub _local_lib_path {
+ return File::Spec->catdir(_local_lib_home(), 'perl5');
+}
+
+# Adapted from resolve_home_path() in local::lib -- this is where
+# local::lib thinks the user's home is
+{
+ my $local_lib_home;
+ sub _local_lib_home {
+ $local_lib_home ||= File::Spec->rel2abs( do {
+ if (CPAN::_use_file_homedir()) {
+ File::HomeDir->my_home;
+ } elsif (defined $ENV{HOME}) {
+ $ENV{HOME};
+ } else {
+ (getpwuid $<)[7] || "~";
+ }
+ });
+ }
+}
+
+sub _do_pick_mirrors {
+ local *_real_prompt;
+ *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
+ $CPAN::Frontend->myprint($prompts{urls_intro});
+ # Only prompt for auto-pick if Net::Ping is new enough to do timings
+ my $_conf = 'n';
+ if ( $CPAN::META->has_usable("Net::Ping") && Net::Ping->VERSION gt '2.13') {
+ $_conf = prompt($prompts{auto_pick}, "yes");
+ }
+ my @old_list = @{ $CPAN::Config->{urllist} };
+ if ( $_conf =~ /^y/i ) {
+ conf_sites( auto_pick => 1 ) or bring_your_own();
+ }
+ else {
+ _print_urllist('Current') if @old_list;
+ my $msg = scalar @old_list
+ ? "Would you like to edit the urllist or pick new mirrors from a list?"
+ : "Would you like to pick from the CPAN mirror list?" ;
+ my $_conf = prompt($msg, "yes");
+ if ( $_conf =~ /^y/i ) {
+ conf_sites();
+ }
+ bring_your_own();
+ }
+ _print_urllist('New');
+}
+
+sub _init_external_progs {
+ my($matcher,$args) = @_;
+ my $PATH = $args->{path};
+ my @external_progs = @{ $args->{progs} };
+ my $shortcut = $args->{shortcut};
+ my $showed_make_warning;
+
+ if (!$matcher or "@external_progs" =~ /$matcher/) {
my $old_warn = $^W;
local $^W if $^O eq 'MacOS';
local $^W = $old_warn;
@@ -1276,15 +1492,64 @@ sub _init_external_progs {
$path ||= find_exe($progcall,$PATH);
unless ($path) { # not -e $path, because find_exe already checked that
local $"=";";
- $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@$PATH]\n") unless $silent;
- if ($progname eq "make") {
- $CPAN::Frontend->mywarn("ALERT: 'make' is an essential tool for ".
- "building perl Modules. Please make sure you ".
- "have 'make' (or some equivalent) ".
- "working.\n"
- );
+ $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@$PATH]\n") unless $auto_config;
+ _beg_for_make(), $showed_make_warning++ if $progname eq "make";
+ }
+ $prompts{$progname} = "Where is your $progname program?";
+ $path = my_dflt_prompt($progname,$path,$matcher,1); # 1 => no strip spaces
+ my $disabling = $path =~ m/^\s*$/;
+
+ # don't let them disable or misconfigure make without warning
+ if ( $progname eq "make" && ( $disabling || ! _check_found($path) ) ) {
+ if ( $disabling && $showed_make_warning ) {
+ next;
+ }
+ else {
+ _beg_for_make() unless $showed_make_warning++;
+ undef $CPAN::Config->{$progname};
+ $CPAN::Frontend->mywarn("Press SPACE and ENTER to disable make (NOT RECOMMENDED)\n");
+ redo;
+ }
+ }
+ elsif ( $disabling ) {
+ next;
+ }
+ elsif ( _check_found( $CPAN::Config->{$progname} ) ) {
+ last if $shortcut && !$matcher;
+ }
+ else {
+ undef $CPAN::Config->{$progname};
+ $CPAN::Frontend->mywarn("Press SPACE and ENTER to disable $progname\n");
+ redo;
+ }
+ }
+ }
+}
+
+sub _check_found {
+ my ($prog) = @_;
+ if ( ! -f $prog ) {
+ $CPAN::Frontend->mywarn("Warning: '$prog' does not exist\n")
+ unless $auto_config;
+ return;
+ }
+ elsif ( ! -x $prog ) {
+ $CPAN::Frontend->mywarn("Warning: '$prog' is not executable\n")
+ unless $auto_config;
+ return;
+ }
+ return 1;
+}
+
+sub _beg_for_make {
+ $CPAN::Frontend->mywarn(<<"HERE");
+
+ALERT: 'make' is an essential tool for building perl Modules.
+Please make sure you have 'make' (or some equivalent) working.
+
+HERE
if ($^O eq "MSWin32") {
- $CPAN::Frontend->mywarn("
+ $CPAN::Frontend->mywarn(<<"HERE");
Windows users may want to follow this procedure when back in the CPAN shell:
look YVES/scripts/alien_nmake.pl
@@ -1295,13 +1560,7 @@ substitute. You can then revisit this dialog with
o conf init make
-");
- }
- }
- }
- $prompts{$progname} = "Where is your $progname program?";
- my_dflt_prompt($progname,$path,$matcher);
- }
+HERE
}
}
@@ -1318,16 +1577,16 @@ I see you already have a directory
$cpan_home
Shall we use it as the general CPAN build and cache directory?
-}) unless $silent;
+}) unless $auto_config;
} else {
# no cpan-home, must prompt and get one
- $CPAN::Frontend->myprint($prompts{cpan_home_where}) unless $silent;
+ $CPAN::Frontend->myprint($prompts{cpan_home_where}) unless $auto_config;
}
my $default = $cpan_home;
my $loop = 0;
my($last_ans,$ans);
- $CPAN::Frontend->myprint(" <cpan_home>\n") unless $silent;
+ $CPAN::Frontend->myprint(" <cpan_home>\n") unless $auto_config;
PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) {
if (File::Spec->file_name_is_absolute($ans)) {
my @cpan_home = split /[\/\\]/, $ans;
@@ -1372,18 +1631,21 @@ Shall we use it as the general CPAN build and cache directory?
}
sub my_dflt_prompt {
- my ($item, $dflt, $m) = @_;
+ my ($item, $dflt, $m, $no_strip) = @_;
my $default = $CPAN::Config->{$item} || $dflt;
- if (!$silent && (!$m || $item =~ /$m/)) {
+ if (!$auto_config && (!$m || $item =~ /$m/)) {
if (my $intro = $prompts{$item . "_intro"}) {
$CPAN::Frontend->myprint($intro);
}
$CPAN::Frontend->myprint(" <$item>\n");
- $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
+ $CPAN::Config->{$item} =
+ $no_strip ? prompt_no_strip($prompts{$item}, $default)
+ : prompt( $prompts{$item}, $default);
} else {
$CPAN::Config->{$item} = $default;
}
+ return $CPAN::Config->{$item};
}
sub my_yn_prompt {
@@ -1392,7 +1654,7 @@ sub my_yn_prompt {
defined($default = $CPAN::Config->{$item}) or $default = $dflt;
# $DB::single = 1;
- if (!$silent && (!$m || $item =~ /$m/)) {
+ if (!$auto_config && (!$m || $item =~ /$m/)) {
if (my $intro = $prompts{$item . "_intro"}) {
$CPAN::Frontend->myprint($intro);
}
@@ -1409,7 +1671,7 @@ sub my_prompt_loop {
my $default = $CPAN::Config->{$item} || $dflt;
my $ans;
- if (!$silent && (!$m || $item =~ /$m/)) {
+ if (!$auto_config && (!$m || $item =~ /$m/)) {
$CPAN::Frontend->myprint($prompts{$item . "_intro"});
$CPAN::Frontend->myprint(" <$item>\n");
do { $ans = prompt($prompts{$item}, $default);
@@ -1524,6 +1786,7 @@ HERE
sub find_exe {
my($exe,$path) = @_;
+ $path ||= [split /$Config{'path_sep'}/, $ENV{'PATH'}];
my($dir);
#warn "in find_exe exe[$exe] path[@$path]";
for $dir (@$path) {
@@ -1611,7 +1874,7 @@ sub display_some {
for my $item (@displayable) {
$CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item);
}
- my $hit_what = $default ? "SPACE RETURN" : "RETURN";
+ my $hit_what = $default ? "SPACE ENTER" : "ENTER";
$CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n",
(@$items - $pos),
$hit_what,
@@ -1623,17 +1886,20 @@ sub display_some {
sub auto_mirrored_by {
my $local = shift or return;
local $|=1;
- $CPAN::Frontend->myprint("Searching for the best CPAN mirrors (please be patient) ...");
+ $CPAN::Frontend->myprint("Looking for CPAN mirrors near you (please be patient)\n");
my $mirrors = CPAN::Mirrors->new($local);
my $cnt = 0;
my @best = $mirrors->best_mirrors(
- how_many => 5,
- callback => sub { $CPAN::Frontend->myprint(".") },
+ how_many => 3,
+ callback => sub {
+ $CPAN::Frontend->myprint(".");
+ if ($cnt++>60) { $cnt=0; $CPAN::Frontend->myprint("\n"); }
+ },
);
- my $urllist = [ map { $_->ftp } @best ];
+ my $urllist = [ map { $_->http } @best ];
push @$urllist, grep { /^file:/ } @{$CPAN::Config->{urllist}};
$CPAN::Frontend->myprint(" done!\n\n");
- return $urllist;
+ return $urllist
}
sub choose_mirrored_by {
@@ -1704,7 +1970,7 @@ put them on one line, separated by blanks, hyphenated ranges allowed
if (@previous_urls) {
$default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
(scalar @urls));
- $prompt .= "\n(or just hit RETURN to keep your previous picks)";
+ $prompt .= "\n(or just hit ENTER to keep your previous picks)";
}
@urls = picklist (\@urls, $prompt, $default);
@@ -1724,7 +1990,7 @@ listed using a 'file:' URL like 'file:///path/to/cpan/'
HERE
do {
- my $prompt = "Enter another URL or RETURN to quit:";
+ my $prompt = "Enter another URL or ENTER to quit:";
unless (%seen) {
$prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
@@ -1767,10 +2033,32 @@ later if you\'re sure it\'s right.\n},
}
sub _print_urllist {
- $CPAN::Frontend->myprint("New urllist\n");
+ my ($which) = @_;
+ $CPAN::Frontend->myprint("$which urllist\n");
for ( @{$CPAN::Config->{urllist} || []} ) {
$CPAN::Frontend->myprint(" $_\n")
};
+ $CPAN::Frontend->myprint("\n");
+}
+
+sub _can_write_to_libdirs {
+ return -w $Config{installprivlib}
+ && -w $Config{installarchlib}
+ && -w $Config{installsitelib}
+ && -w $Config{installsitearch}
+}
+
+sub _using_installbase {
+ return 1 if $ENV{PERL_MM_OPT} && $ENV{PERL_MM_OPT} =~ /install_base/i;
+ return 1 if grep { ($CPAN::Config->{$_}||q{}) =~ /install_base/i }
+ qw(makepl_arg make_install_arg mbuildpl_arg mbuild_install_arg);
+ return;
+}
+
+sub _using_sudo {
+ return 1 if grep { ($CPAN::Config->{$_}||q{}) =~ /sudo/ }
+ qw(make_install_make_command mbuild_install_build_command);
+ return;
}
sub _strip_spaces {
@@ -1792,6 +2080,9 @@ sub prompt ($;$) {
sub prompt_no_strip ($;$) {
+ unless (defined &_real_prompt) {
+ *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
+ }
return _real_prompt(@_);
}
diff --git a/cpan/CPAN/lib/CPAN/HTTP/Client.pm b/cpan/CPAN/lib/CPAN/HTTP/Client.pm
new file mode 100644
index 0000000000..c9821d3bd6
--- /dev/null
+++ b/cpan/CPAN/lib/CPAN/HTTP/Client.pm
@@ -0,0 +1,254 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
+package CPAN::HTTP::Client;
+use strict;
+use vars qw(@ISA);
+use CPAN::HTTP::Credentials;
+use HTTP::Tiny 0.005;
+
+$CPAN::HTTP::Client::VERSION = $CPAN::HTTP::Client::VERSION = "1.94";
+
+# CPAN::HTTP::Client is adapted from parts of cpanm by Tatsuhiko Miyagawa
+# and parts of LWP by Gisle Aas
+
+sub new {
+ my $class = shift;
+ my %args = @_;
+ for my $k ( keys %args ) {
+ $args{$k} = '' unless defined $args{$k};
+ }
+ $args{no_proxy} = [split(",", $args{no_proxy}) ] if $args{no_proxy};
+ return bless \%args, $class;
+}
+
+# This executes a request with redirection (up to 5) and returns the
+# response structure generated by HTTP::Tiny
+#
+# If authentication fails, it will attempt to get new authentication
+# information and repeat up to 5 times
+
+sub mirror {
+ my($self, $uri, $path) = @_;
+
+ my $want_proxy = $self->_want_proxy($uri);
+ my $http = HTTP::Tiny->new(
+ $want_proxy ? (proxy => $self->{proxy}) : ()
+ );
+
+ my ($response, %headers);
+ my $retries = 0;
+ while ( $retries++ < 5 ) {
+ $response = $http->mirror( $uri, $path, {headers => \%headers} );
+ if ( $response->{status} eq '401' ) {
+ last unless $self->_get_auth_params( $response, 'non_proxy' );
+ }
+ elsif ( $response->{status} eq '407' ) {
+ last unless $self->_get_auth_params( $response, 'proxy' );
+ }
+ else {
+ last; # either success or failure
+ }
+ my %headers = (
+ $self->_auth_headers( $uri, 'non_proxy' ),
+ ( $want_proxy ? $self->_auth_headers($uri, 'proxy') : () ),
+ );
+ }
+
+ return $response;
+}
+
+sub _want_proxy {
+ my ($self, $uri) = @_;
+ return unless $self->{proxy};
+ my($host) = $uri =~ m|://([^/:]+)|;
+ return ! grep { $host =~ /\Q$_\E$/ } @{ $self->{no_proxy} || [] };
+}
+
+# Generates the authentication headers for a given mode
+# C<mode> is 'proxy' or 'non_proxy'
+# C<_${mode}_type> is 'basic' or 'digest'
+# C<_${mode}_params> will be the challenge parameters from the 401/407 headers
+sub _auth_headers {
+ my ($self, $uri, $mode) = @_;
+ # Get names for our mode-specific attributes
+ my ($type_key, $param_key) = map {"_" . $mode . $_} qw/_type _params/;
+
+ # If _prepare_auth has not been called, we can't prepare headers
+ return unless $self->{$type_key};
+
+ # Get user credentials for mode
+ my $cred_method = "get_" . ($mode ? "proxy" : "non_proxy") ."_credentials";
+ my ($user, $pass) = return CPAN::HTTP::Credentials->$cred_method;
+
+ # Generate the header for the mode & type
+ my $header = $mode eq 'proxy' ? 'Proxy-Authorization' : 'Authorization';
+ my $value_method = "_" . $self->{$type_key} . "_auth";
+ my $value = $self->$value_method($user, $pass, $self->{$param_key}, $uri);
+
+ # If we didn't get a value, we didn't have the right modules available
+ return $value ? ( $header, $value ) : ();
+}
+
+# Extract authentication parameters from headers, but clear any prior
+# credentials if we failed (so we might prompt user for password again)
+sub _get_auth_params {
+ my ($self, $response, $mode) = @_;
+ my $prefix = $mode eq 'proxy' ? 'Proxy' : 'WWW';
+ my ($type_key, $param_key) = map {"_" . $mode . $_} qw/_type _params/;
+ if ( ! $response->{success} ) { # auth failed
+ my $method = "clear_${mode}_credentials";
+ CPAN::HTTP::Credentials->$method;
+ delete $self->{$_} for $type_key, $param_key;
+ }
+ ($self->{$type_key}, $self->{$param_key}) =
+ $self->_get_challenge( $response, "${prefix}-Authenticate");
+ return $self->{$type_key};
+}
+
+# Extract challenge type and parameters for a challenge list
+sub _get_challenge {
+ my ($self, $response, $auth_header) = @_;
+
+ my $auth_list = $response->{headers}(lc $auth_header);
+ return unless defined $auth_list;
+ $auth_list = [$auth_list] unless ref $auth_list;
+
+ for my $challenge (@$auth_list) {
+ $challenge =~ tr/,/;/; # "," is used to separate auth-params!!
+ ($challenge) = $self->split_header_words($challenge);
+ my $scheme = shift(@$challenge);
+ shift(@$challenge); # no value
+ $challenge = { @$challenge }; # make rest into a hash
+
+ unless ($scheme =~ /^(basic|digest)$/) {
+ next; # bad scheme
+ }
+ $scheme = $1; # untainted now
+
+ return ($scheme, $challenge);
+ }
+ return;
+}
+
+# Generate a basic authentication header value
+sub _basic_auth {
+ my ($self, $user, $pass) = @_;
+ unless ( $CPAN::META->has_usable('MIME::Base64') ) {
+ $CPAN::Frontend->mywarn(
+ "MIME::Base64 is required for 'Basic' style authentication"
+ );
+ return;
+ }
+ return "Basic " . MIME::Base64::encode_base64("$user\:$pass", q{});
+}
+
+# Generate a digest authentication header value
+sub _digest_auth {
+ my ($self, $user, $pass, $auth_param, $uri) = @_;
+ unless ( $CPAN::META->has_usable('Digest::MD5') ) {
+ $CPAN::Frontend->mywarn(
+ "Digest::MD5 is required for 'Digest' style authentication"
+ );
+ return;
+ }
+
+ my $nc = sprintf "%08X", ++$self->{_nonce_count}{$auth_param->{nonce}};
+ my $cnonce = sprintf "%8x", time;
+
+ my ($path) = $uri =~ m{^\w+?://[^/]+(/.*)$};
+ $path = "/" unless defined $path;
+
+ my $md5 = Digest::MD5->new;
+
+ my(@digest);
+ $md5->add(join(":", $user, $auth_param->{realm}, $pass));
+ push(@digest, $md5->hexdigest);
+ $md5->reset;
+
+ push(@digest, $auth_param->{nonce});
+
+ if ($auth_param->{qop}) {
+ push(@digest, $nc, $cnonce, ($auth_param->{qop} =~ m|^auth[,;]auth-int$|) ? 'auth' : $auth_param->{qop});
+ }
+
+ $md5->add(join(":", 'GET', $path));
+ push(@digest, $md5->hexdigest);
+ $md5->reset;
+
+ $md5->add(join(":", @digest));
+ my($digest) = $md5->hexdigest;
+ $md5->reset;
+
+ my %resp = map { $_ => $auth_param->{$_} } qw(realm nonce opaque);
+ @resp{qw(username uri response algorithm)} = ($user, $path, $digest, "MD5");
+
+ if (($auth_param->{qop} || "") =~ m|^auth([,;]auth-int)?$|) {
+ @resp{qw(qop cnonce nc)} = ("auth", $cnonce, $nc);
+ }
+
+ my(@order) =
+ qw(username realm qop algorithm uri nonce nc cnonce response opaque);
+ my @pairs;
+ for (@order) {
+ next unless defined $resp{$_};
+ push(@pairs, "$_=" . qq("$resp{$_}"));
+ }
+
+ my $auth_value = "Digest " . join(", ", @pairs);
+ return $auth_value;
+}
+
+# split_header_words adapted from HTTP::Headers::Util
+sub split_header_words {
+ my ($self, @words) = @_;
+ my @res = $self->_split_header_words(@words);
+ for my $arr (@res) {
+ for (my $i = @$arr - 2; $i >= 0; $i -= 2) {
+ $arr->[$i] = lc($arr->[$i]);
+ }
+ }
+ return @res;
+}
+
+sub _split_header_words {
+ my($self, @val) = @_;
+ my @res;
+ for (@val) {
+ my @cur;
+ while (length) {
+ if (s/^\s*(=*[^\s=;,]+)//) { # 'token' or parameter 'attribute'
+ push(@cur, $1);
+ # a quoted value
+ if (s/^\s*=\s*\"([^\"\\]*(?:\\.[^\"\\]*)*)\"//) {
+ my $val = $1;
+ $val =~ s/\\(.)/$1/g;
+ push(@cur, $val);
+ # some unquoted value
+ }
+ elsif (s/^\s*=\s*([^;,\s]*)//) {
+ my $val = $1;
+ $val =~ s/\s+$//;
+ push(@cur, $val);
+ # no value, a lone token
+ }
+ else {
+ push(@cur, undef);
+ }
+ }
+ elsif (s/^\s*,//) {
+ push(@res, [@cur]) if @cur;
+ @cur = ();
+ }
+ elsif (s/^\s*;// || s/^\s+//) {
+ # continue
+ }
+ else {
+ die "This should not happen: '$_'";
+ }
+ }
+ push(@res, \@cur) if @cur;
+ }
+ @res;
+}
+
+1;
diff --git a/cpan/CPAN/lib/CPAN/HTTP/Credentials.pm b/cpan/CPAN/lib/CPAN/HTTP/Credentials.pm
new file mode 100644
index 0000000000..3caccd8502
--- /dev/null
+++ b/cpan/CPAN/lib/CPAN/HTTP/Credentials.pm
@@ -0,0 +1,91 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
+package CPAN::HTTP::Credentials;
+use strict;
+use vars qw($USER $PASSWORD $PROXY_USER $PROXY_PASSWORD);
+
+$CPAN::HTTP::Credentials::VERSION = $CPAN::HTTP::Credentials::VERSION = "1.94";
+
+sub clear_credentials {
+ _clear_non_proxy_credentials();
+ _clear_proxy_credentials();
+}
+
+sub clear_non_proxy_credentials {
+ undef $USER;
+ undef $PASSWORD;
+}
+
+sub clear_proxy_credentials {
+ undef $PROXY_USER;
+ undef $PROXY_PASSWORD;
+}
+
+sub get_proxy_credentials {
+ my $self = shift;
+ if ($PROXY_USER && $PROXY_PASSWORD) {
+ return ($PROXY_USER, $PROXY_PASSWORD);
+ }
+ if ( defined $CPAN::Config->{proxy_user}
+ && $CPAN::Config->{proxy_user}
+ ) {
+ $PROXY_USER = $CPAN::Config->{proxy_user};
+ $PROXY_PASSWORD = $CPAN::Config->{proxy_pass} || "";
+ return ($PROXY_USER, $PROXY_PASSWORD);
+ }
+ my $username_prompt = "\nProxy authentication needed!
+ (Note: to permanently configure username and password run
+ o conf proxy_user your_username
+ o conf proxy_pass your_password
+ )\nUsername:";
+ ($PROXY_USER, $PROXY_PASSWORD) =
+ _get_username_and_password_from_user($username_prompt);
+ return ($PROXY_USER,$PROXY_PASSWORD);
+}
+
+sub get_non_proxy_credentials {
+ my $self = shift;
+ if ($USER && $PASSWORD) {
+ return ($USER, $PASSWORD);
+ }
+ if ( defined $CPAN::Config->{username} ) {
+ $USER = $CPAN::Config->{username};
+ $PASSWORD = $CPAN::Config->{password} || "";
+ return ($USER, $PASSWORD);
+ }
+ my $username_prompt = "\nAuthentication needed!
+ (Note: to permanently configure username and password run
+ o conf username your_username
+ o conf password your_password
+ )\nUsername:";
+
+ ($USER, $PASSWORD) =
+ _get_username_and_password_from_user($username_prompt);
+ return ($USER,$PASSWORD);
+}
+
+sub _get_username_and_password_from_user {
+ my $username_message = shift;
+ my ($username,$password);
+
+ ExtUtils::MakeMaker->import(qw(prompt));
+ $username = prompt($username_message);
+ if ($CPAN::META->has_inst("Term::ReadKey")) {
+ Term::ReadKey::ReadMode("noecho");
+ }
+ else {
+ $CPAN::Frontend->mywarn(
+ "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
+ );
+ }
+ $password = prompt("Password:");
+
+ if ($CPAN::META->has_inst("Term::ReadKey")) {
+ Term::ReadKey::ReadMode("restore");
+ }
+ $CPAN::Frontend->myprint("\n\n");
+ return ($username,$password);
+}
+
+1;
+
diff --git a/cpan/CPAN/lib/CPAN/HandleConfig.pm b/cpan/CPAN/lib/CPAN/HandleConfig.pm
index 76cd81eee8..cca1186077 100644
--- a/cpan/CPAN/lib/CPAN/HandleConfig.pm
+++ b/cpan/CPAN/lib/CPAN/HandleConfig.pm
@@ -12,8 +12,8 @@ $VERSION = "5.5001"; # see also CPAN::Config::VERSION at end of file
);
# 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
+# A1: svn diff -r 757:758 # where dagolden added test_report [git e997b71de88f1019a1472fc13cb97b1b7f96610f]
+# A2: svn diff -r 985:986 # where andk added yaml_module [git 312b6d9b12b1bdec0b6e282d853482145475021f]
# 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
@@ -78,6 +78,7 @@ $VERSION = "5.5001"; # see also CPAN::Config::VERSION at end of file
"patch",
"patches_dir",
"perl5lib_verbosity",
+ "prefer_external_tar",
"prefer_installer",
"prefs_dir",
"prerequisites_policy",
@@ -97,6 +98,7 @@ $VERSION = "5.5001"; # see also CPAN::Config::VERSION at end of file
"trust_test_report_history",
"unzip",
"urllist",
+ "use_file_homedir",
"use_sqlite",
"username",
"version_timeout",
@@ -503,7 +505,7 @@ sub home () {
# 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")) {
+ if (CPAN::_use_file_homedir()) {
if ($^O eq 'darwin') {
$home = File::HomeDir->my_home; # my_data is ~/Library/Application Support on darwin,
# which causes issues in the toolchain.
@@ -521,7 +523,8 @@ sub home () {
sub load {
my($self, %args) = @_;
- $CPAN::Be_Silent++ if $args{be_silent};
+ $CPAN::Be_Silent+=0; # protect against 'used only once'
+ $CPAN::Be_Silent++ if $args{be_silent}; # do not use; planned to be removed in 2011
my $doit;
$doit = delete $args{doit} || 0;
$loading = 0 unless defined $loading;
diff --git a/cpan/CPAN/lib/CPAN/Index.pm b/cpan/CPAN/lib/CPAN/Index.pm
index 9df757de70..fa33801d83 100644
--- a/cpan/CPAN/lib/CPAN/Index.pm
+++ b/cpan/CPAN/lib/CPAN/Index.pm
@@ -292,6 +292,7 @@ sub rd_modpacks {
$shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
}
CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
+ my $errors = 0;
if (not defined $line_count) {
$CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
@@ -299,7 +300,7 @@ Please check the validity of the index file by comparing it to more
than one CPAN mirror. I'll continue but problems seem likely to
happen.\a
});
-
+ $errors++;
$CPAN::Frontend->mysleep(5);
} elsif ($line_count != scalar @lines) {
@@ -317,7 +318,7 @@ Please check the validity of the index file by comparing it to more
than one CPAN mirror. I'll continue but problems seem likely to
happen.\a
});
-
+ $errors++;
$CPAN::Frontend->mysleep(5);
} else {
@@ -371,14 +372,19 @@ happen.\a
my(%exists);
my $i = 0;
my $painted = 0;
- foreach (@lines) {
+ LINE: foreach (@lines) {
# before 1.56 we split into 3 and discarded the rest. From
# 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;
+ require Dumpvalue;
+ my $dv = Dumpvalue->new(tick => '"');
+ $CPAN::Frontend->mywarn(sprintf "Could not split line[%s]\n", $dv->stringify($_));
+ if ($errors++ >= 5){
+ $CPAN::Frontend->mydie("Giving up parsing your $index_target, too many errors");
+ }
+ next LINE;
}
my($bundle,$id,$userid);
diff --git a/cpan/CPAN/lib/CPAN/LWP/UserAgent.pm b/cpan/CPAN/lib/CPAN/LWP/UserAgent.pm
index 2e5c8c6c3d..18aba1a6df 100644
--- a/cpan/CPAN/lib/CPAN/LWP/UserAgent.pm
+++ b/cpan/CPAN/lib/CPAN/LWP/UserAgent.pm
@@ -3,10 +3,12 @@
package CPAN::LWP::UserAgent;
use strict;
use vars qw(@ISA $USER $PASSWD $SETUPDONE);
+use CPAN::HTTP::Credentials;
# we delay requiring LWP::UserAgent and setting up inheritance until we need it
$CPAN::LWP::UserAgent::VERSION = $CPAN::LWP::UserAgent::VERSION = "1.94";
+
sub config {
return if $SETUPDONE;
if ($CPAN::META->has_usable('LWP::UserAgent')) {
@@ -20,80 +22,13 @@ sub config {
sub get_basic_credentials {
my($self, $realm, $uri, $proxy) = @_;
- if ($USER && $PASSWD) {
- return ($USER, $PASSWD);
- }
if ( $proxy ) {
- ($USER,$PASSWD) = $self->get_proxy_credentials();
+ return CPAN::HTTP::Credentials->get_proxy_credentials();
} else {
- ($USER,$PASSWD) = $self->get_non_proxy_credentials();
- }
- return($USER,$PASSWD);
-}
-
-sub get_proxy_credentials {
- my $self = shift;
- my ($user, $password);
- if ( defined $CPAN::Config->{proxy_user}
- && $CPAN::Config->{proxy_user}
- ) {
- $user = $CPAN::Config->{proxy_user};
- $password = $CPAN::Config->{proxy_pass} || "";
- return ($user, $password);
+ return CPAN::HTTP::Credentials->get_non_proxy_credentials();
}
- my $username_prompt = "\nProxy authentication needed!
- (Note: to permanently configure username and password run
- o conf proxy_user your_username
- o conf proxy_pass your_password
- )\nUsername:";
- ($user, $password) =
- _get_username_and_password_from_user($username_prompt);
- return ($user,$password);
}
-sub get_non_proxy_credentials {
- my $self = shift;
- my ($user,$password);
- if ( defined $CPAN::Config->{username} ) {
- $user = $CPAN::Config->{username};
- $password = $CPAN::Config->{password} || "";
- return ($user, $password);
- }
- my $username_prompt = "\nAuthentication needed!
- (Note: to permanently configure username and password run
- o conf username your_username
- o conf password your_password
- )\nUsername:";
-
- ($user, $password) =
- _get_username_and_password_from_user($username_prompt);
- return ($user,$password);
-}
-
-sub _get_username_and_password_from_user {
- my $username_message = shift;
- my ($username,$password);
-
- ExtUtils::MakeMaker->import(qw(prompt));
- $username = prompt($username_message);
- if ($CPAN::META->has_inst("Term::ReadKey")) {
- Term::ReadKey::ReadMode("noecho");
- }
- else {
- $CPAN::Frontend->mywarn(
- "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
- );
- }
- $password = prompt("Password:");
-
- if ($CPAN::META->has_inst("Term::ReadKey")) {
- Term::ReadKey::ReadMode("restore");
- }
- $CPAN::Frontend->myprint("\n\n");
- return ($username,$password);
-}
-
-
sub no_proxy {
my ( $self, $no_proxy ) = @_;
return $self->SUPER::no_proxy( split(',',$no_proxy) );
@@ -133,8 +68,7 @@ sub mirror {
my($self,$url,$aslocal) = @_;
my $result = $self->SUPER::mirror($url,$aslocal);
if ($result->code == 407) {
- undef $USER;
- undef $PASSWD;
+ CPAN::HTTP::Credentials->clear_credentials;
$result = $self->SUPER::mirror($url,$aslocal);
}
$result;
diff --git a/cpan/CPAN/lib/CPAN/Mirrors.pm b/cpan/CPAN/lib/CPAN/Mirrors.pm
index 1a3402e8de..ae1c9fbd3a 100644
--- a/cpan/CPAN/lib/CPAN/Mirrors.pm
+++ b/cpan/CPAN/lib/CPAN/Mirrors.pm
@@ -8,6 +8,7 @@ $VERSION = "1.77";
use Carp;
use FileHandle;
use Fcntl ":flock";
+use Net::Ping ();
sub new {
my ($class, $file) = @_;
@@ -63,27 +64,38 @@ sub best_mirrors {
my $conts = $args{continents} || [];
$conts = [$conts] unless ref $conts;
+ # Old Net::Ping did not do timings at all
+ return "http://www.cpan.org/" unless Net::Ping->VERSION gt '2.13';
+
my $seen = {};
if ( ! @$conts ) {
print "Searching for the best continent ...\n" if $verbose;
my @best = $self->_find_best_continent($seen, $verbose, $callback);
- # how many continents to find enough mirrors? We should scan
- # more than we need -- arbitrarily, we'll say x2
+ # Only add enough continents to find enough mirrors
my $count = 0;
for my $c ( @best ) {
push @$conts, $c;
$count += $self->mirrors( $self->countries($c) );
- last if $count >= 2 * $how_many;
+ last if $count >= $how_many;
}
}
print "Scanning " . join(", ", @$conts) . " ...\n" if $verbose;
my @timings;
- for my $m ($self->mirrors($self->countries(@$conts))) {
- next unless $m->ftp;
+ my @long_list = $self->mirrors($self->countries(@$conts));
+ my $long_list_size = ( $how_many > 10 ? $how_many : 10 );
+ if ( @long_list > $long_list_size ) {
+ @long_list = map {$_->[0]}
+ sort {$a->[1] <=> $b->[1]}
+ map {[$_, rand]} @long_list;
+ splice @long_list, $long_list_size; # truncate
+ }
+
+ for my $m ( @long_list ) {
+ next unless $m->http;
my $hostname = $m->hostname;
if ( $seen->{$hostname} ) {
push @timings, $seen->{$hostname}
@@ -97,6 +109,7 @@ sub best_mirrors {
}
}
return unless @timings;
+
$how_many = @timings if $how_many > @timings;
my @best =
map { $_->[0] }
@@ -112,7 +125,7 @@ sub _find_best_continent {
CONT: for my $c ( $self->continents ) {
my @mirrors = $self->mirrors( $self->countries($c) );
next CONT unless @mirrors;
- my $sample = 9;
+ my $sample = 3;
my $n = (@mirrors < $sample) ? @mirrors : $sample;
my @tests;
RANDOM: while ( @mirrors && @tests < $n ) {
@@ -240,7 +253,7 @@ sub rsync { shift->{rsync} || '' }
sub url {
my $self = shift;
- return $self->{ftp} || $self->{http};
+ return $self->{http} || $self->{ftp};
}
sub ping {
@@ -249,8 +262,13 @@ sub ping {
my ($proto) = $self->url =~ m{^([^:]+)};
my $port = $proto eq 'http' ? 80 : 21;
return unless $port;
+ if ( $ping->can('port_number') ) {
$ping->port_number($port);
- $ping->hires(1);
+ }
+ else {
+ $ping->{'port_num'} = $port;
+ }
+ $ping->hires(1) if $ping->can('hires');
my ($alive,$rtt) = $ping->ping($self->hostname);
return $alive ? $rtt : undef;
}
diff --git a/cpan/CPAN/lib/CPAN/Tarzip.pm b/cpan/CPAN/lib/CPAN/Tarzip.pm
index 63451e7450..972df6ca06 100644
--- a/cpan/CPAN/lib/CPAN/Tarzip.pm
+++ b/cpan/CPAN/lib/CPAN/Tarzip.pm
@@ -253,14 +253,21 @@ sub untar {
if (0) { # makes changing order easier
} elsif ($BUGHUNTING) {
$prefer=2;
- } elsif ($exttar && $extgzip && $file =~ /\.(?:bz2|tbz)$/i) {
- # until Archive::Tar handles bzip2
+ } elsif ($CPAN::Config->{prefer_external_tar}) {
$prefer = 1;
} elsif (
$CPAN::META->has_usable("Archive::Tar")
&&
$CPAN::META->has_inst("Compress::Zlib") ) {
- $prefer = 2;
+ my $prefer_external_tar = $CPAN::Config->{prefer_external_tar};
+ unless (defined $prefer_external_tar) {
+ if ($^O =~ /(MSWin32|solaris)/) {
+ $prefer_external_tar = 0;
+ } else {
+ $prefer_external_tar = 1;
+ }
+ }
+ $prefer = $prefer_external_tar ? 1 : 2;
} elsif ($exttar && $extgzip) {
# no modules and not bz2
$prefer = 1;
diff --git a/cpan/CPAN/t/11mirroredby.t b/cpan/CPAN/t/11mirroredby.t
index 444ceb18c1..42b359d97e 100644
--- a/cpan/CPAN/t/11mirroredby.t
+++ b/cpan/CPAN/t/11mirroredby.t
@@ -26,7 +26,7 @@ isa_ok( $cmb, 'CPAN::Mirrored::By' );
is( $cmb->continent(), 'continent',
'continent() should return continent entry' );
is( $cmb->country(), 'country', 'country() should return country entry' );
-is( $cmb->url(), 'ftp', 'url() should return best url entry' );
+is( $cmb->url(), 'http', 'url() should return best url entry' );
__END__
# Local Variables: