File Coverage

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