File Coverage

blib/lib/CPAN/FirstTime.pm
Criterion Covered Total %
statement 30 657 4.5
branch 0 386 0.0
condition 0 226 0.0
subroutine 10 41 24.3
pod 0 15 0.0
total 40 1325 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   37501 use strict;
  4         6  
  4         145  
5              
6 4     4   1719 use ExtUtils::MakeMaker ();
  4         189919  
  4         71  
7 4     4   849 use FileHandle ();
  4         15001  
  4         80  
8 4     4   22 use File::Basename ();
  4         6  
  4         59  
9 4     4   13 use File::Path ();
  4         7  
  4         64  
10 4     4   14 use File::Spec ();
  4         6  
  4         42  
11 4     4   1303 use CPAN::Mirrors ();
  4         8  
  4         79  
12 4     4   16 use vars qw($VERSION $auto_config);
  4         4  
  4         752  
13             $VERSION = "5.5308";
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         8  
  4         1142  
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   17 use Config;
  4         4  
  4         22446  
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;
1304 0 0         if ( $dist = CPAN::Shell->expand('Module', 'local::lib')->distribution ) {
1305             # this is a hack to force bootstrapping
1306 0           $dist->{prefs}{pl}{commandline} = "$^X Makefile.PL --bootstrap";
1307             # Set @INC for this process so we find things as they bootstrap
1308 0           require lib;
1309 0           lib->import(_local_lib_inc_path());
1310 0           eval { $dist->install };
  0            
1311             }
1312 0 0 0       if ( ! $dist || (my $err = $@) ) {
1313 0   0       $err ||= 'Could not locate local::lib in the CPAN index';
1314 0           $CPAN::Frontend->mywarn("Error bootstrapping local::lib: $@\n");
1315 0           $CPAN::Frontend->myprint("From the CPAN Shell, you might try 'look local::lib' and \n"
1316             . "run 'perl Makefile --bootstrap' and see if that is successful. Then\n"
1317             . "restart your CPAN client\n"
1318             );
1319             }
1320             else {
1321 0           _local_lib_config();
1322             }
1323             }
1324             }
1325              
1326             # install_help is temporary for configuration and not saved
1327 0           delete $CPAN::Config->{install_help};
1328              
1329 0           $CPAN::Frontend->myprint("\n");
1330 0 0 0       if ($matcher && !$CPAN::Config->{auto_commit}) {
1331 0           $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ".
1332             "make the config permanent!\n");
1333             } else {
1334 0           CPAN::HandleConfig->commit;
1335             }
1336              
1337 0 0         if (! $matcher) {
1338 0           $CPAN::Frontend->myprint(
1339             "\nYou can re-run configuration any time with 'o conf init' in the CPAN shell\n"
1340             );
1341             }
1342              
1343             }
1344              
1345             sub _local_lib_config {
1346             # Set environment stuff for this process
1347 0     0     require local::lib;
1348              
1349             # Tell user about environment vars to set
1350 0           $CPAN::Frontend->myprint($prompts{local_lib_installed});
1351 0   0       local $ENV{SHELL} = $CPAN::Config->{shell} || $ENV{SHELL};
1352 0           my $shellvars = local::lib->environment_vars_string_for(_local_lib_path());
1353 0           $CPAN::Frontend->myprint($shellvars);
1354              
1355             # Set %ENV after getting string above
1356 0           my %env = local::lib->build_environment_vars_for(_local_lib_path(), 1);
1357 0           while ( my ($k, $v) = each %env ) {
1358 0           $ENV{$k} = $v;
1359             }
1360              
1361             # Offer to mangle the shell config
1362 0           my $munged_rc;
1363 0 0         if ( my $rc = _find_shell_config() ) {
1364 0           local $auto_config = 0; # We *must* ask, even under autoconfig
1365 0           local *_real_prompt; # We *must* show prompt
1366 0           my $_conf = prompt(
1367             "\nWould you like me to append that to $rc now?", "yes"
1368             );
1369 0 0         if ($_conf =~ /^y/i) {
1370 0           open my $fh, ">>", $rc;
1371 0           print {$fh} "\n$shellvars";
  0            
1372 0           close $fh;
1373 0           $munged_rc++;
1374             }
1375             }
1376              
1377             # Warn at exit time
1378 0 0         if ($munged_rc) {
1379 0           push @{$CPAN::META->_exit_messages}, << "HERE";
  0            
1380              
1381             *** Remember to restart your shell before running cpan again ***
1382             HERE
1383             }
1384             else {
1385 0           push @{$CPAN::META->_exit_messages}, << "HERE";
  0            
1386              
1387             *** Remember to add these environment variables to your shell config
1388             and restart your shell before running cpan again ***
1389              
1390             $shellvars
1391             HERE
1392             }
1393             }
1394              
1395             {
1396             my %shell_rc_map = (
1397             map { $_ => ".${_}rc" } qw/ bash tcsh csh /,
1398             map { $_ => ".profile" } qw/dash ash sh/,
1399             zsh => ".zshenv",
1400             );
1401              
1402             sub _find_shell_config {
1403 0     0     my $shell = File::Basename::basename($CPAN::Config->{shell});
1404 0 0         if ( my $rc = $shell_rc_map{$shell} ) {
1405 0           my $path = File::Spec->catfile($ENV{HOME}, $rc);
1406 0 0         return $path if -w $path;
1407             }
1408             }
1409             }
1410              
1411              
1412             sub _local_lib_inc_path {
1413 0     0     return File::Spec->catdir(_local_lib_path(), qw/lib perl5/);
1414             }
1415              
1416             sub _local_lib_path {
1417 0     0     return File::Spec->catdir(_local_lib_home(), 'perl5');
1418             }
1419              
1420             # Adapted from resolve_home_path() in local::lib -- this is where
1421             # local::lib thinks the user's home is
1422             {
1423             my $local_lib_home;
1424             sub _local_lib_home {
1425 0   0 0     $local_lib_home ||= File::Spec->rel2abs( do {
1426 0 0 0       if ($CPAN::META->has_usable("File::HomeDir") && File::HomeDir->VERSION >= 0.65) {
    0          
1427 0           File::HomeDir->my_home;
1428             } elsif (defined $ENV{HOME}) {
1429 0           $ENV{HOME};
1430             } else {
1431 0 0         (getpwuid $<)[7] || "~";
1432             }
1433             });
1434             }
1435             }
1436              
1437             sub _do_pick_mirrors {
1438 0     0     local *_real_prompt;
1439 0           *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
1440 0           $CPAN::Frontend->myprint($prompts{urls_intro});
1441             # Only prompt for auto-pick if Net::Ping is new enough to do timings
1442 0           my $_conf = 'n';
1443 0 0 0       if ( $CPAN::META->has_usable("Net::Ping") && Net::Ping->VERSION gt '2.13') {
1444 0           $_conf = prompt($prompts{auto_pick}, "yes");
1445             } else {
1446 0           prompt("Autoselection disabled due to Net::Ping missing or insufficient. Please press ENTER");
1447             }
1448 0           my @old_list = @{ $CPAN::Config->{urllist} };
  0            
1449 0 0         if ( $_conf =~ /^y/i ) {
1450 0 0         conf_sites( auto_pick => 1 ) or bring_your_own();
1451             }
1452             else {
1453 0 0         _print_urllist('Current') if @old_list;
1454 0 0         my $msg = scalar @old_list
1455             ? "\nWould you like to edit the urllist or pick new mirrors from a list?"
1456             : "\nWould you like to pick from the CPAN mirror list?" ;
1457 0           my $_conf = prompt($msg, "yes");
1458 0 0         if ( $_conf =~ /^y/i ) {
1459 0           conf_sites();
1460             }
1461 0           bring_your_own();
1462             }
1463 0           _print_urllist('New');
1464             }
1465              
1466             sub _init_external_progs {
1467 0     0     my($matcher,$args) = @_;
1468 0           my $PATH = $args->{path};
1469 0           my @external_progs = @{ $args->{progs} };
  0            
1470 0           my $shortcut = $args->{shortcut};
1471 0           my $showed_make_warning;
1472              
1473 0 0 0       if (!$matcher or "@external_progs" =~ /$matcher/) {
1474 0           my $old_warn = $^W;
1475 0 0         local $^W if $^O eq 'MacOS';
1476 0           local $^W = $old_warn;
1477 0           my $progname;
1478 0           for $progname (@external_progs) {
1479 0 0 0       next if $matcher && $progname !~ /$matcher/;
1480 0 0         if ($^O eq 'MacOS') {
1481 0           $CPAN::Config->{$progname} = 'not_here';
1482 0           next;
1483             }
1484              
1485 0           my $progcall = $progname;
1486 0 0         unless ($matcher) {
1487             # we really don't need ncftp if we have ncftpget, but
1488             # if they chose this dialog via matcher, they shall have it
1489 0 0 0       next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
1490             }
1491             my $path = $CPAN::Config->{$progname}
1492 0   0       || $Config::Config{$progname}
1493             || "";
1494 0 0         if (File::Spec->file_name_is_absolute($path)) {
    0          
1495             # testing existence is not good enough, some have these exe
1496             # extensions
1497              
1498             # warn "Warning: configured $path does not exist\n" unless -e $path;
1499             # $path = "";
1500             } elsif ($path =~ /^\s+$/) {
1501             # preserve disabled programs
1502             } else {
1503 0           $path = '';
1504             }
1505 0 0         unless ($path) {
1506             # e.g. make -> nmake
1507 0 0         $progcall = $Config::Config{$progname} if $Config::Config{$progname};
1508             }
1509              
1510 0   0       $path ||= find_exe($progcall,$PATH);
1511 0 0         unless ($path) { # not -e $path, because find_exe already checked that
1512 0           local $"=";";
1513 0 0         $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@$PATH]\n") unless $auto_config;
1514 0 0         _beg_for_make(), $showed_make_warning++ if $progname eq "make";
1515             }
1516 0           $prompts{$progname} = "Where is your $progname program?";
1517 0           $path = my_dflt_prompt($progname,$path,$matcher,1); # 1 => no strip spaces
1518 0           my $disabling = $path =~ m/^\s*$/;
1519              
1520             # don't let them disable or misconfigure make without warning
1521 0 0 0       if ( $progname eq "make" && ( $disabling || ! _check_found($path) ) ) {
    0 0        
    0          
1522 0 0 0       if ( $disabling && $showed_make_warning ) {
1523 0           next;
1524             }
1525             else {
1526 0 0         _beg_for_make() unless $showed_make_warning++;
1527 0           undef $CPAN::Config->{$progname};
1528 0           $CPAN::Frontend->mywarn("Press SPACE and ENTER to disable make (NOT RECOMMENDED)\n");
1529 0           redo;
1530             }
1531             }
1532             elsif ( $disabling ) {
1533 0           next;
1534             }
1535             elsif ( _check_found( $CPAN::Config->{$progname} ) ) {
1536 0 0 0       last if $shortcut && !$matcher;
1537             }
1538             else {
1539 0           undef $CPAN::Config->{$progname};
1540 0           $CPAN::Frontend->mywarn("Press SPACE and ENTER to disable $progname\n");
1541 0           redo;
1542             }
1543             }
1544             }
1545             }
1546              
1547             sub _check_found {
1548 0     0     my ($prog) = @_;
1549 0 0         if ( ! -f $prog ) {
    0          
1550 0 0         $CPAN::Frontend->mywarn("Warning: '$prog' does not exist\n")
1551             unless $auto_config;
1552 0           return;
1553             }
1554             elsif ( ! -x $prog ) {
1555 0 0         $CPAN::Frontend->mywarn("Warning: '$prog' is not executable\n")
1556             unless $auto_config;
1557 0           return;
1558             }
1559 0           return 1;
1560             }
1561              
1562             sub _beg_for_make {
1563 0     0     $CPAN::Frontend->mywarn(<<"HERE");
1564              
1565             ALERT: 'make' is an essential tool for building perl Modules.
1566             Please make sure you have 'make' (or some equivalent) working.
1567              
1568             HERE
1569 0 0         if ($^O eq "MSWin32") {
1570 0           $CPAN::Frontend->mywarn(<<"HERE");
1571             Windows users may want to follow this procedure when back in the CPAN shell:
1572              
1573             look YVES/scripts/alien_nmake.pl
1574             perl alien_nmake.pl
1575              
1576             This will install nmake on your system which can be used as a 'make'
1577             substitute. You can then revisit this dialog with
1578              
1579             o conf init make
1580              
1581             HERE
1582             }
1583             }
1584              
1585             sub init_cpan_home {
1586 0     0 0   my($matcher) = @_;
1587 0 0 0       if (!$matcher or 'cpan_home' =~ /$matcher/) {
1588             my $cpan_home =
1589 0   0       $CPAN::Config->{cpan_home} || CPAN::HandleConfig::cpan_home();
1590 0 0         if (-d $cpan_home) {
1591 0 0         $CPAN::Frontend->myprint(
1592             "\nI see you already have a directory\n" .
1593             "\n$cpan_home\n" .
1594             "Shall we use it as the general CPAN build and cache directory?\n\n"
1595             ) unless $auto_config;
1596             } else {
1597             # no cpan-home, must prompt and get one
1598 0 0         $CPAN::Frontend->myprint($prompts{cpan_home_where}) unless $auto_config;
1599             }
1600              
1601 0           my $default = $cpan_home;
1602 0           my $loop = 0;
1603 0           my($last_ans,$ans);
1604 0 0         $CPAN::Frontend->myprint(" \n") unless $auto_config;
1605 0           PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) {
1606 0 0         if (File::Spec->file_name_is_absolute($ans)) {
1607 0           my @cpan_home = split /[\/\\]/, $ans;
1608 0           DIR: for my $dir (@cpan_home) {
1609 0 0 0       if ($dir =~ /^~/ and (!$last_ans or $ans ne $last_ans)) {
      0        
1610 0           $CPAN::Frontend
1611             ->mywarn("Warning: a tilde in the path will be ".
1612             "taken as a literal tilde. Please ".
1613             "confirm again if you want to keep it\n");
1614 0           $last_ans = $default = $ans;
1615 0           next PROMPT;
1616             }
1617             }
1618             } else {
1619 0           require Cwd;
1620 0           my $cwd = Cwd::cwd();
1621 0           my $absans = File::Spec->catdir($cwd,$ans);
1622 0           $CPAN::Frontend->mywarn("The path '$ans' is not an ".
1623             "absolute path. Please specify ".
1624             "an absolute path\n");
1625 0           $default = $absans;
1626 0           next PROMPT;
1627             }
1628 0           eval { File::Path::mkpath($ans); }; # dies if it can't
  0            
1629 0 0         if ($@) {
1630 0           $CPAN::Frontend->mywarn("Couldn't create directory $ans.\n".
1631             "Please retry.\n");
1632 0           next PROMPT;
1633             }
1634 0 0 0       if (-d $ans && -w _) {
1635 0           last PROMPT;
1636             } else {
1637 0           $CPAN::Frontend->mywarn("Couldn't find directory $ans\n".
1638             "or directory is not writable. Please retry.\n");
1639 0 0         if (++$loop > 5) {
1640 0           $CPAN::Frontend->mydie("Giving up");
1641             }
1642             }
1643             }
1644 0           $CPAN::Config->{cpan_home} = $ans;
1645             }
1646             }
1647              
1648             sub my_dflt_prompt {
1649 0     0 0   my ($item, $dflt, $m, $no_strip) = @_;
1650 0   0       my $default = $CPAN::Config->{$item} || $dflt;
1651              
1652 0 0 0       if (!$auto_config && (!$m || $item =~ /$m/)) {
      0        
1653 0 0         if (my $intro = $prompts{$item . "_intro"}) {
1654 0           $CPAN::Frontend->myprint($intro);
1655             }
1656 0           $CPAN::Frontend->myprint(" <$item>\n");
1657             $CPAN::Config->{$item} =
1658             $no_strip ? prompt_no_strip($prompts{$item}, $default)
1659 0 0         : prompt( $prompts{$item}, $default);
1660             } else {
1661 0           $CPAN::Config->{$item} = $default;
1662             }
1663 0           return $CPAN::Config->{$item};
1664             }
1665              
1666             sub my_yn_prompt {
1667 0     0 0   my ($item, $dflt, $m) = @_;
1668 0           my $default;
1669 0 0         defined($default = $CPAN::Config->{$item}) or $default = $dflt;
1670              
1671             # $DB::single = 1;
1672 0 0 0       if (!$auto_config && (!$m || $item =~ /$m/)) {
      0        
1673 0 0         if (my $intro = $prompts{$item . "_intro"}) {
1674 0           $CPAN::Frontend->myprint($intro);
1675             }
1676 0           $CPAN::Frontend->myprint(" <$item>\n");
1677 0 0         my $ans = prompt($prompts{$item}, $default ? 'yes' : 'no');
1678 0 0         $CPAN::Config->{$item} = ($ans =~ /^[y1]/i ? 1 : 0);
1679             } else {
1680 0           $CPAN::Config->{$item} = $default;
1681             }
1682             }
1683              
1684             sub my_prompt_loop {
1685 0     0 0   my ($item, $dflt, $m, $ok) = @_;
1686 0   0       my $default = $CPAN::Config->{$item} || $dflt;
1687 0           my $ans;
1688              
1689 0 0 0       if (!$auto_config && (!$m || $item =~ /$m/)) {
      0        
1690 0           $CPAN::Frontend->myprint($prompts{$item . "_intro"});
1691 0           $CPAN::Frontend->myprint(" <$item>\n");
1692 0           do { $ans = prompt($prompts{$item}, $default);
  0            
1693             } until $ans =~ /$ok/;
1694 0           $CPAN::Config->{$item} = $ans;
1695             } else {
1696 0           $CPAN::Config->{$item} = $default;
1697             }
1698             }
1699              
1700              
1701             # Here's the logic about the MIRRORED.BY file. There are a number of scenarios:
1702             # (1) We have a cached MIRRORED.BY file
1703             # (1a) We're auto-picking
1704             # - Refresh it automatically if it's old
1705             # (1b) Otherwise, ask if using cached is ok. If old, default to no.
1706             # - If cached is not ok, get it from the Internet. If it succeeds we use
1707             # the new file. Otherwise, we use the old file.
1708             # (2) We don't have a copy at all
1709             # (2a) If we are allowed to connect, we try to get a new copy. If it succeeds,
1710             # we use it, otherwise, we warn about failure
1711             # (2b) If we aren't allowed to connect,
1712              
1713             sub conf_sites {
1714 0     0 0   my %args = @_;
1715             # auto pick implies using the internet
1716 0 0         $CPAN::Config->{connect_to_internet_ok} = 1 if $args{auto_pick};
1717              
1718 0           my $m = 'MIRRORED.BY';
1719 0           my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
1720 0           File::Path::mkpath(File::Basename::dirname($mby));
1721             # Why are we using MIRRORED.BY from the current directory?
1722             # Is this for testing? -- dagolden, 2009-11-05
1723 0 0 0       if (-f $mby && -f $m && -M $m < -M $mby) {
      0        
1724 0           require File::Copy;
1725 0 0         File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
1726             }
1727 0           local $^T = time;
1728             # if we have a cached copy is not older than 60 days, we either
1729             # use it or refresh it or fall back to it if the refresh failed.
1730 0 0 0       if ($mby && -f $mby && -s _ > 0 ) {
      0        
1731 0           my $very_old = (-M $mby > 60);
1732 0           my $mtime = localtime((stat _)[9]);
1733             # if auto_pick, refresh anything old automatically
1734 0 0         if ( $args{auto_pick} ) {
1735 0 0         if ( $very_old ) {
1736 0           $CPAN::Frontend->myprint(qq{Trying to refresh your mirror list\n});
1737 0 0         eval { CPAN::FTP->localize($m,$mby,3,1) }
  0            
1738             or $CPAN::Frontend->myprint(qq{Refresh failed. Using the old cached copy instead.\n});
1739 0           $CPAN::Frontend->myprint("\n");
1740             }
1741             }
1742             else {
1743 0           my $prompt = qq{Found a cached mirror list as of $mtime
1744              
1745             If you'd like to just use the cached copy, answer 'yes', below.
1746             If you'd like an updated copy of the mirror list, answer 'no' and
1747             I'll get a fresh one from the Internet.
1748              
1749             Shall I use the cached mirror list?};
1750 0 0         my $ans = prompt($prompt, $very_old ? "no" : "yes");
1751 0 0         if ($ans =~ /^n/i) {
1752 0           $CPAN::Frontend->myprint(qq{Trying to refresh your mirror list\n});
1753             # you asked for it from the Internet
1754 0           $CPAN::Config->{connect_to_internet_ok} = 1;
1755 0 0         eval { CPAN::FTP->localize($m,$mby,3,1) }
  0            
1756             or $CPAN::Frontend->myprint(qq{Refresh failed. Using the old cached copy instead.\n});
1757 0           $CPAN::Frontend->myprint("\n");
1758             }
1759             }
1760             }
1761             # else there is no cached copy and we must fetch or fail
1762             else {
1763             # If they haven't agree to connect to the internet, ask again
1764 0 0         if ( ! $CPAN::Config->{connect_to_internet_ok} ) {
1765 0           my $prompt = q{You are missing a copy of the CPAN mirror list.
1766              
1767             May I connect to the Internet to get it?};
1768 0           my $ans = prompt($prompt, "yes");
1769 0 0         if ($ans =~ /^y/i) {
1770 0           $CPAN::Config->{connect_to_internet_ok} = 1;
1771             }
1772             }
1773              
1774             # Now get it from the Internet or complain
1775 0 0         if ( $CPAN::Config->{connect_to_internet_ok} ) {
1776 0           $CPAN::Frontend->myprint(qq{Trying to fetch a mirror list from the Internet\n});
1777 0 0         eval { CPAN::FTP->localize($m,$mby,3,1) }
  0            
1778             or $CPAN::Frontend->mywarn(<<'HERE');
1779             We failed to get a copy of the mirror list from the Internet.
1780             You will need to provide CPAN mirror URLs yourself.
1781             HERE
1782 0           $CPAN::Frontend->myprint("\n");
1783             }
1784             else {
1785 0           $CPAN::Frontend->mywarn(<<'HERE');
1786             You will need to provide CPAN mirror URLs yourself or set
1787             'o conf connect_to_internet_ok 1' and try again.
1788             HERE
1789             }
1790             }
1791              
1792             # if we finally have a good local MIRRORED.BY, get on with picking
1793 0 0 0       if (-f $mby && -s _ > 0){
1794             $CPAN::Config->{urllist} =
1795 0 0         $args{auto_pick} ? auto_mirrored_by($mby) : choose_mirrored_by($mby);
1796 0           return 1;
1797             }
1798              
1799 0           return;
1800             }
1801              
1802             sub find_exe {
1803 0     0 0   my($exe,$path) = @_;
1804 0   0       $path ||= [split /$Config{'path_sep'}/, $ENV{'PATH'}];
1805 0           my($dir);
1806             #warn "in find_exe exe[$exe] path[@$path]";
1807 0           for $dir (@$path) {
1808 0           my $abs = File::Spec->catfile($dir,$exe);
1809 0 0         if (($abs = MM->maybe_command($abs))) {
1810 0           return $abs;
1811             }
1812             }
1813             }
1814              
1815             sub picklist {
1816 0     0 0   my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
1817 0 0         CPAN->debug("picklist('$items','$prompt','$default','$require_nonempty',".
1818             "'$empty_warning')") if $CPAN::DEBUG;
1819 0   0       $default ||= '';
1820              
1821 0           my $pos = 0;
1822              
1823 0           my @nums;
1824 0           SELECTION: while (1) {
1825              
1826             # display, at most, 15 items at a time
1827 0           my $limit = $#{ $items } - $pos;
  0            
1828 0 0         $limit = 15 if $limit > 15;
1829              
1830             # show the next $limit items, get the new position
1831 0           $pos = display_some($items, $limit, $pos, $default);
1832 0 0         $pos = 0 if $pos >= @$items;
1833              
1834 0           my $num = prompt($prompt,$default);
1835              
1836 0           @nums = split (' ', $num);
1837             {
1838 0           my %seen;
  0            
1839 0           @nums = grep { !$seen{$_}++ } @nums;
  0            
1840             }
1841 0           my $i = scalar @$items;
1842 0           unrangify(\@nums);
1843 0 0 0       if (0 == @nums) {
    0          
1844             # cannot allow nothing because nothing means paging!
1845             # return;
1846             } elsif (grep (/\D/ || $_ < 1 || $_ > $i, @nums)) {
1847 0           $CPAN::Frontend->mywarn("invalid items entered, try again\n");
1848 0 0         if ("@nums" =~ /\D/) {
1849 0           $CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n");
1850             }
1851 0           next SELECTION;
1852             }
1853 0 0 0       if ($require_nonempty && !@nums) {
1854 0           $CPAN::Frontend->mywarn("$empty_warning\n");
1855             }
1856              
1857             # a blank line continues...
1858 0 0         unless (@nums){
1859 0           $CPAN::Frontend->mysleep(0.1); # prevent hot spinning process on the next bug
1860 0           next SELECTION;
1861             }
1862 0           last;
1863             }
1864 0           for (@nums) { $_-- }
  0            
1865 0           @{$items}[@nums];
  0            
1866             }
1867              
1868             sub unrangify ($) {
1869 0     0 0   my($nums) = $_[0];
1870 0           my @nums2 = ();
1871 0 0         while (@{$nums||[]}) {
  0            
1872 0           my $n = shift @$nums;
1873 0 0         if ($n =~ /^(\d+)-(\d+)$/) {
1874 0           my @range = $1 .. $2;
1875             # warn "range[@range]";
1876 0           push @nums2, @range;
1877             } else {
1878 0           push @nums2, $n;
1879             }
1880             }
1881 0           push @$nums, @nums2;
1882             }
1883              
1884             sub display_some {
1885 0     0 0   my ($items, $limit, $pos, $default) = @_;
1886 0   0       $pos ||= 0;
1887              
1888 0           my @displayable = @$items[$pos .. ($pos + $limit)];
1889 0           for my $item (@displayable) {
1890 0           $CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item);
1891             }
1892 0 0         my $hit_what = $default ? "SPACE ENTER" : "ENTER";
1893 0 0         $CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n",
1894             (@$items - $pos),
1895             $hit_what,
1896             ))
1897             if $pos < @$items;
1898 0           return $pos;
1899             }
1900              
1901             sub auto_mirrored_by {
1902 0 0   0 0   my $local = shift or return;
1903 0           local $|=1;
1904 0           $CPAN::Frontend->myprint("Looking for CPAN mirrors near you (please be patient)\n");
1905 0           my $mirrors = CPAN::Mirrors->new($local);
1906              
1907 0           my $cnt = 0;
1908             my @best = $mirrors->best_mirrors(
1909             how_many => 3,
1910             callback => sub {
1911 0     0     $CPAN::Frontend->myprint(".");
1912 0 0         if ($cnt++>60) { $cnt=0; $CPAN::Frontend->myprint("\n"); }
  0            
  0            
1913             },
1914 0           );
1915              
1916 0           my $urllist = [ map { $_->http } @best ];
  0            
1917 0           push @$urllist, grep { /^file:/ } @{$CPAN::Config->{urllist}};
  0            
  0            
1918 0           $CPAN::Frontend->myprint(" done!\n\n");
1919              
1920 0           return $urllist
1921             }
1922              
1923             sub choose_mirrored_by {
1924 0 0   0 0   my $local = shift or return;
1925 0           my ($default);
1926 0           my $mirrors = CPAN::Mirrors->new($local);
1927 0           my @previous_urls = @{$CPAN::Config->{urllist}};
  0            
1928              
1929 0           $CPAN::Frontend->myprint($prompts{urls_picker_intro});
1930              
1931 0           my (@cont, $cont, %cont, @countries, @urls, %seen);
1932 0           my $no_previous_warn =
1933             "Sorry! since you don't have any existing picks, you must make a\n" .
1934             "geographic selection.";
1935 0           my $offer_cont = [sort $mirrors->continents];
1936 0 0         if (@previous_urls) {
1937 0           push @$offer_cont, "(edit previous picks)";
1938 0           $default = @$offer_cont;
1939             } else {
1940             # cannot allow nothing because nothing means paging!
1941             # push @$offer_cont, "(none of the above)";
1942             }
1943 0           @cont = picklist($offer_cont,
1944             "Select your continent (or several nearby continents)",
1945             $default,
1946             ! @previous_urls,
1947             $no_previous_warn);
1948             # cannot allow nothing because nothing means paging!
1949             # return unless @cont;
1950              
1951 0           foreach $cont (@cont) {
1952 0           my @c = sort $mirrors->countries($cont);
1953 0           @cont{@c} = map ($cont, 0..$#c);
1954 0 0         @c = map ("$_ ($cont)", @c) if @cont > 1;
1955 0           push (@countries, @c);
1956             }
1957 0 0 0       if (@previous_urls && @countries) {
1958 0           push @countries, "(edit previous picks)";
1959 0           $default = @countries;
1960             }
1961              
1962 0 0         if (@countries) {
1963 0           @countries = picklist (\@countries,
1964             "Select your country (or several nearby countries)",
1965             $default,
1966             ! @previous_urls,
1967             $no_previous_warn);
1968 0           %seen = map (($_ => 1), @previous_urls);
1969             # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
1970 0           foreach my $country (@countries) {
1971 0 0         next if $country =~ /edit previous picks/;
1972 0           (my $bare_country = $country) =~ s/ \(.*\)//;
1973 0           my @u;
1974 0           for my $m ( $mirrors->mirrors($bare_country) ) {
1975 0 0         push @u, $m->ftp if $m->ftp;
1976 0 0         push @u, $m->http if $m->http;
1977             }
1978 0           @u = grep (! $seen{$_}, @u);
1979 0 0         @u = map ("$_ ($bare_country)", @u)
1980             if @countries > 1;
1981 0           push (@urls, sort @u);
1982             }
1983             }
1984 0           push (@urls, map ("$_ (previous pick)", @previous_urls));
1985 0           my $prompt = "Select as many URLs as you like (by number),
1986             put them on one line, separated by blanks, hyphenated ranges allowed
1987             e.g. '1 4 5' or '7 1-4 8'";
1988 0 0         if (@previous_urls) {
1989 0           $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
1990             (scalar @urls));
1991 0           $prompt .= "\n(or just hit ENTER to keep your previous picks)";
1992             }
1993              
1994 0           @urls = picklist (\@urls, $prompt, $default);
1995 0           foreach (@urls) { s/ \(.*\)//; }
  0            
1996 0           return [ @urls ];
1997             }
1998              
1999             sub bring_your_own {
2000 0     0 0   my $urllist = [ @{$CPAN::Config->{urllist}} ];
  0            
2001 0           my %seen = map (($_ => 1), @$urllist);
2002 0           my($ans,@urls);
2003 0           my $eacnt = 0; # empty answers
2004 0           $CPAN::Frontend->myprint(<<'HERE');
2005             Now you can enter your own CPAN URLs by hand. A local CPAN mirror can be
2006             listed using a 'file:' URL like 'file:///path/to/cpan/'
2007              
2008             HERE
2009 0   0       do {
2010 0           my $prompt = "Enter another URL or ENTER to quit:";
2011 0 0         unless (%seen) {
2012 0           $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
2013              
2014             Please enter your CPAN site:};
2015             }
2016 0           $ans = prompt ($prompt, "");
2017              
2018 0 0         if ($ans) {
2019 0           $ans =~ s|/?\z|/|; # has to end with one slash
2020             # XXX This manipulation is odd. Shouldn't we check that $ans is
2021             # a directory before converting to file:///? And we need /// below,
2022             # too, don't we? -- dagolden, 2009-11-05
2023 0 0         $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
2024 0 0         if ($ans =~ /^\w+:\/./) {
2025 0 0         push @urls, $ans unless $seen{$ans}++;
2026             } else {
2027             $CPAN::Frontend->
2028             myprint(sprintf(qq{"%s" doesn\'t look like an URL at first sight.
2029             I\'ll ignore it for now.
2030             You can add it to your %s
2031             later if you\'re sure it\'s right.\n},
2032             $ans,
2033             $INC{'CPAN/MyConfig.pm'}
2034 0   0       || $INC{'CPAN/Config.pm'}
2035             || "configuration file",
2036             ));
2037             }
2038             } else {
2039 0 0         if (++$eacnt >= 5) {
2040 0           $CPAN::Frontend->
2041             mywarn("Giving up.\n");
2042 0           $CPAN::Frontend->mysleep(5);
2043 0           return;
2044             }
2045             }
2046             } while $ans || !%seen;
2047              
2048 0           @$urllist = CPAN::_uniq(@$urllist, @urls);
2049 0           $CPAN::Config->{urllist} = $urllist;
2050             }
2051              
2052             sub _print_urllist {
2053 0     0     my ($which) = @_;
2054 0           $CPAN::Frontend->myprint("$which urllist\n");
2055 0 0         for ( @{$CPAN::Config->{urllist} || []} ) {
  0            
2056 0           $CPAN::Frontend->myprint(" $_\n")
2057             };
2058             }
2059              
2060             sub _can_write_to_libdirs {
2061             return -w $Config{installprivlib}
2062             && -w $Config{installarchlib}
2063             && -w $Config{installsitelib}
2064             && -w $Config{installsitearch}
2065 0   0 0     }
2066              
2067             sub _using_installbase {
2068 0 0 0 0     return 1 if $ENV{PERL_MM_OPT} && $ENV{PERL_MM_OPT} =~ /install_base/i;
2069 0 0 0       return 1 if grep { ($CPAN::Config->{$_}||q{}) =~ /install_base/i }
  0            
2070             qw(makepl_arg make_install_arg mbuildpl_arg mbuild_install_arg);
2071 0           return;
2072             }
2073              
2074             sub _using_sudo {
2075 0 0 0 0     return 1 if grep { ($CPAN::Config->{$_}||q{}) =~ /sudo/ }
  0            
2076             qw(make_install_make_command mbuild_install_build_command);
2077 0           return;
2078             }
2079              
2080             sub _strip_spaces {
2081 0     0     $_[0] =~ s/^\s+//; # no leading spaces
2082 0           $_[0] =~ s/\s+\z//; # no trailing spaces
2083             }
2084              
2085             sub prompt ($;$) {
2086 0 0   0 0   unless (defined &_real_prompt) {
2087 0           *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
2088             }
2089 0           my $ans = _real_prompt(@_);
2090              
2091 0           _strip_spaces($ans);
2092 0 0         $CPAN::Frontend->myprint("\n") unless $auto_config;
2093              
2094 0           return $ans;
2095             }
2096              
2097              
2098             sub prompt_no_strip ($;$) {
2099 0 0   0 0   unless (defined &_real_prompt) {
2100 0           *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
2101             }
2102 0           return _real_prompt(@_);
2103             }
2104              
2105              
2106              
2107             1;