File Coverage

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


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