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