File Coverage

blib/lib/CPAN/FirstTime.pm
Criterion Covered Total %
statement 33 672 4.9
branch 0 400 0.0
condition 0 232 0.0
subroutine 11 42 26.1
pod 0 15 0.0
total 44 1361 3.2


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