summaryrefslogtreecommitdiff
path: root/lib/CPAN
diff options
context:
space:
mode:
authorSteve Peters <steve@fisharerojo.org>2007-10-02 13:39:06 +0000
committerSteve Peters <steve@fisharerojo.org>2007-10-02 13:39:06 +0000
commit547d3dfd0918e1335aa86e352904fbb22cccfb6d (patch)
treed14fc423423be4e8c31fc6fc5da12c189125f68c /lib/CPAN
parent8dbc25a7eceae74c5e1ad14a02cc8019dd0767a2 (diff)
downloadperl-547d3dfd0918e1335aa86e352904fbb22cccfb6d.tar.gz
Upgrade to CPAN-1.9203
p4raw-id: //depot/perl@32008
Diffstat (limited to 'lib/CPAN')
-rw-r--r--lib/CPAN/API/HOWTO.pm44
-rw-r--r--lib/CPAN/Debug.pm4
-rw-r--r--lib/CPAN/DeferedCode.pm16
-rw-r--r--lib/CPAN/FirstTime.pm1316
-rw-r--r--lib/CPAN/HandleConfig.pm266
-rw-r--r--lib/CPAN/Kwalify/distroprefs.dd20
-rw-r--r--lib/CPAN/Kwalify/distroprefs.yml13
-rw-r--r--lib/CPAN/Queue.pm135
-rw-r--r--lib/CPAN/Tarzip.pm525
-rw-r--r--lib/CPAN/Version.pm151
-rw-r--r--lib/CPAN/t/03pkgs.t2
-rw-r--r--lib/CPAN/t/10version.t13
12 files changed, 1352 insertions, 1153 deletions
diff --git a/lib/CPAN/API/HOWTO.pm b/lib/CPAN/API/HOWTO.pm
new file mode 100644
index 0000000000..e65a4bc931
--- /dev/null
+++ b/lib/CPAN/API/HOWTO.pm
@@ -0,0 +1,44 @@
+=head1 NAME
+
+CPAN::API::HOWTO - a recipe book for programming with CPAN.pm
+
+=head1 RECIPES
+
+All of these recipes assume that you have put "use CPAN" at the top of
+your program.
+
+=head2 What distribution contains a particular module?
+
+ my $distribution = CPAN::Shell->expand(
+ "Module", "Data::UUID"
+ )->distribution()->pretty_id();
+
+This returns a string of the form "AUTHORID/TARBALL". If you want the
+full path and filename to this distribution on a CPAN mirror, then it is
+C<.../authors/id/A/AU/AUTHORID/TARBALL>.
+
+=head2 What modules does a particular distribution contain?
+
+ CPAN::Index->reload();
+ my @modules = CPAN::Shell->expand(
+ "Distribution", "JHI/Graph-0.83.tar.gz"
+ )->containsmods();
+
+You may also refer to a distribution in the form A/AU/AUTHORID/TARBALL.
+
+=head1 SEE ALSO
+
+the main CPAN.pm documentation
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=head1 AUTHOR
+
+David Cantrell
+
+=cut
diff --git a/lib/CPAN/Debug.pm b/lib/CPAN/Debug.pm
index 239fb6b0ea..086b623852 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: 955 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
# module is internal to CPAN.pm
%CPAN::DEBUG = qw[
@@ -48,7 +48,7 @@ sub debug {
last if ++$i>=3;
}
pop @caller;
- if ($CPAN::DEBUG{$caller[0][0]} & $CPAN::DEBUG){
+ if ($CPAN::DEBUG{$caller[0][0]} & $CPAN::DEBUG) {
if ($arg and ref $arg) {
eval { require Data::Dumper };
if ($@) {
diff --git a/lib/CPAN/DeferedCode.pm b/lib/CPAN/DeferedCode.pm
new file mode 100644
index 0000000000..c57669b177
--- /dev/null
+++ b/lib/CPAN/DeferedCode.pm
@@ -0,0 +1,16 @@
+package CPAN::DeferedCode;
+
+use strict;
+use vars qw/$VERSION/;
+
+use overload fallback => 1, map { ($_ => 'run') } qw/
+ bool "" 0+
+/;
+
+$VERSION = "5.50";
+
+sub run {
+ $_[0]->();
+}
+
+1;
diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm
index 02a7f85b9e..d5d3e21763 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: 1669 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 2229 $,4)/1000000 + 5.4;
=head1 NAME
@@ -34,6 +34,475 @@ CPAN::FirstTime::init()
The init routine asks a few questions and writes a CPAN/Config.pm or
CPAN/MyConfig.pm file (depending on what it is currently using).
+In the following all questions and explanations regarding config
+variables are collected.
+
+=cut
+
+# down until the next =back the manpage must be parsed by the program
+# because the text is used in the init dialogues.
+
+=over 2
+
+=item auto_commit
+
+Normally CPAN.pm keeps config variables in memory and changes need to
+be saved in a separate 'o conf commit' command to make them permanent
+between sessions. If you set the 'auto_commit' option to true, changes
+to a config variable are always automatically committed to disk.
+
+Always commit changes to config variables to disk?
+
+=item build_cache
+
+CPAN.pm can limit the size of the disk area for keeping the build
+directories with all the intermediate files.
+
+Cache size for build directory (in MB)?
+
+=item build_dir
+
+Directory where the build process takes place?
+
+=item build_dir_reuse
+
+Until version 1.88 CPAN.pm never trusted the contents of the build_dir
+directory between sessions. Since 1.88_58 CPAN.pm has a YAML-based
+mechanism that makes it possible to share the contents of the
+build_dir/ directory between different sessions with the same version
+of perl. People who prefer to test things several days before
+installing will like this feature because it safes a lot of time.
+
+If you say yes to the following question, CPAN will try to store
+enough information about the build process so that it can pick up in
+future sessions at the same state of affairs as it left a previous
+session.
+
+Store and re-use state information about distributions between
+CPAN.pm sessions?
+
+=item build_requires_install_policy
+
+When a module declares another one as a 'build_requires' prerequisite
+this means that the other module is only needed for building or
+testing the module but need not be installed permanently. In this case
+you may wish to install that other module nonetheless or just keep it
+in the 'build_dir' directory to have it available only temporarily.
+Installing saves time on future installations but makes the perl
+installation bigger.
+
+You can choose if you want to always install (yes), never install (no)
+or be always asked. In the latter case you can set the default answer
+for the question to yes (ask/yes) or no (ask/no).
+
+Policy on installing 'build_requires' modules (yes, no, ask/yes,
+ask/no)?
+
+=item cache_metadata
+
+To considerably speed up the initial CPAN shell startup, it is
+possible to use Storable to create a cache of metadata. If Storable is
+not available, the normal index mechanism will be used.
+
+Note: this mechanism is not used when use_sqlite is on and SQLLite is
+running.
+
+Cache metadata (yes/no)?
+
+=item check_sigs
+
+CPAN packages can be digitally signed by authors and thus verified
+with the security provided by strong cryptography. The exact mechanism
+is defined in the Module::Signature module. While this is generally
+considered a good thing, it is not always convenient to the end user
+to install modules that are signed incorrectly or where the key of the
+author is not available or where some prerequisite for
+Module::Signature has a bug and so on.
+
+With the check_sigs parameter you can turn signature checking on and
+off. The default is off for now because the whole tool chain for the
+functionality is not yet considered mature by some. The author of
+CPAN.pm would recommend setting it to true most of the time and
+turning it off only if it turns out to be annoying.
+
+Note that if you do not have Module::Signature installed, no signature
+checks will be performed at all.
+
+Always try to check and verify signatures if a SIGNATURE file is in
+the package and Module::Signature is installed (yes/no)?
+
+=item colorize_output
+
+When you have Term::ANSIColor installed, you can turn on colorized
+output to have some visual differences between normal CPAN.pm output,
+warnings, debugging output, and the output of the modules being
+installed. Set your favorite colors after some experimenting with the
+Term::ANSIColor module.
+
+Do you want to turn on colored output?
+
+=item colorize_print
+
+Color for normal output?
+
+=item colorize_warn
+
+Color for warnings?
+
+=item colorize_debug
+
+Color for debugging messages?
+
+=item commandnumber_in_prompt
+
+The prompt of the cpan shell can contain the current command number
+for easier tracking of the session or be a plain string.
+
+Do you want the command number in the prompt (yes/no)?
+
+=item ftp_passive
+
+Shall we always set the FTP_PASSIVE environment variable when dealing
+with ftp download (yes/no)?
+
+=item getcwd
+
+CPAN.pm changes the current working directory often and needs to
+determine its own current working directory. Per default it uses
+Cwd::cwd but if this doesn't work on your system for some reason,
+alternatives can be configured according to the following table:
+
+ cwd Cwd::cwd
+ getcwd Cwd::getcwd
+ fastcwd Cwd::fastcwd
+ backtickcwd external command cwd
+
+Preferred method for determining the current working directory?
+
+=item histfile
+
+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.
+
+File to save your history?
+
+=item histsize
+
+Number of lines to save?
+
+=item inactivity_timeout
+
+Sometimes you may wish to leave the processes run by CPAN alone
+without caring about them. Because the Makefile.PL or the Build.PL
+sometimes contains question you're expected to answer, you can set a
+timer that will kill a 'perl Makefile.PL' process after the specified
+time in seconds.
+
+If you set this value to 0, these processes will wait forever. This is
+the default and recommended setting.
+
+Timeout for inactivity during {Makefile,Build}.PL?
+
+=item index_expire
+
+The CPAN indexes are usually rebuilt once or twice per hour, but the
+typical CPAN mirror mirrors only once or twice per day. Depending on
+the quality of your mirror and your desire to be on the bleeding edge,
+you may want to set the following value to more or less than one day
+(which is the default). It determines after how many days CPAN.pm
+downloads new indexes.
+
+Let the index expire after how many days?
+
+=item inhibit_startup_message
+
+When the CPAN shell is started it normally displays a greeting message
+that contains the running version and the status of readline support.
+
+Do you want to turn this message off?
+
+=item keep_source_where
+
+Unless you are accessing the CPAN on your filesystem via a file: URL,
+CPAN.pm needs to keep the source files it downloads somewhere. Please
+supply a directory where the downloaded files are to be kept.
+
+Download target directory?
+
+=item load_module_verbosity
+
+When CPAN.pm loads a module it needs for some optional feature, it
+usually reports about module name and version. Choose 'v' to get this
+message, 'none' to suppress it.
+
+Verbosity level for loading modules (none or v)?
+
+=item makepl_arg
+
+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
+pass to the calls, please specify them here.
+
+If you don't understand this question, just press ENTER.
+
+Typical frequently used settings:
+
+ PREFIX=~/perl # non-root users (please see manual for more hints)
+
+Parameters for the 'perl Makefile.PL' command?
+
+=item make_arg
+
+Parameters for the 'make' command? Typical frequently used setting:
+
+ -j3 # dual processor system (on GNU make)
+
+Your choice:
+
+=item make_install_arg
+
+Parameters for the 'make install' command?
+Typical frequently used setting:
+
+ UNINST=1 # to always uninstall potentially conflicting files
+
+Your choice:
+
+=item make_install_make_command
+
+Do you want to use a different make command for 'make install'?
+Cautious people will probably prefer:
+
+ su root -c make
+ or
+ sudo make
+ or
+ /path1/to/sudo -u admin_account /path2/to/make
+
+or some such. Your choice:
+
+=item mbuildpl_arg
+
+A Build.PL is run by perl in a separate process. Likewise we run
+'./Build' and './Build install' in separate processes. If you have any
+parameters you want to pass to the calls, please specify them here.
+
+Typical frequently used settings:
+
+ --install_base /home/xxx # different installation directory
+
+Parameters for the 'perl Build.PL' command?
+
+=item mbuild_arg
+
+Parameters for the './Build' command? Setting might be:
+
+ --extra_linker_flags -L/usr/foo/lib # non-standard library location
+
+Your choice:
+
+=item mbuild_install_arg
+
+Parameters for the './Build install' command? Typical frequently used
+setting:
+
+ --uninst 1 # uninstall conflicting files
+
+Your choice:
+
+=item mbuild_install_build_command
+
+Do you want to use a different command for './Build install'? Sudo
+users will probably prefer:
+
+ su root -c ./Build
+ or
+ sudo ./Build
+ or
+ /path1/to/sudo -u admin_account ./Build
+
+or some such. Your choice:
+
+=item pager
+
+What is your favorite pager program?
+
+=item prefer_installer
+
+When you have Module::Build installed and a module comes with both a
+Makefile.PL and a Build.PL, which shall have precedence?
+
+The main two standard installer modules are the old and well
+established ExtUtils::MakeMaker (for short: EUMM) which uses the
+Makefile.PL. And the next generation installer Module::Build (MB)
+which works with the Build.PL (and often comes with a Makefile.PL
+too). If a module comes only with one of the two we will use that one
+but if both are supplied then a decision must be made between EUMM and
+MB. See also http://rt.cpan.org/Ticket/Display.html?id=29235 for a
+discussion about the right default.
+
+Or, as a third option you can choose RAND which will make a random
+decision (something regular CPAN testers will enjoy).
+
+In case you can choose between running a Makefile.PL or a Build.PL,
+which installer would you prefer (EUMM or MB or RAND)?
+
+=item prefs_dir
+
+CPAN.pm can store customized build environments based on regular
+expressions for distribution names. These are YAML files where the
+default options for CPAN.pm and the environment can be overridden and
+dialog sequences can be stored that can later be executed by an
+Expect.pm object. The CPAN.pm distribution comes with some prefab YAML
+files that cover sample distributions that can be used as blueprints
+to store one own prefs. Please check out the distroprefs/ directory of
+the CPAN.pm distribution to get a quick start into the prefs system.
+
+Directory where to store default options/environment/dialogs for
+building modules that need some customization?
+
+=item prerequisites_policy
+
+The CPAN module can detect when a module which you are trying to build
+depends on prerequisites. If this happens, it can build the
+prerequisites for you automatically ('follow'), ask you for
+confirmation ('ask'), or just ignore them ('ignore'). Please set your
+policy to one of the three values.
+
+Policy on building prerequisites (follow, ask or ignore)?
+
+=item randomize_urllist
+
+CPAN.pm can introduce some randomness when using hosts for download
+that are configured in the urllist parameter. Enter a numeric value
+between 0 and 1 to indicate how often you want to let CPAN.pm try a
+random host from the urllist. A value of one specifies to always use a
+random host as the first try. A value of zero means no randomness at
+all. Anything in between specifies how often, on average, a random
+host should be tried first.
+
+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'.
+
+Perform cache scanning (atstart or never)?
+
+=item shell
+
+What is your favorite shell?
+
+=item show_unparsable_versions
+
+During the 'r' command CPAN.pm finds modules without version number.
+When the command finishes, it prints a report about this. If you
+want this report to be very verbose, say yes to the following
+variable.
+
+Show all individual modules that have no $VERSION?
+
+=item show_upload_date
+
+The 'd' and the 'm' command normally only show you information they
+have in their in-memory database and thus will never connect to the
+internet. If you set the 'show_upload_date' variable to true, 'm' and
+'d' will additionally show you the upload date of the module or
+distribution. Per default this feature is off because it may require a
+net connection to get at the upload date.
+
+Always try to show upload date with 'd' and 'm' command (yes/no)?
+
+=item show_zero_versions
+
+During the 'r' command CPAN.pm finds modules with a version number of
+zero. When the command finishes, it prints a report about this. If you
+want this report to be very verbose, say yes to the following
+variable.
+
+Show all individual modules that have a $VERSION of zero?
+
+=item tar_verbosity
+
+When CPAN.pm uses the tar command, which switch for the verbosity
+shall be used? Choose 'none' for quiet operation, 'v' for file
+name listing, 'vv' for full listing.
+
+Tar command verbosity level (none or v or vv)?
+
+=item term_is_latin
+
+The next option deals with the charset (aka character set) your
+terminal supports. In general, CPAN is English speaking territory, so
+the charset does not matter much but some CPAN have names that are
+outside the ASCII range. If your terminal supports UTF-8, you should
+say no to the next question. If it expects ISO-8859-1 (also known as
+LATIN1) then you should say yes. If it supports neither, your answer
+does not matter because you will not be able to read the names of some
+authors anyway. If you answer no, names will be output in UTF-8.
+
+Your terminal expects ISO-8859-1 (yes/no)?
+
+=item term_ornaments
+
+When using Term::ReadLine, you can turn ornaments on so that your
+input stands out against the output from CPAN.pm.
+
+Do you want to turn ornaments on?
+
+=item test_report
+
+The goal of the CPAN Testers project (http://testers.cpan.org/) is to
+test as many CPAN packages as possible on as many platforms as
+possible. This provides valuable feedback to module authors and
+potential users to identify bugs or platform compatibility issues and
+improves the overall quality and value of CPAN.
+
+One way you can contribute is to send test results for each module
+that you install. If you install the CPAN::Reporter module, you have
+the option to automatically generate and email test reports to CPAN
+Testers whenever you run tests on a CPAN package.
+
+See the CPAN::Reporter documentation for additional details and
+configuration settings. If your firewall blocks outgoing email,
+you will need to configure CPAN::Reporter before sending reports.
+
+Email test reports if CPAN::Reporter is installed (yes/no)?
+
+=item use_sqlite
+
+CPAN::SQLite is a layer between the index files that are downloaded
+from the CPAN and CPAN.pm that speeds up metadata queries and reduces
+memory consumption of CPAN.pm considerably.
+
+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.
+
+Do you want to enable code deserialisation (yes/no)?
+
+=item yaml_module
+
+At the time of this writing there are two competing YAML modules,
+YAML.pm and YAML::Syck. The latter is faster but needs a C compiler
+installed on your system. There may be more alternative YAML
+conforming modules but at the time of writing a potential third
+player, YAML::Tiny, seemed not powerful enough to work with CPAN.pm.
+
+Which YAML implementation would you prefer?
+
+=back
+
=head1 LICENSE
This program is free software; you can redistribute it and/or
@@ -78,7 +547,7 @@ sub init {
CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG;
unless ($CPAN::VERSION) {
- require CPAN::Nox;
+ require CPAN::Nox;
}
require CPAN::HandleConfig;
CPAN::HandleConfig::require_myconfig_or_config();
@@ -112,43 +581,43 @@ sub init {
CPAN->debug("manual_conf[$manual_conf]") if $CPAN::DEBUG;
my $fastread;
{
- if ($manual_conf =~ /^y/i) {
- $fastread = 0;
- } else {
- $fastread = 1;
- $CPAN::Config->{urllist} ||= [];
-
- local $^W = 0;
- # prototype should match that of &MakeMaker::prompt
- my $current_second = time;
- my $current_second_count = 0;
- my $i_am_mad = 0;
- *_real_prompt = sub {
- my($q,$a) = @_;
- my($ret) = defined $a ? $a : "";
- $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
- eval { require Time::HiRes };
- unless ($@) {
- if (time == $current_second) {
- $current_second_count++;
- if ($current_second_count > 20) {
- # I don't like more than 20 prompts per second
- $i_am_mad++;
- }
- } else {
- $current_second = time;
- $current_second_count = 0;
- $i_am_mad-- if $i_am_mad>0;
- }
- if ($i_am_mad>0){
- #require Carp;
- #Carp::cluck("SLEEEEEEEEPIIIIIIIIIIINGGGGGGGGGGG");
- Time::HiRes::sleep(0.1);
- }
- }
- $ret;
- };
- }
+ if ($manual_conf =~ /^y/i) {
+ $fastread = 0;
+ } else {
+ $fastread = 1;
+ $CPAN::Config->{urllist} ||= [];
+
+ local $^W = 0;
+ # prototype should match that of &MakeMaker::prompt
+ my $current_second = time;
+ my $current_second_count = 0;
+ my $i_am_mad = 0;
+ *_real_prompt = sub {
+ my($q,$a) = @_;
+ my($ret) = defined $a ? $a : "";
+ $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
+ eval { require Time::HiRes };
+ unless ($@) {
+ if (time == $current_second) {
+ $current_second_count++;
+ if ($current_second_count > 20) {
+ # I don't like more than 20 prompts per second
+ $i_am_mad++;
+ }
+ } else {
+ $current_second = time;
+ $current_second_count = 0;
+ $i_am_mad-- if $i_am_mad>0;
+ }
+ if ($i_am_mad>0) {
+ #require Carp;
+ #Carp::cluck("SLEEEEEEEEPIIIIIIIIIIINGGGGGGGGGGG");
+ Time::HiRes::sleep(0.1);
+ }
+ }
+ $ret;
+ };
+ }
}
if (!$matcher or q{
@@ -157,7 +626,7 @@ sub init {
cpan_home
keep_source_where
prefs_dir
- } =~ /$matcher/){
+ } =~ /$matcher/) {
$CPAN::Frontend->myprint($prompts{config_intro});
if (!$matcher or 'cpan_home' =~ /$matcher/) {
@@ -180,7 +649,9 @@ Shall we use it as the general CPAN build and cache directory?
$default = $cpan_home;
my $loop = 0;
my $last_ans;
+ $CPAN::Frontend->myprint(" <cpan_home>\n");
PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) {
+ print "\n";
if (File::Spec->file_name_is_absolute($ans)) {
my @cpan_home = split /[\/\\]/, $ans;
DIR: for my $dir (@cpan_home) {
@@ -201,16 +672,16 @@ Shall we use it as the general CPAN build and cache directory?
"absolute path. Please specify ".
"an absolute path\n");
$default = $absans;
- next;
+ next PROMPT;
}
eval { File::Path::mkpath($ans); }; # dies if it can't
if ($@) {
$CPAN::Frontend->mywarn("Couldn't create directory $ans.\n".
"Please retry.\n");
- next;
+ next PROMPT;
}
if (-d $ans && -w _) {
- last;
+ last PROMPT;
} else {
$CPAN::Frontend->mywarn("Couldn't find directory $ans\n".
"or directory is not writable. Please retry.\n");
@@ -237,7 +708,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 => "y", $matcher);
+ my_yn_prompt(build_dir_reuse => 1, $matcher);
}
if (!$matcher or 'prefs_dir' =~ /$matcher/) {
@@ -258,7 +729,7 @@ Shall we use it as the general CPAN build and cache directory?
#= Cache size, Index expire
#
- if (!$matcher or 'build_cache' =~ /$matcher/){
+ if (!$matcher or 'build_cache' =~ /$matcher/) {
# large enough to build large dists like Tk
my_dflt_prompt(build_cache => 100, $matcher);
}
@@ -267,8 +738,7 @@ Shall we use it as the general CPAN build and cache directory?
my_dflt_prompt(index_expire => 1, $matcher);
}
- if (!$matcher or 'scan_cache' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{scan_cache_intro});
+ if (!$matcher or 'scan_cache' =~ /$matcher/) {
my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
}
@@ -283,16 +753,12 @@ Shall we use it as the general CPAN build and cache directory?
#= Do we follow PREREQ_PM?
#
- if (!$matcher or 'prerequisites_policy' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{prerequisites_policy_intro});
-
+ if (!$matcher or 'prerequisites_policy' =~ /$matcher/) {
my_prompt_loop(prerequisites_policy => 'ask', $matcher,
'follow|ask|ignore');
}
- if (!$matcher or 'build_requires_install_policy' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{build_requires_install_policy_intro});
-
+ if (!$matcher or 'build_requires_install_policy' =~ /$matcher/) {
my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher,
'yes|no|ask/yes|ask/no');
}
@@ -310,7 +776,7 @@ Shall we use it as the general CPAN build and cache directory?
if (!$matcher or 'test_report' =~ /$matcher/) {
my_yn_prompt(test_report => 0, $matcher);
if (
- $CPAN::Config->{test_report} &&
+ $CPAN::Config->{test_report} &&
$CPAN::META->has_inst("CPAN::Reporter") &&
CPAN::Reporter->can('configure')
) {
@@ -333,6 +799,13 @@ Shall we use it as the general CPAN build and cache directory?
}
#
+ #= YAML code deserialisation
+ #
+ if (!$matcher or "yaml_load_code" =~ /$matcher/) {
+ my_yn_prompt(yaml_load_code => 0, $matcher);
+ }
+
+ #
#= External programs
#
@@ -387,7 +860,7 @@ Shall we use it as the general CPAN build and cache directory?
}
$path ||= find_exe($progcall,\@path);
- unless ($path){ # not -e $path, because find_exe already checked that
+ unless ($path) { # not -e $path, because find_exe already checked that
local $"=";";
$CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@path]\n");
if ($progname eq "make") {
@@ -412,18 +885,17 @@ substitute. You can then revisit this dialog with
}
}
}
- $ans = prompt("Where is your $progname program?",$path) || $path;
- $CPAN::Config->{$progname} = $ans;
+ $prompts{$progname} = "Where is your $progname program?";
+ my_dflt_prompt($progname,$path,$matcher);
}
}
if (!$matcher or 'pager' =~ /$matcher/) {
- my $path = $CPAN::Config->{'pager'} ||
- $ENV{PAGER} || find_exe("less",\@path) ||
+ my $path = $CPAN::Config->{'pager'} ||
+ $ENV{PAGER} || find_exe("less",\@path) ||
find_exe("more",\@path) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
|| "more";
- $ans = prompt("What is your favorite pager program?",$path);
- $CPAN::Config->{'pager'} = $ans;
+ my_dflt_prompt(pager => $path, $matcher);
}
if (!$matcher or 'shell' =~ /$matcher/) {
@@ -438,23 +910,36 @@ substitute. You can then revisit this dialog with
if ($^O eq 'MacOS') {
$CPAN::Config->{'shell'} = 'not_here';
} else {
- $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
- $ans = prompt("What is your favorite shell?",$path);
- $CPAN::Config->{'shell'} = $ans;
+ $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
+ my_dflt_prompt(shell => $path, $matcher);
}
}
#
- #= Installer, arguments to make etc.
+ # verbosity
#
- if (!$matcher or 'prefer_installer' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{prefer_installer_intro});
+ if (!$matcher or 'tar_verbosity' =~ /$matcher/) {
+ my_prompt_loop(tar_verbosity => 'v', $matcher,
+ 'none|v|vv');
+ }
+
+ if (!$matcher or 'load_module_verbosity' =~ /$matcher/) {
+ my_prompt_loop(load_module_verbosity => 'v', $matcher,
+ 'none|v');
+ }
+
+ my_yn_prompt(inhibit_startup_message => 0, $matcher);
+
+ #
+ #= Installer, arguments to make etc.
+ #
- my_prompt_loop(prefer_installer => 'EUMM', $matcher, 'MB|EUMM');
+ if (!$matcher or 'prefer_installer' =~ /$matcher/) {
+ my_prompt_loop(prefer_installer => 'MB', $matcher, 'MB|EUMM|RAND');
}
- if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/){
+ if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/) {
my_dflt_prompt(makepl_arg => "", $matcher);
my_dflt_prompt(make_arg => "", $matcher);
}
@@ -467,13 +952,11 @@ substitute. You can then revisit this dialog with
$matcher);
}
- my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "",
- $matcher);
+ my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "",
+ $matcher);
- if (!$matcher or 'mbuildpl_arg mbuild_arg' =~ /$matcher/){
- my_dflt_prompt(mbuildpl_arg => "", $matcher);
- my_dflt_prompt(mbuild_arg => "", $matcher);
- }
+ my_dflt_prompt(mbuildpl_arg => "", $matcher);
+ my_dflt_prompt(mbuild_arg => "", $matcher);
if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command}) {
# as long as Windows needs $self->_build_command, we cannot
@@ -487,12 +970,7 @@ substitute. You can then revisit this dialog with
#= Alarm period
#
- if (!$matcher or 'inactivity_timeout' =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{inactivity_timeout_intro});
- $default = $CPAN::Config->{inactivity_timeout} || 0;
- $CPAN::Config->{inactivity_timeout} =
- prompt("Timeout for inactivity during {Makefile,Build}.PL?",$default);
- }
+ my_dflt_prompt(inactivity_timeout => 0, $matcher);
#
#= Proxies
@@ -500,14 +978,12 @@ substitute. You can then revisit this dialog with
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/){
+ if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/) {
$CPAN::Frontend->myprint($prompts{proxy_intro});
for (@proxy_vars) {
- if (!$matcher or /$matcher/){
- $default = $CPAN::Config->{$_} || $ENV{$_} || "";
- $CPAN::Config->{$_} = prompt("Your $_?",$default);
- }
+ $prompts{$_} = "Your $_?";
+ my_dflt_prompt($_ => $ENV{$_}||"", $matcher);
}
if ($CPAN::Config->{ftp_proxy} ||
@@ -544,9 +1020,7 @@ substitute. You can then revisit this dialog with
#= how cwd works
#
- if (!$matcher or 'getcwd' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{getcwd_intro});
-
+ if (!$matcher or 'getcwd' =~ /$matcher/) {
my_prompt_loop(getcwd => 'cwd', $matcher,
'cwd|getcwd|fastcwd|backtickcwd');
}
@@ -563,7 +1037,7 @@ substitute. You can then revisit this dialog with
if ($CPAN::META->has_inst("Term::ANSIColor")) {
my $T="gYw";
print " on_ on_y ".
- " on_ma on_\n";
+ " on_ma on_\n";
print " on_black on_red green ellow ".
"on_blue genta on_cyan white\n";
@@ -571,10 +1045,10 @@ substitute. You can then revisit this dialog with
map {$_,"bold $_"} "black","red","green",
"yellow","blue",
"magenta",
- "cyan","white"){
+ "cyan","white") {
printf "%12s ", $FG;
for my $BG ("",map {"on_$_"} qw(black red green yellow
- blue magenta cyan white)){
+ blue magenta cyan white)) {
print $FG||$BG ?
Term::ANSIColor::colored(" $T ","$FG $BG") : " $T ";
}
@@ -603,8 +1077,7 @@ substitute. You can then revisit this dialog with
#== term_is_latin
#
- if (!$matcher or 'term_is_latin' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{term_is_latin});
+ if (!$matcher or 'term_is_latin' =~ /$matcher/) {
my_yn_prompt(term_is_latin => 1, $matcher);
}
@@ -616,34 +1089,36 @@ substitute. You can then revisit this dialog with
$CPAN::Frontend->myprint($prompts{histfile_intro});
defined($default = $CPAN::Config->{histfile}) or
$default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
- $ans = prompt("File to save your history?", $default);
- $CPAN::Config->{histfile} = $ans;
+ my_dflt_prompt(histfile => $default, $matcher);
if ($CPAN::Config->{histfile}) {
defined($default = $CPAN::Config->{histsize}) or $default = 100;
- $ans = prompt("Number of lines to save?", $default);
- $CPAN::Config->{histsize} = $ans;
+ my_dflt_prompt(histsize => $default, $matcher);
}
}
#
#== do an ls on the m or the d command
#
- if (!$matcher or 'show_upload_date' =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{show_upload_date_intro});
-
- defined($default = $CPAN::Config->{show_upload_date}) or
- $default = 'n';
- $ans = prompt("Always try to show upload date with 'd' and 'm' command (yes/no)?",
- ($default ? 'yes' : 'no'));
- $CPAN::Config->{show_upload_date} = ($ans =~ /^[y1]/i ? 1 : 0);
+ my_yn_prompt(show_upload_date => 0, $matcher);
+
+ #
+ #== verbosity at the end of the r command
+ #
+ if (!$matcher
+ or 'show_unparsable_versions' =~ /$matcher/
+ or 'show_zero_versions' =~ /$matcher/
+ ) {
+ $CPAN::Frontend->myprint($prompts{show_unparsable_or_zero_versions_intro});
+ my_yn_prompt(show_unparsable_versions => 0, $matcher);
+ my_yn_prompt(show_zero_versions => 0, $matcher);
}
#
#= MIRRORED.BY and conf_sites()
#
- if ($matcher){
+ if ($matcher) {
if ("urllist" =~ $matcher) {
# conf_sites would go into endless loop with the smash prompt
local *_real_prompt;
@@ -661,10 +1136,6 @@ substitute. You can then revisit this dialog with
conf_sites();
}
- # We don't ask this one now, it's plain silly and maybe is not
- # even used correctly everywhere.
- $CPAN::Config->{inhibit_startup_message} = 0;
-
$CPAN::Frontend->myprint("\n\n");
if ($matcher && !$CPAN::Config->{auto_commit}) {
$CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ".
@@ -683,9 +1154,11 @@ sub my_dflt_prompt {
if (my $intro = $prompts{$item . "_intro"}) {
$CPAN::Frontend->myprint($intro);
}
- $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
+ $CPAN::Frontend->myprint(" <$item>\n");
+ $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
+ print "\n";
} else {
- $CPAN::Config->{$item} = $default;
+ $CPAN::Config->{$item} = $default;
}
}
@@ -694,15 +1167,17 @@ sub my_yn_prompt {
my $default;
defined($default = $CPAN::Config->{$item}) or $default = $dflt;
- $DB::single = 1;
+ # $DB::single = 1;
if (!$m || $item =~ /$m/) {
if (my $intro = $prompts{$item . "_intro"}) {
$CPAN::Frontend->myprint($intro);
}
- my $ans = prompt($prompts{$item}, $default ? 'yes' : 'no');
+ $CPAN::Frontend->myprint(" <$item>\n");
+ my $ans = prompt($prompts{$item}, $default ? 'yes' : 'no');
$CPAN::Config->{$item} = ($ans =~ /^[y1]/i ? 1 : 0);
+ print "\n";
} else {
- $CPAN::Config->{$item} = $default;
+ $CPAN::Config->{$item} = $default;
}
}
@@ -713,62 +1188,65 @@ sub my_prompt_loop {
$DB::single = 1;
if (!$m || $item =~ /$m/) {
- do { $ans = prompt($prompts{$item}, $default);
- } until $ans =~ /$ok/;
- $CPAN::Config->{$item} = $ans;
+ $CPAN::Frontend->myprint($prompts{$item . "_intro"});
+ $CPAN::Frontend->myprint(" <$item>\n");
+ do { $ans = prompt($prompts{$item}, $default);
+ } until $ans =~ /$ok/;
+ $CPAN::Config->{$item} = $ans;
+ print "\n";
} else {
- $CPAN::Config->{$item} = $default;
+ $CPAN::Config->{$item} = $default;
}
}
sub conf_sites {
- my $m = 'MIRRORED.BY';
- my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
- File::Path::mkpath(File::Basename::dirname($mby));
- if (-f $mby && -f $m && -M $m < -M $mby) {
- require File::Copy;
- File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
- }
- my $loopcount = 0;
- local $^T = time;
- my $overwrite_local = 0;
- if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) {
- my $mtime = localtime((stat _)[9]);
- my $prompt = qq{Found $mby as of $mtime
+ my $m = 'MIRRORED.BY';
+ my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
+ File::Path::mkpath(File::Basename::dirname($mby));
+ if (-f $mby && -f $m && -M $m < -M $mby) {
+ require File::Copy;
+ File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
+ }
+ my $loopcount = 0;
+ local $^T = time;
+ my $overwrite_local = 0;
+ if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) {
+ my $mtime = localtime((stat _)[9]);
+ my $prompt = qq{Found $mby as of $mtime
I\'d use that as a database of CPAN sites. If that is OK for you,
please answer 'y', but if you want me to get a new database now,
please answer 'n' to the following question.
Shall I use the local database in $mby?};
- my $ans = prompt($prompt,"y");
- $overwrite_local = 1 unless $ans =~ /^y/i;
- }
- while ($mby) {
- if ($overwrite_local) {
- $CPAN::Frontend->myprint(qq{Trying to overwrite $mby\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- $overwrite_local = 0;
- } elsif ( ! -f $mby ){
- $CPAN::Frontend->myprint(qq{You have no $mby\n I\'m trying to fetch one\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- } elsif (-M $mby > 60 && $loopcount == 0) {
- $CPAN::Frontend->myprint(qq{Your $mby is older than 60 days,\n I\'m trying }.
- qq{to fetch one\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- $loopcount++;
- } elsif (-s $mby == 0) {
- $CPAN::Frontend->myprint(qq{You have an empty $mby,\n I\'m trying to fetch one\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- } else {
- last;
+ my $ans = prompt($prompt,"y");
+ $overwrite_local = 1 unless $ans =~ /^y/i;
}
- }
- local $urllist = [];
- read_mirrored_by($mby);
- bring_your_own();
- $CPAN::Config->{urllist} = $urllist;
+ while ($mby) {
+ if ($overwrite_local) {
+ $CPAN::Frontend->myprint(qq{Trying to overwrite $mby\n});
+ $mby = CPAN::FTP->localize($m,$mby,3);
+ $overwrite_local = 0;
+ } elsif ( ! -f $mby ) {
+ $CPAN::Frontend->myprint(qq{You have no $mby\n I\'m trying to fetch one\n});
+ $mby = CPAN::FTP->localize($m,$mby,3);
+ } elsif (-M $mby > 60 && $loopcount == 0) {
+ $CPAN::Frontend->myprint(qq{Your $mby is older than 60 days,\n I\'m trying }.
+ qq{to fetch one\n});
+ $mby = CPAN::FTP->localize($m,$mby,3);
+ $loopcount++;
+ } elsif (-s $mby == 0) {
+ $CPAN::Frontend->myprint(qq{You have an empty $mby,\n I\'m trying to fetch one\n});
+ $mby = CPAN::FTP->localize($m,$mby,3);
+ } else {
+ last;
+ }
+ }
+ local $urllist = [];
+ read_mirrored_by($mby);
+ bring_your_own();
+ $CPAN::Config->{urllist} = $urllist;
}
sub find_exe {
@@ -776,10 +1254,10 @@ sub find_exe {
my($dir);
#warn "in find_exe exe[$exe] path[@$path]";
for $dir (@$path) {
- my $abs = File::Spec->catfile($dir,$exe);
- if (($abs = MM->maybe_command($abs))) {
- return $abs;
- }
+ my $abs = File::Spec->catfile($dir,$exe);
+ if (($abs = MM->maybe_command($abs))) {
+ return $abs;
+ }
}
}
@@ -811,7 +1289,7 @@ sub picklist {
}
my $i = scalar @$items;
unrangify(\@nums);
- if (grep (/\D/ || $_ < 1 || $_ > $i, @nums)){
+ if (grep (/\D/ || $_ < 1 || $_ > $i, @nums)) {
$CPAN::Frontend->mywarn("invalid items entered, try again\n");
if ("@nums" =~ /\D/) {
$CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n");
@@ -872,18 +1350,18 @@ sub read_mirrored_by {
$fh->open($local) or die "Couldn't open $local: $!";
local $/ = "\012";
while (<$fh>) {
- ($host) = /^([\w\.\-]+)/ unless defined $host;
- next unless defined $host;
- next unless /\s+dst_(dst|location)/;
- /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
- ($continent, $country) = @location[-1,-2];
- $continent =~ s/\s\(.*//;
- $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
- /dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
- next unless $host && $dst && $continent && $country;
- $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
- undef $host;
- $dst=$continent=$country="";
+ ($host) = /^([\w\.\-]+)/ unless defined $host;
+ next unless defined $host;
+ next unless /\s+dst_(dst|location)/;
+ /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
+ ($continent, $country) = @location[-1,-2];
+ $continent =~ s/\s\(.*//;
+ $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
+ /dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
+ next unless $host && $dst && $continent && $country;
+ $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
+ undef $host;
+ $dst=$continent=$country="";
}
$fh->close;
$CPAN::Config->{urllist} ||= [];
@@ -956,12 +1434,12 @@ sub bring_your_own {
my($ans,@urls);
my $eacnt = 0; # empty answers
do {
- my $prompt = "Enter another URL or RETURN to quit:";
- unless (%seen) {
- $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
+ my $prompt = "Enter another URL or RETURN to quit:";
+ unless (%seen) {
+ $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
Please enter your CPAN site:};
- }
+ }
$ans = prompt ($prompt, "");
if ($ans) {
@@ -1038,7 +1516,6 @@ If you prefer to enter a dialog instead, you can answer 'no' to this
question and I'll let you configure in small steps one thing after the
other. (Note: you can revisit this dialog anytime later by typing 'o
conf init' at the cpan prompt.)
-
],
config_intro => qq{
@@ -1046,348 +1523,28 @@ 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{ },
cpan_home_where => qq{
-First of all, I\'d like to create this directory. Where?
-
-},
-
-keep_source_where => qq{
-
-Unless you are accessing the CPAN via the filesystem directly CPAN.pm
-needs to keep the source files it downloads somewhere. Please supply a
-directory where the downloaded files are to be kept.},
-
-build_cache_intro => qq{
-
-How big should the disk cache be for keeping the build directories
-with all the intermediate files\?
-
-},
-
-build_cache =>
-"Cache size for build directory (in MB)?",
-
-build_dir =>
-
-"Directory where the build process takes place?",
-
-build_dir_reuse_intro =>
-
-qq{Until version 1.88 CPAN.pm never trusted the contents of the
-build_dir directory between sessions. Since 1.88_58 CPAN.pm has a
-YAML-based mechanism that makes it possible to share the contents of
-the build_dir/ directory between different sessions with the same
-version of perl. People who prefer to test things several days before
-installing will like this feature because it safes a lot of time.
-
-If you say yes to the following question, CPAN will try to store
-enough information about the build process so that it can pick up in
-future sessions at the same state of affairs as it left a previous
-session.
-
-},
-
-build_dir_reuse =>
-
-qq{Store and re-use state information about distributions between
-CPAN.pm sessions?},
-
-prefs_dir_intro => qq{
-
-CPAN.pm can store customized build environments based on regular
-expressions for distribution names. These are YAML files where the
-default options for CPAN.pm and the environment can be overridden and
-dialog sequences can be stored that can later be executed by an
-Expect.pm object. The CPAN.pm distribution comes with some prefab YAML
-files that cover sample distributions that can be used as blueprints
-to store one own prefs. Please check out the distroprefs/ directory of
-the CPAN.pm distribution to get a quick start into the prefs system.
-
-},
-
-prefs_dir =>
-
-"Directory where to store default options/environment/dialogs for
-building modules that need some customization?",
-
-scan_cache_intro => qq{
-
-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'.
+First of all, I'd like to create this directory. Where?
},
-scan_cache => "Perform cache scanning (atstart or never)?",
-
-cache_metadata_intro => qq{
-
-To considerably speed up the initial CPAN shell startup, it is
-possible to use Storable to create a cache of metadata. If Storable
-is not available, the normal index mechanism will be used.
-
-Note: this mechanism is not used when use_sqlite is on and SQLLite is
-running.
-
-},
-
-cache_metadata => qq{Cache metadata (yes/no)?},
-
-use_sqlite_intro => qq{
-
-CPAN::SQLite is a layer between the index files that are downloaded
-from the CPAN and CPAN.pm that speeds up metadata queries and reduces
-memory consumption of CPAN.pm considereably.
-
-},
-
-use_sqlite => qq{Use CPAN::SQLite if available? (yes/no)?},
-
-term_is_latin_intro => qq{
-
-The next option deals with the charset (aka character set) your
-terminal supports. In general, CPAN is English speaking territory, so
-the charset does not matter much, but some of the aliens out there who
-upload their software to CPAN bear names that are outside the ASCII
-range. If your terminal supports UTF-8, you should say no to the next
-question. If it supports ISO-8859-1 (also known as LATIN1) then you
-should say yes. If it supports neither, your answer does not matter
-because you will not be able to read the names of some authors
-anyway. If you answer no, names will be output in UTF-8.
-
-},
-
-term_is_latin => qq{Your terminal expects ISO-8859-1 (yes/no)?},
-
-histfile_intro => qq{
-
-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.
-
-},
-
-histfile => qq{File to save your history?},
-
-show_upload_date_intro => qq{
-
-The 'd' and the 'm' command normally only show you information they
-have in their in-memory database and thus will never connect to the
-internet. If you set the 'show_upload_date' variable to true, 'm' and
-'d' will additionally show you the upload date of the module or
-distribution. Per default this feature is off because it may require a
-net connection to get at the upload date.
-
-},
-
-show_upload_date =>
-"Always try to show upload date with 'd' and 'm' command (yes/no)?",
-
-prerequisites_policy_intro => qq{
-
-The CPAN module can detect when a module which you are trying to build
-depends on prerequisites. If this happens, it can build the
-prerequisites for you automatically ('follow'), ask you for
-confirmation ('ask'), or just ignore them ('ignore'). Please set your
-policy to one of the three values.
-
-},
-
-prerequisites_policy =>
-"Policy on building prerequisites (follow, ask or ignore)?",
-
-check_sigs_intro => qq{
-
-CPAN packages can be digitally signed by authors and thus verified
-with the security provided by strong cryptography. The exact mechanism
-is defined in the Module::Signature module. While this is generally
-considered a good thing, it is not always convenient to the end user
-to install modules that are signed incorrectly or where the key of the
-author is not available or where some prerequisite for
-Module::Signature has a bug and so on.
-
-With the check_sigs parameter you can turn signature checking on and
-off. The default is off for now because the whole tool chain for the
-functionality is not yet considered mature by some. The author of
-CPAN.pm would recommend setting it to true most of the time and
-turning it off only if it turns out to be annoying.
-
-Note that if you do not have Module::Signature installed, no signature
-checks will be performed at all.
-
-},
-
-check_sigs =>
-qq{Always try to check and verify signatures if a SIGNATURE file is in the package
-and Module::Signature is installed (yes/no)?},
-
-test_report_intro =>
-qq{
-
-The goal of the CPAN Testers project (http://testers.cpan.org/) is to
-test as many CPAN packages as possible on as many platforms as
-possible. This provides valuable feedback to module authors and
-potential users to identify bugs or platform compatibility issues and
-improves the overall quality and value of CPAN.
-
-One way you can contribute is to send test results for each module
-that you install. If you install the CPAN::Reporter module, you have
-the option to automatically generate and email test reports to CPAN
-Testers whenever you run tests on a CPAN package.
-
-See the CPAN::Reporter documentation for additional details and
-configuration settings. If your firewall blocks outgoing email,
-you will need to configure CPAN::Reporter before sending reports.
-
-},
-
-test_report =>
-qq{Email test reports if CPAN::Reporter is installed (yes/no)?},
-
external_progs => qq{
The CPAN module will need a few external programs to work properly.
-Please correct me, if I guess the wrong path for a program. Don\'t
+Please correct me, if I guess the wrong path for a program. Don't
panic if you do not have some of them, just press ENTER for those. To
disable the use of a program, you can type a space followed by ENTER.
},
-prefer_installer_intro => qq{
-
-When you have Module::Build installed and a module comes with both a
-Makefile.PL and a Build.PL, which shall have precedence? The two
-installer modules we have are the old and well established
-ExtUtils::MakeMaker (for short: EUMM) which uses the Makefile.PL and
-the next generation installer Module::Build (MB) works with the
-Build.PL.
-
-},
-
-prefer_installer =>
-qq{In case you could choose, which installer would you prefer (EUMM or MB)?},
-
-makepl_arg_intro => qq{
-
-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
-pass to the calls, please specify them here.
-
-If you don\'t understand this question, just press ENTER.
-},
-
-makepl_arg => qq{
-Parameters for the 'perl Makefile.PL' command?
-Typical frequently used settings:
-
- PREFIX=~/perl # non-root users (please see manual for more hints)
-
-Your choice: },
-
-make_arg => qq{Parameters for the 'make' command?
-Typical frequently used setting:
-
- -j3 # dual processor system (on GNU make)
-
-Your choice: },
-
-
-make_install_make_command => qq{Do you want to use a different make command for 'make install'?
-Cautious people will probably prefer:
-
- su root -c make
-or
- sudo make
-or
- /path1/to/sudo -u admin_account /path2/to/make
-
-or some such. Your choice: },
-
-
-make_install_arg => qq{Parameters for the 'make install' command?
-Typical frequently used setting:
-
- UNINST=1 # to always uninstall potentially conflicting files
-
-Your choice: },
-
-
-mbuildpl_arg_intro => qq{
-
-The next questions deal with Module::Build support.
-
-A Build.PL is run by perl in a separate process. Likewise we run
-'./Build' and './Build install' in separate processes. If you have any
-parameters you want to pass to the calls, please specify them here.
-
-},
-
-mbuildpl_arg => qq{Parameters for the 'perl Build.PL' command?
-Typical frequently used settings:
-
- --install_base /home/xxx # different installation directory
-
-Your choice: },
-
-mbuild_arg => qq{Parameters for the './Build' command?
-Setting might be:
-
- --extra_linker_flags -L/usr/foo/lib # non-standard library location
-
-Your choice: },
-
-
-mbuild_install_build_command => qq{Do you want to use a different command for './Build install'?
-Sudo users will probably prefer:
-
- su root -c ./Build
-or
- sudo ./Build
-or
- /path1/to/sudo -u admin_account ./Build
-
-or some such. Your choice: },
-
-
-mbuild_install_arg => qq{Parameters for the './Build install' command?
-Typical frequently used setting:
-
- --uninst 1 # uninstall conflicting files
-
-Your choice: },
-
-
-
-inactivity_timeout_intro => qq{
-
-Sometimes you may wish to leave the processes run by CPAN alone
-without caring about them. Because the Makefile.PL or the Build.PL
-sometimes contains question you\'re expected to answer, you can set a
-timer that will kill a 'perl Makefile.PL' process after the specified
-time in seconds.
-
-If you set this value to 0, these processes will wait forever. This is
-the default and recommended setting.
-
-},
-
-inactivity_timeout =>
-qq{Timeout for inactivity during {Makefile,Build}.PL? },
-
-
proxy_intro => qq{
-If you\'re accessing the net via proxies, you can specify them in the
+If you're accessing the net via proxies, you can specify them in the
CPAN configuration or via environment variables. The variable in
the \$CPAN::Config takes precedence.
@@ -1434,136 +1591,43 @@ be echoed to the terminal!
},
-commandnumber_in_prompt => qq{
-
-The prompt of the cpan shell can contain the current command number
-for easier tracking of the session or be a plain string. Do you want
-the command number in the prompt (yes/no)?},
-
-ftp_passive => qq{
-
-Shall we always set FTP_PASSIVE envariable when dealing with ftp
-download (yes/no)?},
-
-# taken from the manpage:
-getcwd_intro => qq{
-
-CPAN.pm changes the current working directory often and needs to
-determine its own current working directory. Per default it uses
-Cwd::cwd but if this doesn't work on your system for some reason,
-alternatives can be configured according to the following table:
-
- cwd Cwd::cwd
- getcwd Cwd::getcwd
- fastcwd Cwd::fastcwd
- backtickcwd external command cwd
-
-},
-
-getcwd => qq{Preferred method for determining the current working directory?},
-
-index_expire_intro => qq{
-
-The CPAN indexes are usually rebuilt once or twice per hour, but the
-typical CPAN mirror mirrors only once or twice per day. Depending on
-the quality of your mirror and your desire to be on the bleeding edge,
-you may want to set the following value to more or less than one day
-(which is the default). It determines after how many days CPAN.pm
-downloads new indexes.
-
-},
-
-index_expire => qq{Let the index expire after how many days?},
-
-term_ornaments => qq{
-
-When using Term::ReadLine, you can turn ornaments on so that your
-input stands out against the output from CPAN.pm. Do you want to turn
-ornaments on?},
-
-colorize_output => qq{
-
-When you have Term::ANSIColor installed, you can turn on colorized
-output to have some visual differences between normal CPAN.pm output,
-warnings, debugging output, and the output of the modules being
-installed. Set your favorite colors after some experimenting with the
-Term::ANSIColor module. Do you want to turn on colored output?},
-
-colorize_print => qq{Color for normal output?},
-
-colorize_warn => qq{Color for warnings?},
-
-colorize_debug => qq{Color for debugging messages?},
-
-build_requires_install_policy_intro => qq{
-
-When a module declares another one as a 'build_requires' prerequisite
-this means that the other module is only needed for building or
-testing the module but need not be installed permanently. In this case
-you may wish to install that other module nonetheless or just keep it
-in the 'build_dir' directory to have it available only temporarily.
-Installing saves time on future installations but makes the perl
-installation bigger.
-
-You can choose if you want to always install (yes), never install (no)
-or be always asked. In the latter case you can set the default answer
-for the question to yes (ask/yes) or no (ask/no).
-
-},
-
-build_requires_install_policy =>
-qq{Policy on installing 'build_requires' modules (yes, no, ask/yes,
-ask/no)?},
-
-yaml_module_intro => qq{
-
-At the time of this writing there are two competing YAML modules,
-YAML.pm and YAML::Syck. The latter is faster but needs a C compiler
-installed on your system. There may be more alternative YAML
-conforming modules but at the time of writing a potential third
-player, YAML::Tiny, seemed not powerful enough to work with CPAN.pm.
-
-},
-
-yaml_module => qq{Which YAML implementation would you prefer?},
-
-randomize_urllist_intro => qq{
-
-CPAN.pm can introduce some randomness when using hosts for download
-that are configured in the urllist parameter. Enter a numeric value
-between 0 and 1 to indicate how often you want to let CPAN.pm try a
-random host from the urllist. A value of one specifies to always use a
-random host as the first try. A value of zero means no randomness at
-all. Anything in between specifies how often, on average, a random
-host should be tried first.
-
-},
-
-randomize_urllist => "Randomize parameter",
-
-auto_commit_intro => qq{
-
-Normally CPAN.pm keeps config variables in memory and changes need to
-be saved in a separate 'o conf commit' command to make them permanent
-between sessions. If you set the 'auto_commit' option to true, changes
-to a config variable are always automatically committed to disk.
-
-},
-
-auto_commit => qq{Always commit changes to config variables to disk?},
-
);
die "Coding error in \@prompts declaration. Odd number of elements, above"
- if (@prompts % 2);
+ if (@prompts % 2);
%prompts = @prompts;
if (scalar(keys %prompts) != scalar(@prompts)/2) {
my %already;
for my $item (0..$#prompts) {
- next if $item % 2;
- die "$prompts[$item] is duplicated\n" if $already{$prompts[$item]}++;
+ next if $item % 2;
+ die "$prompts[$item] is duplicated\n" if $already{$prompts[$item]}++;
+ }
+}
+
+local *FH;
+my $pmfile = __FILE__;
+open FH, $pmfile or die "Could not open '$pmfile': $!";
+local $/ = "";
+my @podpara;
+while (<FH>) {
+ next if 1 .. /^=over/;
+ chomp;
+ push @podpara, $_;
+ last if /^=back/;
+}
+pop @podpara;
+while (@podpara) {
+ warn "Alert: cannot parse my own manpage for init dialog" unless $podpara[0] =~ s/^=item\s+//;
+ my $name = shift @podpara;
+ my @para;
+ while (@podpara && $podpara[0] !~ /^=item/) {
+ push @para, shift @podpara;
+ }
+ $prompts{$name} = pop @para;
+ if (@para) {
+ $prompts{$name . "_intro"} = join "", map { "$_\n\n" } @para;
}
}
diff --git a/lib/CPAN/HandleConfig.pm b/lib/CPAN/HandleConfig.pm
index 49a8a50d8e..ec0aefdab9 100644
--- a/lib/CPAN/HandleConfig.pm
+++ b/lib/CPAN/HandleConfig.pm
@@ -1,8 +1,8 @@
package CPAN::HandleConfig;
use strict;
-use vars qw(%can %keys $VERSION);
+use vars qw(%can %keys $loading $VERSION);
-$VERSION = sprintf "%.6f", substr(q$Rev: 1744 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
%can = (
commit => "Commit changes to disk",
@@ -48,6 +48,7 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 1744 $,4)/1000000 + 5.4;
"index_expire",
"inhibit_startup_message",
"keep_source_where",
+ "load_module_verbosity",
"lynx",
"make",
"make_arg",
@@ -65,15 +66,18 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 1744 $,4)/1000000 + 5.4;
"password",
"patch",
"prefer_installer",
- "prerequisites_policy",
"prefs_dir",
+ "prerequisites_policy",
"proxy_pass",
"proxy_user",
"randomize_urllist",
"scan_cache",
"shell",
+ "show_unparsable_versions",
"show_upload_date",
+ "show_zero_versions",
"tar",
+ "tar_verbosity",
"term_is_latin",
"term_ornaments",
"test_report",
@@ -83,6 +87,7 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 1744 $,4)/1000000 + 5.4;
"username",
"wait_list",
"wget",
+ "yaml_load_code",
"yaml_module",
);
@@ -120,8 +125,8 @@ sub edit {
$o = shift @args;
$DB::single = 1;
if($can{$o}) {
- $self->$o(args => \@args); # o conf init => sub init => sub load
- return 1;
+ $self->$o(args => \@args); # o conf init => sub init => sub load
+ return 1;
} else {
CPAN->debug("o[$o]") if $CPAN::DEBUG;
unless (exists $keys{$o}) {
@@ -132,40 +137,40 @@ sub edit {
# one day I used randomize_urllist for a boolean, so we must
# list them explicitly --ak
- if (0) {
+ if (0) {
} elsif ($o =~ /^(wait_list|urllist|dontload_list)$/) {
#
# ARRAYS
#
- $func = shift @args;
- $func ||= "";
+ $func = shift @args;
+ $func ||= "";
CPAN->debug("func[$func]args[@args]") if $CPAN::DEBUG;
- # Let's avoid eval, it's easier to comprehend without.
- if ($func eq "push") {
- push @{$CPAN::Config->{$o}}, @args;
+ # Let's avoid eval, it's easier to comprehend without.
+ if ($func eq "push") {
+ push @{$CPAN::Config->{$o}}, @args;
$changed = 1;
- } elsif ($func eq "pop") {
- pop @{$CPAN::Config->{$o}};
+ } elsif ($func eq "pop") {
+ pop @{$CPAN::Config->{$o}};
$changed = 1;
- } elsif ($func eq "shift") {
- shift @{$CPAN::Config->{$o}};
+ } elsif ($func eq "shift") {
+ shift @{$CPAN::Config->{$o}};
$changed = 1;
- } elsif ($func eq "unshift") {
- unshift @{$CPAN::Config->{$o}}, @args;
+ } elsif ($func eq "unshift") {
+ unshift @{$CPAN::Config->{$o}}, @args;
$changed = 1;
- } elsif ($func eq "splice") {
+ } elsif ($func eq "splice") {
my $offset = shift @args || 0;
my $length = shift @args || 0;
- splice @{$CPAN::Config->{$o}}, $offset, $length, @args; # may warn
+ splice @{$CPAN::Config->{$o}}, $offset, $length, @args; # may warn
$changed = 1;
- } elsif ($func) {
- $CPAN::Config->{$o} = [$func, @args];
+ } elsif ($func) {
+ $CPAN::Config->{$o} = [$func, @args];
$changed = 1;
- } else {
+ } else {
$self->prettyprint($o);
- }
+ }
if ($changed) {
if ($o eq "urllist") {
# reset the cached values
@@ -183,7 +188,7 @@ sub edit {
# HASHES
#
- if (@args==1 && $args[0] eq ""){
+ if (@args==1 && $args[0] eq "") {
@args = ();
} elsif (@args % 2) {
push @args, "";
@@ -196,14 +201,14 @@ sub edit {
# SCALARS
#
- if (defined $args[0]){
+ if (defined $args[0]) {
$CPAN::CONFIG_DIRTY = 1;
$CPAN::Config->{$o} = $args[0];
$changed = 1;
}
- $self->prettyprint($o)
+ $self->prettyprint($o)
if exists $keys{$o} or defined $CPAN::Config->{$o};
- }
+ }
if ($changed) {
if ($CPAN::Config->{auto_commit}) {
$self->commit;
@@ -217,33 +222,35 @@ sub edit {
}
sub prettyprint {
- my($self,$k) = @_;
- my $v = $CPAN::Config->{$k};
- if (ref $v) {
- my(@report);
- if (ref $v eq "ARRAY") {
- @report = map {"\t$_ \[$v->[$_]]\n"} 0..$#$v;
+ my($self,$k) = @_;
+ my $v = $CPAN::Config->{$k};
+ if (ref $v) {
+ my(@report);
+ if (ref $v eq "ARRAY") {
+ @report = map {"\t$_ \[$v->[$_]]\n"} 0..$#$v;
+ } else {
+ @report = map
+ {
+ sprintf "\t%-18s => %s\n",
+ "[$_]",
+ defined $v->{$_} ? "[$v->{$_}]" : "undef"
+ } keys %$v;
+ }
+ $CPAN::Frontend->myprint(
+ join(
+ "",
+ sprintf(
+ " %-18s\n",
+ $k
+ ),
+ @report
+ )
+ );
+ } elsif (defined $v) {
+ $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
} else {
- @report = map { sprintf("\t%-18s => %s\n",
- map { "[$_]" } $_,
- defined $v->{$_} ? $v->{$_} : "UNDEFINED"
- )} keys %$v;
+ $CPAN::Frontend->myprint(sprintf " %-18s undef\n", $k);
}
- $CPAN::Frontend->myprint(
- join(
- "",
- sprintf(
- " %-18s\n",
- $k
- ),
- @report
- )
- );
- } elsif (defined $v) {
- $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
- } else {
- $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, "UNDEFINED");
- }
}
sub commit {
@@ -264,10 +271,10 @@ sub commit {
$configpm = $args[0];
}
}
- unless (defined $configpm){
- $configpm ||= $INC{"CPAN/MyConfig.pm"};
- $configpm ||= $INC{"CPAN/Config.pm"};
- $configpm || Carp::confess(q{
+ unless (defined $configpm) {
+ $configpm ||= $INC{"CPAN/MyConfig.pm"};
+ $configpm ||= $INC{"CPAN/Config.pm"};
+ $configpm || Carp::confess(q{
CPAN::Config::commit called without an argument.
Please specify a filename where to save the configuration or try
"o conf init" to have an interactive course through configing.
@@ -275,10 +282,10 @@ Please specify a filename where to save the configuration or try
}
my($mode);
if (-f $configpm) {
- $mode = (stat $configpm)[2];
- if ($mode && ! -w _) {
- Carp::confess("$configpm is not writable");
- }
+ $mode = (stat $configpm)[2];
+ if ($mode && ! -w _) {
+ Carp::confess("$configpm is not writable");
+ }
}
my $msg;
@@ -302,11 +309,11 @@ EOF
$CPAN::Frontend->mywarn("Unknown config variable '$_'\n");
next;
}
- $fh->print(
- " '$_' => ",
- $self->neatvalue($CPAN::Config->{$_}),
- ",\n"
- );
+ $fh->print(
+ " '$_' => ",
+ $self->neatvalue($CPAN::Config->{$_}),
+ ",\n"
+ );
}
$fh->print("};\n1;\n__END__\n");
@@ -327,7 +334,7 @@ sub neatvalue {
my($self, $v) = @_;
return "undef" unless defined $v;
my($t) = ref $v;
- unless ($t){
+ unless ($t) {
$v =~ s/\\/\\\\/g;
return "q[$v]";
}
@@ -343,7 +350,7 @@ sub neatvalue {
}
return "$v" unless $t eq 'HASH';
my(@m, $key, $val);
- while (($key,$val) = each %$v){
+ while (($key,$val) = each %$v) {
last unless defined $key; # cautious programming in case (undef,undef) is true
push(@m,"q[$key]=>".$self->neatvalue($val)) ;
}
@@ -408,7 +415,7 @@ else: quote it with the correct quote type for the box we're on
my ($quotes,$use_quote)
= $^O eq 'MSWin32'
? ('"', '"')
- : (q<"'>, "'")
+ : (q{"'}, "'")
;
sub safe_quote {
@@ -428,12 +435,8 @@ else: quote it with the correct quote type for the box we're on
sub init {
my($self,@args) = @_;
- undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
- # have the least
- # important
- # variable
- # undefined
- $self->load(@args);
+ CPAN->debug("self[$self]args[".join(",",@args)."]");
+ $self->load(doit => 1, @args);
1;
}
@@ -441,7 +444,7 @@ sub init {
# maintainability. RMB
#
sub _configpmtest {
- my($configpmdir, $configpmtest) = @_;
+ my($configpmdir, $configpmtest) = @_;
if (-w $configpmtest) {
return $configpmtest;
} elsif (-w $configpmdir) {
@@ -450,20 +453,20 @@ sub _configpmtest {
unlink $configpm_bak if -f $configpm_bak;
if( -f $configpmtest ) {
if( rename $configpmtest, $configpm_bak ) {
- $CPAN::Frontend->mywarn(<<END);
+ $CPAN::Frontend->mywarn(<<END);
Old configuration file $configpmtest
moved to $configpm_bak
END
- }
- }
- my $fh = FileHandle->new;
- if ($fh->open(">$configpmtest")) {
- $fh->print("1;\n");
- return $configpmtest;
- } else {
- # Should never happen
- Carp::confess("Cannot open >$configpmtest");
- }
+ }
+ }
+ my $fh = FileHandle->new;
+ if ($fh->open(">$configpmtest")) {
+ $fh->print("1;\n");
+ return $configpmtest;
+ } else {
+ # Should never happen
+ Carp::confess("Cannot open >$configpmtest");
+ }
} else { return }
}
@@ -490,7 +493,11 @@ sub home () {
my $home;
if ($CPAN::META->has_usable("File::HomeDir")) {
$home = File::HomeDir->my_data;
- } else {
+ unless (defined $home) {
+ $home = File::HomeDir->my_home
+ }
+ }
+ unless (defined $home) {
$home = $ENV{HOME};
}
$home;
@@ -498,39 +505,42 @@ sub home () {
sub load {
my($self, %args) = @_;
- $CPAN::Be_Silent++ if $args{be_silent};
+ $CPAN::Be_Silent++ if $args{be_silent};
+ my $doit;
+ $doit = delete $args{doit};
- my(@miss);
use Carp;
require_myconfig_or_config;
- return unless @miss = $self->missing_config_data;
+ my @miss = $self->missing_config_data;
+ return unless $doit || @miss;
+ return if $loading;
+ $loading++;
require CPAN::FirstTime;
- my($configpm,$fh,$redo,$theycalled);
+ my($configpm,$fh,$redo);
$redo ||= "";
- $theycalled++ if @miss==1 && $miss[0] eq 'inhibit_startup_message';
if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
- $configpm = $INC{"CPAN/Config.pm"};
- $redo++;
+ $configpm = $INC{"CPAN/Config.pm"};
+ $redo++;
} elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
- $configpm = $INC{"CPAN/MyConfig.pm"};
- $redo++;
+ $configpm = $INC{"CPAN/MyConfig.pm"};
+ $redo++;
} else {
- my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
- my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN");
- my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm");
+ my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
+ my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN");
+ my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm");
my $inc_key;
- if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
- $configpm = _configpmtest($configpmdir,$configpmtest);
+ if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
+ $configpm = _configpmtest($configpmdir,$configpmtest);
$inc_key = "CPAN/Config.pm";
- }
- unless ($configpm) {
- $configpmdir = File::Spec->catdir(home,".cpan","CPAN");
- File::Path::mkpath($configpmdir);
- $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm");
- $configpm = _configpmtest($configpmdir,$configpmtest);
+ }
+ unless ($configpm) {
+ $configpmdir = File::Spec->catdir(home,".cpan","CPAN");
+ File::Path::mkpath($configpmdir);
+ $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm");
+ $configpm = _configpmtest($configpmdir,$configpmtest);
$inc_key = "CPAN/MyConfig.pm";
- }
+ }
if ($configpm) {
$INC{$inc_key} = $configpm;
} else {
@@ -541,22 +551,17 @@ sub load {
}
local($") = ", ";
- if ($redo && ! $theycalled){
+ if ($redo && !$doit) {
$CPAN::Frontend->myprint(<<END);
Sorry, we have to rerun the configuration dialog for CPAN.pm due to
-the following indispensable but missing parameters:
+some missing parameters...
-@miss
END
$args{args} = \@miss;
}
- if (0) {
- # where do we need this?
- $CPAN::Frontend->myprint(qq{
-$configpm initialized.
-});
- }
CPAN::FirstTime::init($configpm, %args);
+ $loading--;
+ return;
}
@@ -573,7 +578,7 @@ sub missing_config_data {
#"gzip",
"http_proxy",
"index_expire",
- "inhibit_startup_message",
+ #"inhibit_startup_message",
"keep_source_where",
#"make",
"make_arg",
@@ -592,7 +597,7 @@ sub missing_config_data {
"urllist",
) {
next unless exists $keys{$_};
- push @miss, $_ unless defined $CPAN::Config->{$_};
+ push @miss, $_ unless defined $CPAN::Config->{$_};
}
return @miss;
}
@@ -622,17 +627,17 @@ sub cpl {
CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
my(@words) = split " ", substr($line,0,$pos+1);
if (
- defined($words[2])
- and
+ defined($words[2])
+ and
$words[2] =~ /list$/
and
- (
- @words == 3
- ||
- @words == 4 && length($word)
- )
+ (
+ @words == 3
+ ||
+ @words == 4 && length($word)
+ )
) {
- return grep /^\Q$word\E/, qw(splice shift unshift pop push);
+ return grep /^\Q$word\E/, qw(splice shift unshift pop push);
} elsif (defined($words[2])
and
$words[2] eq "init"
@@ -642,9 +647,9 @@ sub cpl {
||
@words >= 4 && length($word)
)) {
- return sort grep /^\Q$word\E/, keys %keys;
+ return sort grep /^\Q$word\E/, keys %keys;
} elsif (@words >= 4) {
- return ();
+ return ();
}
my %seen;
my(@o_conf) = sort grep { !$seen{$_}++ }
@@ -685,10 +690,11 @@ sub prefs_lookup {
use strict;
use vars qw($AUTOLOAD $VERSION);
- $VERSION = sprintf "%.2f", substr(q$Rev: 1744 $,4)/100;
+ $VERSION = sprintf "%.2f", substr(q$Rev: 2212 $,4)/100;
# formerly CPAN::HandleConfig was known as CPAN::Config
sub AUTOLOAD {
+ my $class = shift; # e.g. in dh-make-perl: CPAN::Config
my($l) = $AUTOLOAD;
$CPAN::Frontend->mywarn("Dispatching deprecated method '$l' to CPAN::HandleConfig\n");
$l =~ s/.*:://;
diff --git a/lib/CPAN/Kwalify/distroprefs.dd b/lib/CPAN/Kwalify/distroprefs.dd
index 392c821ab0..52118e5a98 100644
--- a/lib/CPAN/Kwalify/distroprefs.dd
+++ b/lib/CPAN/Kwalify/distroprefs.dd
@@ -11,6 +11,21 @@ $VAR1 = {
},
"type" => "map"
},
+ "depends" => {
+ "mapping" => {
+ "build_requires" => {
+ "mapping" => {
+ "=" => {
+ "type" => "text"
+ }
+ },
+ "type" => "map"
+ },
+ "configure_requires" => {},
+ "requires" => {}
+ },
+ "type" => "map"
+ },
"disabled" => {
"enum" => [
0,
@@ -43,6 +58,9 @@ $VAR1 = {
],
"type" => "text"
},
+ "reuse" => {
+ "type" => "int"
+ },
"talk" => {
"sequence" => [
{
@@ -112,6 +130,8 @@ $VAR1 = {
},
"type" => "map"
};
+$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"}{"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 60a43726d9..68ff72b5be 100644
--- a/lib/CPAN/Kwalify/distroprefs.yml
+++ b/lib/CPAN/Kwalify/distroprefs.yml
@@ -3,6 +3,17 @@ type: map
mapping:
comment:
type: text
+ depends:
+ type: map
+ mapping:
+ configure_requires:
+ &requires_common
+ type: map
+ mapping:
+ =:
+ type: text
+ build_requires: *requires_common
+ requires: *requires_common
match:
type: map
mapping:
@@ -46,6 +57,8 @@ mapping:
- anyorder
timeout:
type: number
+ reuse:
+ type: int
talk:
type: seq
sequence:
diff --git a/lib/CPAN/Queue.pm b/lib/CPAN/Queue.pm
index dac56f543a..f01ab5133d 100644
--- a/lib/CPAN/Queue.pm
+++ b/lib/CPAN/Queue.pm
@@ -1,6 +1,26 @@
# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
-package CPAN::Queue;
use strict;
+package CPAN::Queue::Item;
+
+# CPAN::Queue::Item::new ;
+sub new {
+ my($class,@attr) = @_;
+ my $self = bless { @attr }, $class;
+ return $self;
+}
+
+sub as_string {
+ my($self) = @_;
+ $self->{qmod};
+}
+
+# r => requires, b => build_requires, c => commandline
+sub reqtype {
+ my($self) = @_;
+ $self->{reqtype};
+}
+
+package CPAN::Queue;
# One use of the queue is to determine if we should or shouldn't
# announce the availability of a new CPAN module
@@ -45,49 +65,43 @@ use strict;
# tell the distribution object that it should ask the user before
# processing. Where would the question be triggered then? Most probably
# in CPAN::Distribution::rematein.
-# Hope that makes sense, my head is a bit off:-) -- AK
use vars qw{ @All $VERSION };
-$VERSION = sprintf "%.6f", substr(q$Rev: 1704 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
+
+# CPAN::Queue::queue_item ;
+sub queue_item {
+ my($class,@attr) = @_;
+ my $item = "$class\::Item"->new(@attr);
+ $class->qpush($item);
+ return 1;
+}
-# CPAN::Queue::new ;
-sub new {
- my($class,@attr) = @_;
- my $self = bless { @attr }, $class;
- push @All, $self;
- CPAN->debug(sprintf("in new All[%s]",
- join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All),
- )) if $CPAN::DEBUG;
- return $self;
+# CPAN::Queue::qpush ;
+sub qpush {
+ my($class,$obj) = @_;
+ push @All, $obj;
+ CPAN->debug(sprintf("in new All[%s]",
+ join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All),
+ )) if $CPAN::DEBUG;
}
# CPAN::Queue::first ;
sub first {
- my $obj = $All[0];
- $obj;
-}
-
-sub as_string {
- my($self) = @_;
- $self->{qmod};
-}
-
-# r => requires, b => build_requires, c => commandline
-sub reqtype {
- my($self) = @_;
- $self->{reqtype};
+ my $obj = $All[0];
+ $obj;
}
# CPAN::Queue::delete_first ;
sub delete_first {
- my($class,$what) = @_;
- my $i;
- for my $i (0..$#All) {
- if ( $All[$i]->{qmod} eq $what ) {
- splice @All, $i, 1;
- return;
+ my($class,$what) = @_;
+ my $i;
+ for my $i (0..$#All) {
+ if ( $All[$i]->{qmod} eq $what ) {
+ splice @All, $i, 1;
+ return;
+ }
}
- }
}
# CPAN::Queue::jumpqueue ;
@@ -95,17 +109,17 @@ sub jumpqueue {
my $class = shift;
my @what = @_;
CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
- join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All),
- join("",map {sprintf " %s\[%s]",$_->[0],$_->[1]} @what)
- )) if $CPAN::DEBUG;
- unless (defined $what[0][1]) {
+ join("",
+ map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All, @what
+ ))) if $CPAN::DEBUG;
+ unless (defined $what[0]{reqtype}) {
# apparently it was not the Shell that sent us this enquiry,
# treat it as commandline
- $what[0][1] = "c";
- }
- my $inherit_reqtype = $what[0][1] =~ /^(c|r)$/ ? "r" : "b";
+ $what[0]{reqtype} = "c";
+ }
+ my $inherit_reqtype = $what[0]{reqtype} =~ /^(c|r)$/ ? "r" : "b";
WHAT: for my $what_tuple (@what) {
- my($what,$reqtype) = @$what_tuple;
+ my($what,$reqtype) = @$what_tuple{qw(qmod reqtype)};
if ($reqtype eq "r"
&&
$inherit_reqtype eq "b"
@@ -115,24 +129,27 @@ sub jumpqueue {
my $jumped = 0;
for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
# CPAN->debug("i[$i]this[$All[$i]{qmod}]what[$what]") if $CPAN::DEBUG;
- if ($All[$i]{qmod} eq $what){
+ if ($All[$i]{qmod} eq $what) {
$jumped++;
- if ($jumped > 25) { # one's OK if e.g. just processing
+ if ($jumped >= 50) {
+ die "PANIC: object[$what] 50 instances on the queue, looks like ".
+ "some recursiveness has hit";
+ } elsif ($jumped > 25) { # one's OK if e.g. just processing
# now; more are OK if user typed
# it several times
my $sleep = sprintf "%.1f", $jumped/10;
$CPAN::Frontend->mywarn(
qq{Warning: Object [$what] queued $jumped times, sleeping $sleep secs!\n}
- );
+ );
$CPAN::Frontend->mysleep($sleep);
# next WHAT;
}
}
}
- my $obj = bless {
- qmod => $what,
- reqtype => $reqtype
- }, $class;
+ my $obj = "$class\::Item"->new(
+ qmod => $what,
+ reqtype => $reqtype
+ );
unshift @All, $obj;
}
CPAN->debug(sprintf("after jumpqueue All[%s]",
@@ -142,26 +159,26 @@ qq{Warning: Object [$what] queued $jumped times, sleeping $sleep secs!\n}
# CPAN::Queue::exists ;
sub exists {
- my($self,$what) = @_;
- my @all = map { $_->{qmod} } @All;
- my $exists = grep { $_->{qmod} eq $what } @All;
- # warn "in exists what[$what] all[@all] exists[$exists]";
- $exists;
+ my($self,$what) = @_;
+ my @all = map { $_->{qmod} } @All;
+ my $exists = grep { $_->{qmod} eq $what } @All;
+ # warn "in exists what[$what] all[@all] exists[$exists]";
+ $exists;
}
# CPAN::Queue::delete ;
sub delete {
- my($self,$mod) = @_;
- @All = grep { $_->{qmod} ne $mod } @All;
- CPAN->debug(sprintf("after delete mod[%s] All[%s]",
- $mod,
- join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All)
- )) if $CPAN::DEBUG;
+ my($self,$mod) = @_;
+ @All = grep { $_->{qmod} ne $mod } @All;
+ CPAN->debug(sprintf("after delete mod[%s] All[%s]",
+ $mod,
+ join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All)
+ )) if $CPAN::DEBUG;
}
# CPAN::Queue::nullify_queue ;
sub nullify_queue {
- @All = ();
+ @All = ();
}
1;
diff --git a/lib/CPAN/Tarzip.pm b/lib/CPAN/Tarzip.pm
index 88e8ef505f..a9cad24727 100644
--- a/lib/CPAN/Tarzip.pm
+++ b/lib/CPAN/Tarzip.pm
@@ -1,10 +1,10 @@
-# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 2 -*-
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
package CPAN::Tarzip;
use strict;
use vars qw($VERSION @ISA $BUGHUNTING);
use CPAN::Debug;
use File::Basename ();
-$VERSION = sprintf "%.6f", substr(q$Rev: 1717 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 2213 $,4)/1000000 + 5.4;
# module is internal to CPAN.pm
@ISA = qw(CPAN::Debug);
@@ -12,173 +12,173 @@ $BUGHUNTING ||= 0; # released code must have turned off
# it's ok if file doesn't exist, it just matters if it is .gz or .bz2
sub new {
- my($class,$file) = @_;
- $CPAN::Frontend->mydie("CPAN::Tarzip->new called without arg") unless defined $file;
- if (0) {
- # nonono, we get e.g. 01mailrc.txt uncompressed if only wget is available
- $CPAN::Frontend->mydie("file[$file] doesn't match /\\.(bz2|gz|zip|tgz)\$/")
- unless $file =~ /\.(bz2|gz|zip|tgz)$/i;
- }
- my $me = { FILE => $file };
- 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");
- }
- if ($bzip2) {
- $me->{UNGZIPPRG} = $bzip2 || "bzip2";
- } else {
- $CPAN::Frontend->mydie(qq{
+ my($class,$file) = @_;
+ $CPAN::Frontend->mydie("CPAN::Tarzip->new called without arg") unless defined $file;
+ if (0) {
+ # nonono, we get e.g. 01mailrc.txt uncompressed if only wget is available
+ $CPAN::Frontend->mydie("file[$file] doesn't match /\\.(bz2|gz|zip|tgz)\$/")
+ unless $file =~ /\.(bz2|gz|zip|tgz)$/i;
+ }
+ my $me = { FILE => $file };
+ 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");
+ }
+ if ($bzip2) {
+ $me->{UNGZIPPRG} = $bzip2 || "bzip2";
+ } else {
+ $CPAN::Frontend->mydie(qq{
CPAN.pm needs the external program bzip2 in order to handle '$file'.
Please install it now and run 'o conf init' to register it as external
program.
});
- }
+ }
+ }
+ } else {
+ # yes, we let gzip figure it out in *any* other case
+ $me->{UNGZIPPRG} = $CPAN::Config->{gzip} || "gzip";
}
- } else {
- # yes, we let gzip figure it out in *any* other case
- $me->{UNGZIPPRG} = $CPAN::Config->{gzip} || "gzip";
- }
- bless $me, $class;
+ bless $me, $class;
}
sub gzip {
- my($self,$read) = @_;
- my $write = $self->{FILE};
- if ($CPAN::META->has_inst("Compress::Zlib")) {
- my($buffer,$fhw);
- $fhw = FileHandle->new($read)
- or $CPAN::Frontend->mydie("Could not open $read: $!");
- my $cwd = `pwd`;
- my $gz = Compress::Zlib::gzopen($write, "wb")
- or $CPAN::Frontend->mydie("Cannot gzopen $write: $! (pwd is $cwd)\n");
- $gz->gzwrite($buffer)
- while read($fhw,$buffer,4096) > 0 ;
- $gz->gzclose() ;
- $fhw->close;
- return 1;
- } else {
- my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- system(qq{$command -c "$read" > "$write"})==0;
- }
+ my($self,$read) = @_;
+ my $write = $self->{FILE};
+ if ($CPAN::META->has_inst("Compress::Zlib")) {
+ my($buffer,$fhw);
+ $fhw = FileHandle->new($read)
+ or $CPAN::Frontend->mydie("Could not open $read: $!");
+ my $cwd = `pwd`;
+ my $gz = Compress::Zlib::gzopen($write, "wb")
+ or $CPAN::Frontend->mydie("Cannot gzopen $write: $! (pwd is $cwd)\n");
+ $gz->gzwrite($buffer)
+ while read($fhw,$buffer,4096) > 0 ;
+ $gz->gzclose() ;
+ $fhw->close;
+ return 1;
+ } else {
+ my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ system(qq{$command -c "$read" > "$write"})==0;
+ }
}
sub gunzip {
- my($self,$write) = @_;
- my $read = $self->{FILE};
- if ($CPAN::META->has_inst("Compress::Zlib")) {
- my($buffer,$fhw);
- $fhw = FileHandle->new(">$write")
- or $CPAN::Frontend->mydie("Could not open >$write: $!");
- my $gz = Compress::Zlib::gzopen($read, "rb")
- or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
- $fhw->print($buffer)
- while $gz->gzread($buffer) > 0 ;
- $CPAN::Frontend->mydie("Error reading from $read: $!\n")
- if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
- $gz->gzclose() ;
- $fhw->close;
- return 1;
- } else {
- my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- system(qq{$command -dc "$read" > "$write"})==0;
- }
+ my($self,$write) = @_;
+ my $read = $self->{FILE};
+ if ($CPAN::META->has_inst("Compress::Zlib")) {
+ my($buffer,$fhw);
+ $fhw = FileHandle->new(">$write")
+ or $CPAN::Frontend->mydie("Could not open >$write: $!");
+ my $gz = Compress::Zlib::gzopen($read, "rb")
+ or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
+ $fhw->print($buffer)
+ while $gz->gzread($buffer) > 0 ;
+ $CPAN::Frontend->mydie("Error reading from $read: $!\n")
+ if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
+ $gz->gzclose() ;
+ $fhw->close;
+ return 1;
+ } else {
+ my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ system(qq{$command -dc "$read" > "$write"})==0;
+ }
}
sub gtest {
- my($self) = @_;
- return $self->{GTEST} if exists $self->{GTEST};
- defined $self->{FILE} or $CPAN::Frontend->mydie("gtest called but no FILE specified");
- my $read = $self->{FILE};
- my $success;
- # After I had reread the documentation in zlib.h, I discovered that
- # uncompressed files do not lead to an gzerror (anymore?).
- if ( $CPAN::META->has_inst("Compress::Zlib") ) {
- my($buffer,$len);
- $len = 0;
- my $gz = Compress::Zlib::gzopen($read, "rb")
- or $CPAN::Frontend->mydie(sprintf("Cannot gzopen %s: %s\n",
- $read,
- $Compress::Zlib::gzerrno));
- while ($gz->gzread($buffer) > 0 ){
- $len += length($buffer);
- $buffer = "";
- }
- my $err = $gz->gzerror;
- $success = ! $err || $err == Compress::Zlib::Z_STREAM_END();
- if ($len == -s $read){
- $success = 0;
- CPAN->debug("hit an uncompressed file") if $CPAN::DEBUG;
+ my($self) = @_;
+ return $self->{GTEST} if exists $self->{GTEST};
+ defined $self->{FILE} or $CPAN::Frontend->mydie("gtest called but no FILE specified");
+ my $read = $self->{FILE};
+ my $success;
+ # After I had reread the documentation in zlib.h, I discovered that
+ # uncompressed files do not lead to an gzerror (anymore?).
+ if ( $CPAN::META->has_inst("Compress::Zlib") ) {
+ my($buffer,$len);
+ $len = 0;
+ my $gz = Compress::Zlib::gzopen($read, "rb")
+ or $CPAN::Frontend->mydie(sprintf("Cannot gzopen %s: %s\n",
+ $read,
+ $Compress::Zlib::gzerrno));
+ while ($gz->gzread($buffer) > 0 ) {
+ $len += length($buffer);
+ $buffer = "";
+ }
+ my $err = $gz->gzerror;
+ $success = ! $err || $err == Compress::Zlib::Z_STREAM_END();
+ if ($len == -s $read) {
+ $success = 0;
+ CPAN->debug("hit an uncompressed file") if $CPAN::DEBUG;
+ }
+ $gz->gzclose();
+ CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG;
+ } else {
+ my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ $success = 0==system(qq{$command -qdt "$read"});
}
- $gz->gzclose();
- CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG;
- } else {
- my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- $success = 0==system(qq{$command -qdt "$read"});
- }
- return $self->{GTEST} = $success;
+ return $self->{GTEST} = $success;
}
sub TIEHANDLE {
- my($class,$file) = @_;
- my $ret;
- $class->debug("file[$file]");
- my $self = $class->new($file);
- if (0) {
- } elsif (!$self->gtest) {
- my $fh = FileHandle->new($file)
- or $CPAN::Frontend->mydie("Could not open file[$file]: $!");
- binmode $fh;
- $self->{FH} = $fh;
- $class->debug("via uncompressed FH");
- } elsif ($CPAN::META->has_inst("Compress::Zlib")) {
- my $gz = Compress::Zlib::gzopen($file,"rb") or
- $CPAN::Frontend->mydie("Could not gzopen $file");
- $self->{GZ} = $gz;
- $class->debug("via Compress::Zlib");
- } else {
- my $gzip = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- my $pipe = "$gzip -dc $file |";
- my $fh = FileHandle->new($pipe) or $CPAN::Frontend->mydie("Could not pipe[$pipe]: $!");
- binmode $fh;
- $self->{FH} = $fh;
- $class->debug("via external gzip");
- }
- $self;
+ my($class,$file) = @_;
+ my $ret;
+ $class->debug("file[$file]");
+ my $self = $class->new($file);
+ if (0) {
+ } elsif (!$self->gtest) {
+ my $fh = FileHandle->new($file)
+ or $CPAN::Frontend->mydie("Could not open file[$file]: $!");
+ binmode $fh;
+ $self->{FH} = $fh;
+ $class->debug("via uncompressed FH");
+ } elsif ($CPAN::META->has_inst("Compress::Zlib")) {
+ my $gz = Compress::Zlib::gzopen($file,"rb") or
+ $CPAN::Frontend->mydie("Could not gzopen $file");
+ $self->{GZ} = $gz;
+ $class->debug("via Compress::Zlib");
+ } else {
+ my $gzip = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ my $pipe = "$gzip -dc $file |";
+ my $fh = FileHandle->new($pipe) or $CPAN::Frontend->mydie("Could not pipe[$pipe]: $!");
+ binmode $fh;
+ $self->{FH} = $fh;
+ $class->debug("via external gzip");
+ }
+ $self;
}
sub READLINE {
- my($self) = @_;
- if (exists $self->{GZ}) {
- my $gz = $self->{GZ};
- my($line,$bytesread);
- $bytesread = $gz->gzreadline($line);
- return undef if $bytesread <= 0;
- return $line;
- } else {
- my $fh = $self->{FH};
- return scalar <$fh>;
- }
+ my($self) = @_;
+ if (exists $self->{GZ}) {
+ my $gz = $self->{GZ};
+ my($line,$bytesread);
+ $bytesread = $gz->gzreadline($line);
+ return undef if $bytesread <= 0;
+ return $line;
+ } else {
+ my $fh = $self->{FH};
+ return scalar <$fh>;
+ }
}
sub READ {
- my($self,$ref,$length,$offset) = @_;
- $CPAN::Frontend->mydie("read with offset not implemented") if defined $offset;
- if (exists $self->{GZ}) {
- my $gz = $self->{GZ};
- my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
- return $byteread;
- } else {
- my $fh = $self->{FH};
- return read($fh,$$ref,$length);
- }
+ my($self,$ref,$length,$offset) = @_;
+ $CPAN::Frontend->mydie("read with offset not implemented") if defined $offset;
+ if (exists $self->{GZ}) {
+ my $gz = $self->{GZ};
+ my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
+ return $byteread;
+ } else {
+ my $fh = $self->{FH};
+ return read($fh,$$ref,$length);
+ }
}
@@ -197,140 +197,147 @@ sub DESTROY {
sub untar {
- my($self) = @_;
- my $file = $self->{FILE};
- my($prefer) = 0;
+ my($self) = @_;
+ my $file = $self->{FILE};
+ my($prefer) = 0;
- if (0) { # makes changing order easier
- } elsif ($BUGHUNTING){
- $prefer=2;
- } elsif (MM->maybe_command($self->{UNGZIPPRG})
- &&
- MM->maybe_command($CPAN::Config->{tar})) {
- # should be default until Archive::Tar handles bzip2
- $prefer = 1;
- } elsif (
- $CPAN::META->has_usable("Archive::Tar")
- &&
- $CPAN::META->has_inst("Compress::Zlib") ) {
- $prefer = 2;
- } else {
- $CPAN::Frontend->mydie(qq{
+ if (0) { # makes changing order easier
+ } elsif ($BUGHUNTING) {
+ $prefer=2;
+ } elsif (MM->maybe_command($self->{UNGZIPPRG})
+ &&
+ MM->maybe_command($CPAN::Config->{tar})) {
+ # should be default until Archive::Tar handles bzip2
+ $prefer = 1;
+ } elsif (
+ $CPAN::META->has_usable("Archive::Tar")
+ &&
+ $CPAN::META->has_inst("Compress::Zlib") ) {
+ $prefer = 2;
+ } else {
+ $CPAN::Frontend->mydie(qq{
CPAN.pm needs either the external programs tar, gzip and bzip2
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";
- if ($is_compressed) {
- my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- $system = qq{$command -dc }.
- qq{< "$file" | $tarcommand xvf -};
- } else {
- $system = qq{$tarcommand xvf "$file"};
}
- if (system($system) != 0) {
- # people find the most curious tar binaries that cannot handle
- # pipes
- if ($is_compressed) {
- (my $ungzf = $file) =~ s/\.gz(?!\n)\Z//;
- $ungzf = File::Basename::basename($ungzf);
- my $ct = CPAN::Tarzip->new($file);
- if ($ct->gunzip($ungzf)) {
- $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
+ my $tar_verb = "v";
+ if (defined $CPAN::Config->{tar_verbosity}) {
+ $tar_verb = $CPAN::Config->{tar_verbosity} eq "none" ? "" :
+ $CPAN::Config->{tar_verbosity};
+ }
+ if ($prefer==1) { # 1 => external gzip+tar
+ my($system);
+ my $is_compressed = $self->gtest();
+ my $tarcommand = CPAN::HandleConfig->safe_quote($CPAN::Config->{tar}) || "tar";
+ if ($is_compressed) {
+ my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ $system = qq{$command -dc }.
+ qq{< "$file" | $tarcommand x${tar_verb}f -};
} else {
- $CPAN::Frontend->mydie(qq{Couldn\'t uncompress $file\n});
+ $system = qq{$tarcommand x${tar_verb}f "$file"};
}
- $file = $ungzf;
- }
- $system = qq{$tarcommand xvf "$file"};
- $CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
- if (system($system)==0) {
- $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
- } else {
- $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
- }
- return 1;
- } else {
- return 1;
- }
- } elsif ($prefer==2) { # 2 => modules
- unless ($CPAN::META->has_usable("Archive::Tar")) {
- $CPAN::Frontend->mydie("Archive::Tar not installed, please install it to continue");
- }
- my $tar = Archive::Tar->new($file,1);
- my $af; # archive file
- my @af;
- if ($BUGHUNTING) {
- # RCS 1.337 had this code, it turned out unacceptable slow but
- # it revealed a bug in Archive::Tar. Code is only here to hunt
- # the bug again. It should never be enabled in published code.
- # GDGraph3d-0.53 was an interesting case according to Larry
- # Virden.
- warn(">>>Bughunting code enabled<<< " x 20);
- for $af ($tar->list_files) {
- if ($af =~ m!^(/|\.\./)!) {
- $CPAN::Frontend->mydie("ALERT: Archive contains ".
- "illegal member [$af]");
+ if (system($system) != 0) {
+ # people find the most curious tar binaries that cannot handle
+ # pipes
+ if ($is_compressed) {
+ (my $ungzf = $file) =~ s/\.gz(?!\n)\Z//;
+ $ungzf = File::Basename::basename($ungzf);
+ my $ct = CPAN::Tarzip->new($file);
+ if ($ct->gunzip($ungzf)) {
+ $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
+ } else {
+ $CPAN::Frontend->mydie(qq{Couldn\'t uncompress $file\n});
+ }
+ $file = $ungzf;
+ }
+ $system = qq{$tarcommand x${tar_verb}f "$file"};
+ $CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
+ if (system($system)==0) {
+ $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
+ } else {
+ $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
+ }
+ return 1;
+ } else {
+ return 1;
}
- $CPAN::Frontend->myprint("$af\n");
- $tar->extract($af); # slow but effective for finding the bug
- return if $CPAN::Signal;
- }
- } else {
- for $af ($tar->list_files) {
- if ($af =~ m!^(/|\.\./)!) {
- $CPAN::Frontend->mydie("ALERT: Archive contains ".
- "illegal member [$af]");
+ } elsif ($prefer==2) { # 2 => modules
+ unless ($CPAN::META->has_usable("Archive::Tar")) {
+ $CPAN::Frontend->mydie("Archive::Tar not installed, please install it to continue");
+ }
+ my $tar = Archive::Tar->new($file,1);
+ my $af; # archive file
+ my @af;
+ if ($BUGHUNTING) {
+ # RCS 1.337 had this code, it turned out unacceptable slow but
+ # it revealed a bug in Archive::Tar. Code is only here to hunt
+ # the bug again. It should never be enabled in published code.
+ # GDGraph3d-0.53 was an interesting case according to Larry
+ # Virden.
+ warn(">>>Bughunting code enabled<<< " x 20);
+ for $af ($tar->list_files) {
+ if ($af =~ m!^(/|\.\./)!) {
+ $CPAN::Frontend->mydie("ALERT: Archive contains ".
+ "illegal member [$af]");
+ }
+ $CPAN::Frontend->myprint("$af\n");
+ $tar->extract($af); # slow but effective for finding the bug
+ return if $CPAN::Signal;
+ }
+ } else {
+ for $af ($tar->list_files) {
+ if ($af =~ m!^(/|\.\./)!) {
+ $CPAN::Frontend->mydie("ALERT: Archive contains ".
+ "illegal member [$af]");
+ }
+ if ($tar_verb eq "v" || $tar_verb eq "vv") {
+ $CPAN::Frontend->myprint("$af\n");
+ }
+ push @af, $af;
+ return if $CPAN::Signal;
+ }
+ $tar->extract(@af) or
+ $CPAN::Frontend->mydie("Could not untar with Archive::Tar.");
}
- $CPAN::Frontend->myprint("$af\n");
- push @af, $af;
- return if $CPAN::Signal;
- }
- $tar->extract(@af) or
- $CPAN::Frontend->mydie("Could not untar with Archive::Tar.");
- }
- Mac::BuildTools::convert_files([$tar->list_files], 1)
- if ($^O eq 'MacOS');
+ Mac::BuildTools::convert_files([$tar->list_files], 1)
+ if ($^O eq 'MacOS');
- return 1;
- }
+ return 1;
+ }
}
sub unzip {
- my($self) = @_;
- my $file = $self->{FILE};
- if ($CPAN::META->has_inst("Archive::Zip")) {
- # blueprint of the code from Archive::Zip::Tree::extractTree();
- my $zip = Archive::Zip->new();
- my $status;
- $status = $zip->read($file);
- $CPAN::Frontend->mydie("Read of file[$file] failed\n")
- if $status != Archive::Zip::AZ_OK();
- $CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG;
- my @members = $zip->members();
- for my $member ( @members ) {
- my $af = $member->fileName();
- if ($af =~ m!^(/|\.\./)!) {
- $CPAN::Frontend->mydie("ALERT: Archive contains ".
- "illegal member [$af]");
- }
- $status = $member->extractToFileNamed( $af );
- $CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG;
- $CPAN::Frontend->mydie("Extracting of file[$af] from zipfile[$file] failed\n") if
- $status != Archive::Zip::AZ_OK();
- return if $CPAN::Signal;
+ my($self) = @_;
+ my $file = $self->{FILE};
+ if ($CPAN::META->has_inst("Archive::Zip")) {
+ # blueprint of the code from Archive::Zip::Tree::extractTree();
+ my $zip = Archive::Zip->new();
+ my $status;
+ $status = $zip->read($file);
+ $CPAN::Frontend->mydie("Read of file[$file] failed\n")
+ if $status != Archive::Zip::AZ_OK();
+ $CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG;
+ my @members = $zip->members();
+ for my $member ( @members ) {
+ my $af = $member->fileName();
+ if ($af =~ m!^(/|\.\./)!) {
+ $CPAN::Frontend->mydie("ALERT: Archive contains ".
+ "illegal member [$af]");
+ }
+ $status = $member->extractToFileNamed( $af );
+ $CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG;
+ $CPAN::Frontend->mydie("Extracting of file[$af] from zipfile[$file] failed\n") if
+ $status != Archive::Zip::AZ_OK();
+ return if $CPAN::Signal;
+ }
+ return 1;
+ } else {
+ my $unzip = $CPAN::Config->{unzip} or
+ $CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
+ my @system = ($unzip, $file);
+ return system(@system) == 0;
}
- return 1;
- } else {
- my $unzip = $CPAN::Config->{unzip} or
- $CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
- my @system = ($unzip, $file);
- return system(@system) == 0;
- }
}
1;
diff --git a/lib/CPAN/Version.pm b/lib/CPAN/Version.pm
index d2791349be..c306634148 100644
--- a/lib/CPAN/Version.pm
+++ b/lib/CPAN/Version.pm
@@ -2,68 +2,68 @@ package CPAN::Version;
use strict;
use vars qw($VERSION);
-$VERSION = sprintf "%.6f", substr(q$Rev: 1387 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 2210 $,4)/1000000 + 5.4;
# CPAN::Version::vcmp courtesy Jost Krieger
sub vcmp {
- my($self,$l,$r) = @_;
- local($^W) = 0;
- CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
-
- return 0 if $l eq $r; # short circuit for quicker success
-
- for ($l,$r) {
- s/_//g;
- }
- CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
- for ($l,$r) {
- next unless tr/.// > 1;
- s/^v?/v/;
- 1 while s/\.0+(\d)/.$1/; # remove leading zeroes per group
- }
- CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
- if ($l=~/^v/ <=> $r=~/^v/) {
- for ($l,$r) {
- next if /^v/;
- $_ = $self->float2vv($_);
- }
- }
- CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
- my $lvstring = "v0";
- my $rvstring = "v0";
- if ($] >= 5.006
- && $l =~ /^v/
- && $r =~ /^v/) {
- $lvstring = $self->vstring($l);
- $rvstring = $self->vstring($r);
- CPAN->debug(sprintf "lv[%vd] rv[%vd]", $lvstring, $rvstring) if $CPAN::DEBUG;
- }
-
- return (
- ($l ne "undef") <=> ($r ne "undef")
- ||
- $lvstring cmp $rvstring
- ||
- $l <=> $r
- ||
- $l cmp $r
- );
+ my($self,$l,$r) = @_;
+ local($^W) = 0;
+ CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
+
+ return 0 if $l eq $r; # short circuit for quicker success
+
+ for ($l,$r) {
+ s/_//g;
+ }
+ CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
+ for ($l,$r) {
+ next unless tr/.// > 1 || /^v/;
+ s/^v?/v/;
+ 1 while s/\.0+(\d)/.$1/; # remove leading zeroes per group
+ }
+ CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
+ if ($l=~/^v/ <=> $r=~/^v/) {
+ for ($l,$r) {
+ next if /^v/;
+ $_ = $self->float2vv($_);
+ }
+ }
+ CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
+ my $lvstring = "v0";
+ my $rvstring = "v0";
+ if ($] >= 5.006
+ && $l =~ /^v/
+ && $r =~ /^v/) {
+ $lvstring = $self->vstring($l);
+ $rvstring = $self->vstring($r);
+ CPAN->debug(sprintf "lv[%vd] rv[%vd]", $lvstring, $rvstring) if $CPAN::DEBUG;
+ }
+
+ return (
+ ($l ne "undef") <=> ($r ne "undef")
+ ||
+ $lvstring cmp $rvstring
+ ||
+ $l <=> $r
+ ||
+ $l cmp $r
+ );
}
sub vgt {
- my($self,$l,$r) = @_;
- $self->vcmp($l,$r) > 0;
+ my($self,$l,$r) = @_;
+ $self->vcmp($l,$r) > 0;
}
sub vlt {
- my($self,$l,$r) = @_;
- 0 + ($self->vcmp($l,$r) < 0);
+ my($self,$l,$r) = @_;
+ 0 + ($self->vcmp($l,$r) < 0);
}
sub vstring {
- my($self,$n) = @_;
- $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid arg [$n]";
- pack "U*", split /\./, $n;
+ my($self,$n) = @_;
+ $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid arg [$n]";
+ pack "U*", split /\./, $n;
}
# vv => visible vstring
@@ -82,35 +82,36 @@ sub float2vv {
$ret .= ".".int($1);
}
# warn "n[$n]ret[$ret]";
+ $ret =~ s/(\.0)+/.0/; # v1.0.0 => v1.0
$ret;
}
sub readable {
- my($self,$n) = @_;
- $n =~ /^([\w\-\+\.]+)/;
-
- return $1 if defined $1 && length($1)>0;
- # if the first user reaches version v43, he will be treated as "+".
- # We'll have to decide about a new rule here then, depending on what
- # will be the prevailing versioning behavior then.
-
- if ($] < 5.006) { # or whenever v-strings were introduced
- # we get them wrong anyway, whatever we do, because 5.005 will
- # have already interpreted 0.2.4 to be "0.24". So even if he
- # indexer sends us something like "v0.2.4" we compare wrongly.
-
- # And if they say v1.2, then the old perl takes it as "v12"
-
- if (defined $CPAN::Frontend) {
- $CPAN::Frontend->mywarn("Suspicious version string seen [$n]\n");
- } else {
- warn("Suspicious version string seen [$n]\n");
+ my($self,$n) = @_;
+ $n =~ /^([\w\-\+\.]+)/;
+
+ return $1 if defined $1 && length($1)>0;
+ # if the first user reaches version v43, he will be treated as "+".
+ # We'll have to decide about a new rule here then, depending on what
+ # will be the prevailing versioning behavior then.
+
+ if ($] < 5.006) { # or whenever v-strings were introduced
+ # we get them wrong anyway, whatever we do, because 5.005 will
+ # have already interpreted 0.2.4 to be "0.24". So even if he
+ # indexer sends us something like "v0.2.4" we compare wrongly.
+
+ # And if they say v1.2, then the old perl takes it as "v12"
+
+ if (defined $CPAN::Frontend) {
+ $CPAN::Frontend->mywarn("Suspicious version string seen [$n]\n");
+ } else {
+ warn("Suspicious version string seen [$n]\n");
+ }
+ return $n;
}
- return $n;
- }
- my $better = sprintf "v%vd", $n;
- CPAN->debug("n[$n] better[$better]") if $CPAN::DEBUG;
- return $better;
+ my $better = sprintf "v%vd", $n;
+ CPAN->debug("n[$n] better[$better]") if $CPAN::DEBUG;
+ return $better;
}
1;
@@ -158,5 +159,5 @@ modify it under the same terms as Perl itself.
# Local Variables:
# mode: cperl
-# cperl-indent-level: 2
+# cperl-indent-level: 4
# End:
diff --git a/lib/CPAN/t/03pkgs.t b/lib/CPAN/t/03pkgs.t
index 5848c7354b..5abb96c071 100644
--- a/lib/CPAN/t/03pkgs.t
+++ b/lib/CPAN/t/03pkgs.t
@@ -6,7 +6,7 @@ use lib "lib";
my @m;
if ($ENV{PERL_CORE}){
- @m = ("CPAN", map { "CPAN::$_" } qw(Debug FirstTime Nox Queue Tarzip Version));
+ @m = ("CPAN", map { "CPAN::$_" } qw(Debug DeferedCode FirstTime 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/10version.t b/lib/CPAN/t/10version.t
index 3c6978f27b..c1199e99a7 100644
--- a/lib/CPAN/t/10version.t
+++ b/lib/CPAN/t/10version.t
@@ -20,7 +20,7 @@ $N = scalar @$D;
print "1..$N\n";
my $has_sort_versions = eval { require Sort::Versions; 1 };
-my $has_versionpm = eval { require version; 1 };
+my $has_versionpm = eval q{ use version 0.7203; 1 };
my $has_perl_versionpm = eval { require Perl::Version; 1 };
while (@$D) {
my($l,$r,$exp) = @{shift @$D};
@@ -109,7 +109,18 @@ v1.0.22 122 -1
0.005.018 0.005018 0
4.008.000 4.008000 0
4.008.000 4.008 1
+v4.8 4.008 0
+v4.8.0 4.008000 0
v1.99.1_1 1.98 -1
+v2.3999 v2.4000 -1
+v2.3999 2.004000 1
+v2.3999 2.999999 1
+v2.1000 2.999999 1
+0123 123 -1
+v2.005 2.005 0
+v1.0 1.0 0
+v1.0 1.000 0
+v1.0 1.000000 0
__END__
# Local Variables:
View Lorry Controller Status