This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to CPAN-1.9203
authorSteve Peters <steve@fisharerojo.org>
Tue, 2 Oct 2007 13:39:06 +0000 (13:39 +0000)
committerSteve Peters <steve@fisharerojo.org>
Tue, 2 Oct 2007 13:39:06 +0000 (13:39 +0000)
p4raw-id: //depot/perl@32008

13 files changed:
MANIFEST
lib/CPAN/API/HOWTO.pm [new file with mode: 0644]
lib/CPAN/Debug.pm
lib/CPAN/DeferedCode.pm [new file with mode: 0644]
lib/CPAN/FirstTime.pm
lib/CPAN/HandleConfig.pm
lib/CPAN/Kwalify/distroprefs.dd
lib/CPAN/Kwalify/distroprefs.yml
lib/CPAN/Queue.pm
lib/CPAN/Tarzip.pm
lib/CPAN/Version.pm
lib/CPAN/t/03pkgs.t
lib/CPAN/t/10version.t

index 420d2e8..3fafe76 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1559,8 +1559,10 @@ lib/Config.t                     See if Config works
 lib/constant.pm                        For "use constant"
 lib/constant.t                 See if compile-time constants work
 lib/CORE.pod                   document the CORE namespace
+lib/CPAN/API/HOWTO.pm          recipe book for programming with CPAN.pm
 lib/CPAN/bin/cpan              easily interact with CPAN from the command line
 lib/CPAN/Debug.pm              helper package for CPAN.pm
+lib/CPAN/DeferedCode.pm                helper package for CPAN.pm
 lib/CPAN/FirstTime.pm          Utility for creating CPAN config files
 lib/CPAN/HandleConfig.pm       helper package for CPAN.pm
 lib/CPAN/Kwalify/distroprefs.dd                helper file for validating config files
@@ -3940,8 +3942,8 @@ utils/h2xs.PL                     Program to make .xs files from C header files
 utils/instmodsh.PL             Give information about installed extensions
 utils/libnetcfg.PL             libnet
 utils.lst                      Lists utilities bundled with Perl
-utils/Makefile.SH              Extract the utility scripts
 utils/Makefile                 Pregenerated from utils/Makefile.SH
+utils/Makefile.SH              Extract the utility scripts
 utils/perlbug.PL               A simple tool to submit a bug report
 utils/perldoc.PL               A simple tool to find & display perl's documentation
 utils/perlivp.PL               installation verification procedure
diff --git a/lib/CPAN/API/HOWTO.pm b/lib/CPAN/API/HOWTO.pm
new file mode 100644 (file)
index 0000000..e65a4bc
--- /dev/null
@@ -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
index 239fb6b..086b623 100644 (file)
@@ -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 (file)
index 0000000..c57669b
--- /dev/null
@@ -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;
index 02a7f85..d5d3e21 100644 (file)
@@ -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,1151 +34,381 @@ 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).
 
-=head1 LICENSE
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
+In the following all questions and explanations regarding config
+variables are collected.
 
 =cut
 
-use vars qw( %prompts );
+# down until the next =back the manpage must be parsed by the program
+# because the text is used in the init dialogues.
 
-sub init {
-    my($configpm, %args) = @_;
-    use Config;
-    # extra args after 'o conf init'
-    my $matcher = $args{args} && @{$args{args}} ? $args{args}[0] : '';
-    if ($matcher =~ /^\/(.*)\/$/) {
-        # case /regex/ => take the first, ignore the rest
-        $matcher = $1;
-        shift @{$args{args}};
-        if (@{$args{args}}) {
-            local $" = " ";
-            $CPAN::Frontend->mywarn("Ignoring excessive arguments '@{$args{args}}'");
-            $CPAN::Frontend->mysleep(2);
-        }
-    } elsif (0 == length $matcher) {
-    } elsif (0 && $matcher eq "~") { # extremely buggy, but a nice idea
-        my @unconfigured = grep { not exists $CPAN::Config->{$_}
-                                      or not defined $CPAN::Config->{$_}
-                                          or not length $CPAN::Config->{$_}
-                                  } keys %$CPAN::Config;
-        $matcher = "\\b(".join("|", @unconfigured).")\\b";
-        $CPAN::Frontend->mywarn("matcher[$matcher]");
-    } else {
-        # case WORD... => all arguments must be valid
-        for my $arg (@{$args{args}}) {
-            unless (exists $CPAN::HandleConfig::keys{$arg}) {
-                $CPAN::Frontend->mywarn("'$arg' is not a valid configuration variable\n");
-                return;
-            }
-        }
-        $matcher = "\\b(".join("|",@{$args{args}}).")\\b";
-    }
-    CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG;
+=over 2
 
-    unless ($CPAN::VERSION) {
-       require CPAN::Nox;
-    }
-    require CPAN::HandleConfig;
-    CPAN::HandleConfig::require_myconfig_or_config();
-    $CPAN::Config ||= {};
-    local($/) = "\n";
-    local($\) = "";
-    local($|) = 1;
+=item auto_commit
 
-    my($ans,$default);
+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.
 
-    #
-    #= Files, directories
-    #
+Always commit changes to config variables to disk?
 
-    unless ($matcher) {
-        $CPAN::Frontend->myprint($prompts{manual_config});
-    }
+=item build_cache
 
-    my $manual_conf;
+CPAN.pm can limit the size of the disk area for keeping the build
+directories with all the intermediate files.
 
-    local *_real_prompt;
-    if ( $args{autoconfig} ) {
-        $manual_conf = "no";
-    } elsif ($matcher) {
-        $manual_conf = "yes";
-    } else {
-        my $_conf = prompt("Would you like me to configure as much as possible ".
-                           "automatically?", "yes");
-        $manual_conf = ($_conf and $_conf =~ /^y/i) ? "no" : "yes";
-    }
-    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;
-       };
-      }
-    }
+Cache size for build directory (in MB)?
 
-    if (!$matcher or q{
-                       build_dir
-                       build_dir_reuse
-                       cpan_home
-                       keep_source_where
-                       prefs_dir
-                      } =~ /$matcher/){
-        $CPAN::Frontend->myprint($prompts{config_intro});
+=item build_dir
 
-        if (!$matcher or 'cpan_home' =~ /$matcher/) {
-            my $cpan_home = $CPAN::Config->{cpan_home}
-                || File::Spec->catdir($ENV{HOME}, ".cpan");
+Directory where the build process takes place?
 
-            if (-d $cpan_home) {
-                $CPAN::Frontend->myprint(qq{
+=item build_dir_reuse
 
-I see you already have a  directory
-    $cpan_home
-Shall we use it as the general CPAN build and cache directory?
+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.
 
-});
-            } else {
-                # no cpan-home, must prompt and get one
-                $CPAN::Frontend->myprint($prompts{cpan_home_where});
-            }
+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.
 
-            $default = $cpan_home;
-            my $loop = 0;
-            my $last_ans;
-          PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) {
-                if (File::Spec->file_name_is_absolute($ans)) {
-                    my @cpan_home = split /[\/\\]/, $ans;
-                  DIR: for my $dir (@cpan_home) {
-                        if ($dir =~ /^~/ and (!$last_ans or $ans ne $last_ans)) {
-                            $CPAN::Frontend
-                                ->mywarn("Warning: a tilde in the path will be ".
-                                         "taken as a literal tilde. Please ".
-                                         "confirm again if you want to keep it\n");
-                            $last_ans = $default = $ans;
-                            next PROMPT;
-                        }
-                    }
-                } else {
-                    require Cwd;
-                    my $cwd = Cwd::cwd();
-                    my $absans = File::Spec->catdir($cwd,$ans);
-                    $CPAN::Frontend->mywarn("The path '$ans' is not an ".
-                                            "absolute path. Please specify ".
-                                            "an absolute path\n");
-                    $default = $absans;
-                    next;
-                }
-                eval { File::Path::mkpath($ans); }; # dies if it can't
-                if ($@) {
-                    $CPAN::Frontend->mywarn("Couldn't create directory $ans.\n".
-                                            "Please retry.\n");
-                    next;
-                }
-                if (-d $ans && -w _) {
-                    last;
-                } else {
-                    $CPAN::Frontend->mywarn("Couldn't find directory $ans\n".
-                                            "or directory is not writable. Please retry.\n");
-                    if (++$loop > 5) {
-                        $CPAN::Frontend->mydie("Giving up");
-                    }
-                }
-            }
-            $CPAN::Config->{cpan_home} = $ans;
-        }
+Store and re-use state information about distributions between
+CPAN.pm sessions?
 
-        if (!$matcher or 'keep_source_where' =~ /$matcher/) {
-            my_dflt_prompt("keep_source_where",
-                           File::Spec->catdir($CPAN::Config->{cpan_home},"sources"),
-                           $matcher,
-                          );
-        }
+=item build_requires_install_policy
 
-        if (!$matcher or 'build_dir' =~ /$matcher/) {
-            my_dflt_prompt("build_dir",
-                           File::Spec->catdir($CPAN::Config->{cpan_home},"build"),
-                           $matcher
-                          );
-        }
+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.
 
-        if (!$matcher or 'build_dir_reuse' =~ /$matcher/) {
-            my_yn_prompt(build_dir_reuse => "y", $matcher);
-        }
+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).
 
-        if (!$matcher or 'prefs_dir' =~ /$matcher/) {
-            my_dflt_prompt("prefs_dir",
-                           File::Spec->catdir($CPAN::Config->{cpan_home},"prefs"),
-                           $matcher
-                          );
-        }
-    }
+Policy on installing 'build_requires' modules (yes, no, ask/yes,
+ask/no)?
 
-    #
-    #= Config: auto_commit
-    #
+=item cache_metadata
 
-    my_yn_prompt(auto_commit => 0, $matcher);
+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.
 
-    #
-    #= Cache size, Index expire
-    #
+Note: this mechanism is not used when use_sqlite is on and SQLLite is
+running.
 
-    if (!$matcher or 'build_cache' =~ /$matcher/){
-        # large enough to build large dists like Tk
-        my_dflt_prompt(build_cache => 100, $matcher);
-    }
+Cache metadata (yes/no)?
 
-    if (!$matcher or 'index_expire' =~ /$matcher/) {
-        my_dflt_prompt(index_expire => 1, $matcher);
-    }
+=item check_sigs
 
-    if (!$matcher or 'scan_cache' =~ /$matcher/){
-        $CPAN::Frontend->myprint($prompts{scan_cache_intro});
-        my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
-    }
+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.
 
-    #
-    #= cache_metadata
-    #
+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.
 
-    my_yn_prompt(cache_metadata => 1, $matcher);
-    my_yn_prompt(use_sqlite => 0, $matcher);
+Note that if you do not have Module::Signature installed, no signature
+checks will be performed at all.
 
-    #
-    #= Do we follow PREREQ_PM?
-    #
+Always try to check and verify signatures if a SIGNATURE file is in
+the package and Module::Signature is installed (yes/no)?
 
-    if (!$matcher or 'prerequisites_policy' =~ /$matcher/){
-        $CPAN::Frontend->myprint($prompts{prerequisites_policy_intro});
+=item colorize_output
 
-        my_prompt_loop(prerequisites_policy => 'ask', $matcher,
-                       'follow|ask|ignore');
-    }
+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.
 
-    if (!$matcher or 'build_requires_install_policy' =~ /$matcher/){
-        $CPAN::Frontend->myprint($prompts{build_requires_install_policy_intro});
+Do you want to turn on colored output?
 
-        my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher,
-                       'yes|no|ask/yes|ask/no');
-    }
+=item colorize_print
 
-    #
-    #= Module::Signature
-    #
-    if (!$matcher or 'check_sigs' =~ /$matcher/) {
-        my_yn_prompt(check_sigs => 0, $matcher);
-    }
+Color for normal output?
 
-    #
-    #= CPAN::Reporter
-    #
-    if (!$matcher or 'test_report' =~ /$matcher/) {
-        my_yn_prompt(test_report => 0, $matcher);
-        if (
-            $CPAN::Config->{test_report} && 
-            $CPAN::META->has_inst("CPAN::Reporter") &&
-            CPAN::Reporter->can('configure')
-           ) {
-            $CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n");
-            CPAN::Reporter::configure();
-            $CPAN::Frontend->myprint("\nReturning to CPAN configuration.\n");
-        }
-    }
+=item colorize_warn
 
-    #
-    #= YAML vs. YAML::Syck
-    #
-    if (!$matcher or "yaml_module" =~ /$matcher/) {
-        my_dflt_prompt(yaml_module => "YAML", $matcher);
-        unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
-            $CPAN::Frontend->mywarn
-                ("Warning (maybe harmless): '$CPAN::Config->{yaml_module}' not installed.\n");
-            $CPAN::Frontend->mysleep(3);
-        }
-    }
+Color for warnings?
 
-    #
-    #= External programs
-    #
+=item colorize_debug
 
-    my @external_progs = qw/bzip2 gzip tar unzip
+Color for debugging messages?
 
-                            make
+=item commandnumber_in_prompt
 
-                            curl lynx wget ncftpget ncftp ftp
+The prompt of the cpan shell can contain the current command number
+for easier tracking of the session or be a plain string.
 
-                            gpg
+Do you want the command number in the prompt (yes/no)?
 
-                            patch applypatch
-                            /;
-    my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
-    if (!$matcher or "@external_progs" =~ /$matcher/) {
-        $CPAN::Frontend->myprint($prompts{external_progs});
+=item ftp_passive
 
-        my $old_warn = $^W;
-        local $^W if $^O eq 'MacOS';
-        local $^W = $old_warn;
-        my $progname;
-        for $progname (@external_progs) {
-            next if $matcher && $progname !~ /$matcher/;
-            if ($^O eq 'MacOS') {
-                $CPAN::Config->{$progname} = 'not_here';
-                next;
-            }
+Shall we always set the FTP_PASSIVE environment variable when dealing
+with ftp download (yes/no)?
 
-            my $progcall = $progname;
-            unless ($matcher) {
-                # we really don't need ncftp if we have ncftpget, but
-                # if they chose this dialog via matcher, they shall have it
-                next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
-            }
-            my $path = $CPAN::Config->{$progname}
-                || $Config::Config{$progname}
-                    || "";
-            if (File::Spec->file_name_is_absolute($path)) {
-                # testing existence is not good enough, some have these exe
-                # extensions
+=item getcwd
 
-                # warn "Warning: configured $path does not exist\n" unless -e $path;
-                # $path = "";
-            } elsif ($path =~ /^\s+$/) {
-                # preserve disabled programs
-            } else {
-                $path = '';
-            }
-            unless ($path) {
-                # e.g. make -> nmake
-                $progcall = $Config::Config{$progname} if $Config::Config{$progname};
-            }
+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:
 
-            $path ||= find_exe($progcall,\@path);
-            unless ($path){ # not -e $path, because find_exe already checked that
-                local $"=";";
-                $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@path]\n");
-                if ($progname eq "make") {
-                    $CPAN::Frontend->mywarn("ALERT: 'make' is an essential tool for ".
-                                            "building perl Modules. Please make sure you ".
-                                            "have 'make' (or some equivalent) ".
-                                            "working.\n"
-                                           );
-                    if ($^O eq "MSWin32") {
-                        $CPAN::Frontend->mywarn("
-Windows users may want to follow this procedure when back in the CPAN shell:
+    cwd         Cwd::cwd
+    getcwd      Cwd::getcwd
+    fastcwd     Cwd::fastcwd
+    backtickcwd external command cwd
 
-    look YVES/scripts/alien_nmake.pl
-    perl alien_nmake.pl
+Preferred method for determining the current working directory?
 
-This will install nmake on your system which can be used as a 'make'
-substitute. You can then revisit this dialog with
+=item histfile
 
-    o conf init make
+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.
 
-");
-                    }
-                }
-            }
-            $ans = prompt("Where is your $progname program?",$path) || $path;
-            $CPAN::Config->{$progname} = $ans;
-        }
-    }
+File to save your history?
 
-    if (!$matcher or 'pager' =~ /$matcher/) {
-        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;
-    }
+=item histsize
 
-    if (!$matcher or 'shell' =~ /$matcher/) {
-        my $path = $CPAN::Config->{'shell'};
-        if ($path && File::Spec->file_name_is_absolute($path)) {
-            $CPAN::Frontend->mywarn("Warning: configured $path does not exist\n")
-                unless -e $path;
-            $path = "";
-        }
-        $path ||= $ENV{SHELL};
-        $path ||= $ENV{COMSPEC} if $^O eq "MSWin32";
-        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;
-        }
-    }
+Number of lines to save?
 
-    #
-    #= Installer, arguments to make etc.
-    #
+=item inactivity_timeout
 
-    if (!$matcher or 'prefer_installer' =~ /$matcher/){
-        $CPAN::Frontend->myprint($prompts{prefer_installer_intro});
+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.
 
-        my_prompt_loop(prefer_installer => 'EUMM', $matcher, 'MB|EUMM');
-    }
+If you set this value to 0, these processes will wait forever. This is
+the default and recommended setting.
 
-    if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/){
-        my_dflt_prompt(makepl_arg => "", $matcher);
-        my_dflt_prompt(make_arg => "", $matcher);
-    }
+Timeout for inactivity during {Makefile,Build}.PL?
 
-    require CPAN::HandleConfig;
-    if (exists $CPAN::HandleConfig::keys{make_install_make_command}) {
-        # as long as Windows needs $self->_build_command, we cannot
-        # support sudo on windows :-)
-        my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "",
-                       $matcher);
-    }
+=item index_expire
 
-    my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "", 
-                  $matcher);
+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.
 
-    if (!$matcher or 'mbuildpl_arg mbuild_arg' =~ /$matcher/){
-        my_dflt_prompt(mbuildpl_arg => "", $matcher);
-        my_dflt_prompt(mbuild_arg => "", $matcher);
-    }
+Let the index expire after how many days?
 
-    if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command}) {
-        # as long as Windows needs $self->_build_command, we cannot
-        # support sudo on windows :-)
-        my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher);
-    }
+=item inhibit_startup_message
 
-    my_dflt_prompt(mbuild_install_arg => "", $matcher);
+When the CPAN shell is started it normally displays a greeting message
+that contains the running version and the status of readline support.
 
-    #
-    #= Alarm period
-    #
+Do you want to turn this message off?
 
-    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);
-    }
+=item keep_source_where
 
-    #
-    #= Proxies
-    #
+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.
 
-    my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/;
-    my @proxy_user_vars = qw/proxy_user proxy_pass/;
-    if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/){
-        $CPAN::Frontend->myprint($prompts{proxy_intro});
+Download target directory?
 
-        for (@proxy_vars) {
-            if (!$matcher or /$matcher/){
-                $default = $CPAN::Config->{$_} || $ENV{$_} || "";
-                $CPAN::Config->{$_} = prompt("Your $_?",$default);
-            }
-        }
+=item load_module_verbosity
 
-        if ($CPAN::Config->{ftp_proxy} ||
-            $CPAN::Config->{http_proxy}) {
+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.
 
-            $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || "";
+Verbosity level for loading modules (none or v)?
 
-            $CPAN::Frontend->myprint($prompts{proxy_user});
+=item makepl_arg
 
-            if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
-                $CPAN::Frontend->myprint($prompts{proxy_pass});
+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 ($CPAN::META->has_inst("Term::ReadKey")) {
-                    Term::ReadKey::ReadMode("noecho");
-                } else {
-                    $CPAN::Frontend->myprint($prompts{password_warn});
-                }
-                $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
-                if ($CPAN::META->has_inst("Term::ReadKey")) {
-                    Term::ReadKey::ReadMode("restore");
-                }
-                $CPAN::Frontend->myprint("\n\n");
-            }
-        }
-    }
+If you don't understand this question, just press ENTER.
 
-    #
-    #= how FTP works
-    #
+Typical frequently used settings:
 
-    my_yn_prompt(ftp_passive => 1, $matcher);
+    PREFIX=~/perl    # non-root users (please see manual for more hints)
 
-    #
-    #= how cwd works
-    #
+Parameters for the 'perl Makefile.PL' command?
 
-    if (!$matcher or 'getcwd' =~ /$matcher/){
-        $CPAN::Frontend->myprint($prompts{getcwd_intro});
+=item make_arg
 
-        my_prompt_loop(getcwd => 'cwd', $matcher,
-                       'cwd|getcwd|fastcwd|backtickcwd');
-    }
+Parameters for the 'make' command? Typical frequently used setting:
 
-    #
-    #= the CPAN shell itself (prompt, color)
-    #
+    -j3              # dual processor system (on GNU make)
 
-    my_yn_prompt(commandnumber_in_prompt => 1, $matcher);
-    my_yn_prompt(term_ornaments => 1, $matcher);
-    if ("colorize_output colorize_print colorize_warn colorize_debug" =~ $matcher) {
-        my_yn_prompt(colorize_output => 0, $matcher);
-        if ($CPAN::Config->{colorize_output}) {
-            if ($CPAN::META->has_inst("Term::ANSIColor")) {
-                my $T="gYw";
-                print "                                      on_  on_y ".
-                    "        on_ma           on_\n"; 
-                print "                   on_black on_red  green ellow ".
-                    "on_blue genta on_cyan white\n";
+Your choice:
 
-                for my $FG ("", "bold",
-                            map {$_,"bold $_"} "black","red","green",
-                            "yellow","blue",
-                            "magenta",
-                            "cyan","white"){
-                    printf "%12s ", $FG;
-                    for my $BG ("",map {"on_$_"} qw(black red green yellow
-                                                    blue magenta cyan white)){
-                        print $FG||$BG ?
-                            Term::ANSIColor::colored("  $T  ","$FG $BG") : "  $T  ";
-                    }
-                    print "\n";
-                }
-                print "\n";
-            }
-            for my $tuple (
-                           ["colorize_print", "bold blue on_white"],
-                           ["colorize_warn", "bold red on_white"],
-                           ["colorize_debug", "black on_cyan"],
-                          ) {
-                my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher);
-                if ($CPAN::META->has_inst("Term::ANSIColor")) {
-                    eval { Term::ANSIColor::color($CPAN::Config->{$tuple->[0]})};
-                    if ($@) {
-                        $CPAN::Config->{$tuple->[0]} = $tuple->[1];
-                        $CPAN::Frontend->mywarn($@."setting to default '$tuple->[1]'\n");
-                    }
-                }
-            }
-        }
-    }
+=item make_install_arg
 
-    #
-    #== term_is_latin
-    #
+Parameters for the 'make install' command?
+Typical frequently used setting:
 
-    if (!$matcher or 'term_is_latin' =~ /$matcher/){
-        $CPAN::Frontend->myprint($prompts{term_is_latin});
-        my_yn_prompt(term_is_latin => 1, $matcher);
-    }
+    UNINST=1         # to always uninstall potentially conflicting files
 
-    #
-    #== save history in file 'histfile'
-    #
+Your choice:
 
-    if (!$matcher or 'histfile histsize' =~ /$matcher/) {
-        $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;
+=item make_install_make_command
 
-        if ($CPAN::Config->{histfile}) {
-            defined($default = $CPAN::Config->{histsize}) or $default = 100;
-            $ans = prompt("Number of lines to save?", $default);
-            $CPAN::Config->{histsize} = $ans;
-        }
-    }
+Do you want to use a different make command for 'make install'?
+Cautious people will probably prefer:
 
-    #
-    #== 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);
-    }
+    su root -c make
+ or
+    sudo make
+ or
+    /path1/to/sudo -u admin_account /path2/to/make
 
-    #
-    #= MIRRORED.BY and conf_sites()
-    #
+or some such. Your choice:
 
-    if ($matcher){
-        if ("urllist" =~ $matcher) {
-            # conf_sites would go into endless loop with the smash prompt
-            local *_real_prompt;
-            *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
-            conf_sites();
-        }
-        if ("randomize_urllist" =~ $matcher) {
-            my_dflt_prompt(randomize_urllist => 0, $matcher);
-        }
-    } elsif ($fastread) {
-        $CPAN::Frontend->myprint("Autoconfigured everything but 'urllist'.\n".
-                                 "Please call 'o conf init urllist' to configure ".
-                                 "your CPAN server(s) now!");
-    } else {
-        conf_sites();
-    }
+=item mbuildpl_arg
 
-    # 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;
+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.
 
-    $CPAN::Frontend->myprint("\n\n");
-    if ($matcher && !$CPAN::Config->{auto_commit}) {
-        $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ".
-                                 "make the config permanent!\n\n");
-    } else {
-        CPAN::HandleConfig->commit($configpm);
-    }
-}
+Typical frequently used settings:
 
-sub my_dflt_prompt {
-    my ($item, $dflt, $m) = @_;
-    my $default = $CPAN::Config->{$item} || $dflt;
+    --install_base /home/xxx             # different installation directory
 
-    $DB::single = 1;
-    if (!$m || $item =~ /$m/) {
-        if (my $intro = $prompts{$item . "_intro"}) {
-            $CPAN::Frontend->myprint($intro);
-        }
-       $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
-    } else {
-       $CPAN::Config->{$item} = $default;
-    }
-}
+Parameters for the 'perl Build.PL' command?
 
-sub my_yn_prompt {
-    my ($item, $dflt, $m) = @_;
-    my $default;
-    defined($default = $CPAN::Config->{$item}) or $default = $dflt;
+=item mbuild_arg
 
-    $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::Config->{$item} = ($ans =~ /^[y1]/i ? 1 : 0);
-    } else {
-       $CPAN::Config->{$item} = $default;
-    }
-}
+Parameters for the './Build' command? Setting might be:
 
-sub my_prompt_loop {
-    my ($item, $dflt, $m, $ok) = @_;
-    my $default = $CPAN::Config->{$item} || $dflt;
-    my $ans;
+    --extra_linker_flags -L/usr/foo/lib  # non-standard library location
 
-    $DB::single = 1;
-    if (!$m || $item =~ /$m/) {
-       do { $ans = prompt($prompts{$item}, $default);
-       } until $ans =~ /$ok/;
-       $CPAN::Config->{$item} = $ans;
-    } else {
-       $CPAN::Config->{$item} = $default;
-    }
-}
+Your choice:
 
+=item mbuild_install_arg
 
-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
+Parameters for the './Build install' command? Typical frequently used
+setting:
 
-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.
+    --uninst 1                           # uninstall conflicting files
 
-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;
-    }
-  }
-  local $urllist = [];
-  read_mirrored_by($mby);
-  bring_your_own();
-  $CPAN::Config->{urllist} = $urllist;
-}
+Your choice:
 
-sub find_exe {
-    my($exe,$path) = @_;
-    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;
-       }
-    }
-}
+=item mbuild_install_build_command
 
-sub picklist {
-    my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
-    CPAN->debug("picklist('$items','$prompt','$default','$require_nonempty',".
-                "'$empty_warning')") if $CPAN::DEBUG;
-    $default ||= '';
+Do you want to use a different command for './Build install'? Sudo
+users will probably prefer:
 
-    my $pos = 0;
+    su root -c ./Build
+ or
+    sudo ./Build
+ or
+    /path1/to/sudo -u admin_account ./Build
 
-    my @nums;
-  SELECTION: while (1) {
+or some such. Your choice:
 
-        # display, at most, 15 items at a time
-        my $limit = $#{ $items } - $pos;
-        $limit = 15 if $limit > 15;
+=item pager
 
-        # show the next $limit items, get the new position
-        $pos = display_some($items, $limit, $pos, $default);
-        $pos = 0 if $pos >= @$items;
+What is your favorite pager program?
 
-        my $num = prompt($prompt,$default);
+=item prefer_installer
 
-        @nums = split (' ', $num);
-        {
-            my %seen;
-            @nums = grep { !$seen{$_}++ } @nums;
-        }
-        my $i = scalar @$items;
-        unrangify(\@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");
-            }
-            next SELECTION;
-        }
-        if ($require_nonempty && !@nums) {
-            $CPAN::Frontend->mywarn("$empty_warning\n");
-        }
-        $CPAN::Frontend->myprint("\n");
+When you have Module::Build installed and a module comes with both a
+Makefile.PL and a Build.PL, which shall have precedence?
 
-        # a blank line continues...
-        next SELECTION unless @nums;
-        last;
-    }
-    for (@nums) { $_-- }
-    @{$items}[@nums];
-}
+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.
 
-sub unrangify ($) {
-    my($nums) = $_[0];
-    my @nums2 = ();
-    while (@{$nums||[]}) {
-        my $n = shift @$nums;
-        if ($n =~ /^(\d+)-(\d+)$/) {
-            my @range = $1 .. $2;
-            # warn "range[@range]";
-            push @nums2, @range;
-        } else {
-            push @nums2, $n;
-        }
-    }
-    push @$nums, @nums2;
-}
+Or, as a third option you can choose RAND which will make a random
+decision (something regular CPAN testers will enjoy).
 
-sub display_some {
-    my ($items, $limit, $pos, $default) = @_;
-    $pos ||= 0;
+In case you can choose between running a Makefile.PL or a Build.PL,
+which installer would you prefer (EUMM or MB or RAND)?
 
-    my @displayable = @$items[$pos .. ($pos + $limit)];
-    for my $item (@displayable) {
-        $CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item);
-    }
-    my $hit_what = $default ? "SPACE RETURN" : "RETURN";
-    $CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n",
-                                     (@$items - $pos),
-                                     $hit_what,
-                                    ))
-        if $pos < @$items;
-    return $pos;
-}
+=item prefs_dir
 
-sub read_mirrored_by {
-    my $local = shift or return;
-    my(%all,$url,$expected_size,$default,$ans,$host,
-       $dst,$country,$continent,@location);
-    my $fh = FileHandle->new;
-    $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="";
-    }
-    $fh->close;
-    $CPAN::Config->{urllist} ||= [];
-    my @previous_urls = @{$CPAN::Config->{urllist}};
+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.
 
-    $CPAN::Frontend->myprint($prompts{urls_intro});
+Directory where to store default options/environment/dialogs for
+building modules that need some customization?
 
-    my (@cont, $cont, %cont, @countries, @urls, %seen);
-    my $no_previous_warn =
-        "Sorry! since you don't have any existing picks, you must make a\n" .
-            "geographic selection.";
-    my $offer_cont = [sort keys %all];
-    if (@previous_urls) {
-        push @$offer_cont, "(edit previous picks)";
-        $default = @$offer_cont;
-    }
-    @cont = picklist($offer_cont,
-                     "Select your continent (or several nearby continents)",
-                     $default,
-                     ! @previous_urls,
-                     $no_previous_warn);
+=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.
 
-    foreach $cont (@cont) {
-        my @c = sort keys %{$all{$cont}};
-        @cont{@c} = map ($cont, 0..$#c);
-        @c = map ("$_ ($cont)", @c) if @cont > 1;
-        push (@countries, @c);
-    }
-    if (@previous_urls && @countries) {
-        push @countries, "(edit previous picks)";
-        $default = @countries;
-    }
+Policy on building prerequisites (follow, ask or ignore)?
 
-    if (@countries) {
-        @countries = picklist (\@countries,
-                               "Select your country (or several nearby countries)",
-                               $default,
-                               ! @previous_urls,
-                               $no_previous_warn);
-        %seen = map (($_ => 1), @previous_urls);
-        # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
-        foreach $country (@countries) {
-            next if $country =~ /edit previous picks/;
-            (my $bare_country = $country) =~ s/ \(.*\)//;
-            my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
-            @u = grep (! $seen{$_}, @u);
-            @u = map ("$_ ($bare_country)", @u)
-                if @countries > 1;
-            push (@urls, @u);
-        }
-    }
-    push (@urls, map ("$_ (previous pick)", @previous_urls));
-    my $prompt = "Select as many URLs as you like (by number),
-put them on one line, separated by blanks, hyphenated ranges allowed
- e.g. '1 4 5' or '7 1-4 8'";
-    if (@previous_urls) {
-        $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
-                         (scalar @urls));
-        $prompt .= "\n(or just hit RETURN to keep your previous picks)";
-    }
+=item randomize_urllist
 
-    @urls = picklist (\@urls, $prompt, $default);
-    foreach (@urls) { s/ \(.*\)//; }
-    push @$urllist, @urls;
-}
+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.
 
-sub bring_your_own {
-    my %seen = map (($_ => 1), @$urllist);
-    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.
+Randomize parameter
 
-Please enter your CPAN site:};
-       }
-        $ans = prompt ($prompt, "");
-
-        if ($ans) {
-            $ans =~ s|/?\z|/|; # has to end with one slash
-            $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
-            if ($ans =~ /^\w+:\/./) {
-                push @urls, $ans unless $seen{$ans}++;
-            } else {
-                $CPAN::Frontend->
-                    myprint(sprintf(qq{"%s" doesn\'t look like an URL at first sight.
-I\'ll ignore it for now.
-You can add it to your %s
-later if you\'re sure it\'s right.\n},
-                                   $ans,
-                                   $INC{'CPAN/MyConfig.pm'}
-                                   || $INC{'CPAN/Config.pm'}
-                                   || "configuration file",
-                                  ));
-            }
-        } else {
-            if (++$eacnt >= 5) {
-                $CPAN::Frontend->
-                    mywarn("Giving up.\n");
-                $CPAN::Frontend->mysleep(5);
-                return;
-            }
-        }
-    } while $ans || !%seen;
-
-    push @$urllist, @urls;
-    # xxx delete or comment these out when you're happy that it works
-    $CPAN::Frontend->myprint("New set of picks:\n");
-    map { $CPAN::Frontend->myprint("  $_\n") } @$urllist;
-}
-
-
-sub _strip_spaces {
-    $_[0] =~ s/^\s+//;  # no leading spaces
-    $_[0] =~ s/\s+\z//; # no trailing spaces
-}
-
-sub prompt ($;$) {
-    unless (defined &_real_prompt) {
-        *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
-    }
-    my $ans = _real_prompt(@_);
-
-    _strip_spaces($ans);
-
-    return $ans;
-}
-
-
-sub prompt_no_strip ($;$) {
-    return _real_prompt(@_);
-}
-
-
-BEGIN {
-
-my @prompts = (
-
-manual_config => qq[
-
-CPAN is the world-wide archive of perl resources. It consists of about
-300 sites that all replicate the same contents around the globe. Many
-countries have at least one CPAN site already. The resources found on
-CPAN are easily accessible with the CPAN.pm module. If you want to use
-CPAN.pm, lots of things have to be configured. Fortunately, most of
-them can be determined automatically. If you prefer the automatic
-configuration, answer 'yes' below.
-
-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{
-
-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.
-
-},
-
-# 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{
+=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'.
 
-},
-
-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{
+Perform cache scanning (atstart or never)?
 
-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.
-
-},
+=item shell
 
-term_is_latin => qq{Your terminal expects ISO-8859-1 (yes/no)?},
+What is your favorite shell?
 
-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.
+=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.
 
-histfile => qq{File to save your history?},
+Show all individual modules that have no $VERSION?
 
-show_upload_date_intro => qq{
+=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
@@ -1187,51 +417,46 @@ internet. If you set the 'show_upload_date' variable to true, 'm' and
 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)?
 
-show_upload_date =>
-"Always try to show upload date with 'd' and 'm' command (yes/no)?",
+=item show_zero_versions
 
-prerequisites_policy_intro => qq{
+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.
 
-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.
+Show all individual modules that have a $VERSION of zero?
 
-},
+=item tar_verbosity
 
-prerequisites_policy =>
-"Policy on building prerequisites (follow, ask or ignore)?",
+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.
 
-check_sigs_intro  => qq{
+Tar command verbosity level (none or v or vv)?
 
-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.
+=item term_is_latin
 
-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.
+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.
 
-Note that if you do not have Module::Signature installed, no signature
-checks will be performed at all.
+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.
 
-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)?},
+Do you want to turn ornaments on?
 
-test_report_intro =>
-qq{
+=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
@@ -1248,146 +473,1078 @@ 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)?
 
-test_report =>
-qq{Email test reports if CPAN::Reporter is installed (yes/no)?},
+=item use_sqlite
 
-external_progs => 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 considerably.
 
-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
-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.
+Use CPAN::SQLite if available? (yes/no)?
 
-},
+=item yaml_load_code
 
-prefer_installer_intro => qq{
+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.
 
-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.
+Do you want to enable code deserialisation (yes/no)?
 
-},
+=item yaml_module
 
-prefer_installer =>
-qq{In case you could choose, which installer would you prefer (EUMM or MB)?},
+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.
 
-makepl_arg_intro => qq{
+Which YAML implementation would you prefer?
 
-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.
+=back
 
-If you don\'t understand this question, just press ENTER.
-},
+=head1 LICENSE
 
-makepl_arg => qq{
-Parameters for the 'perl Makefile.PL' command?
-Typical frequently used settings:
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
 
-    PREFIX=~/perl    # non-root users (please see manual for more hints)
+=cut
 
-Your choice: },
+use vars qw( %prompts );
 
-make_arg => qq{Parameters for the 'make' command?
-Typical frequently used setting:
+sub init {
+    my($configpm, %args) = @_;
+    use Config;
+    # extra args after 'o conf init'
+    my $matcher = $args{args} && @{$args{args}} ? $args{args}[0] : '';
+    if ($matcher =~ /^\/(.*)\/$/) {
+        # case /regex/ => take the first, ignore the rest
+        $matcher = $1;
+        shift @{$args{args}};
+        if (@{$args{args}}) {
+            local $" = " ";
+            $CPAN::Frontend->mywarn("Ignoring excessive arguments '@{$args{args}}'");
+            $CPAN::Frontend->mysleep(2);
+        }
+    } elsif (0 == length $matcher) {
+    } elsif (0 && $matcher eq "~") { # extremely buggy, but a nice idea
+        my @unconfigured = grep { not exists $CPAN::Config->{$_}
+                                      or not defined $CPAN::Config->{$_}
+                                          or not length $CPAN::Config->{$_}
+                                  } keys %$CPAN::Config;
+        $matcher = "\\b(".join("|", @unconfigured).")\\b";
+        $CPAN::Frontend->mywarn("matcher[$matcher]");
+    } else {
+        # case WORD... => all arguments must be valid
+        for my $arg (@{$args{args}}) {
+            unless (exists $CPAN::HandleConfig::keys{$arg}) {
+                $CPAN::Frontend->mywarn("'$arg' is not a valid configuration variable\n");
+                return;
+            }
+        }
+        $matcher = "\\b(".join("|",@{$args{args}}).")\\b";
+    }
+    CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG;
 
-    -j3              # dual processor system (on GNU make)
+    unless ($CPAN::VERSION) {
+        require CPAN::Nox;
+    }
+    require CPAN::HandleConfig;
+    CPAN::HandleConfig::require_myconfig_or_config();
+    $CPAN::Config ||= {};
+    local($/) = "\n";
+    local($\) = "";
+    local($|) = 1;
+
+    my($ans,$default);
+
+    #
+    #= Files, directories
+    #
 
-Your choice: },
+    unless ($matcher) {
+        $CPAN::Frontend->myprint($prompts{manual_config});
+    }
+
+    my $manual_conf;
 
+    local *_real_prompt;
+    if ( $args{autoconfig} ) {
+        $manual_conf = "no";
+    } elsif ($matcher) {
+        $manual_conf = "yes";
+    } else {
+        my $_conf = prompt("Would you like me to configure as much as possible ".
+                           "automatically?", "yes");
+        $manual_conf = ($_conf and $_conf =~ /^y/i) ? "no" : "yes";
+    }
+    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 (!$matcher or q{
+                       build_dir
+                       build_dir_reuse
+                       cpan_home
+                       keep_source_where
+                       prefs_dir
+                      } =~ /$matcher/) {
+        $CPAN::Frontend->myprint($prompts{config_intro});
+
+        if (!$matcher or 'cpan_home' =~ /$matcher/) {
+            my $cpan_home = $CPAN::Config->{cpan_home}
+                || File::Spec->catdir($ENV{HOME}, ".cpan");
+
+            if (-d $cpan_home) {
+                $CPAN::Frontend->myprint(qq{
+
+I see you already have a  directory
+    $cpan_home
+Shall we use it as the general CPAN build and cache directory?
+
+});
+            } else {
+                # no cpan-home, must prompt and get one
+                $CPAN::Frontend->myprint($prompts{cpan_home_where});
+            }
+
+            $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) {
+                        if ($dir =~ /^~/ and (!$last_ans or $ans ne $last_ans)) {
+                            $CPAN::Frontend
+                                ->mywarn("Warning: a tilde in the path will be ".
+                                         "taken as a literal tilde. Please ".
+                                         "confirm again if you want to keep it\n");
+                            $last_ans = $default = $ans;
+                            next PROMPT;
+                        }
+                    }
+                } else {
+                    require Cwd;
+                    my $cwd = Cwd::cwd();
+                    my $absans = File::Spec->catdir($cwd,$ans);
+                    $CPAN::Frontend->mywarn("The path '$ans' is not an ".
+                                            "absolute path. Please specify ".
+                                            "an absolute path\n");
+                    $default = $absans;
+                    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 PROMPT;
+                }
+                if (-d $ans && -w _) {
+                    last PROMPT;
+                } else {
+                    $CPAN::Frontend->mywarn("Couldn't find directory $ans\n".
+                                            "or directory is not writable. Please retry.\n");
+                    if (++$loop > 5) {
+                        $CPAN::Frontend->mydie("Giving up");
+                    }
+                }
+            }
+            $CPAN::Config->{cpan_home} = $ans;
+        }
+
+        if (!$matcher or 'keep_source_where' =~ /$matcher/) {
+            my_dflt_prompt("keep_source_where",
+                           File::Spec->catdir($CPAN::Config->{cpan_home},"sources"),
+                           $matcher,
+                          );
+        }
+
+        if (!$matcher or 'build_dir' =~ /$matcher/) {
+            my_dflt_prompt("build_dir",
+                           File::Spec->catdir($CPAN::Config->{cpan_home},"build"),
+                           $matcher
+                          );
+        }
+
+        if (!$matcher or 'build_dir_reuse' =~ /$matcher/) {
+            my_yn_prompt(build_dir_reuse => 1, $matcher);
+        }
+
+        if (!$matcher or 'prefs_dir' =~ /$matcher/) {
+            my_dflt_prompt("prefs_dir",
+                           File::Spec->catdir($CPAN::Config->{cpan_home},"prefs"),
+                           $matcher
+                          );
+        }
+    }
+
+    #
+    #= Config: auto_commit
+    #
+
+    my_yn_prompt(auto_commit => 0, $matcher);
+
+    #
+    #= Cache size, Index expire
+    #
+
+    if (!$matcher or 'build_cache' =~ /$matcher/) {
+        # large enough to build large dists like Tk
+        my_dflt_prompt(build_cache => 100, $matcher);
+    }
+
+    if (!$matcher or 'index_expire' =~ /$matcher/) {
+        my_dflt_prompt(index_expire => 1, $matcher);
+    }
+
+    if (!$matcher or 'scan_cache' =~ /$matcher/) {
+        my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
+    }
+
+    #
+    #= cache_metadata
+    #
+
+    my_yn_prompt(cache_metadata => 1, $matcher);
+    my_yn_prompt(use_sqlite => 0, $matcher);
+
+    #
+    #= Do we follow PREREQ_PM?
+    #
+
+    if (!$matcher or 'prerequisites_policy' =~ /$matcher/) {
+        my_prompt_loop(prerequisites_policy => 'ask', $matcher,
+                       'follow|ask|ignore');
+    }
+
+    if (!$matcher or 'build_requires_install_policy' =~ /$matcher/) {
+        my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher,
+                       'yes|no|ask/yes|ask/no');
+    }
+
+    #
+    #= Module::Signature
+    #
+    if (!$matcher or 'check_sigs' =~ /$matcher/) {
+        my_yn_prompt(check_sigs => 0, $matcher);
+    }
+
+    #
+    #= CPAN::Reporter
+    #
+    if (!$matcher or 'test_report' =~ /$matcher/) {
+        my_yn_prompt(test_report => 0, $matcher);
+        if (
+            $CPAN::Config->{test_report} &&
+            $CPAN::META->has_inst("CPAN::Reporter") &&
+            CPAN::Reporter->can('configure')
+           ) {
+            $CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n");
+            CPAN::Reporter::configure();
+            $CPAN::Frontend->myprint("\nReturning to CPAN configuration.\n");
+        }
+    }
+
+    #
+    #= YAML vs. YAML::Syck
+    #
+    if (!$matcher or "yaml_module" =~ /$matcher/) {
+        my_dflt_prompt(yaml_module => "YAML", $matcher);
+        unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
+            $CPAN::Frontend->mywarn
+                ("Warning (maybe harmless): '$CPAN::Config->{yaml_module}' not installed.\n");
+            $CPAN::Frontend->mysleep(3);
+        }
+    }
+
+    #
+    #= YAML code deserialisation
+    #
+    if (!$matcher or "yaml_load_code" =~ /$matcher/) {
+        my_yn_prompt(yaml_load_code => 0, $matcher);
+    }
+
+    #
+    #= External programs
+    #
+
+    my @external_progs = qw/bzip2 gzip tar unzip
+
+                            make
+
+                            curl lynx wget ncftpget ncftp ftp
+
+                            gpg
+
+                            patch applypatch
+                            /;
+    my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
+    if (!$matcher or "@external_progs" =~ /$matcher/) {
+        $CPAN::Frontend->myprint($prompts{external_progs});
+
+        my $old_warn = $^W;
+        local $^W if $^O eq 'MacOS';
+        local $^W = $old_warn;
+        my $progname;
+        for $progname (@external_progs) {
+            next if $matcher && $progname !~ /$matcher/;
+            if ($^O eq 'MacOS') {
+                $CPAN::Config->{$progname} = 'not_here';
+                next;
+            }
+
+            my $progcall = $progname;
+            unless ($matcher) {
+                # we really don't need ncftp if we have ncftpget, but
+                # if they chose this dialog via matcher, they shall have it
+                next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
+            }
+            my $path = $CPAN::Config->{$progname}
+                || $Config::Config{$progname}
+                    || "";
+            if (File::Spec->file_name_is_absolute($path)) {
+                # testing existence is not good enough, some have these exe
+                # extensions
+
+                # warn "Warning: configured $path does not exist\n" unless -e $path;
+                # $path = "";
+            } elsif ($path =~ /^\s+$/) {
+                # preserve disabled programs
+            } else {
+                $path = '';
+            }
+            unless ($path) {
+                # e.g. make -> nmake
+                $progcall = $Config::Config{$progname} if $Config::Config{$progname};
+            }
+
+            $path ||= find_exe($progcall,\@path);
+            unless ($path) { # not -e $path, because find_exe already checked that
+                local $"=";";
+                $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@path]\n");
+                if ($progname eq "make") {
+                    $CPAN::Frontend->mywarn("ALERT: 'make' is an essential tool for ".
+                                            "building perl Modules. Please make sure you ".
+                                            "have 'make' (or some equivalent) ".
+                                            "working.\n"
+                                           );
+                    if ($^O eq "MSWin32") {
+                        $CPAN::Frontend->mywarn("
+Windows users may want to follow this procedure when back in the CPAN shell:
+
+    look YVES/scripts/alien_nmake.pl
+    perl alien_nmake.pl
+
+This will install nmake on your system which can be used as a 'make'
+substitute. You can then revisit this dialog with
+
+    o conf init make
+
+");
+                    }
+                }
+            }
+            $prompts{$progname} = "Where is your $progname program?";
+            my_dflt_prompt($progname,$path,$matcher);
+        }
+    }
+
+    if (!$matcher or 'pager' =~ /$matcher/) {
+        my $path = $CPAN::Config->{'pager'} ||
+            $ENV{PAGER} || find_exe("less",\@path) ||
+                find_exe("more",\@path) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
+                    || "more";
+        my_dflt_prompt(pager => $path, $matcher);
+    }
+
+    if (!$matcher or 'shell' =~ /$matcher/) {
+        my $path = $CPAN::Config->{'shell'};
+        if ($path && File::Spec->file_name_is_absolute($path)) {
+            $CPAN::Frontend->mywarn("Warning: configured $path does not exist\n")
+                unless -e $path;
+            $path = "";
+        }
+        $path ||= $ENV{SHELL};
+        $path ||= $ENV{COMSPEC} if $^O eq "MSWin32";
+        if ($^O eq 'MacOS') {
+            $CPAN::Config->{'shell'} = 'not_here';
+        } else {
+            $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
+            my_dflt_prompt(shell => $path, $matcher);
+        }
+    }
+
+    #
+    # verbosity
+    #
+
+    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.
+    #
+
+    if (!$matcher or 'prefer_installer' =~ /$matcher/) {
+        my_prompt_loop(prefer_installer => 'MB', $matcher, 'MB|EUMM|RAND');
+    }
+
+    if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/) {
+        my_dflt_prompt(makepl_arg => "", $matcher);
+        my_dflt_prompt(make_arg => "", $matcher);
+    }
+
+    require CPAN::HandleConfig;
+    if (exists $CPAN::HandleConfig::keys{make_install_make_command}) {
+        # as long as Windows needs $self->_build_command, we cannot
+        # support sudo on windows :-)
+        my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "",
+                       $matcher);
+    }
+
+    my_dflt_prompt(make_install_arg => $CPAN::Config->{make_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
+        # support sudo on windows :-)
+        my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher);
+    }
+
+    my_dflt_prompt(mbuild_install_arg => "", $matcher);
+
+    #
+    #= Alarm period
+    #
+
+    my_dflt_prompt(inactivity_timeout => 0, $matcher);
+
+    #
+    #= Proxies
+    #
+
+    my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/;
+    my @proxy_user_vars = qw/proxy_user proxy_pass/;
+    if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/) {
+        $CPAN::Frontend->myprint($prompts{proxy_intro});
+
+        for (@proxy_vars) {
+            $prompts{$_} = "Your $_?";
+            my_dflt_prompt($_ => $ENV{$_}||"", $matcher);
+        }
+
+        if ($CPAN::Config->{ftp_proxy} ||
+            $CPAN::Config->{http_proxy}) {
+
+            $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || "";
+
+            $CPAN::Frontend->myprint($prompts{proxy_user});
+
+            if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
+                $CPAN::Frontend->myprint($prompts{proxy_pass});
+
+                if ($CPAN::META->has_inst("Term::ReadKey")) {
+                    Term::ReadKey::ReadMode("noecho");
+                } else {
+                    $CPAN::Frontend->myprint($prompts{password_warn});
+                }
+                $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
+                if ($CPAN::META->has_inst("Term::ReadKey")) {
+                    Term::ReadKey::ReadMode("restore");
+                }
+                $CPAN::Frontend->myprint("\n\n");
+            }
+        }
+    }
+
+    #
+    #= how FTP works
+    #
+
+    my_yn_prompt(ftp_passive => 1, $matcher);
+
+    #
+    #= how cwd works
+    #
+
+    if (!$matcher or 'getcwd' =~ /$matcher/) {
+        my_prompt_loop(getcwd => 'cwd', $matcher,
+                       'cwd|getcwd|fastcwd|backtickcwd');
+    }
+
+    #
+    #= the CPAN shell itself (prompt, color)
+    #
+
+    my_yn_prompt(commandnumber_in_prompt => 1, $matcher);
+    my_yn_prompt(term_ornaments => 1, $matcher);
+    if ("colorize_output colorize_print colorize_warn colorize_debug" =~ $matcher) {
+        my_yn_prompt(colorize_output => 0, $matcher);
+        if ($CPAN::Config->{colorize_output}) {
+            if ($CPAN::META->has_inst("Term::ANSIColor")) {
+                my $T="gYw";
+                print "                                      on_  on_y ".
+                    "        on_ma           on_\n";
+                print "                   on_black on_red  green ellow ".
+                    "on_blue genta on_cyan white\n";
+
+                for my $FG ("", "bold",
+                            map {$_,"bold $_"} "black","red","green",
+                            "yellow","blue",
+                            "magenta",
+                            "cyan","white") {
+                    printf "%12s ", $FG;
+                    for my $BG ("",map {"on_$_"} qw(black red green yellow
+                                                    blue magenta cyan white)) {
+                        print $FG||$BG ?
+                            Term::ANSIColor::colored("  $T  ","$FG $BG") : "  $T  ";
+                    }
+                    print "\n";
+                }
+                print "\n";
+            }
+            for my $tuple (
+                           ["colorize_print", "bold blue on_white"],
+                           ["colorize_warn", "bold red on_white"],
+                           ["colorize_debug", "black on_cyan"],
+                          ) {
+                my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher);
+                if ($CPAN::META->has_inst("Term::ANSIColor")) {
+                    eval { Term::ANSIColor::color($CPAN::Config->{$tuple->[0]})};
+                    if ($@) {
+                        $CPAN::Config->{$tuple->[0]} = $tuple->[1];
+                        $CPAN::Frontend->mywarn($@."setting to default '$tuple->[1]'\n");
+                    }
+                }
+            }
+        }
+    }
+
+    #
+    #== term_is_latin
+    #
+
+    if (!$matcher or 'term_is_latin' =~ /$matcher/) {
+        my_yn_prompt(term_is_latin => 1, $matcher);
+    }
+
+    #
+    #== save history in file 'histfile'
+    #
+
+    if (!$matcher or 'histfile histsize' =~ /$matcher/) {
+        $CPAN::Frontend->myprint($prompts{histfile_intro});
+        defined($default = $CPAN::Config->{histfile}) or
+            $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
+        my_dflt_prompt(histfile => $default, $matcher);
+
+        if ($CPAN::Config->{histfile}) {
+            defined($default = $CPAN::Config->{histsize}) or $default = 100;
+            my_dflt_prompt(histsize => $default, $matcher);
+        }
+    }
+
+    #
+    #== do an ls on the m or the d command
+    #
+    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 ("urllist" =~ $matcher) {
+            # conf_sites would go into endless loop with the smash prompt
+            local *_real_prompt;
+            *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
+            conf_sites();
+        }
+        if ("randomize_urllist" =~ $matcher) {
+            my_dflt_prompt(randomize_urllist => 0, $matcher);
+        }
+    } elsif ($fastread) {
+        $CPAN::Frontend->myprint("Autoconfigured everything but 'urllist'.\n".
+                                 "Please call 'o conf init urllist' to configure ".
+                                 "your CPAN server(s) now!");
+    } else {
+        conf_sites();
+    }
+
+    $CPAN::Frontend->myprint("\n\n");
+    if ($matcher && !$CPAN::Config->{auto_commit}) {
+        $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ".
+                                 "make the config permanent!\n\n");
+    } else {
+        CPAN::HandleConfig->commit($configpm);
+    }
+}
+
+sub my_dflt_prompt {
+    my ($item, $dflt, $m) = @_;
+    my $default = $CPAN::Config->{$item} || $dflt;
+
+    $DB::single = 1;
+    if (!$m || $item =~ /$m/) {
+        if (my $intro = $prompts{$item . "_intro"}) {
+            $CPAN::Frontend->myprint($intro);
+        }
+        $CPAN::Frontend->myprint(" <$item>\n");
+        $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
+        print "\n";
+    } else {
+        $CPAN::Config->{$item} = $default;
+    }
+}
+
+sub my_yn_prompt {
+    my ($item, $dflt, $m) = @_;
+    my $default;
+    defined($default = $CPAN::Config->{$item}) or $default = $dflt;
+
+    # $DB::single = 1;
+    if (!$m || $item =~ /$m/) {
+        if (my $intro = $prompts{$item . "_intro"}) {
+            $CPAN::Frontend->myprint($intro);
+        }
+        $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;
+    }
+}
+
+sub my_prompt_loop {
+    my ($item, $dflt, $m, $ok) = @_;
+    my $default = $CPAN::Config->{$item} || $dflt;
+    my $ans;
+
+    $DB::single = 1;
+    if (!$m || $item =~ /$m/) {
+        $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;
+    }
+}
+
+
+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
+
+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;
+        }
+    }
+    local $urllist = [];
+    read_mirrored_by($mby);
+    bring_your_own();
+    $CPAN::Config->{urllist} = $urllist;
+}
+
+sub find_exe {
+    my($exe,$path) = @_;
+    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;
+        }
+    }
+}
+
+sub picklist {
+    my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
+    CPAN->debug("picklist('$items','$prompt','$default','$require_nonempty',".
+                "'$empty_warning')") if $CPAN::DEBUG;
+    $default ||= '';
+
+    my $pos = 0;
+
+    my @nums;
+  SELECTION: while (1) {
+
+        # display, at most, 15 items at a time
+        my $limit = $#{ $items } - $pos;
+        $limit = 15 if $limit > 15;
+
+        # show the next $limit items, get the new position
+        $pos = display_some($items, $limit, $pos, $default);
+        $pos = 0 if $pos >= @$items;
+
+        my $num = prompt($prompt,$default);
+
+        @nums = split (' ', $num);
+        {
+            my %seen;
+            @nums = grep { !$seen{$_}++ } @nums;
+        }
+        my $i = scalar @$items;
+        unrangify(\@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");
+            }
+            next SELECTION;
+        }
+        if ($require_nonempty && !@nums) {
+            $CPAN::Frontend->mywarn("$empty_warning\n");
+        }
+        $CPAN::Frontend->myprint("\n");
+
+        # a blank line continues...
+        next SELECTION unless @nums;
+        last;
+    }
+    for (@nums) { $_-- }
+    @{$items}[@nums];
+}
+
+sub unrangify ($) {
+    my($nums) = $_[0];
+    my @nums2 = ();
+    while (@{$nums||[]}) {
+        my $n = shift @$nums;
+        if ($n =~ /^(\d+)-(\d+)$/) {
+            my @range = $1 .. $2;
+            # warn "range[@range]";
+            push @nums2, @range;
+        } else {
+            push @nums2, $n;
+        }
+    }
+    push @$nums, @nums2;
+}
+
+sub display_some {
+    my ($items, $limit, $pos, $default) = @_;
+    $pos ||= 0;
+
+    my @displayable = @$items[$pos .. ($pos + $limit)];
+    for my $item (@displayable) {
+        $CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item);
+    }
+    my $hit_what = $default ? "SPACE RETURN" : "RETURN";
+    $CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n",
+                                     (@$items - $pos),
+                                     $hit_what,
+                                    ))
+        if $pos < @$items;
+    return $pos;
+}
+
+sub read_mirrored_by {
+    my $local = shift or return;
+    my(%all,$url,$expected_size,$default,$ans,$host,
+       $dst,$country,$continent,@location);
+    my $fh = FileHandle->new;
+    $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="";
+    }
+    $fh->close;
+    $CPAN::Config->{urllist} ||= [];
+    my @previous_urls = @{$CPAN::Config->{urllist}};
 
-make_install_make_command => qq{Do you want to use a different make command for 'make install'?
-Cautious people will probably prefer:
+    $CPAN::Frontend->myprint($prompts{urls_intro});
 
-    su root -c make
-or
-    sudo make
-or
-    /path1/to/sudo -u admin_account /path2/to/make
+    my (@cont, $cont, %cont, @countries, @urls, %seen);
+    my $no_previous_warn =
+        "Sorry! since you don't have any existing picks, you must make a\n" .
+            "geographic selection.";
+    my $offer_cont = [sort keys %all];
+    if (@previous_urls) {
+        push @$offer_cont, "(edit previous picks)";
+        $default = @$offer_cont;
+    }
+    @cont = picklist($offer_cont,
+                     "Select your continent (or several nearby continents)",
+                     $default,
+                     ! @previous_urls,
+                     $no_previous_warn);
 
-or some such. Your choice: },
 
+    foreach $cont (@cont) {
+        my @c = sort keys %{$all{$cont}};
+        @cont{@c} = map ($cont, 0..$#c);
+        @c = map ("$_ ($cont)", @c) if @cont > 1;
+        push (@countries, @c);
+    }
+    if (@previous_urls && @countries) {
+        push @countries, "(edit previous picks)";
+        $default = @countries;
+    }
 
-make_install_arg => qq{Parameters for the 'make install' command?
-Typical frequently used setting:
+    if (@countries) {
+        @countries = picklist (\@countries,
+                               "Select your country (or several nearby countries)",
+                               $default,
+                               ! @previous_urls,
+                               $no_previous_warn);
+        %seen = map (($_ => 1), @previous_urls);
+        # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
+        foreach $country (@countries) {
+            next if $country =~ /edit previous picks/;
+            (my $bare_country = $country) =~ s/ \(.*\)//;
+            my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
+            @u = grep (! $seen{$_}, @u);
+            @u = map ("$_ ($bare_country)", @u)
+                if @countries > 1;
+            push (@urls, @u);
+        }
+    }
+    push (@urls, map ("$_ (previous pick)", @previous_urls));
+    my $prompt = "Select as many URLs as you like (by number),
+put them on one line, separated by blanks, hyphenated ranges allowed
+ e.g. '1 4 5' or '7 1-4 8'";
+    if (@previous_urls) {
+        $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
+                         (scalar @urls));
+        $prompt .= "\n(or just hit RETURN to keep your previous picks)";
+    }
 
-    UNINST=1         # to always uninstall potentially conflicting files
+    @urls = picklist (\@urls, $prompt, $default);
+    foreach (@urls) { s/ \(.*\)//; }
+    push @$urllist, @urls;
+}
 
-Your choice: },
+sub bring_your_own {
+    my %seen = map (($_ => 1), @$urllist);
+    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.
 
+Please enter your CPAN site:};
+        }
+        $ans = prompt ($prompt, "");
 
-mbuildpl_arg_intro => qq{
+        if ($ans) {
+            $ans =~ s|/?\z|/|; # has to end with one slash
+            $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
+            if ($ans =~ /^\w+:\/./) {
+                push @urls, $ans unless $seen{$ans}++;
+            } else {
+                $CPAN::Frontend->
+                    myprint(sprintf(qq{"%s" doesn\'t look like an URL at first sight.
+I\'ll ignore it for now.
+You can add it to your %s
+later if you\'re sure it\'s right.\n},
+                                   $ans,
+                                   $INC{'CPAN/MyConfig.pm'}
+                                   || $INC{'CPAN/Config.pm'}
+                                   || "configuration file",
+                                  ));
+            }
+        } else {
+            if (++$eacnt >= 5) {
+                $CPAN::Frontend->
+                    mywarn("Giving up.\n");
+                $CPAN::Frontend->mysleep(5);
+                return;
+            }
+        }
+    } while $ans || !%seen;
 
-The next questions deal with Module::Build support.
+    push @$urllist, @urls;
+    # xxx delete or comment these out when you're happy that it works
+    $CPAN::Frontend->myprint("New set of picks:\n");
+    map { $CPAN::Frontend->myprint("  $_\n") } @$urllist;
+}
 
-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.
 
-},
+sub _strip_spaces {
+    $_[0] =~ s/^\s+//;  # no leading spaces
+    $_[0] =~ s/\s+\z//; # no trailing spaces
+}
 
-mbuildpl_arg => qq{Parameters for the 'perl Build.PL' command?
-Typical frequently used settings:
+sub prompt ($;$) {
+    unless (defined &_real_prompt) {
+        *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
+    }
+    my $ans = _real_prompt(@_);
 
-    --install_base /home/xxx             # different installation directory
+    _strip_spaces($ans);
 
-Your choice: },
+    return $ans;
+}
 
-mbuild_arg => qq{Parameters for the './Build' command?
-Setting might be:
 
-    --extra_linker_flags -L/usr/foo/lib  # non-standard library location
+sub prompt_no_strip ($;$) {
+    return _real_prompt(@_);
+}
 
-Your choice: },
 
+BEGIN {
 
-mbuild_install_build_command => qq{Do you want to use a different command for './Build install'?
-Sudo users will probably prefer:
+my @prompts = (
 
-    su root -c ./Build
-or
-    sudo ./Build
-or
-    /path1/to/sudo -u admin_account ./Build
+manual_config => qq[
 
-or some such. Your choice: },
+CPAN is the world-wide archive of perl resources. It consists of about
+300 sites that all replicate the same contents around the globe. Many
+countries have at least one CPAN site already. The resources found on
+CPAN are easily accessible with the CPAN.pm module. If you want to use
+CPAN.pm, lots of things have to be configured. Fortunately, most of
+them can be determined automatically. If you prefer the automatic
+configuration, answer 'yes' below.
 
+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.)
+],
 
-mbuild_install_arg => qq{Parameters for the './Build install' command?
-Typical frequently used setting:
+config_intro => qq{
 
-    --uninst 1                           # uninstall conflicting files
+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.},
 
-Your choice: },
+# cpan_home => qq{ },
 
+cpan_home_where => qq{
 
+First of all, I'd like to create this directory. Where?
 
-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.
+external_progs => qq{
 
-If you set this value to 0, these processes will wait forever. This is
-the default and recommended setting.
+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
+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.
 
 },
 
-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;
     }
 }
 
index 49a8a50..ec0aefd 100644 (file)
@@ -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/.*:://;
index 392c821..52118e5 100644 (file)
@@ -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"};
index 60a4372..68ff72b 100644 (file)
@@ -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:
index dac56f5..f01ab51 100644 (file)
@@ -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;
index 88e8ef5..a9cad24 100644 (file)
@@ -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;
index d279134..c306634 100644 (file)
@@ -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:
index 5848c73..5abb96c 100644 (file)
@@ -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);
index 3c6978f..c1199e9 100644 (file)
@@ -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: