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