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