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