This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: CPAN-1.9301 can't clean bootstrap .cpan
[perl5.git] / lib / CPAN / FirstTime.pm
1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2 package CPAN::Mirrored::By;
3 use strict;
4
5 sub new {
6     my($self,@arg) = @_;
7     bless [@arg], $self;
8 }
9 sub continent { shift->[0] }
10 sub country { shift->[1] }
11 sub url { shift->[2] }
12
13 package CPAN::FirstTime;
14 use strict;
15
16 use ExtUtils::MakeMaker ();
17 use FileHandle ();
18 use File::Basename ();
19 use File::Path ();
20 use File::Spec ();
21 use vars qw($VERSION $urllist);
22 $VERSION = "5.5_01";
23
24 =head1 NAME
25
26 CPAN::FirstTime - Utility for CPAN::Config file Initialization
27
28 =head1 SYNOPSIS
29
30 CPAN::FirstTime::init()
31
32 =head1 DESCRIPTION
33
34 The init routine asks a few questions and writes a CPAN/Config.pm or
35 CPAN/MyConfig.pm file (depending on what it is currently using).
36
37 In the following all questions and explanations regarding config
38 variables are collected.
39
40 =cut
41
42 # down until the next =back the manpage must be parsed by the program
43 # because the text is used in the init dialogues.
44
45 =over 2
46
47 =item auto_commit
48
49 Normally CPAN.pm keeps config variables in memory and changes need to
50 be saved in a separate 'o conf commit' command to make them permanent
51 between sessions. If you set the 'auto_commit' option to true, changes
52 to a config variable are always automatically committed to disk.
53
54 Always commit changes to config variables to disk?
55
56 =item build_cache
57
58 CPAN.pm can limit the size of the disk area for keeping the build
59 directories with all the intermediate files.
60
61 Cache size for build directory (in MB)?
62
63 =item build_dir
64
65 Directory where the build process takes place?
66
67 =item build_dir_reuse
68
69 Until version 1.88 CPAN.pm never trusted the contents of the build_dir
70 directory between sessions. Since 1.88_58 CPAN.pm has a YAML-based
71 mechanism that makes it possible to share the contents of the
72 build_dir/ directory between different sessions with the same version
73 of perl. People who prefer to test things several days before
74 installing will like this feature because it safes a lot of time.
75
76 If you say yes to the following question, CPAN will try to store
77 enough information about the build process so that it can pick up in
78 future sessions at the same state of affairs as it left a previous
79 session.
80
81 Store and re-use state information about distributions between
82 CPAN.pm sessions?
83
84 =item build_requires_install_policy
85
86 When a module declares another one as a 'build_requires' prerequisite
87 this means that the other module is only needed for building or
88 testing the module but need not be installed permanently. In this case
89 you may wish to install that other module nonetheless or just keep it
90 in the 'build_dir' directory to have it available only temporarily.
91 Installing saves time on future installations but makes the perl
92 installation bigger.
93
94 You can choose if you want to always install (yes), never install (no)
95 or be always asked. In the latter case you can set the default answer
96 for the question to yes (ask/yes) or no (ask/no).
97
98 Policy on installing 'build_requires' modules (yes, no, ask/yes,
99 ask/no)?
100
101 =item cache_metadata
102
103 To considerably speed up the initial CPAN shell startup, it is
104 possible to use Storable to create a cache of metadata. If Storable is
105 not available, the normal index mechanism will be used.
106
107 Note: this mechanism is not used when use_sqlite is on and SQLLite is
108 running.
109
110 Cache metadata (yes/no)?
111
112 =item check_sigs
113
114 CPAN packages can be digitally signed by authors and thus verified
115 with the security provided by strong cryptography. The exact mechanism
116 is defined in the Module::Signature module. While this is generally
117 considered a good thing, it is not always convenient to the end user
118 to install modules that are signed incorrectly or where the key of the
119 author is not available or where some prerequisite for
120 Module::Signature has a bug and so on.
121
122 With the check_sigs parameter you can turn signature checking on and
123 off. The default is off for now because the whole tool chain for the
124 functionality is not yet considered mature by some. The author of
125 CPAN.pm would recommend setting it to true most of the time and
126 turning it off only if it turns out to be annoying.
127
128 Note that if you do not have Module::Signature installed, no signature
129 checks will be performed at all.
130
131 Always try to check and verify signatures if a SIGNATURE file is in
132 the package and Module::Signature is installed (yes/no)?
133
134 =item colorize_output
135
136 When you have Term::ANSIColor installed, you can turn on colorized
137 output to have some visual differences between normal CPAN.pm output,
138 warnings, debugging output, and the output of the modules being
139 installed. Set your favorite colors after some experimenting with the
140 Term::ANSIColor module.
141
142 Do you want to turn on colored output?
143
144 =item colorize_print
145
146 Color for normal output?
147
148 =item colorize_warn
149
150 Color for warnings?
151
152 =item colorize_debug
153
154 Color for debugging messages?
155
156 =item commandnumber_in_prompt
157
158 The prompt of the cpan shell can contain the current command number
159 for easier tracking of the session or be a plain string.
160
161 Do you want the command number in the prompt (yes/no)?
162
163 =item connect_to_internet_ok
164
165 If you have never defined your own C<urllist> in your configuration
166 then C<CPAN.pm> will be hesitant to use the built in default sites for
167 downloading. It will ask you once per session if a connection to the
168 internet is OK and only if you say yes, it will try to connect. But to
169 avoid this question, you can choose your favorite download sites once
170 and get away with it. Or, if you have no favorite download sites
171 answer yes to the following question.
172
173 If no urllist has been chosen yet, would you prefer CPAN.pm to connect
174 to the built-in default sites without asking? (yes/no)?
175
176 =item ftp_passive
177
178 Shall we always set the FTP_PASSIVE environment variable when dealing
179 with ftp download (yes/no)?
180
181 =item ftpstats_period
182
183 Statistics about downloads are truncated by size and period
184 simultaneously.
185
186 How many days shall we keep statistics about downloads?
187
188 =item ftpstats_size
189
190 Statistics about downloads are truncated by size and period
191 simultaneously.
192
193 How many items shall we keep in the statistics about downloads?
194
195 =item getcwd
196
197 CPAN.pm changes the current working directory often and needs to
198 determine its own current working directory. Per default it uses
199 Cwd::cwd but if this doesn't work on your system for some reason,
200 alternatives can be configured according to the following table:
201
202     cwd         Cwd::cwd
203     getcwd      Cwd::getcwd
204     fastcwd     Cwd::fastcwd
205     backtickcwd external command cwd
206
207 Preferred method for determining the current working directory?
208
209 =item halt_on_failure
210
211 Normaly, CPAN.pm continues processing the full list of targets and
212 dependencies, even if one of them fails.  However, you can specify 
213 that CPAN should halt after the first failure. 
214
215 Do you want to halt on failure (yes/no)?
216
217 =item histfile
218
219 If you have one of the readline packages (Term::ReadLine::Perl,
220 Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN
221 shell will have history support. The next two questions deal with the
222 filename of the history file and with its size. If you do not want to
223 set this variable, please hit SPACE RETURN to the following question.
224
225 File to save your history?
226
227 =item histsize
228
229 Number of lines to save?
230
231 =item inactivity_timeout
232
233 Sometimes you may wish to leave the processes run by CPAN alone
234 without caring about them. Because the Makefile.PL or the Build.PL
235 sometimes contains question you're expected to answer, you can set a
236 timer that will kill a 'perl Makefile.PL' process after the specified
237 time in seconds.
238
239 If you set this value to 0, these processes will wait forever. This is
240 the default and recommended setting.
241
242 Timeout for inactivity during {Makefile,Build}.PL?
243
244 =item index_expire
245
246 The CPAN indexes are usually rebuilt once or twice per hour, but the
247 typical CPAN mirror mirrors only once or twice per day. Depending on
248 the quality of your mirror and your desire to be on the bleeding edge,
249 you may want to set the following value to more or less than one day
250 (which is the default). It determines after how many days CPAN.pm
251 downloads new indexes.
252
253 Let the index expire after how many days?
254
255 =item inhibit_startup_message
256
257 When the CPAN shell is started it normally displays a greeting message
258 that contains the running version and the status of readline support.
259
260 Do you want to turn this message off?
261
262 =item keep_source_where
263
264 Unless you are accessing the CPAN on your filesystem via a file: URL,
265 CPAN.pm needs to keep the source files it downloads somewhere. Please
266 supply a directory where the downloaded files are to be kept.
267
268 Download target directory?
269
270 =item load_module_verbosity
271
272 When CPAN.pm loads a module it needs for some optional feature, it
273 usually reports about module name and version. Choose 'v' to get this
274 message, 'none' to suppress it.
275
276 Verbosity level for loading modules (none or v)?
277
278 =item makepl_arg
279
280 Every Makefile.PL is run by perl in a separate process. Likewise we
281 run 'make' and 'make install' in separate processes. If you have
282 any parameters (e.g. PREFIX, UNINST or the like) you want to
283 pass to the calls, please specify them here.
284
285 If you don't understand this question, just press ENTER.
286
287 Typical frequently used settings:
288
289     PREFIX=~/perl    # non-root users (please see manual for more hints)
290
291 Parameters for the 'perl Makefile.PL' command?
292
293 =item make_arg
294
295 Parameters for the 'make' command? Typical frequently used setting:
296
297     -j3              # dual processor system (on GNU make)
298
299 Your choice:
300
301 =item make_install_arg
302
303 Parameters for the 'make install' command?
304 Typical frequently used setting:
305
306     UNINST=1         # to always uninstall potentially conflicting files
307
308 Your choice:
309
310 =item make_install_make_command
311
312 Do you want to use a different make command for 'make install'?
313 Cautious people will probably prefer:
314
315     su root -c make
316  or
317     sudo make
318  or
319     /path1/to/sudo -u admin_account /path2/to/make
320
321 or some such. Your choice:
322
323 =item mbuildpl_arg
324
325 A Build.PL is run by perl in a separate process. Likewise we run
326 './Build' and './Build install' in separate processes. If you have any
327 parameters you want to pass to the calls, please specify them here.
328
329 Typical frequently used settings:
330
331     --install_base /home/xxx             # different installation directory
332
333 Parameters for the 'perl Build.PL' command?
334
335 =item mbuild_arg
336
337 Parameters for the './Build' command? Setting might be:
338
339     --extra_linker_flags -L/usr/foo/lib  # non-standard library location
340
341 Your choice:
342
343 =item mbuild_install_arg
344
345 Parameters for the './Build install' command? Typical frequently used
346 setting:
347
348     --uninst 1                           # uninstall conflicting files
349
350 Your choice:
351
352 =item mbuild_install_build_command
353
354 Do you want to use a different command for './Build install'? Sudo
355 users will probably prefer:
356
357     su root -c ./Build
358  or
359     sudo ./Build
360  or
361     /path1/to/sudo -u admin_account ./Build
362
363 or some such. Your choice:
364
365 =item pager
366
367 What is your favorite pager program?
368
369 =item prefer_installer
370
371 When you have Module::Build installed and a module comes with both a
372 Makefile.PL and a Build.PL, which shall have precedence?
373
374 The main two standard installer modules are the old and well
375 established ExtUtils::MakeMaker (for short: EUMM) which uses the
376 Makefile.PL. And the next generation installer Module::Build (MB)
377 which works with the Build.PL (and often comes with a Makefile.PL
378 too). If a module comes only with one of the two we will use that one
379 but if both are supplied then a decision must be made between EUMM and
380 MB. See also http://rt.cpan.org/Ticket/Display.html?id=29235 for a
381 discussion about the right default.
382
383 Or, as a third option you can choose RAND which will make a random
384 decision (something regular CPAN testers will enjoy).
385
386 In case you can choose between running a Makefile.PL or a Build.PL,
387 which installer would you prefer (EUMM or MB or RAND)?
388
389 =item prefs_dir
390
391 CPAN.pm can store customized build environments based on regular
392 expressions for distribution names. These are YAML files where the
393 default options for CPAN.pm and the environment can be overridden and
394 dialog sequences can be stored that can later be executed by an
395 Expect.pm object. The CPAN.pm distribution comes with some prefab YAML
396 files that cover sample distributions that can be used as blueprints
397 to store one own prefs. Please check out the distroprefs/ directory of
398 the CPAN.pm distribution to get a quick start into the prefs system.
399
400 Directory where to store default options/environment/dialogs for
401 building modules that need some customization?
402
403 =item prerequisites_policy
404
405 The CPAN module can detect when a module which you are trying to build
406 depends on prerequisites. If this happens, it can build the
407 prerequisites for you automatically ('follow'), ask you for
408 confirmation ('ask'), or just ignore them ('ignore'). Please set your
409 policy to one of the three values.
410
411 Policy on building prerequisites (follow, ask or ignore)?
412
413 =item randomize_urllist
414
415 CPAN.pm can introduce some randomness when using hosts for download
416 that are configured in the urllist parameter. Enter a numeric value
417 between 0 and 1 to indicate how often you want to let CPAN.pm try a
418 random host from the urllist. A value of one specifies to always use a
419 random host as the first try. A value of zero means no randomness at
420 all. Anything in between specifies how often, on average, a random
421 host should be tried first.
422
423 Randomize parameter
424
425 =item scan_cache
426
427 By default, each time the CPAN module is started, cache scanning is
428 performed to keep the cache size in sync. To prevent this, answer
429 'never'.
430
431 Perform cache scanning (atstart or never)?
432
433 =item shell
434
435 What is your favorite shell?
436
437 =item show_unparsable_versions
438
439 During the 'r' command CPAN.pm finds modules without version number.
440 When the command finishes, it prints a report about this. If you
441 want this report to be very verbose, say yes to the following
442 variable.
443
444 Show all individual modules that have no $VERSION?
445
446 =item show_upload_date
447
448 The 'd' and the 'm' command normally only show you information they
449 have in their in-memory database and thus will never connect to the
450 internet. If you set the 'show_upload_date' variable to true, 'm' and
451 'd' will additionally show you the upload date of the module or
452 distribution. Per default this feature is off because it may require a
453 net connection to get at the upload date.
454
455 Always try to show upload date with 'd' and 'm' command (yes/no)?
456
457 =item show_zero_versions
458
459 During the 'r' command CPAN.pm finds modules with a version number of
460 zero. When the command finishes, it prints a report about this. If you
461 want this report to be very verbose, say yes to the following
462 variable.
463
464 Show all individual modules that have a $VERSION of zero?
465
466 =item tar_verbosity
467
468 When CPAN.pm uses the tar command, which switch for the verbosity
469 shall be used? Choose 'none' for quiet operation, 'v' for file
470 name listing, 'vv' for full listing.
471
472 Tar command verbosity level (none or v or vv)?
473
474 =item term_is_latin
475
476 The next option deals with the charset (aka character set) your
477 terminal supports. In general, CPAN is English speaking territory, so
478 the charset does not matter much but some CPAN have names that are
479 outside the ASCII range. If your terminal supports UTF-8, you should
480 say no to the next question. If it expects ISO-8859-1 (also known as
481 LATIN1) then you should say yes. If it supports neither, your answer
482 does not matter because you will not be able to read the names of some
483 authors anyway. If you answer no, names will be output in UTF-8.
484
485 Your terminal expects ISO-8859-1 (yes/no)?
486
487 =item term_ornaments
488
489 When using Term::ReadLine, you can turn ornaments on so that your
490 input stands out against the output from CPAN.pm.
491
492 Do you want to turn ornaments on?
493
494 =item test_report
495
496 The goal of the CPAN Testers project (http://testers.cpan.org/) is to
497 test as many CPAN packages as possible on as many platforms as
498 possible.  This provides valuable feedback to module authors and
499 potential users to identify bugs or platform compatibility issues and
500 improves the overall quality and value of CPAN.
501
502 One way you can contribute is to send test results for each module
503 that you install.  If you install the CPAN::Reporter module, you have
504 the option to automatically generate and email test reports to CPAN
505 Testers whenever you run tests on a CPAN package.
506
507 See the CPAN::Reporter documentation for additional details and
508 configuration settings.  If your firewall blocks outgoing email,
509 you will need to configure CPAN::Reporter before sending reports.
510
511 Email test reports if CPAN::Reporter is installed (yes/no)?
512
513 =item perl5lib_verbosity
514
515 When CPAN.pm extends @INC via PERL5LIB, it prints a list of
516 directories added (or a summary of how many directories are
517 added).  Choose 'v' to get this message, 'none' to suppress it.
518
519 Verbosity level for PERL5LIB changes (none or v)?
520
521 =item trust_test_report_history
522
523 When a distribution has already been tested by CPAN::Reporter on
524 this machine, CPAN can skip the test phase and just rely on the
525 test report history instead.
526
527 Note that this will not apply to distributions that failed tests
528 because of missing dependencies.  Also, tests can be run
529 regardless of the history using "force".
530
531 Do you want to rely on the test report history (yes/no)?
532
533 =item use_sqlite
534
535 CPAN::SQLite is a layer between the index files that are downloaded
536 from the CPAN and CPAN.pm that speeds up metadata queries and reduces
537 memory consumption of CPAN.pm considerably.
538
539 Use CPAN::SQLite if available? (yes/no)?
540
541 =item yaml_load_code
542
543 Both YAML.pm and YAML::Syck are capable of deserialising code. As this
544 requires a string eval, which might be a security risk, you can use
545 this option to enable or disable the deserialisation of code via
546 CPAN::DeferedCode. (Note: This does not work under perl 5.6)
547
548 Do you want to enable code deserialisation (yes/no)?
549
550 =item yaml_module
551
552 At the time of this writing there are two competing YAML modules,
553 YAML.pm and YAML::Syck. The latter is faster but needs a C compiler
554 installed on your system. There may be more alternative YAML
555 conforming modules but at the time of writing a potential third
556 player, YAML::Tiny, seemed not powerful enough to work with CPAN.pm.
557
558 Which YAML implementation would you prefer?
559
560 =back
561
562 =head1 LICENSE
563
564 This program is free software; you can redistribute it and/or
565 modify it under the same terms as Perl itself.
566
567 =cut
568
569 use vars qw( %prompts );
570
571 sub init {
572     my($configpm, %args) = @_;
573     use Config;
574     # extra args after 'o conf init'
575     my $matcher = $args{args} && @{$args{args}} ? $args{args}[0] : '';
576     if ($matcher =~ /^\/(.*)\/$/) {
577         # case /regex/ => take the first, ignore the rest
578         $matcher = $1;
579         shift @{$args{args}};
580         if (@{$args{args}}) {
581             local $" = " ";
582             $CPAN::Frontend->mywarn("Ignoring excessive arguments '@{$args{args}}'");
583             $CPAN::Frontend->mysleep(2);
584         }
585     } elsif (0 == length $matcher) {
586     } elsif (0 && $matcher eq "~") { # extremely buggy, but a nice idea
587         my @unconfigured = grep { not exists $CPAN::Config->{$_}
588                                       or not defined $CPAN::Config->{$_}
589                                           or not length $CPAN::Config->{$_}
590                                   } keys %$CPAN::Config;
591         $matcher = "\\b(".join("|", @unconfigured).")\\b";
592         $CPAN::Frontend->mywarn("matcher[$matcher]");
593     } else {
594         # case WORD... => all arguments must be valid
595         for my $arg (@{$args{args}}) {
596             unless (exists $CPAN::HandleConfig::keys{$arg}) {
597                 $CPAN::Frontend->mywarn("'$arg' is not a valid configuration variable\n");
598                 return;
599             }
600         }
601         $matcher = "\\b(".join("|",@{$args{args}}).")\\b";
602     }
603     CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG;
604
605     unless ($CPAN::VERSION) {
606         require CPAN::Nox;
607     }
608     require CPAN::HandleConfig;
609     CPAN::HandleConfig::require_myconfig_or_config();
610     $CPAN::Config ||= {};
611     local($/) = "\n";
612     local($\) = "";
613     local($|) = 1;
614
615     my($ans,$default);
616
617     #
618     #= Files, directories
619     #
620
621     unless ($matcher) {
622         $CPAN::Frontend->myprint($prompts{manual_config});
623     }
624
625     my $manual_conf;
626
627     local *_real_prompt;
628     if ( $args{autoconfig} ) {
629         $manual_conf = "no";
630     } elsif ($matcher) {
631         $manual_conf = "yes";
632     } else {
633         my $_conf = prompt("Would you like me to configure as much as possible ".
634                            "automatically?", "yes");
635         $manual_conf = ($_conf and $_conf =~ /^y/i) ? "no" : "yes";
636     }
637     CPAN->debug("manual_conf[$manual_conf]") if $CPAN::DEBUG;
638     my $fastread;
639     {
640         if ($manual_conf =~ /^y/i) {
641             $fastread = 0;
642         } else {
643             $fastread = 1;
644             $CPAN::Config->{urllist} ||= [];
645
646             local $^W = 0;
647             # prototype should match that of &MakeMaker::prompt
648             my $current_second = time;
649             my $current_second_count = 0;
650             my $i_am_mad = 0;
651             *_real_prompt = sub {
652                 my($q,$a) = @_;
653                 my($ret) = defined $a ? $a : "";
654                 $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
655                 eval { require Time::HiRes };
656                 unless ($@) {
657                     if (time == $current_second) {
658                         $current_second_count++;
659                         if ($current_second_count > 20) {
660                             # I don't like more than 20 prompts per second
661                             $i_am_mad++;
662                         }
663                     } else {
664                         $current_second = time;
665                         $current_second_count = 0;
666                         $i_am_mad-- if $i_am_mad>0;
667                     }
668                     if ($i_am_mad>0) {
669                         #require Carp;
670                         #Carp::cluck("SLEEEEEEEEPIIIIIIIIIIINGGGGGGGGGGG");
671                         Time::HiRes::sleep(0.1);
672                     }
673                 }
674                 $ret;
675             };
676         }
677     }
678
679     if (!$matcher or q{
680                        build_dir
681                        build_dir_reuse
682                        cpan_home
683                        keep_source_where
684                        prefs_dir
685                       } =~ /$matcher/) {
686         $CPAN::Frontend->myprint($prompts{config_intro});
687
688         if (!$matcher or 'cpan_home' =~ /$matcher/) {
689             my $cpan_home = $CPAN::Config->{cpan_home}
690                 || File::Spec->catdir(CPAN::HandleConfig::home(), ".cpan");
691
692             if (-d $cpan_home) {
693                 $CPAN::Frontend->myprint(qq{
694
695 I see you already have a  directory
696     $cpan_home
697 Shall we use it as the general CPAN build and cache directory?
698
699 });
700             } else {
701                 # no cpan-home, must prompt and get one
702                 $CPAN::Frontend->myprint($prompts{cpan_home_where});
703             }
704
705             $default = $cpan_home;
706             my $loop = 0;
707             my $last_ans;
708             $CPAN::Frontend->myprint(" <cpan_home>\n");
709           PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) {
710                 print "\n";
711                 if (File::Spec->file_name_is_absolute($ans)) {
712                     my @cpan_home = split /[\/\\]/, $ans;
713                   DIR: for my $dir (@cpan_home) {
714                         if ($dir =~ /^~/ and (!$last_ans or $ans ne $last_ans)) {
715                             $CPAN::Frontend
716                                 ->mywarn("Warning: a tilde in the path will be ".
717                                          "taken as a literal tilde. Please ".
718                                          "confirm again if you want to keep it\n");
719                             $last_ans = $default = $ans;
720                             next PROMPT;
721                         }
722                     }
723                 } else {
724                     require Cwd;
725                     my $cwd = Cwd::cwd();
726                     my $absans = File::Spec->catdir($cwd,$ans);
727                     $CPAN::Frontend->mywarn("The path '$ans' is not an ".
728                                             "absolute path. Please specify ".
729                                             "an absolute path\n");
730                     $default = $absans;
731                     next PROMPT;
732                 }
733                 eval { File::Path::mkpath($ans); }; # dies if it can't
734                 if ($@) {
735                     $CPAN::Frontend->mywarn("Couldn't create directory $ans.\n".
736                                             "Please retry.\n");
737                     next PROMPT;
738                 }
739                 if (-d $ans && -w _) {
740                     last PROMPT;
741                 } else {
742                     $CPAN::Frontend->mywarn("Couldn't find directory $ans\n".
743                                             "or directory is not writable. Please retry.\n");
744                     if (++$loop > 5) {
745                         $CPAN::Frontend->mydie("Giving up");
746                     }
747                 }
748             }
749             $CPAN::Config->{cpan_home} = $ans;
750         }
751
752         if (!$matcher or 'keep_source_where' =~ /$matcher/) {
753             my_dflt_prompt("keep_source_where",
754                            File::Spec->catdir($CPAN::Config->{cpan_home},"sources"),
755                            $matcher,
756                           );
757         }
758
759         if (!$matcher or 'build_dir' =~ /$matcher/) {
760             my_dflt_prompt("build_dir",
761                            File::Spec->catdir($CPAN::Config->{cpan_home},"build"),
762                            $matcher
763                           );
764         }
765
766         if (!$matcher or 'build_dir_reuse' =~ /$matcher/) {
767             my_yn_prompt(build_dir_reuse => 0, $matcher);
768         }
769
770         if (!$matcher or 'prefs_dir' =~ /$matcher/) {
771             my_dflt_prompt("prefs_dir",
772                            File::Spec->catdir($CPAN::Config->{cpan_home},"prefs"),
773                            $matcher
774                           );
775         }
776     }
777
778     #
779     #= Config: auto_commit
780     #
781
782     my_yn_prompt(auto_commit => 0, $matcher);
783
784     #
785     #= Cache size, Index expire
786     #
787
788     if (!$matcher or 'build_cache' =~ /$matcher/) {
789         # large enough to build large dists like Tk
790         my_dflt_prompt(build_cache => 100, $matcher);
791     }
792
793     if (!$matcher or 'index_expire' =~ /$matcher/) {
794         my_dflt_prompt(index_expire => 1, $matcher);
795     }
796
797     if (!$matcher or 'scan_cache' =~ /$matcher/) {
798         my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
799     }
800
801     #
802     #= cache_metadata
803     #
804
805     my_yn_prompt(cache_metadata => 1, $matcher);
806     my_yn_prompt(use_sqlite => 0, $matcher);
807
808     #
809     #= Do we follow PREREQ_PM?
810     #
811
812     if (!$matcher or 'prerequisites_policy' =~ /$matcher/) {
813         my_prompt_loop(prerequisites_policy => 'ask', $matcher,
814                        'follow|ask|ignore');
815     }
816
817     if (!$matcher or 'build_requires_install_policy' =~ /$matcher/) {
818         my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher,
819                        'yes|no|ask/yes|ask/no');
820     }
821
822     #
823     #= Module::Signature
824     #
825     if (!$matcher or 'check_sigs' =~ /$matcher/) {
826         my_yn_prompt(check_sigs => 0, $matcher);
827     }
828
829     #
830     #= CPAN::Reporter
831     #
832     if (!$matcher or 'test_report' =~ /$matcher/) {
833         my_yn_prompt(test_report => 0, $matcher);
834         if (
835             $CPAN::Config->{test_report} &&
836             $CPAN::META->has_inst("CPAN::Reporter") &&
837             CPAN::Reporter->can('configure')
838            ) {
839             $CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n");
840             CPAN::Reporter::configure();
841             $CPAN::Frontend->myprint("\nReturning to CPAN configuration.\n");
842         }
843     }
844
845     if (!$matcher or 'trust_test_report_history' =~ /$matcher/) {
846         my_yn_prompt(trust_test_report_history => 0, $matcher);
847     }
848
849     #
850     #= YAML vs. YAML::Syck
851     #
852     if (!$matcher or "yaml_module" =~ /$matcher/) {
853         my_dflt_prompt(yaml_module => "YAML", $matcher);
854         unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
855             $CPAN::Frontend->mywarn
856                 ("Warning (maybe harmless): '$CPAN::Config->{yaml_module}' not installed.\n");
857             $CPAN::Frontend->mysleep(3);
858         }
859     }
860
861     #
862     #= YAML code deserialisation
863     #
864     if (!$matcher or "yaml_load_code" =~ /$matcher/) {
865         my_yn_prompt(yaml_load_code => 0, $matcher);
866     }
867
868     #
869     #= External programs
870     #
871
872     my @external_progs = qw/bzip2 gzip tar unzip
873
874                             make
875
876                             curl lynx wget ncftpget ncftp ftp
877
878                             gpg
879
880                             patch applypatch
881                             /;
882     my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
883     if (!$matcher or "@external_progs" =~ /$matcher/) {
884         $CPAN::Frontend->myprint($prompts{external_progs});
885
886         my $old_warn = $^W;
887         local $^W if $^O eq 'MacOS';
888         local $^W = $old_warn;
889         my $progname;
890         for $progname (@external_progs) {
891             next if $matcher && $progname !~ /$matcher/;
892             if ($^O eq 'MacOS') {
893                 $CPAN::Config->{$progname} = 'not_here';
894                 next;
895             }
896
897             my $progcall = $progname;
898             unless ($matcher) {
899                 # we really don't need ncftp if we have ncftpget, but
900                 # if they chose this dialog via matcher, they shall have it
901                 next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
902             }
903             my $path = $CPAN::Config->{$progname}
904                 || $Config::Config{$progname}
905                     || "";
906             if (File::Spec->file_name_is_absolute($path)) {
907                 # testing existence is not good enough, some have these exe
908                 # extensions
909
910                 # warn "Warning: configured $path does not exist\n" unless -e $path;
911                 # $path = "";
912             } elsif ($path =~ /^\s+$/) {
913                 # preserve disabled programs
914             } else {
915                 $path = '';
916             }
917             unless ($path) {
918                 # e.g. make -> nmake
919                 $progcall = $Config::Config{$progname} if $Config::Config{$progname};
920             }
921
922             $path ||= find_exe($progcall,\@path);
923             unless ($path) { # not -e $path, because find_exe already checked that
924                 local $"=";";
925                 $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@path]\n");
926                 if ($progname eq "make") {
927                     $CPAN::Frontend->mywarn("ALERT: 'make' is an essential tool for ".
928                                             "building perl Modules. Please make sure you ".
929                                             "have 'make' (or some equivalent) ".
930                                             "working.\n"
931                                            );
932                     if ($^O eq "MSWin32") {
933                         $CPAN::Frontend->mywarn("
934 Windows users may want to follow this procedure when back in the CPAN shell:
935
936     look YVES/scripts/alien_nmake.pl
937     perl alien_nmake.pl
938
939 This will install nmake on your system which can be used as a 'make'
940 substitute. You can then revisit this dialog with
941
942     o conf init make
943
944 ");
945                     }
946                 }
947             }
948             $prompts{$progname} = "Where is your $progname program?";
949             my_dflt_prompt($progname,$path,$matcher);
950         }
951     }
952
953     if (!$matcher or 'pager' =~ /$matcher/) {
954         my $path = $CPAN::Config->{'pager'} ||
955             $ENV{PAGER} || find_exe("less",\@path) ||
956                 find_exe("more",\@path) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
957                     || "more";
958         my_dflt_prompt(pager => $path, $matcher);
959     }
960
961     if (!$matcher or 'shell' =~ /$matcher/) {
962         my $path = $CPAN::Config->{'shell'};
963         if ($path && File::Spec->file_name_is_absolute($path)) {
964             $CPAN::Frontend->mywarn("Warning: configured $path does not exist\n")
965                 unless -e $path;
966             $path = "";
967         }
968         $path ||= $ENV{SHELL};
969         $path ||= $ENV{COMSPEC} if $^O eq "MSWin32";
970         if ($^O eq 'MacOS') {
971             $CPAN::Config->{'shell'} = 'not_here';
972         } else {
973             $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
974             my_dflt_prompt(shell => $path, $matcher);
975         }
976     }
977
978     #
979     # verbosity
980     #
981
982     if (!$matcher or 'tar_verbosity' =~ /$matcher/) {
983         my_prompt_loop(tar_verbosity => 'v', $matcher,
984                        'none|v|vv');
985     }
986
987     if (!$matcher or 'load_module_verbosity' =~ /$matcher/) {
988         my_prompt_loop(load_module_verbosity => 'v', $matcher,
989                        'none|v');
990     }
991
992     if (!$matcher or 'perl5lib_verbosity' =~ /$matcher/) {
993         my_prompt_loop(perl5lib_verbosity => 'v', $matcher,
994                        'none|v');
995     }
996
997     my_yn_prompt(inhibit_startup_message => 0, $matcher);
998
999     #
1000     #= Installer, arguments to make etc.
1001     #
1002
1003     if (!$matcher or 'prefer_installer' =~ /$matcher/) {
1004         my_prompt_loop(prefer_installer => 'MB', $matcher, 'MB|EUMM|RAND');
1005     }
1006
1007     if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/) {
1008         my_dflt_prompt(makepl_arg => "", $matcher);
1009         my_dflt_prompt(make_arg => "", $matcher);
1010         if ( $CPAN::Config->{makepl_arg} =~ /LIBS=|INC=/ ) {
1011             $CPAN::Frontend->mywarn( 
1012                 "Warning: Using LIBS or INC in makepl_arg will likely break distributions\n" . 
1013                 "that specify their own LIBS or INC options in Makefile.PL.\n"
1014             );
1015         }
1016
1017     }
1018
1019     require CPAN::HandleConfig;
1020     if (exists $CPAN::HandleConfig::keys{make_install_make_command}) {
1021         # as long as Windows needs $self->_build_command, we cannot
1022         # support sudo on windows :-)
1023         my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "",
1024                        $matcher);
1025     }
1026
1027     my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "",
1028                    $matcher);
1029
1030     my_dflt_prompt(mbuildpl_arg => "", $matcher);
1031     my_dflt_prompt(mbuild_arg => "", $matcher);
1032
1033     if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command}
1034         and $^O ne "MSWin32") {
1035         # as long as Windows needs $self->_build_command, we cannot
1036         # support sudo on windows :-)
1037         my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher);
1038     }
1039
1040     my_dflt_prompt(mbuild_install_arg => "", $matcher);
1041
1042     #
1043     #= Alarm period
1044     #
1045
1046     my_dflt_prompt(inactivity_timeout => 0, $matcher);
1047
1048     #
1049     #== halt_on_failure
1050     #
1051     if (!$matcher or 'halt_on_failure' =~ /$matcher/) {
1052         my_yn_prompt(halt_on_failure => 0, $matcher);
1053     }
1054
1055     #
1056     #= Proxies
1057     #
1058
1059     my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/;
1060     my @proxy_user_vars = qw/proxy_user proxy_pass/;
1061     if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/) {
1062         $CPAN::Frontend->myprint($prompts{proxy_intro});
1063
1064         for (@proxy_vars) {
1065             $prompts{$_} = "Your $_?";
1066             my_dflt_prompt($_ => $ENV{$_}||"", $matcher);
1067         }
1068
1069         if ($CPAN::Config->{ftp_proxy} ||
1070             $CPAN::Config->{http_proxy}) {
1071
1072             $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || "";
1073
1074             $CPAN::Frontend->myprint($prompts{proxy_user});
1075
1076             if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
1077                 $CPAN::Frontend->myprint($prompts{proxy_pass});
1078
1079                 if ($CPAN::META->has_inst("Term::ReadKey")) {
1080                     Term::ReadKey::ReadMode("noecho");
1081                 } else {
1082                     $CPAN::Frontend->myprint($prompts{password_warn});
1083                 }
1084                 $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
1085                 if ($CPAN::META->has_inst("Term::ReadKey")) {
1086                     Term::ReadKey::ReadMode("restore");
1087                 }
1088                 $CPAN::Frontend->myprint("\n\n");
1089             }
1090         }
1091     }
1092
1093     #
1094     #= how FTP works
1095     #
1096
1097     my_yn_prompt(ftp_passive => 1, $matcher);
1098
1099     #
1100     #= how cwd works
1101     #
1102
1103     if (!$matcher or 'getcwd' =~ /$matcher/) {
1104         my_prompt_loop(getcwd => 'cwd', $matcher,
1105                        'cwd|getcwd|fastcwd|backtickcwd');
1106     }
1107
1108     #
1109     #= the CPAN shell itself (prompt, color)
1110     #
1111
1112     my_yn_prompt(commandnumber_in_prompt => 1, $matcher);
1113     my_yn_prompt(term_ornaments => 1, $matcher);
1114     if ("colorize_output colorize_print colorize_warn colorize_debug" =~ $matcher) {
1115         my_yn_prompt(colorize_output => 0, $matcher);
1116         if ($CPAN::Config->{colorize_output}) {
1117             if ($CPAN::META->has_inst("Term::ANSIColor")) {
1118                 my $T="gYw";
1119                 print "                                      on_  on_y ".
1120                     "        on_ma           on_\n";
1121                 print "                   on_black on_red  green ellow ".
1122                     "on_blue genta on_cyan white\n";
1123
1124                 for my $FG ("", "bold",
1125                             map {$_,"bold $_"} "black","red","green",
1126                             "yellow","blue",
1127                             "magenta",
1128                             "cyan","white") {
1129                     printf "%12s ", $FG;
1130                     for my $BG ("",map {"on_$_"} qw(black red green yellow
1131                                                     blue magenta cyan white)) {
1132                         print $FG||$BG ?
1133                             Term::ANSIColor::colored("  $T  ","$FG $BG") : "  $T  ";
1134                     }
1135                     print "\n";
1136                 }
1137                 print "\n";
1138             }
1139             for my $tuple (
1140                            ["colorize_print", "bold blue on_white"],
1141                            ["colorize_warn", "bold red on_white"],
1142                            ["colorize_debug", "black on_cyan"],
1143                           ) {
1144                 my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher);
1145                 if ($CPAN::META->has_inst("Term::ANSIColor")) {
1146                     eval { Term::ANSIColor::color($CPAN::Config->{$tuple->[0]})};
1147                     if ($@) {
1148                         $CPAN::Config->{$tuple->[0]} = $tuple->[1];
1149                         $CPAN::Frontend->mywarn($@."setting to default '$tuple->[1]'\n");
1150                     }
1151                 }
1152             }
1153         }
1154     }
1155
1156     #
1157     #== term_is_latin
1158     #
1159
1160     if (!$matcher or 'term_is_latin' =~ /$matcher/) {
1161         my_yn_prompt(term_is_latin => 1, $matcher);
1162     }
1163
1164     #
1165     #== save history in file 'histfile'
1166     #
1167
1168     if (!$matcher or 'histfile histsize' =~ /$matcher/) {
1169         $CPAN::Frontend->myprint($prompts{histfile_intro});
1170         defined($default = $CPAN::Config->{histfile}) or
1171             $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
1172         my_dflt_prompt(histfile => $default, $matcher);
1173
1174         if ($CPAN::Config->{histfile}) {
1175             defined($default = $CPAN::Config->{histsize}) or $default = 100;
1176             my_dflt_prompt(histsize => $default, $matcher);
1177         }
1178     }
1179
1180     #
1181     #== do an ls on the m or the d command
1182     #
1183     my_yn_prompt(show_upload_date => 0, $matcher);
1184
1185     #
1186     #== verbosity at the end of the r command
1187     #
1188     if (!$matcher
1189         or 'show_unparsable_versions' =~ /$matcher/
1190         or 'show_zero_versions' =~ /$matcher/
1191        ) {
1192         $CPAN::Frontend->myprint($prompts{show_unparsable_or_zero_versions_intro});
1193         my_yn_prompt(show_unparsable_versions => 0, $matcher);
1194         my_yn_prompt(show_zero_versions => 0, $matcher);
1195     }
1196
1197     #
1198     #= MIRRORED.BY and conf_sites()
1199     #
1200
1201     my_yn_prompt("connect_to_internet_ok" => 1, $matcher);
1202     if ($matcher) {
1203         if ("urllist" =~ $matcher) {
1204             # conf_sites would go into endless loop with the smash prompt
1205             local *_real_prompt;
1206             *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
1207             conf_sites();
1208         }
1209         if ("randomize_urllist" =~ $matcher) {
1210             my_dflt_prompt(randomize_urllist => 0, $matcher);
1211         }
1212         if ("ftpstats_size" =~ $matcher) {
1213             my_dflt_prompt(ftpstats_size => 99, $matcher);
1214         }
1215         if ("ftpstats_period" =~ $matcher) {
1216             my_dflt_prompt(ftpstats_period => 14, $matcher);
1217         }
1218     } elsif ($fastread) {
1219         $CPAN::Frontend->myprint("Autoconfigured everything but 'urllist'.\n".
1220                                  "Please call 'o conf init urllist' to configure ".
1221                                  "your CPAN server(s) now!\n\n");
1222     } else {
1223         conf_sites();
1224     }
1225
1226     $CPAN::Frontend->myprint("\n\n");
1227     if ($matcher && !$CPAN::Config->{auto_commit}) {
1228         $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ".
1229                                  "make the config permanent!\n\n");
1230     } else {
1231         CPAN::HandleConfig->commit($configpm);
1232     }
1233 }
1234
1235 sub my_dflt_prompt {
1236     my ($item, $dflt, $m) = @_;
1237     my $default = $CPAN::Config->{$item} || $dflt;
1238
1239     $DB::single = 1;
1240     if (!$m || $item =~ /$m/) {
1241         if (my $intro = $prompts{$item . "_intro"}) {
1242             $CPAN::Frontend->myprint($intro);
1243         }
1244         $CPAN::Frontend->myprint(" <$item>\n");
1245         $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
1246         print "\n";
1247     } else {
1248         $CPAN::Config->{$item} = $default;
1249     }
1250 }
1251
1252 sub my_yn_prompt {
1253     my ($item, $dflt, $m) = @_;
1254     my $default;
1255     defined($default = $CPAN::Config->{$item}) or $default = $dflt;
1256
1257     # $DB::single = 1;
1258     if (!$m || $item =~ /$m/) {
1259         if (my $intro = $prompts{$item . "_intro"}) {
1260             $CPAN::Frontend->myprint($intro);
1261         }
1262         $CPAN::Frontend->myprint(" <$item>\n");
1263         my $ans = prompt($prompts{$item}, $default ? 'yes' : 'no');
1264         $CPAN::Config->{$item} = ($ans =~ /^[y1]/i ? 1 : 0);
1265         print "\n";
1266     } else {
1267         $CPAN::Config->{$item} = $default;
1268     }
1269 }
1270
1271 sub my_prompt_loop {
1272     my ($item, $dflt, $m, $ok) = @_;
1273     my $default = $CPAN::Config->{$item} || $dflt;
1274     my $ans;
1275
1276     $DB::single = 1;
1277     if (!$m || $item =~ /$m/) {
1278         $CPAN::Frontend->myprint($prompts{$item . "_intro"});
1279         $CPAN::Frontend->myprint(" <$item>\n");
1280         do { $ans = prompt($prompts{$item}, $default);
1281         } until $ans =~ /$ok/;
1282         $CPAN::Config->{$item} = $ans;
1283         print "\n";
1284     } else {
1285         $CPAN::Config->{$item} = $default;
1286     }
1287 }
1288
1289
1290 sub conf_sites {
1291     my $m = 'MIRRORED.BY';
1292     my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
1293     File::Path::mkpath(File::Basename::dirname($mby));
1294     if (-f $mby && -f $m && -M $m < -M $mby) {
1295         require File::Copy;
1296         File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
1297     }
1298     my $loopcount = 0;
1299     local $^T = time;
1300     my $overwrite_local = 0;
1301     if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) {
1302         my $mtime = localtime((stat _)[9]);
1303         my $prompt = qq{Found $mby as of $mtime
1304
1305 I\'d use that as a database of CPAN sites. If that is OK for you,
1306 please answer 'y', but if you want me to get a new database now,
1307 please answer 'n' to the following question.
1308
1309 Shall I use the local database in $mby?};
1310         my $ans = prompt($prompt,"y");
1311         $overwrite_local = 1 unless $ans =~ /^y/i;
1312     }
1313     while ($mby) {
1314         if ($overwrite_local) {
1315             $CPAN::Frontend->myprint(qq{Trying to overwrite $mby\n});
1316             $mby = CPAN::FTP->localize($m,$mby,3);
1317             $overwrite_local = 0;
1318         } elsif ( ! -f $mby ) {
1319             $CPAN::Frontend->myprint(qq{You have no $mby\n  I\'m trying to fetch one\n});
1320             $mby = CPAN::FTP->localize($m,$mby,3);
1321         } elsif (-M $mby > 60 && $loopcount == 0) {
1322             $CPAN::Frontend->myprint(qq{Your $mby is older than 60 days,\n  I\'m trying }.
1323                                      qq{to fetch one\n});
1324             $mby = CPAN::FTP->localize($m,$mby,3);
1325             $loopcount++;
1326         } elsif (-s $mby == 0) {
1327             $CPAN::Frontend->myprint(qq{You have an empty $mby,\n  I\'m trying to fetch one\n});
1328             $mby = CPAN::FTP->localize($m,$mby,3);
1329         } else {
1330             last;
1331         }
1332     }
1333     local $urllist = [];
1334     read_mirrored_by($mby);
1335     bring_your_own();
1336     $CPAN::Config->{urllist} = $urllist;
1337 }
1338
1339 sub find_exe {
1340     my($exe,$path) = @_;
1341     my($dir);
1342     #warn "in find_exe exe[$exe] path[@$path]";
1343     for $dir (@$path) {
1344         my $abs = File::Spec->catfile($dir,$exe);
1345         if (($abs = MM->maybe_command($abs))) {
1346             return $abs;
1347         }
1348     }
1349 }
1350
1351 sub picklist {
1352     my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
1353     CPAN->debug("picklist('$items','$prompt','$default','$require_nonempty',".
1354                 "'$empty_warning')") if $CPAN::DEBUG;
1355     $default ||= '';
1356
1357     my $pos = 0;
1358
1359     my @nums;
1360   SELECTION: while (1) {
1361
1362         # display, at most, 15 items at a time
1363         my $limit = $#{ $items } - $pos;
1364         $limit = 15 if $limit > 15;
1365
1366         # show the next $limit items, get the new position
1367         $pos = display_some($items, $limit, $pos, $default);
1368         $pos = 0 if $pos >= @$items;
1369
1370         my $num = prompt($prompt,$default);
1371
1372         @nums = split (' ', $num);
1373         {
1374             my %seen;
1375             @nums = grep { !$seen{$_}++ } @nums;
1376         }
1377         my $i = scalar @$items;
1378         unrangify(\@nums);
1379         if (grep (/\D/ || $_ < 1 || $_ > $i, @nums)) {
1380             $CPAN::Frontend->mywarn("invalid items entered, try again\n");
1381             if ("@nums" =~ /\D/) {
1382                 $CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n");
1383             }
1384             next SELECTION;
1385         }
1386         if ($require_nonempty && !@nums) {
1387             $CPAN::Frontend->mywarn("$empty_warning\n");
1388         }
1389         $CPAN::Frontend->myprint("\n");
1390
1391         # a blank line continues...
1392         next SELECTION unless @nums;
1393         last;
1394     }
1395     for (@nums) { $_-- }
1396     @{$items}[@nums];
1397 }
1398
1399 sub unrangify ($) {
1400     my($nums) = $_[0];
1401     my @nums2 = ();
1402     while (@{$nums||[]}) {
1403         my $n = shift @$nums;
1404         if ($n =~ /^(\d+)-(\d+)$/) {
1405             my @range = $1 .. $2;
1406             # warn "range[@range]";
1407             push @nums2, @range;
1408         } else {
1409             push @nums2, $n;
1410         }
1411     }
1412     push @$nums, @nums2;
1413 }
1414
1415 sub display_some {
1416     my ($items, $limit, $pos, $default) = @_;
1417     $pos ||= 0;
1418
1419     my @displayable = @$items[$pos .. ($pos + $limit)];
1420     for my $item (@displayable) {
1421         $CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item);
1422     }
1423     my $hit_what = $default ? "SPACE RETURN" : "RETURN";
1424     $CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n",
1425                                      (@$items - $pos),
1426                                      $hit_what,
1427                                     ))
1428         if $pos < @$items;
1429     return $pos;
1430 }
1431
1432 sub read_mirrored_by {
1433     my $local = shift or return;
1434     my(%all,$url,$expected_size,$default,$ans,$host,
1435        $dst,$country,$continent,@location);
1436     my $fh = FileHandle->new;
1437     $fh->open($local) or die "Couldn't open $local: $!";
1438     local $/ = "\012";
1439     while (<$fh>) {
1440         ($host) = /^([\w\.\-]+)/ unless defined $host;
1441         next unless defined $host;
1442         next unless /\s+dst_(dst|location)/;
1443         /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
1444             ($continent, $country) = @location[-1,-2];
1445         $continent =~ s/\s\(.*//;
1446         $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
1447         /dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
1448         next unless $host && $dst && $continent && $country;
1449         $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
1450         undef $host;
1451         $dst=$continent=$country="";
1452     }
1453     $fh->close;
1454     $CPAN::Config->{urllist} ||= [];
1455     my @previous_urls = @{$CPAN::Config->{urllist}};
1456
1457     $CPAN::Frontend->myprint($prompts{urls_intro});
1458
1459     my (@cont, $cont, %cont, @countries, @urls, %seen);
1460     my $no_previous_warn =
1461         "Sorry! since you don't have any existing picks, you must make a\n" .
1462             "geographic selection.";
1463     my $offer_cont = [sort keys %all];
1464     if (@previous_urls) {
1465         push @$offer_cont, "(edit previous picks)";
1466         $default = @$offer_cont;
1467     }
1468     @cont = picklist($offer_cont,
1469                      "Select your continent (or several nearby continents)",
1470                      $default,
1471                      ! @previous_urls,
1472                      $no_previous_warn);
1473
1474
1475     foreach $cont (@cont) {
1476         my @c = sort keys %{$all{$cont}};
1477         @cont{@c} = map ($cont, 0..$#c);
1478         @c = map ("$_ ($cont)", @c) if @cont > 1;
1479         push (@countries, @c);
1480     }
1481     if (@previous_urls && @countries) {
1482         push @countries, "(edit previous picks)";
1483         $default = @countries;
1484     }
1485
1486     if (@countries) {
1487         @countries = picklist (\@countries,
1488                                "Select your country (or several nearby countries)",
1489                                $default,
1490                                ! @previous_urls,
1491                                $no_previous_warn);
1492         %seen = map (($_ => 1), @previous_urls);
1493         # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
1494         foreach $country (@countries) {
1495             next if $country =~ /edit previous picks/;
1496             (my $bare_country = $country) =~ s/ \(.*\)//;
1497             my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
1498             @u = grep (! $seen{$_}, @u);
1499             @u = map ("$_ ($bare_country)", @u)
1500                 if @countries > 1;
1501             push (@urls, @u);
1502         }
1503     }
1504     push (@urls, map ("$_ (previous pick)", @previous_urls));
1505     my $prompt = "Select as many URLs as you like (by number),
1506 put them on one line, separated by blanks, hyphenated ranges allowed
1507  e.g. '1 4 5' or '7 1-4 8'";
1508     if (@previous_urls) {
1509         $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
1510                          (scalar @urls));
1511         $prompt .= "\n(or just hit RETURN to keep your previous picks)";
1512     }
1513
1514     @urls = picklist (\@urls, $prompt, $default);
1515     foreach (@urls) { s/ \(.*\)//; }
1516     push @$urllist, @urls;
1517 }
1518
1519 sub bring_your_own {
1520     my %seen = map (($_ => 1), @$urllist);
1521     my($ans,@urls);
1522     my $eacnt = 0; # empty answers
1523     do {
1524         my $prompt = "Enter another URL or RETURN to quit:";
1525         unless (%seen) {
1526             $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
1527
1528 Please enter your CPAN site:};
1529         }
1530         $ans = prompt ($prompt, "");
1531
1532         if ($ans) {
1533             $ans =~ s|/?\z|/|; # has to end with one slash
1534             $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
1535             if ($ans =~ /^\w+:\/./) {
1536                 push @urls, $ans unless $seen{$ans}++;
1537             } else {
1538                 $CPAN::Frontend->
1539                     myprint(sprintf(qq{"%s" doesn\'t look like an URL at first sight.
1540 I\'ll ignore it for now.
1541 You can add it to your %s
1542 later if you\'re sure it\'s right.\n},
1543                                    $ans,
1544                                    $INC{'CPAN/MyConfig.pm'}
1545                                    || $INC{'CPAN/Config.pm'}
1546                                    || "configuration file",
1547                                   ));
1548             }
1549         } else {
1550             if (++$eacnt >= 5) {
1551                 $CPAN::Frontend->
1552                     mywarn("Giving up.\n");
1553                 $CPAN::Frontend->mysleep(5);
1554                 return;
1555             }
1556         }
1557     } while $ans || !%seen;
1558
1559     push @$urllist, @urls;
1560     # xxx delete or comment these out when you're happy that it works
1561     $CPAN::Frontend->myprint("New set of picks:\n");
1562     map { $CPAN::Frontend->myprint("  $_\n") } @$urllist;
1563 }
1564
1565
1566 sub _strip_spaces {
1567     $_[0] =~ s/^\s+//;  # no leading spaces
1568     $_[0] =~ s/\s+\z//; # no trailing spaces
1569 }
1570
1571 sub prompt ($;$) {
1572     unless (defined &_real_prompt) {
1573         *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
1574     }
1575     my $ans = _real_prompt(@_);
1576
1577     _strip_spaces($ans);
1578
1579     return $ans;
1580 }
1581
1582
1583 sub prompt_no_strip ($;$) {
1584     return _real_prompt(@_);
1585 }
1586
1587
1588 BEGIN {
1589
1590 my @prompts = (
1591
1592 manual_config => qq[
1593
1594 CPAN is the world-wide archive of perl resources. It consists of about
1595 300 sites that all replicate the same contents around the globe. Many
1596 countries have at least one CPAN site already. The resources found on
1597 CPAN are easily accessible with the CPAN.pm module. If you want to use
1598 CPAN.pm, lots of things have to be configured. Fortunately, most of
1599 them can be determined automatically. If you prefer the automatic
1600 configuration, answer 'yes' below.
1601
1602 If you prefer to enter a dialog instead, you can answer 'no' to this
1603 question and I'll let you configure in small steps one thing after the
1604 other. (Note: you can revisit this dialog anytime later by typing 'o
1605 conf init' at the cpan prompt.)
1606 ],
1607
1608 config_intro => qq{
1609
1610 The following questions are intended to help you with the
1611 configuration. The CPAN module needs a directory of its own to cache
1612 important index files and maybe keep a temporary mirror of CPAN files.
1613 This may be a site-wide or a personal directory.
1614
1615 },
1616
1617 # cpan_home => qq{ },
1618
1619 cpan_home_where => qq{
1620
1621 First of all, I'd like to create this directory. Where?
1622
1623 },
1624
1625 external_progs => qq{
1626
1627 The CPAN module will need a few external programs to work properly.
1628 Please correct me, if I guess the wrong path for a program. Don't
1629 panic if you do not have some of them, just press ENTER for those. To
1630 disable the use of a program, you can type a space followed by ENTER.
1631
1632 },
1633
1634 proxy_intro => qq{
1635
1636 If you're accessing the net via proxies, you can specify them in the
1637 CPAN configuration or via environment variables. The variable in
1638 the \$CPAN::Config takes precedence.
1639
1640 },
1641
1642 proxy_user => qq{
1643
1644 If your proxy is an authenticating proxy, you can store your username
1645 permanently. If you do not want that, just press RETURN. You will then
1646 be asked for your username in every future session.
1647
1648 },
1649
1650 proxy_pass => qq{
1651
1652 Your password for the authenticating proxy can also be stored
1653 permanently on disk. If this violates your security policy, just press
1654 RETURN. You will then be asked for the password in every future
1655 session.
1656
1657 },
1658
1659 urls_intro => qq{
1660
1661 Now we need to know where your favorite CPAN sites are located. Push
1662 a few sites onto the array (just in case the first on the array won\'t
1663 work). If you are mirroring CPAN to your local workstation, specify a
1664 file: URL.
1665
1666 First, pick a nearby continent and country by typing in the number(s)
1667 in front of the item(s) you want to select. You can pick several of
1668 each, separated by spaces. Then, you will be presented with a list of
1669 URLs of CPAN mirrors in the countries you selected, along with
1670 previously selected URLs. Select some of those URLs, or just keep the
1671 old list. Finally, you will be prompted for any extra URLs -- file:,
1672 ftp:, or http: -- that host a CPAN mirror.
1673
1674 },
1675
1676 password_warn => qq{
1677
1678 Warning: Term::ReadKey seems not to be available, your password will
1679 be echoed to the terminal!
1680
1681 },
1682
1683               );
1684
1685 die "Coding error in \@prompts declaration.  Odd number of elements, above"
1686     if (@prompts % 2);
1687
1688 %prompts = @prompts;
1689
1690 if (scalar(keys %prompts) != scalar(@prompts)/2) {
1691     my %already;
1692     for my $item (0..$#prompts) {
1693         next if $item % 2;
1694         die "$prompts[$item] is duplicated\n" if $already{$prompts[$item]}++;
1695     }
1696 }
1697
1698 local *FH;
1699 my $pmfile = __FILE__;
1700 open FH, $pmfile or die "Could not open '$pmfile': $!";
1701 local $/ = "";
1702 my @podpara;
1703 while (<FH>) {
1704     next if 1 .. /^=over/;
1705     chomp;
1706     push @podpara, $_;
1707     last if /^=back/;
1708 }
1709 pop @podpara;
1710 while (@podpara) {
1711     warn "Alert: cannot parse my own manpage for init dialog" unless $podpara[0] =~ s/^=item\s+//;
1712     my $name = shift @podpara;
1713     my @para;
1714     while (@podpara && $podpara[0] !~ /^=item/) {
1715         push @para, shift @podpara;
1716     }
1717     $prompts{$name} = pop @para;
1718     if (@para) {
1719         $prompts{$name . "_intro"} = join "", map { "$_\n\n" } @para;
1720     }
1721 }
1722
1723 } # EOBEGIN
1724
1725 1;