File Coverage

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