File Coverage

blib/lib/CPAN/FirstTime.pm
Criterion Covered Total %
statement 30 658 4.5
branch 0 386 0.0
condition 0 229 0.0
subroutine 10 41 24.3
pod 0 15 0.0
total 40 1329 3.0


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