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