File Coverage

blib/lib/CPAN/FirstTime.pm
Criterion Covered Total %
statement 33 678 4.8
branch 0 402 0.0
condition 0 232 0.0
subroutine 11 42 26.1
pod 0 15 0.0
total 44 1369 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   71688 use strict;
  4         20  
  4         121  
5              
6 4     4   1383 use ExtUtils::MakeMaker ();
  4         189274  
  4         110  
7 4     4   749 use FileHandle ();
  4         16716  
  4         90  
8 4     4   21 use File::Basename ();
  4         13  
  4         52  
9 4     4   17 use File::Path ();
  4         14  
  4         69  
10 4     4   29 use File::Spec ();
  4         11  
  4         59  
11 4     4   1862 use CPAN::Mirrors ();
  4         10  
  4         83  
12 4     4   21 use CPAN::Version ();
  4         7  
  4         67  
13 4     4   18 use vars qw($VERSION $auto_config);
  4         6  
  4         994  
14             $VERSION = "5.5317";
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   25 use vars qw( %prompts );
  4         23  
  4         1322  
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   24 use Config;
  4         7  
  4         30188  
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             $ENV{PAGER} || find_exe("less",\@path) ||
1040 0   0       find_exe("more",\@path) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 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         if ($^O eq 'MacOS') {
1055 0           $CPAN::Config->{'shell'} = 'not_here';
1056             } else {
1057 0 0 0       $path ||= 'sh', $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
1058 0           my_dflt_prompt(shell => $path, $matcher);
1059             }
1060             }
1061              
1062             {
1063 0           my $tar = $CPAN::Config->{tar};
  0            
  0            
1064 0           my $prefer_external_tar = $CPAN::Config->{prefer_external_tar}; # XXX not yet supported
1065 0 0         unless (defined $prefer_external_tar) {
1066 0 0         if ($^O =~ /(MSWin32|solaris)/) {
    0          
1067             # both have a record of broken tars
1068 0           $prefer_external_tar = 0;
1069             } elsif ($tar) {
1070 0           $prefer_external_tar = 1;
1071             } else {
1072 0           $prefer_external_tar = 0;
1073             }
1074             }
1075 0           my_yn_prompt(prefer_external_tar => $prefer_external_tar, $matcher);
1076             }
1077              
1078             #
1079             # verbosity
1080             #
1081              
1082 0           my_prompt_loop(tar_verbosity => 'none', $matcher,
1083             'none|v|vv');
1084 0           my_prompt_loop(load_module_verbosity => 'none', $matcher,
1085             'none|v');
1086 0           my_prompt_loop(perl5lib_verbosity => 'none', $matcher,
1087             'none|v');
1088 0           my_yn_prompt(inhibit_startup_message => 0, $matcher);
1089              
1090             #
1091             #= Installer, arguments to make etc.
1092             #
1093              
1094 0           my_prompt_loop(prefer_installer => 'MB', $matcher, 'MB|EUMM|RAND');
1095              
1096 0 0 0       if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/) {
1097 0           my_dflt_prompt(makepl_arg => "", $matcher);
1098 0           my_dflt_prompt(make_arg => "", $matcher);
1099 0 0         if ( $CPAN::Config->{makepl_arg} =~ /LIBS=|INC=/ ) {
1100 0           $CPAN::Frontend->mywarn(
1101             "Warning: Using LIBS or INC in makepl_arg will likely break distributions\n" .
1102             "that specify their own LIBS or INC options in Makefile.PL.\n"
1103             );
1104             }
1105              
1106             }
1107              
1108 0           require CPAN::HandleConfig;
1109 0 0         if (exists $CPAN::HandleConfig::keys{make_install_make_command}) {
1110             # as long as Windows needs $self->_build_command, we cannot
1111             # support sudo on windows :-)
1112 0   0       my $default = $CPAN::Config->{make} || "";
1113 0 0 0       if ( $default && $CPAN::Config->{install_help} eq 'sudo' ) {
1114 0 0         if ( find_exe('sudo') ) {
1115 0           $default = "sudo $default";
1116             delete $CPAN::Config->{make_install_make_command}
1117 0 0         unless $CPAN::Config->{make_install_make_command} =~ /sudo/;
1118             }
1119             else {
1120 0           $CPAN::Frontend->mywarnonce("Could not find 'sudo' in PATH\n");
1121             }
1122             }
1123 0           my_dflt_prompt(make_install_make_command => $default, $matcher);
1124             }
1125              
1126 0   0       my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "",
1127             $matcher);
1128              
1129 0           my_dflt_prompt(mbuildpl_arg => "", $matcher);
1130 0           my_dflt_prompt(mbuild_arg => "", $matcher);
1131              
1132 0 0 0       if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command}
1133             and $^O ne "MSWin32") {
1134             # as long as Windows needs $self->_build_command, we cannot
1135             # support sudo on windows :-)
1136 0 0         my $default = $^O eq 'VMS' ? '@Build.com' : "./Build";
1137 0 0         if ( $CPAN::Config->{install_help} eq 'sudo' ) {
1138 0 0         if ( find_exe('sudo') ) {
1139 0           $default = "sudo $default";
1140             delete $CPAN::Config->{mbuild_install_build_command}
1141 0 0         unless $CPAN::Config->{mbuild_install_build_command} =~ /sudo/;
1142             }
1143             else {
1144 0           $CPAN::Frontend->mywarnonce("Could not find 'sudo' in PATH\n");
1145             }
1146             }
1147 0           my_dflt_prompt(mbuild_install_build_command => $default, $matcher);
1148             }
1149              
1150 0           my_dflt_prompt(mbuild_install_arg => "", $matcher);
1151              
1152 0           for my $o (qw(
1153             allow_installing_outdated_dists
1154             allow_installing_module_downgrades
1155             )) {
1156 0           my_prompt_loop($o => 'ask/no', $matcher,
1157             'yes|no|ask/yes|ask/no');
1158             }
1159              
1160             #
1161             #== use_prompt_default
1162             #
1163 0           my_yn_prompt(use_prompt_default => 0, $matcher);
1164              
1165             #
1166             #= Alarm period
1167             #
1168              
1169 0           my_dflt_prompt(inactivity_timeout => 0, $matcher);
1170 0           my_dflt_prompt(version_timeout => 15, $matcher);
1171              
1172             #
1173             #== halt_on_failure
1174             #
1175 0           my_yn_prompt(halt_on_failure => 0, $matcher);
1176              
1177             #
1178             #= Proxies
1179             #
1180              
1181 0           my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/;
1182 0           my @proxy_user_vars = qw/proxy_user proxy_pass/;
1183 0 0 0       if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/) {
1184 0 0         $CPAN::Frontend->myprint($prompts{proxy_intro}) unless $auto_config;
1185              
1186 0           for (@proxy_vars) {
1187 0           $prompts{$_} = "Your $_?";
1188 0   0       my_dflt_prompt($_ => $ENV{$_}||"", $matcher);
1189             }
1190              
1191 0 0 0       if ($CPAN::Config->{ftp_proxy} ||
1192             $CPAN::Config->{http_proxy}) {
1193              
1194 0   0       $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || "";
1195              
1196 0 0         $CPAN::Frontend->myprint($prompts{proxy_user}) unless $auto_config;
1197              
1198 0 0         if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
1199 0 0         $CPAN::Frontend->myprint($prompts{proxy_pass}) unless $auto_config;
1200              
1201 0 0         if ($CPAN::META->has_inst("Term::ReadKey")) {
1202 0           Term::ReadKey::ReadMode("noecho");
1203             } else {
1204 0 0         $CPAN::Frontend->myprint($prompts{password_warn}) unless $auto_config;
1205             }
1206 0           $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
1207 0 0         if ($CPAN::META->has_inst("Term::ReadKey")) {
1208 0           Term::ReadKey::ReadMode("restore");
1209             }
1210 0 0         $CPAN::Frontend->myprint("\n\n") unless $auto_config;
1211             }
1212             }
1213             }
1214              
1215             #
1216             #= how plugins work
1217             #
1218              
1219             # XXX MISSING: my_array_prompt to be used with plugins. We did something like this near
1220             # git log -p fd68f8f5e33f4cecea4fdb7abc5ee19c12f138f0..test-notest-test-dependency
1221             # Need to do similar steps for plugin_list. As long as we do not support it here, people
1222             # must use the cpan shell prompt to write something like
1223             # o conf plugin_list push CPAN::Plugin::Specfile=dir,/tmp/foo-20141013,...
1224             # o conf commit
1225              
1226             #
1227             #= how FTP works
1228             #
1229              
1230 0           my_yn_prompt(ftp_passive => 1, $matcher);
1231              
1232             #
1233             #= how cwd works
1234             #
1235              
1236 0           my_prompt_loop(getcwd => 'cwd', $matcher,
1237             'cwd|getcwd|fastcwd|getdcwd|backtickcwd');
1238              
1239             #
1240             #= the CPAN shell itself (prompt, color)
1241             #
1242              
1243 0           my_yn_prompt(commandnumber_in_prompt => 1, $matcher);
1244 0           my_yn_prompt(term_ornaments => 1, $matcher);
1245 0 0         if ("colorize_output colorize_print colorize_warn colorize_debug" =~ $matcher) {
1246 0           my_yn_prompt(colorize_output => 0, $matcher);
1247 0 0         if ($CPAN::Config->{colorize_output}) {
1248 0 0         if ($CPAN::META->has_inst("Term::ANSIColor")) {
1249 0           my $T="gYw";
1250 0 0         $CPAN::Frontend->myprint( " on_ on_y ".
1251             " on_ma on_\n") unless $auto_config;
1252 0 0         $CPAN::Frontend->myprint( " on_black on_red green ellow ".
1253             "on_blue genta on_cyan white\n") unless $auto_config;
1254              
1255 0           for my $FG ("", "bold",
1256 0           map {$_,"bold $_"} "black","red","green",
1257             "yellow","blue",
1258             "magenta",
1259             "cyan","white") {
1260 0 0         $CPAN::Frontend->myprint(sprintf( "%12s ", $FG)) unless $auto_config;
1261 0           for my $BG ("",map {"on_$_"} qw(black red green yellow
  0            
1262             blue magenta cyan white)) {
1263 0 0 0       $CPAN::Frontend->myprint( $FG||$BG ?
    0          
1264             Term::ANSIColor::colored(" $T ","$FG $BG") : " $T ") unless $auto_config;
1265             }
1266 0 0         $CPAN::Frontend->myprint( "\n" ) unless $auto_config;
1267             }
1268 0 0         $CPAN::Frontend->myprint( "\n" ) unless $auto_config;
1269             }
1270 0           for my $tuple (
1271             ["colorize_print", "bold blue on_white"],
1272             ["colorize_warn", "bold red on_white"],
1273             ["colorize_debug", "black on_cyan"],
1274             ) {
1275 0           my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher);
1276 0 0         if ($CPAN::META->has_inst("Term::ANSIColor")) {
1277 0           eval { Term::ANSIColor::color($CPAN::Config->{$tuple->[0]})};
  0            
1278 0 0         if ($@) {
1279 0           $CPAN::Config->{$tuple->[0]} = $tuple->[1];
1280 0           $CPAN::Frontend->mywarn($@."setting to default '$tuple->[1]'\n");
1281             }
1282             }
1283             }
1284             }
1285             }
1286              
1287             #
1288             #== term_is_latin
1289             #
1290              
1291 0           my_yn_prompt(term_is_latin => 1, $matcher);
1292              
1293             #
1294             #== save history in file 'histfile'
1295             #
1296              
1297 0 0 0       if (!$matcher or 'histfile histsize' =~ /$matcher/) {
1298 0 0         $CPAN::Frontend->myprint($prompts{histfile_intro}) unless $auto_config;
1299             defined($default = $CPAN::Config->{histfile}) or
1300 0 0         $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
1301 0           my_dflt_prompt(histfile => $default, $matcher);
1302              
1303 0 0         if ($CPAN::Config->{histfile}) {
1304 0 0         defined($default = $CPAN::Config->{histsize}) or $default = 100;
1305 0           my_dflt_prompt(histsize => $default, $matcher);
1306             }
1307             }
1308              
1309             #
1310             #== do an ls on the m or the d command
1311             #
1312 0           my_yn_prompt(show_upload_date => 0, $matcher);
1313              
1314             #
1315             #== verbosity at the end of the r command
1316             #
1317 0 0 0       if (!$matcher
      0        
1318             or 'show_unparsable_versions' =~ /$matcher/
1319             or 'show_zero_versions' =~ /$matcher/
1320             ) {
1321 0           my_yn_prompt(show_unparsable_versions => 0, $matcher);
1322 0           my_yn_prompt(show_zero_versions => 0, $matcher);
1323             }
1324              
1325             #
1326             #= MIRRORED.BY and conf_sites()
1327             #
1328              
1329             # Let's assume they want to use the internet and make them turn it
1330             # off if they really don't.
1331 0           my_yn_prompt("connect_to_internet_ok" => 1, $matcher);
1332 0           my_yn_prompt("pushy_https" => 1, $matcher);
1333              
1334             # Allow matching but don't show during manual config
1335 0 0         if ($matcher) {
1336 0 0         if ("urllist_ping_external" =~ $matcher) {
1337 0           my_yn_prompt(urllist_ping_external => 0, $matcher);
1338             }
1339 0 0         if ("urllist_ping_verbose" =~ $matcher) {
1340 0           my_yn_prompt(urllist_ping_verbose => 0, $matcher);
1341             }
1342 0 0         if ("randomize_urllist" =~ $matcher) {
1343 0           my_dflt_prompt(randomize_urllist => 0, $matcher);
1344             }
1345 0 0         if ("ftpstats_size" =~ $matcher) {
1346 0           my_dflt_prompt(ftpstats_size => 99, $matcher);
1347             }
1348 0 0         if ("ftpstats_period" =~ $matcher) {
1349 0           my_dflt_prompt(ftpstats_period => 14, $matcher);
1350             }
1351             }
1352              
1353 0   0       $CPAN::Config->{urllist} ||= [];
1354              
1355 0 0 0       if ($auto_config) {
    0          
1356 0 0         if(@{ $CPAN::Config->{urllist} }) {
  0            
1357 0           $CPAN::Frontend->myprint(
1358             "Your 'urllist' is already configured. Type 'o conf init urllist' to change it.\n"
1359             );
1360             }
1361             else {
1362             # Hint: as of 2021-11: to get http, use http://www.cpan.org/
1363 0           $CPAN::Config->{urllist} = [ 'https://cpan.org/' ];
1364 0           $CPAN::Frontend->myprint(
1365 0           "We initialized your 'urllist' to @{$CPAN::Config->{urllist}}. Type 'o conf init urllist' to change it.\n"
1366             );
1367             }
1368             }
1369             elsif (!$matcher || "urllist" =~ $matcher) {
1370 0           _do_pick_mirrors();
1371             }
1372              
1373 0 0         if ($auto_config) {
1374 0           $CPAN::Frontend->myprint(
1375             "\nAutoconfiguration complete.\n"
1376             );
1377 0           $auto_config = 0; # reset
1378             }
1379              
1380             # bootstrap local::lib now if requested
1381 0 0         if ( $CPAN::Config->{install_help} eq 'local::lib' ) {
1382 0 0         if ( ! @{ $CPAN::Config->{urllist} } ) {
  0 0          
1383 0           $CPAN::Frontend->myprint(
1384             "\nALERT: Skipping local::lib bootstrap because 'urllist' is not configured.\n"
1385             );
1386             }
1387             elsif (! $CPAN::Config->{make} ) {
1388 0           $CPAN::Frontend->mywarn(
1389             "\nALERT: Skipping local::lib bootstrap because 'make' is not configured.\n"
1390             );
1391 0           _beg_for_make(); # repetitive, but we don't want users to miss it
1392             }
1393             else {
1394 0           $CPAN::Frontend->myprint("\nAttempting to bootstrap local::lib...\n");
1395 0           $CPAN::Frontend->myprint("\nWriting $configpm for bootstrap...\n");
1396 0           delete $CPAN::Config->{install_help}; # temporary only
1397 0           CPAN::HandleConfig->commit;
1398 0           my($dist, $locallib);
1399 0           $locallib = CPAN::Shell->expand('Module', 'local::lib');
1400 0 0 0       if ( $locallib and $dist = $locallib->distribution ) {
1401             # this is a hack to force bootstrapping
1402 0           $dist->{prefs}{pl}{commandline} = "$^X Makefile.PL --bootstrap";
1403             # Set @INC for this process so we find things as they bootstrap
1404 0           require lib;
1405 0           lib->import(_local_lib_inc_path());
1406 0           eval { $dist->install };
  0            
1407             }
1408 0 0 0       if ( ! $dist || (my $err = $@) ) {
1409 0   0       $err ||= 'Could not locate local::lib in the CPAN index';
1410 0           $CPAN::Frontend->mywarn("Error bootstrapping local::lib: $@\n");
1411 0           $CPAN::Frontend->myprint("From the CPAN Shell, you might try 'look local::lib' and \n"
1412             . "run 'perl Makefile --bootstrap' and see if that is successful. Then\n"
1413             . "restart your CPAN client\n"
1414             );
1415             }
1416             else {
1417 0           _local_lib_config();
1418             }
1419             }
1420             }
1421              
1422             # install_help is temporary for configuration and not saved
1423 0           delete $CPAN::Config->{install_help};
1424              
1425 0           $CPAN::Frontend->myprint("\n");
1426 0 0 0       if ($matcher && !$CPAN::Config->{auto_commit}) {
1427 0           $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ".
1428             "make the config permanent!\n");
1429             } else {
1430 0           CPAN::HandleConfig->commit;
1431             }
1432              
1433 0 0         if (! $matcher) {
1434 0           $CPAN::Frontend->myprint(
1435             "\nYou can re-run configuration any time with 'o conf init' in the CPAN shell\n"
1436             );
1437             }
1438              
1439             }
1440              
1441             sub _local_lib_config {
1442             # Set environment stuff for this process
1443 0     0     require local::lib;
1444              
1445             # Tell user about environment vars to set
1446 0           $CPAN::Frontend->myprint($prompts{local_lib_installed});
1447 0   0       local $ENV{SHELL} = $CPAN::Config->{shell} || $ENV{SHELL};
1448 0           my $shellvars = local::lib->environment_vars_string_for(_local_lib_path());
1449 0           $CPAN::Frontend->myprint($shellvars);
1450              
1451             # Set %ENV after getting string above
1452 0           my %env = local::lib->build_environment_vars_for(_local_lib_path(), 1);
1453 0           while ( my ($k, $v) = each %env ) {
1454 0           $ENV{$k} = $v;
1455             }
1456              
1457             # Offer to mangle the shell config
1458 0           my $munged_rc;
1459 0 0         if ( my $rc = _find_shell_config() ) {
1460 0           local $auto_config = 0; # We *must* ask, even under autoconfig
1461 0           local *_real_prompt; # We *must* show prompt
1462 0           my $_conf = prompt(
1463             "\nWould you like me to append that to $rc now?", "yes"
1464             );
1465 0 0         if ($_conf =~ /^y/i) {
1466 0           open my $fh, ">>", $rc;
1467 0           print {$fh} "\n$shellvars";
  0            
1468 0           close $fh;
1469 0           $munged_rc++;
1470             }
1471             }
1472              
1473             # Warn at exit time
1474 0 0         if ($munged_rc) {
1475 0           push @{$CPAN::META->_exit_messages}, << "HERE";
  0            
1476              
1477             *** Remember to restart your shell before running cpan again ***
1478             HERE
1479             }
1480             else {
1481 0           push @{$CPAN::META->_exit_messages}, << "HERE";
  0            
1482              
1483             *** Remember to add these environment variables to your shell config
1484             and restart your shell before running cpan again ***
1485              
1486             $shellvars
1487             HERE
1488             }
1489             }
1490              
1491             {
1492             my %shell_rc_map = (
1493             map { $_ => ".${_}rc" } qw/ bash tcsh csh /,
1494             map { $_ => ".profile" } qw/dash ash sh/,
1495             zsh => ".zshenv",
1496             );
1497              
1498             sub _find_shell_config {
1499 0     0     my $shell = File::Basename::basename($CPAN::Config->{shell});
1500 0 0         if ( my $rc = $shell_rc_map{$shell} ) {
1501 0           my $path = File::Spec->catfile($ENV{HOME}, $rc);
1502 0 0         return $path if -w $path;
1503             }
1504             }
1505             }
1506              
1507              
1508             sub _local_lib_inc_path {
1509 0     0     return File::Spec->catdir(_local_lib_path(), qw/lib perl5/);
1510             }
1511              
1512             sub _local_lib_path {
1513 0     0     return File::Spec->catdir(_local_lib_home(), 'perl5');
1514             }
1515              
1516             # Adapted from resolve_home_path() in local::lib -- this is where
1517             # local::lib thinks the user's home is
1518             {
1519             my $local_lib_home;
1520             sub _local_lib_home {
1521 0   0 0     $local_lib_home ||= File::Spec->rel2abs( do {
1522 0 0 0       if ($CPAN::META->has_usable("File::HomeDir") && File::HomeDir->VERSION >= 0.65) {
    0          
1523 0           File::HomeDir->my_home;
1524             } elsif (defined $ENV{HOME}) {
1525 0           $ENV{HOME};
1526             } else {
1527 0 0         (getpwuid $<)[7] || "~";
1528             }
1529             });
1530             }
1531             }
1532              
1533             sub _do_pick_mirrors {
1534 0     0     local *_real_prompt;
1535 0           *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
1536 0           $CPAN::Frontend->myprint($prompts{urls_intro});
1537             # Only prompt for auto-pick if Net::Ping is new enough to do timings
1538 0           my $_conf = 'n';
1539 0 0 0       if ( $CPAN::META->has_usable("Net::Ping") && CPAN::Version->vgt(Net::Ping->VERSION, '2.13')) {
1540 0           $_conf = prompt($prompts{auto_pick}, "yes");
1541             } else {
1542 0           prompt("Autoselection disabled due to Net::Ping missing or insufficient. Please press ENTER");
1543             }
1544 0           my @old_list = @{ $CPAN::Config->{urllist} };
  0            
1545 0 0         if ( $_conf =~ /^y/i ) {
1546 0 0         conf_sites( auto_pick => 1 ) or bring_your_own();
1547             }
1548             else {
1549 0 0         _print_urllist('Current') if @old_list;
1550 0 0         my $msg = scalar @old_list
1551             ? "\nWould you like to edit the urllist or pick new mirrors from a list?"
1552             : "\nWould you like to pick from the CPAN mirror list?" ;
1553 0           my $_conf = prompt($msg, "yes");
1554 0 0         if ( $_conf =~ /^y/i ) {
1555 0           conf_sites();
1556             }
1557 0           bring_your_own();
1558             }
1559 0           _print_urllist('New');
1560             }
1561              
1562             sub _init_external_progs {
1563 0     0     my($matcher,$args) = @_;
1564 0           my $PATH = $args->{path};
1565 0           my @external_progs = @{ $args->{progs} };
  0            
1566 0           my $shortcut = $args->{shortcut};
1567 0           my $showed_make_warning;
1568              
1569 0 0 0       if (!$matcher or "@external_progs" =~ /$matcher/) {
1570 0           my $old_warn = $^W;
1571 0 0         local $^W if $^O eq 'MacOS';
1572 0           local $^W = $old_warn;
1573 0           my $progname;
1574 0           for $progname (@external_progs) {
1575 0 0 0       next if $matcher && $progname !~ /$matcher/;
1576 0 0         if ($^O eq 'MacOS') {
1577 0           $CPAN::Config->{$progname} = 'not_here';
1578 0           next;
1579             }
1580              
1581 0           my $progcall = $progname;
1582 0 0         unless ($matcher) {
1583             # we really don't need ncftp if we have ncftpget, but
1584             # if they chose this dialog via matcher, they shall have it
1585 0 0 0       next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
1586             }
1587             my $path = $CPAN::Config->{$progname}
1588 0   0       || $Config::Config{$progname}
1589             || "";
1590 0 0         if (File::Spec->file_name_is_absolute($path)) {
    0          
1591             # testing existence is not good enough, some have these exe
1592             # extensions
1593              
1594             # warn "Warning: configured $path does not exist\n" unless -e $path;
1595             # $path = "";
1596             } elsif ($path =~ /^\s+$/) {
1597             # preserve disabled programs
1598             } else {
1599 0           $path = '';
1600             }
1601 0 0         unless ($path) {
1602             # e.g. make -> nmake
1603 0 0         $progcall = $Config::Config{$progname} if $Config::Config{$progname};
1604             }
1605              
1606 0   0       $path ||= find_exe($progcall,$PATH);
1607 0 0         unless ($path) { # not -e $path, because find_exe already checked that
1608 0           local $"=";";
1609 0 0         $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@$PATH]\n") unless $auto_config;
1610 0 0         _beg_for_make(), $showed_make_warning++ if $progname eq "make";
1611             }
1612 0           $prompts{$progname} = "Where is your $progname program?";
1613 0           $path = my_dflt_prompt($progname,$path,$matcher,1); # 1 => no strip spaces
1614 0           my $disabling = $path =~ m/^\s*$/;
1615              
1616             # don't let them disable or misconfigure make without warning
1617 0 0 0       if ( $progname eq "make" && ( $disabling || ! _check_found($path) ) ) {
    0 0        
    0          
1618 0 0 0       if ( $disabling && $showed_make_warning ) {
1619 0           next;
1620             }
1621             else {
1622 0 0         _beg_for_make() unless $showed_make_warning++;
1623 0           undef $CPAN::Config->{$progname};
1624 0           $CPAN::Frontend->mywarn("Press SPACE and ENTER to disable make (NOT RECOMMENDED)\n");
1625 0           redo;
1626             }
1627             }
1628             elsif ( $disabling ) {
1629 0           next;
1630             }
1631             elsif ( _check_found( $CPAN::Config->{$progname} ) ) {
1632 0 0 0       last if $shortcut && !$matcher;
1633             }
1634             else {
1635 0           undef $CPAN::Config->{$progname};
1636 0           $CPAN::Frontend->mywarn("Press SPACE and ENTER to disable $progname\n");
1637 0           redo;
1638             }
1639             }
1640             }
1641             }
1642              
1643             sub _check_found {
1644 0     0     my ($prog) = @_;
1645 0 0         if ( ! -f $prog ) {
    0          
1646 0 0         $CPAN::Frontend->mywarn("Warning: '$prog' does not exist\n")
1647             unless $auto_config;
1648 0           return;
1649             }
1650             elsif ( ! -x $prog ) {
1651 0 0         $CPAN::Frontend->mywarn("Warning: '$prog' is not executable\n")
1652             unless $auto_config;
1653 0           return;
1654             }
1655 0           return 1;
1656             }
1657              
1658             sub _beg_for_make {
1659 0     0     $CPAN::Frontend->mywarn(<<"HERE");
1660              
1661             ALERT: 'make' is an essential tool for building perl Modules.
1662             Please make sure you have 'make' (or some equivalent) working.
1663              
1664             HERE
1665 0 0         if ($^O eq "MSWin32") {
1666 0           $CPAN::Frontend->mywarn(<<"HERE");
1667             Windows users may want to follow this procedure when back in the CPAN shell:
1668              
1669             look YVES/scripts/alien_nmake.pl
1670             perl alien_nmake.pl
1671              
1672             This will install nmake on your system which can be used as a 'make'
1673             substitute.
1674              
1675             HERE
1676             }
1677              
1678 0           $CPAN::Frontend->mywarn(<<"HERE");
1679             You can then retry the 'make' configuration step with
1680              
1681             o conf init make
1682              
1683             HERE
1684             }
1685              
1686             sub init_cpan_home {
1687 0     0 0   my($matcher) = @_;
1688 0 0 0       if (!$matcher or 'cpan_home' =~ /$matcher/) {
1689             my $cpan_home =
1690 0   0       $CPAN::Config->{cpan_home} || CPAN::HandleConfig::cpan_home();
1691 0 0         if (-d $cpan_home) {
1692 0 0         $CPAN::Frontend->myprint(
1693             "\nI see you already have a directory\n" .
1694             "\n$cpan_home\n" .
1695             "Shall we use it as the general CPAN build and cache directory?\n\n"
1696             ) unless $auto_config;
1697             } else {
1698             # no cpan-home, must prompt and get one
1699 0 0         $CPAN::Frontend->myprint($prompts{cpan_home_where}) unless $auto_config;
1700             }
1701              
1702 0           my $default = $cpan_home;
1703 0           my $loop = 0;
1704 0           my($last_ans,$ans);
1705 0 0         $CPAN::Frontend->myprint(" \n") unless $auto_config;
1706 0           PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) {
1707 0 0         if (File::Spec->file_name_is_absolute($ans)) {
1708 0           my @cpan_home = split /[\/\\]/, $ans;
1709 0           DIR: for my $dir (@cpan_home) {
1710 0 0 0       if ($dir =~ /^~/ and (!$last_ans or $ans ne $last_ans)) {
      0        
1711 0           $CPAN::Frontend
1712             ->mywarn("Warning: a tilde in the path will be ".
1713             "taken as a literal tilde. Please ".
1714             "confirm again if you want to keep it\n");
1715 0           $last_ans = $default = $ans;
1716 0           next PROMPT;
1717             }
1718             }
1719             } else {
1720 0           require Cwd;
1721 0           my $cwd = Cwd::cwd();
1722 0           my $absans = File::Spec->catdir($cwd,$ans);
1723 0           $CPAN::Frontend->mywarn("The path '$ans' is not an ".
1724             "absolute path. Please specify ".
1725             "an absolute path\n");
1726 0           $default = $absans;
1727 0           next PROMPT;
1728             }
1729 0           eval { File::Path::mkpath($ans); }; # dies if it can't
  0            
1730 0 0         if ($@) {
1731 0           $CPAN::Frontend->mywarn("Couldn't create directory $ans.\n".
1732             "Please retry.\n");
1733 0           next PROMPT;
1734             }
1735 0 0 0       if (-d $ans && -w _) {
1736 0           last PROMPT;
1737             } else {
1738 0           $CPAN::Frontend->mywarn("Couldn't find directory $ans\n".
1739             "or directory is not writable. Please retry.\n");
1740 0 0         if (++$loop > 5) {
1741 0           $CPAN::Frontend->mydie("Giving up");
1742             }
1743             }
1744             }
1745 0           $CPAN::Config->{cpan_home} = $ans;
1746             }
1747             }
1748              
1749             sub my_dflt_prompt {
1750 0     0 0   my ($item, $dflt, $m, $no_strip) = @_;
1751 0   0       my $default = $CPAN::Config->{$item} || $dflt;
1752              
1753 0 0 0       if (!$auto_config && (!$m || $item =~ /$m/)) {
      0        
1754 0 0         if (my $intro = $prompts{$item . "_intro"}) {
1755 0           $CPAN::Frontend->myprint($intro);
1756             }
1757 0           $CPAN::Frontend->myprint(" <$item>\n");
1758             $CPAN::Config->{$item} =
1759             $no_strip ? prompt_no_strip($prompts{$item}, $default)
1760 0 0         : prompt( $prompts{$item}, $default);
1761             } else {
1762 0           $CPAN::Config->{$item} = $default;
1763             }
1764 0           return $CPAN::Config->{$item};
1765             }
1766              
1767             sub my_yn_prompt {
1768 0     0 0   my ($item, $dflt, $m) = @_;
1769 0           my $default;
1770 0 0         defined($default = $CPAN::Config->{$item}) or $default = $dflt;
1771              
1772 0 0 0       if (!$auto_config && (!$m || $item =~ /$m/)) {
      0        
1773 0 0         if (my $intro = $prompts{$item . "_intro"}) {
1774 0           $CPAN::Frontend->myprint($intro);
1775             }
1776 0           $CPAN::Frontend->myprint(" <$item>\n");
1777 0 0         my $ans = prompt($prompts{$item}, $default ? 'yes' : 'no');
1778 0 0         $CPAN::Config->{$item} = ($ans =~ /^[y1]/i ? 1 : 0);
1779             } else {
1780 0           $CPAN::Config->{$item} = $default;
1781             }
1782             }
1783              
1784             sub my_prompt_loop {
1785 0     0 0   my ($item, $dflt, $m, $ok) = @_;
1786 0   0       my $default = $CPAN::Config->{$item} || $dflt;
1787 0           my $ans;
1788              
1789 0 0 0       if (!$auto_config && (!$m || $item =~ /$m/)) {
      0        
1790 0           my $intro = $prompts{$item . "_intro"};
1791 0 0         $CPAN::Frontend->myprint($intro) if defined $intro;
1792 0           $CPAN::Frontend->myprint(" <$item>\n");
1793 0           do { $ans = prompt($prompts{$item}, $default);
  0            
1794             } until $ans =~ /$ok/;
1795 0           $CPAN::Config->{$item} = $ans;
1796             } else {
1797 0           $CPAN::Config->{$item} = $default;
1798             }
1799             }
1800              
1801              
1802             # Here's the logic about the MIRRORED.BY file. There are a number of scenarios:
1803             # (1) We have a cached MIRRORED.BY file
1804             # (1a) We're auto-picking
1805             # - Refresh it automatically if it's old
1806             # (1b) Otherwise, ask if using cached is ok. If old, default to no.
1807             # - If cached is not ok, get it from the Internet. If it succeeds we use
1808             # the new file. Otherwise, we use the old file.
1809             # (2) We don't have a copy at all
1810             # (2a) If we are allowed to connect, we try to get a new copy. If it succeeds,
1811             # we use it, otherwise, we warn about failure
1812             # (2b) If we aren't allowed to connect,
1813              
1814             sub conf_sites {
1815 0     0 0   my %args = @_;
1816             # auto pick implies using the internet
1817 0 0         $CPAN::Config->{connect_to_internet_ok} = 1 if $args{auto_pick};
1818              
1819 0           my $m = 'MIRRORED.BY';
1820 0           my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
1821 0           File::Path::mkpath(File::Basename::dirname($mby));
1822             # Why are we using MIRRORED.BY from the current directory?
1823             # Is this for testing? -- dagolden, 2009-11-05
1824 0 0 0       if (-f $mby && -f $m && -M $m < -M $mby) {
      0        
1825 0           require File::Copy;
1826 0 0         File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
1827             }
1828 0           local $^T = time;
1829             # if we have a cached copy is not older than 60 days, we either
1830             # use it or refresh it or fall back to it if the refresh failed.
1831 0 0 0       if ($mby && -f $mby && -s _ > 0 ) {
      0        
1832 0           my $very_old = (-M $mby > 60);
1833 0           my $mtime = localtime((stat _)[9]);
1834             # if auto_pick, refresh anything old automatically
1835 0 0         if ( $args{auto_pick} ) {
1836 0 0         if ( $very_old ) {
1837 0           $CPAN::Frontend->myprint(qq{Trying to refresh your mirror list\n});
1838 0 0         eval { CPAN::FTP->localize($m,$mby,3,1) }
  0            
1839             or $CPAN::Frontend->myprint(qq{Refresh failed. Using the old cached copy instead.\n});
1840 0           $CPAN::Frontend->myprint("\n");
1841             }
1842             }
1843             else {
1844 0           my $prompt = qq{Found a cached mirror list as of $mtime
1845              
1846             If you'd like to just use the cached copy, answer 'yes', below.
1847             If you'd like an updated copy of the mirror list, answer 'no' and
1848             I'll get a fresh one from the Internet.
1849              
1850             Shall I use the cached mirror list?};
1851 0 0         my $ans = prompt($prompt, $very_old ? "no" : "yes");
1852 0 0         if ($ans =~ /^n/i) {
1853 0           $CPAN::Frontend->myprint(qq{Trying to refresh your mirror list\n});
1854             # you asked for it from the Internet
1855 0           $CPAN::Config->{connect_to_internet_ok} = 1;
1856 0 0         eval { CPAN::FTP->localize($m,$mby,3,1) }
  0            
1857             or $CPAN::Frontend->myprint(qq{Refresh failed. Using the old cached copy instead.\n});
1858 0           $CPAN::Frontend->myprint("\n");
1859             }
1860             }
1861             }
1862             # else there is no cached copy and we must fetch or fail
1863             else {
1864             # If they haven't agree to connect to the internet, ask again
1865 0 0         if ( ! $CPAN::Config->{connect_to_internet_ok} ) {
1866 0           my $prompt = q{You are missing a copy of the CPAN mirror list.
1867              
1868             May I connect to the Internet to get it?};
1869 0           my $ans = prompt($prompt, "yes");
1870 0 0         if ($ans =~ /^y/i) {
1871 0           $CPAN::Config->{connect_to_internet_ok} = 1;
1872             }
1873             }
1874              
1875             # Now get it from the Internet or complain
1876 0 0         if ( $CPAN::Config->{connect_to_internet_ok} ) {
1877 0           $CPAN::Frontend->myprint(qq{Trying to fetch a mirror list from the Internet\n});
1878 0 0         eval { CPAN::FTP->localize($m,$mby,3,1) }
  0            
1879             or $CPAN::Frontend->mywarn(<<'HERE');
1880             We failed to get a copy of the mirror list from the Internet.
1881             You will need to provide CPAN mirror URLs yourself.
1882             HERE
1883 0           $CPAN::Frontend->myprint("\n");
1884             }
1885             else {
1886 0           $CPAN::Frontend->mywarn(<<'HERE');
1887             You will need to provide CPAN mirror URLs yourself or set
1888             'o conf connect_to_internet_ok 1' and try again.
1889             HERE
1890             }
1891             }
1892              
1893             # if we finally have a good local MIRRORED.BY, get on with picking
1894 0 0 0       if (-f $mby && -s _ > 0){
1895             $CPAN::Config->{urllist} =
1896 0 0         $args{auto_pick} ? auto_mirrored_by($mby) : choose_mirrored_by($mby);
1897 0           return 1;
1898             }
1899              
1900 0           return;
1901             }
1902              
1903             sub find_exe {
1904 0     0 0   my($exe,$path) = @_;
1905 0   0       $path ||= [split /$Config{'path_sep'}/, $ENV{'PATH'}];
1906 0           my($dir);
1907             #warn "in find_exe exe[$exe] path[@$path]";
1908 0           for $dir (@$path) {
1909 0           my $abs = File::Spec->catfile($dir,$exe);
1910 0 0         if (($abs = MM->maybe_command($abs))) {
1911 0           return $abs;
1912             }
1913             }
1914             }
1915              
1916             sub picklist {
1917 0     0 0   my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
1918 0 0         CPAN->debug("picklist('$items','$prompt','$default','$require_nonempty',".
1919             "'$empty_warning')") if $CPAN::DEBUG;
1920 0   0       $default ||= '';
1921              
1922 0           my $pos = 0;
1923              
1924 0           my @nums;
1925 0           SELECTION: while (1) {
1926              
1927             # display, at most, 15 items at a time
1928 0           my $limit = $#{ $items } - $pos;
  0            
1929 0 0         $limit = 15 if $limit > 15;
1930              
1931             # show the next $limit items, get the new position
1932 0           $pos = display_some($items, $limit, $pos, $default);
1933 0 0         $pos = 0 if $pos >= @$items;
1934              
1935 0           my $num = prompt($prompt,$default);
1936              
1937 0           @nums = split (' ', $num);
1938             {
1939 0           my %seen;
  0            
1940 0           @nums = grep { !$seen{$_}++ } @nums;
  0            
1941             }
1942 0           my $i = scalar @$items;
1943 0           unrangify(\@nums);
1944 0 0 0       if (0 == @nums) {
    0          
1945             # cannot allow nothing because nothing means paging!
1946             # return;
1947             } elsif (grep (/\D/ || $_ < 1 || $_ > $i, @nums)) {
1948 0           $CPAN::Frontend->mywarn("invalid items entered, try again\n");
1949 0 0         if ("@nums" =~ /\D/) {
1950 0           $CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n");
1951             }
1952 0           next SELECTION;
1953             }
1954 0 0 0       if ($require_nonempty && !@nums) {
1955 0           $CPAN::Frontend->mywarn("$empty_warning\n");
1956             }
1957              
1958             # a blank line continues...
1959 0 0         unless (@nums){
1960 0           $CPAN::Frontend->mysleep(0.1); # prevent hot spinning process on the next bug
1961 0           next SELECTION;
1962             }
1963 0           last;
1964             }
1965 0           for (@nums) { $_-- }
  0            
1966 0           @{$items}[@nums];
  0            
1967             }
1968              
1969             sub unrangify ($) {
1970 0     0 0   my($nums) = $_[0];
1971 0           my @nums2 = ();
1972 0 0         while (@{$nums||[]}) {
  0            
1973 0           my $n = shift @$nums;
1974 0 0         if ($n =~ /^(\d+)-(\d+)$/) {
1975 0           my @range = $1 .. $2;
1976             # warn "range[@range]";
1977 0           push @nums2, @range;
1978             } else {
1979 0           push @nums2, $n;
1980             }
1981             }
1982 0           push @$nums, @nums2;
1983             }
1984              
1985             sub display_some {
1986 0     0 0   my ($items, $limit, $pos, $default) = @_;
1987 0   0       $pos ||= 0;
1988              
1989 0           my @displayable = @$items[$pos .. ($pos + $limit)];
1990 0           for my $item (@displayable) {
1991 0           $CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item);
1992             }
1993 0 0         my $hit_what = $default ? "SPACE ENTER" : "ENTER";
1994 0 0         $CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n",
1995             (@$items - $pos),
1996             $hit_what,
1997             ))
1998             if $pos < @$items;
1999 0           return $pos;
2000             }
2001              
2002             sub auto_mirrored_by {
2003 0 0   0 0   my $local = shift or return;
2004 0           local $|=1;
2005 0           $CPAN::Frontend->myprint("Looking for CPAN mirrors near you (please be patient)\n");
2006 0           my $mirrors = CPAN::Mirrors->new($local);
2007              
2008 0           my $cnt = 0;
2009 0           my $callback_was_active = 0;
2010             my @best = $mirrors->best_mirrors(
2011             how_many => 3,
2012             callback => sub {
2013 0     0     $callback_was_active++;
2014 0           $CPAN::Frontend->myprint(".");
2015 0 0         if ($cnt++>60) { $cnt=0; $CPAN::Frontend->myprint("\n"); }
  0            
  0            
2016             },
2017             $CPAN::Config->{urllist_ping_external} ? (external_ping => 1) : (),
2018 0 0         $CPAN::Config->{urllist_ping_verbose} ? (verbose => 1) : (),
    0          
2019             );
2020              
2021             my $urllist = [
2022 0           map { $_->http }
2023 0 0 0       grep { $_ && ref $_ && $_->can('http') }
  0            
2024             @best
2025             ];
2026 0           push @$urllist, grep { /^file:/ } @{$CPAN::Config->{urllist}};
  0            
  0            
2027 0 0         $CPAN::Frontend->myprint(" done!\n\n") if $callback_was_active;
2028              
2029 0           return $urllist
2030             }
2031              
2032             sub choose_mirrored_by {
2033 0 0   0 0   my $local = shift or return;
2034 0           my ($default);
2035 0           my $mirrors = CPAN::Mirrors->new($local);
2036 0           my @previous_urls = @{$CPAN::Config->{urllist}};
  0            
2037              
2038 0           $CPAN::Frontend->myprint($prompts{urls_picker_intro});
2039              
2040 0           my (@cont, $cont, %cont, @countries, @urls, %seen);
2041 0           my $no_previous_warn =
2042             "Sorry! since you don't have any existing picks, you must make a\n" .
2043             "geographic selection.";
2044 0           my $offer_cont = [sort $mirrors->continents];
2045 0 0         if (@previous_urls) {
2046 0           push @$offer_cont, "(edit previous picks)";
2047 0           $default = @$offer_cont;
2048             } else {
2049             # cannot allow nothing because nothing means paging!
2050             # push @$offer_cont, "(none of the above)";
2051             }
2052 0           @cont = picklist($offer_cont,
2053             "Select your continent (or several nearby continents)",
2054             $default,
2055             ! @previous_urls,
2056             $no_previous_warn);
2057             # cannot allow nothing because nothing means paging!
2058             # return unless @cont;
2059              
2060 0           foreach $cont (@cont) {
2061 0           my @c = sort $mirrors->countries($cont);
2062 0           @cont{@c} = map ($cont, 0..$#c);
2063 0 0         @c = map ("$_ ($cont)", @c) if @cont > 1;
2064 0           push (@countries, @c);
2065             }
2066 0 0 0       if (@previous_urls && @countries) {
2067 0           push @countries, "(edit previous picks)";
2068 0           $default = @countries;
2069             }
2070              
2071 0 0         if (@countries) {
2072 0           @countries = picklist (\@countries,
2073             "Select your country (or several nearby countries)",
2074             $default,
2075             ! @previous_urls,
2076             $no_previous_warn);
2077 0           %seen = map (($_ => 1), @previous_urls);
2078             # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
2079 0           foreach my $country (@countries) {
2080 0 0         next if $country =~ /edit previous picks/;
2081 0           (my $bare_country = $country) =~ s/ \(.*\)//;
2082 0           my @u;
2083 0           for my $m ( $mirrors->mirrors($bare_country) ) {
2084 0 0         push @u, $m->ftp if $m->ftp;
2085 0 0         push @u, $m->http if $m->http;
2086             }
2087 0           @u = grep (! $seen{$_}, @u);
2088 0 0         @u = map ("$_ ($bare_country)", @u)
2089             if @countries > 1;
2090 0           push (@urls, sort @u);
2091             }
2092             }
2093 0           push (@urls, map ("$_ (previous pick)", @previous_urls));
2094 0           my $prompt = "Select as many URLs as you like (by number),
2095             put them on one line, separated by blanks, hyphenated ranges allowed
2096             e.g. '1 4 5' or '7 1-4 8'";
2097 0 0         if (@previous_urls) {
2098 0           $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
2099             (scalar @urls));
2100 0           $prompt .= "\n(or just hit ENTER to keep your previous picks)";
2101             }
2102              
2103 0           @urls = picklist (\@urls, $prompt, $default);
2104 0           foreach (@urls) { s/ \(.*\)//; }
  0            
2105 0           return [ @urls ];
2106             }
2107              
2108             sub bring_your_own {
2109 0     0 0   my $urllist = [ @{$CPAN::Config->{urllist}} ];
  0            
2110 0           my %seen = map (($_ => 1), @$urllist);
2111 0           my($ans,@urls);
2112 0           my $eacnt = 0; # empty answers
2113 0           $CPAN::Frontend->myprint(<<'HERE');
2114             Now you can enter your own CPAN URLs by hand. A local CPAN mirror can be
2115             listed using a 'file:' URL like 'file:///path/to/cpan/'
2116              
2117             HERE
2118 0   0       do {
2119 0           my $prompt = "Enter another URL or ENTER to quit:";
2120 0 0         unless (%seen) {
2121 0           $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
2122              
2123             Please enter your CPAN site:};
2124             }
2125 0           $ans = prompt ($prompt, "");
2126              
2127 0 0         if ($ans) {
2128 0           $ans =~ s|/?\z|/|; # has to end with one slash
2129             # XXX This manipulation is odd. Shouldn't we check that $ans is
2130             # a directory before converting to file:///? And we need /// below,
2131             # too, don't we? -- dagolden, 2009-11-05
2132 0 0         $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
2133 0 0         if ($ans =~ /^\w+:\/./) {
2134 0 0         push @urls, $ans unless $seen{$ans}++;
2135             } else {
2136             $CPAN::Frontend->
2137             myprint(sprintf(qq{"%s" doesn\'t look like an URL at first sight.
2138             I\'ll ignore it for now.
2139             You can add it to your %s
2140             later if you\'re sure it\'s right.\n},
2141             $ans,
2142             $INC{'CPAN/MyConfig.pm'}
2143 0   0       || $INC{'CPAN/Config.pm'}
2144             || "configuration file",
2145             ));
2146             }
2147             } else {
2148 0 0         if (++$eacnt >= 5) {
2149 0           $CPAN::Frontend->
2150             mywarn("Giving up.\n");
2151 0           $CPAN::Frontend->mysleep(5);
2152 0           return;
2153             }
2154             }
2155             } while $ans || !%seen;
2156              
2157 0           @$urllist = CPAN::_uniq(@$urllist, @urls);
2158 0           $CPAN::Config->{urllist} = $urllist;
2159             }
2160              
2161             sub _print_urllist {
2162 0     0     my ($which) = @_;
2163 0           $CPAN::Frontend->myprint("$which urllist\n");
2164 0 0         for ( @{$CPAN::Config->{urllist} || []} ) {
  0            
2165 0           $CPAN::Frontend->myprint(" $_\n")
2166             };
2167             }
2168              
2169             sub _can_write_to_libdirs {
2170             return -w $Config{installprivlib}
2171             && -w $Config{installarchlib}
2172             && -w $Config{installsitelib}
2173             && -w $Config{installsitearch}
2174 0   0 0     }
2175              
2176             sub _using_installbase {
2177 0 0 0 0     return 1 if $ENV{PERL_MM_OPT} && $ENV{PERL_MM_OPT} =~ /install_base/i;
2178 0 0 0       return 1 if grep { ($CPAN::Config->{$_}||q{}) =~ /install_base/i }
  0            
2179             qw(makepl_arg make_install_arg mbuildpl_arg mbuild_install_arg);
2180 0           return;
2181             }
2182              
2183             sub _using_sudo {
2184 0 0 0 0     return 1 if grep { ($CPAN::Config->{$_}||q{}) =~ /sudo/ }
  0            
2185             qw(make_install_make_command mbuild_install_build_command);
2186 0           return;
2187             }
2188              
2189             sub _strip_spaces {
2190 0     0     $_[0] =~ s/^\s+//; # no leading spaces
2191 0           $_[0] =~ s/\s+\z//; # no trailing spaces
2192             }
2193              
2194             sub prompt ($;$) {
2195 0 0   0 0   unless (defined &_real_prompt) {
2196 0           *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
2197             }
2198 0           my $ans = _real_prompt(@_);
2199              
2200 0           _strip_spaces($ans);
2201 0 0         $CPAN::Frontend->myprint("\n") unless $auto_config;
2202              
2203 0           return $ans;
2204             }
2205              
2206              
2207             sub prompt_no_strip ($;$) {
2208 0 0   0 0   unless (defined &_real_prompt) {
2209 0           *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
2210             }
2211 0           return _real_prompt(@_);
2212             }
2213              
2214              
2215              
2216             1;