This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
document Git_Data
[perl5.git] / lib / CPAN / FirstTime.pm
... / ...
CommitLineData
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
775 local $^W = 0;
776 # prototype should match that of &MakeMaker::prompt
777 my $current_second = time;
778 my $current_second_count = 0;
779 my $i_am_mad = 0;
780 *_real_prompt = sub {
781 my($q,$a) = @_;
782 my($ret) = defined $a ? $a : "";
783 $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
784 eval { require Time::HiRes };
785 unless ($@) {
786 if (time == $current_second) {
787 $current_second_count++;
788 if ($current_second_count > 20) {
789 # I don't like more than 20 prompts per second
790 $i_am_mad++;
791 }
792 } else {
793 $current_second = time;
794 $current_second_count = 0;
795 $i_am_mad-- if $i_am_mad>0;
796 }
797 if ($i_am_mad>0) {
798 #require Carp;
799 #Carp::cluck("SLEEEEEEEEPIIIIIIIIIIINGGGGGGGGGGG");
800 Time::HiRes::sleep(0.1);
801 }
802 }
803 $ret;
804 };
805 }
806 }
807
808 if (!$matcher or q{
809 build_dir
810 build_dir_reuse
811 cpan_home
812 keep_source_where
813 prefs_dir
814 } =~ /$matcher/) {
815 $CPAN::Frontend->myprint($prompts{config_intro});
816
817 init_cpan_home($matcher);
818
819 my_dflt_prompt("keep_source_where",
820 File::Spec->catdir($CPAN::Config->{cpan_home},"sources"),
821 $matcher,
822 );
823 my_dflt_prompt("build_dir",
824 File::Spec->catdir($CPAN::Config->{cpan_home},"build"),
825 $matcher
826 );
827 my_yn_prompt(build_dir_reuse => 0, $matcher);
828 my_dflt_prompt("prefs_dir",
829 File::Spec->catdir($CPAN::Config->{cpan_home},"prefs"),
830 $matcher
831 );
832 }
833
834 #
835 #= Config: auto_commit
836 #
837
838 my_yn_prompt(auto_commit => 0, $matcher);
839
840 #
841 #= Cache size, Index expire
842 #
843 my_dflt_prompt(build_cache => 100, $matcher);
844
845 my_dflt_prompt(index_expire => 1, $matcher);
846 my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
847
848 #
849 #= cache_metadata
850 #
851
852 my_yn_prompt(cache_metadata => 1, $matcher);
853 my_yn_prompt(use_sqlite => 0, $matcher);
854
855 #
856 #= Do we follow PREREQ_PM?
857 #
858
859 my_prompt_loop(prerequisites_policy => 'ask', $matcher,
860 'follow|ask|ignore');
861 my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher,
862 'yes|no|ask/yes|ask/no');
863
864 #
865 #= Module::Signature
866 #
867 my_yn_prompt(check_sigs => 0, $matcher);
868
869 #
870 #= CPAN::Reporter
871 #
872 if (!$matcher or 'test_report' =~ /$matcher/) {
873 my_yn_prompt(test_report => 0, $matcher);
874 if (
875 $CPAN::Config->{test_report} &&
876 $CPAN::META->has_inst("CPAN::Reporter") &&
877 CPAN::Reporter->can('configure')
878 ) {
879 $CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n");
880 CPAN::Reporter::configure();
881 $CPAN::Frontend->myprint("\nReturning to CPAN configuration.\n");
882 }
883 }
884
885 my_yn_prompt(trust_test_report_history => 0, $matcher);
886
887 #
888 #= YAML vs. YAML::Syck
889 #
890 if (!$matcher or "yaml_module" =~ /$matcher/) {
891 my_dflt_prompt(yaml_module => "YAML", $matcher);
892 unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
893 $CPAN::Frontend->mywarn
894 ("Warning (maybe harmless): '$CPAN::Config->{yaml_module}' not installed.\n");
895 $CPAN::Frontend->mysleep(3);
896 }
897 }
898
899 #
900 #= YAML code deserialisation
901 #
902 my_yn_prompt(yaml_load_code => 0, $matcher);
903
904 #
905 #= External programs
906 #
907 my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
908 _init_external_progs($matcher,\@path);
909
910 {
911 my $path = $CPAN::Config->{'pager'} ||
912 $ENV{PAGER} || find_exe("less",\@path) ||
913 find_exe("more",\@path) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
914 || "more";
915 my_dflt_prompt(pager => $path, $matcher);
916 }
917
918 {
919 my $path = $CPAN::Config->{'shell'};
920 if ($path && File::Spec->file_name_is_absolute($path)) {
921 $CPAN::Frontend->mywarn("Warning: configured $path does not exist\n")
922 unless -e $path;
923 $path = "";
924 }
925 $path ||= $ENV{SHELL};
926 $path ||= $ENV{COMSPEC} if $^O eq "MSWin32";
927 if ($^O eq 'MacOS') {
928 $CPAN::Config->{'shell'} = 'not_here';
929 } else {
930 $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
931 my_dflt_prompt(shell => $path, $matcher);
932 }
933 }
934
935 #
936 # verbosity
937 #
938
939 my_prompt_loop(tar_verbosity => 'v', $matcher,
940 'none|v|vv');
941 my_prompt_loop(load_module_verbosity => 'v', $matcher,
942 'none|v');
943 my_prompt_loop(perl5lib_verbosity => 'v', $matcher,
944 'none|v');
945 my_yn_prompt(inhibit_startup_message => 0, $matcher);
946
947 #
948 #= Installer, arguments to make etc.
949 #
950
951 my_prompt_loop(prefer_installer => 'MB', $matcher, 'MB|EUMM|RAND');
952
953 if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/) {
954 my_dflt_prompt(makepl_arg => "", $matcher);
955 my_dflt_prompt(make_arg => "", $matcher);
956 if ( $CPAN::Config->{makepl_arg} =~ /LIBS=|INC=/ ) {
957 $CPAN::Frontend->mywarn(
958 "Warning: Using LIBS or INC in makepl_arg will likely break distributions\n" .
959 "that specify their own LIBS or INC options in Makefile.PL.\n"
960 );
961 }
962
963 }
964
965 require CPAN::HandleConfig;
966 if (exists $CPAN::HandleConfig::keys{make_install_make_command}) {
967 # as long as Windows needs $self->_build_command, we cannot
968 # support sudo on windows :-)
969 my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "",
970 $matcher);
971 }
972
973 my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "",
974 $matcher);
975
976 my_dflt_prompt(mbuildpl_arg => "", $matcher);
977 my_dflt_prompt(mbuild_arg => "", $matcher);
978
979 if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command}
980 and $^O ne "MSWin32") {
981 # as long as Windows needs $self->_build_command, we cannot
982 # support sudo on windows :-)
983 my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher);
984 }
985
986 my_dflt_prompt(mbuild_install_arg => "", $matcher);
987
988 #
989 #= Alarm period
990 #
991
992 my_dflt_prompt(inactivity_timeout => 0, $matcher);
993
994 #
995 #== halt_on_failure
996 #
997 my_yn_prompt(halt_on_failure => 0, $matcher);
998
999 #
1000 #= Proxies
1001 #
1002
1003 my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/;
1004 my @proxy_user_vars = qw/proxy_user proxy_pass/;
1005 if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/) {
1006 $CPAN::Frontend->myprint($prompts{proxy_intro});
1007
1008 for (@proxy_vars) {
1009 $prompts{$_} = "Your $_?";
1010 my_dflt_prompt($_ => $ENV{$_}||"", $matcher);
1011 }
1012
1013 if ($CPAN::Config->{ftp_proxy} ||
1014 $CPAN::Config->{http_proxy}) {
1015
1016 $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || "";
1017
1018 $CPAN::Frontend->myprint($prompts{proxy_user});
1019
1020 if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
1021 $CPAN::Frontend->myprint($prompts{proxy_pass});
1022
1023 if ($CPAN::META->has_inst("Term::ReadKey")) {
1024 Term::ReadKey::ReadMode("noecho");
1025 } else {
1026 $CPAN::Frontend->myprint($prompts{password_warn});
1027 }
1028 $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
1029 if ($CPAN::META->has_inst("Term::ReadKey")) {
1030 Term::ReadKey::ReadMode("restore");
1031 }
1032 $CPAN::Frontend->myprint("\n\n");
1033 }
1034 }
1035 }
1036
1037 #
1038 #= how FTP works
1039 #
1040
1041 my_yn_prompt(ftp_passive => 1, $matcher);
1042
1043 #
1044 #= how cwd works
1045 #
1046
1047 my_prompt_loop(getcwd => 'cwd', $matcher,
1048 'cwd|getcwd|fastcwd|backtickcwd');
1049
1050 #
1051 #= the CPAN shell itself (prompt, color)
1052 #
1053
1054 my_yn_prompt(commandnumber_in_prompt => 1, $matcher);
1055 my_yn_prompt(term_ornaments => 1, $matcher);
1056 if ("colorize_output colorize_print colorize_warn colorize_debug" =~ $matcher) {
1057 my_yn_prompt(colorize_output => 0, $matcher);
1058 if ($CPAN::Config->{colorize_output}) {
1059 if ($CPAN::META->has_inst("Term::ANSIColor")) {
1060 my $T="gYw";
1061 print " on_ on_y ".
1062 " on_ma on_\n";
1063 print " on_black on_red green ellow ".
1064 "on_blue genta on_cyan white\n";
1065
1066 for my $FG ("", "bold",
1067 map {$_,"bold $_"} "black","red","green",
1068 "yellow","blue",
1069 "magenta",
1070 "cyan","white") {
1071 printf "%12s ", $FG;
1072 for my $BG ("",map {"on_$_"} qw(black red green yellow
1073 blue magenta cyan white)) {
1074 print $FG||$BG ?
1075 Term::ANSIColor::colored(" $T ","$FG $BG") : " $T ";
1076 }
1077 print "\n";
1078 }
1079 print "\n";
1080 }
1081 for my $tuple (
1082 ["colorize_print", "bold blue on_white"],
1083 ["colorize_warn", "bold red on_white"],
1084 ["colorize_debug", "black on_cyan"],
1085 ) {
1086 my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher);
1087 if ($CPAN::META->has_inst("Term::ANSIColor")) {
1088 eval { Term::ANSIColor::color($CPAN::Config->{$tuple->[0]})};
1089 if ($@) {
1090 $CPAN::Config->{$tuple->[0]} = $tuple->[1];
1091 $CPAN::Frontend->mywarn($@."setting to default '$tuple->[1]'\n");
1092 }
1093 }
1094 }
1095 }
1096 }
1097
1098 #
1099 #== term_is_latin
1100 #
1101
1102 my_yn_prompt(term_is_latin => 1, $matcher);
1103
1104 #
1105 #== save history in file 'histfile'
1106 #
1107
1108 if (!$matcher or 'histfile histsize' =~ /$matcher/) {
1109 $CPAN::Frontend->myprint($prompts{histfile_intro});
1110 defined($default = $CPAN::Config->{histfile}) or
1111 $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
1112 my_dflt_prompt(histfile => $default, $matcher);
1113
1114 if ($CPAN::Config->{histfile}) {
1115 defined($default = $CPAN::Config->{histsize}) or $default = 100;
1116 my_dflt_prompt(histsize => $default, $matcher);
1117 }
1118 }
1119
1120 #
1121 #== do an ls on the m or the d command
1122 #
1123 my_yn_prompt(show_upload_date => 0, $matcher);
1124
1125 #
1126 #== verbosity at the end of the r command
1127 #
1128 if (!$matcher
1129 or 'show_unparsable_versions' =~ /$matcher/
1130 or 'show_zero_versions' =~ /$matcher/
1131 ) {
1132 $CPAN::Frontend->myprint($prompts{show_unparsable_or_zero_versions_intro});
1133 my_yn_prompt(show_unparsable_versions => 0, $matcher);
1134 my_yn_prompt(show_zero_versions => 0, $matcher);
1135 }
1136
1137 #
1138 #= MIRRORED.BY and conf_sites()
1139 #
1140
1141 # remember, this is only triggered if no urllist is given, so 0 is
1142 # fair and protects the default site from being overloaded and
1143 # gives the user more chances to select his own urllist.
1144 my_yn_prompt("connect_to_internet_ok" => 0, $matcher);
1145 if ($matcher) {
1146 if ("urllist" =~ $matcher) {
1147 # conf_sites would go into endless loop with the smash prompt
1148 local *_real_prompt;
1149 *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
1150 conf_sites();
1151 }
1152 if ("randomize_urllist" =~ $matcher) {
1153 my_dflt_prompt(randomize_urllist => 0, $matcher);
1154 }
1155 if ("ftpstats_size" =~ $matcher) {
1156 my_dflt_prompt(ftpstats_size => 99, $matcher);
1157 }
1158 if ("ftpstats_period" =~ $matcher) {
1159 my_dflt_prompt(ftpstats_period => 14, $matcher);
1160 }
1161 } elsif ($fastread) {
1162 $CPAN::Frontend->myprint("Autoconfigured everything but 'urllist'.\n".
1163 "Please call 'o conf init urllist' to configure ".
1164 "your CPAN server(s) now!\n\n");
1165 } else {
1166 conf_sites();
1167 }
1168
1169 $CPAN::Frontend->myprint("\n\n");
1170 if ($matcher && !$CPAN::Config->{auto_commit}) {
1171 $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ".
1172 "make the config permanent!\n\n");
1173 } else {
1174 CPAN::HandleConfig->commit($configpm);
1175 }
1176}
1177
1178sub _init_external_progs {
1179 my($matcher,$PATH) = @_;
1180 my @external_progs = qw/bzip2 gzip tar unzip
1181
1182 make
1183
1184 curl lynx wget ncftpget ncftp ftp
1185
1186 gpg
1187
1188 patch applypatch
1189 /;
1190 if (!$matcher or "@external_progs" =~ /$matcher/) {
1191 $CPAN::Frontend->myprint($prompts{external_progs});
1192
1193 my $old_warn = $^W;
1194 local $^W if $^O eq 'MacOS';
1195 local $^W = $old_warn;
1196 my $progname;
1197 for $progname (@external_progs) {
1198 next if $matcher && $progname !~ /$matcher/;
1199 if ($^O eq 'MacOS') {
1200 $CPAN::Config->{$progname} = 'not_here';
1201 next;
1202 }
1203
1204 my $progcall = $progname;
1205 unless ($matcher) {
1206 # we really don't need ncftp if we have ncftpget, but
1207 # if they chose this dialog via matcher, they shall have it
1208 next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
1209 }
1210 my $path = $CPAN::Config->{$progname}
1211 || $Config::Config{$progname}
1212 || "";
1213 if (File::Spec->file_name_is_absolute($path)) {
1214 # testing existence is not good enough, some have these exe
1215 # extensions
1216
1217 # warn "Warning: configured $path does not exist\n" unless -e $path;
1218 # $path = "";
1219 } elsif ($path =~ /^\s+$/) {
1220 # preserve disabled programs
1221 } else {
1222 $path = '';
1223 }
1224 unless ($path) {
1225 # e.g. make -> nmake
1226 $progcall = $Config::Config{$progname} if $Config::Config{$progname};
1227 }
1228
1229 $path ||= find_exe($progcall,$PATH);
1230 unless ($path) { # not -e $path, because find_exe already checked that
1231 local $"=";";
1232 $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@$PATH]\n");
1233 if ($progname eq "make") {
1234 $CPAN::Frontend->mywarn("ALERT: 'make' is an essential tool for ".
1235 "building perl Modules. Please make sure you ".
1236 "have 'make' (or some equivalent) ".
1237 "working.\n"
1238 );
1239 if ($^O eq "MSWin32") {
1240 $CPAN::Frontend->mywarn("
1241Windows users may want to follow this procedure when back in the CPAN shell:
1242
1243 look YVES/scripts/alien_nmake.pl
1244 perl alien_nmake.pl
1245
1246This will install nmake on your system which can be used as a 'make'
1247substitute. You can then revisit this dialog with
1248
1249 o conf init make
1250
1251");
1252 }
1253 }
1254 }
1255 $prompts{$progname} = "Where is your $progname program?";
1256 my_dflt_prompt($progname,$path,$matcher);
1257 }
1258 }
1259}
1260
1261sub init_cpan_home {
1262 my($matcher) = @_;
1263 if (!$matcher or 'cpan_home' =~ /$matcher/) {
1264 my $cpan_home = $CPAN::Config->{cpan_home}
1265 || File::Spec->catdir(CPAN::HandleConfig::home(), ".cpan");
1266
1267 if (-d $cpan_home) {
1268 $CPAN::Frontend->myprint(qq{
1269
1270I see you already have a directory
1271 $cpan_home
1272Shall we use it as the general CPAN build and cache directory?
1273
1274});
1275 } else {
1276 # no cpan-home, must prompt and get one
1277 $CPAN::Frontend->myprint($prompts{cpan_home_where});
1278 }
1279
1280 my $default = $cpan_home;
1281 my $loop = 0;
1282 my($last_ans,$ans);
1283 $CPAN::Frontend->myprint(" <cpan_home>\n");
1284 PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) {
1285 print "\n";
1286 if (File::Spec->file_name_is_absolute($ans)) {
1287 my @cpan_home = split /[\/\\]/, $ans;
1288 DIR: for my $dir (@cpan_home) {
1289 if ($dir =~ /^~/ and (!$last_ans or $ans ne $last_ans)) {
1290 $CPAN::Frontend
1291 ->mywarn("Warning: a tilde in the path will be ".
1292 "taken as a literal tilde. Please ".
1293 "confirm again if you want to keep it\n");
1294 $last_ans = $default = $ans;
1295 next PROMPT;
1296 }
1297 }
1298 } else {
1299 require Cwd;
1300 my $cwd = Cwd::cwd();
1301 my $absans = File::Spec->catdir($cwd,$ans);
1302 $CPAN::Frontend->mywarn("The path '$ans' is not an ".
1303 "absolute path. Please specify ".
1304 "an absolute path\n");
1305 $default = $absans;
1306 next PROMPT;
1307 }
1308 eval { File::Path::mkpath($ans); }; # dies if it can't
1309 if ($@) {
1310 $CPAN::Frontend->mywarn("Couldn't create directory $ans.\n".
1311 "Please retry.\n");
1312 next PROMPT;
1313 }
1314 if (-d $ans && -w _) {
1315 last PROMPT;
1316 } else {
1317 $CPAN::Frontend->mywarn("Couldn't find directory $ans\n".
1318 "or directory is not writable. Please retry.\n");
1319 if (++$loop > 5) {
1320 $CPAN::Frontend->mydie("Giving up");
1321 }
1322 }
1323 }
1324 $CPAN::Config->{cpan_home} = $ans;
1325 }
1326}
1327
1328sub my_dflt_prompt {
1329 my ($item, $dflt, $m) = @_;
1330 my $default = $CPAN::Config->{$item} || $dflt;
1331
1332 if (!$m || $item =~ /$m/) {
1333 if (my $intro = $prompts{$item . "_intro"}) {
1334 $CPAN::Frontend->myprint($intro);
1335 }
1336 $CPAN::Frontend->myprint(" <$item>\n");
1337 $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
1338 print "\n";
1339 } else {
1340 $CPAN::Config->{$item} = $default;
1341 }
1342}
1343
1344sub my_yn_prompt {
1345 my ($item, $dflt, $m) = @_;
1346 my $default;
1347 defined($default = $CPAN::Config->{$item}) or $default = $dflt;
1348
1349 # $DB::single = 1;
1350 if (!$m || $item =~ /$m/) {
1351 if (my $intro = $prompts{$item . "_intro"}) {
1352 $CPAN::Frontend->myprint($intro);
1353 }
1354 $CPAN::Frontend->myprint(" <$item>\n");
1355 my $ans = prompt($prompts{$item}, $default ? 'yes' : 'no');
1356 $CPAN::Config->{$item} = ($ans =~ /^[y1]/i ? 1 : 0);
1357 print "\n";
1358 } else {
1359 $CPAN::Config->{$item} = $default;
1360 }
1361}
1362
1363sub my_prompt_loop {
1364 my ($item, $dflt, $m, $ok) = @_;
1365 my $default = $CPAN::Config->{$item} || $dflt;
1366 my $ans;
1367
1368 if (!$m || $item =~ /$m/) {
1369 $CPAN::Frontend->myprint($prompts{$item . "_intro"});
1370 $CPAN::Frontend->myprint(" <$item>\n");
1371 do { $ans = prompt($prompts{$item}, $default);
1372 } until $ans =~ /$ok/;
1373 $CPAN::Config->{$item} = $ans;
1374 print "\n";
1375 } else {
1376 $CPAN::Config->{$item} = $default;
1377 }
1378}
1379
1380
1381sub conf_sites {
1382 my $m = 'MIRRORED.BY';
1383 my $use_mby;
1384 my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
1385 File::Path::mkpath(File::Basename::dirname($mby));
1386 if (-f $mby && -f $m && -M $m < -M $mby) {
1387 $use_mby = 1;
1388 require File::Copy;
1389 File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
1390 }
1391 local $^T = time;
1392 my $overwrite_local = 0;
1393 if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) {
1394 $use_mby = 1;
1395 my $mtime = localtime((stat _)[9]);
1396 my $prompt = qq{Found $mby as of $mtime
1397
1398I'd use that as a database of CPAN sites. If that is OK for you,
1399please answer 'y', but if you want me to get a new database from the
1400internet now, please answer 'n' to the following question.
1401
1402Shall I use the local database in $mby?};
1403 my $ans = prompt($prompt,"y");
1404 if ($ans =~ /^y/i) {
1405 $CPAN::Config->{connect_to_internet_ok} = 1;
1406 } else {
1407 $overwrite_local = 1;
1408 }
1409 }
1410 local $urllist = $CPAN::Config->{urllist};
1411 my $better_mby;
1412 LOOP: while () { # multiple errors possible
1413 if ($use_mby
1414 or (defined $CPAN::Config->{connect_to_internet_ok}
1415 and $CPAN::Config->{connect_to_internet_ok})){
1416 if ($overwrite_local) {
1417 $CPAN::Frontend->myprint(qq{Trying to overwrite $mby\n});
1418 $better_mby = CPAN::FTP->localize($m,$mby,3);
1419 $overwrite_local = 0;
1420 $use_mby=1 if $mby;
1421 } elsif ( ! -f $mby ) {
1422 $CPAN::Frontend->myprint(qq{You have no $mby\n I'm trying to fetch one\n});
1423 $better_mby = CPAN::FTP->localize($m,$mby,3);
1424 $use_mby=1 if $mby;
1425 } elsif ( -M $mby > 60 ) {
1426 $CPAN::Frontend->myprint(qq{Your $mby is older than 60 days,\n I'm trying }.
1427 qq{to fetch a new one\n});
1428 $better_mby = CPAN::FTP->localize($m,$mby,3);
1429 $use_mby=1 if $mby;
1430 } elsif (-s $mby == 0) {
1431 $CPAN::Frontend->myprint(qq{You have an empty $mby,\n I'm trying to fetch a better one\n});
1432 $better_mby = CPAN::FTP->localize($m,$mby,3);
1433 $use_mby=1 if $mby;
1434 } else {
1435 last LOOP;
1436 }
1437 if ($better_mby) {
1438 $mby = $better_mby;
1439 }
1440 } elsif (not @{$urllist||[]}
1441 and (not defined $CPAN::Config->{connect_to_internet_ok}
1442 or not $CPAN::Config->{connect_to_internet_ok})) {
1443 $CPAN::Frontend->myprint(qq{CPAN needs access to at least one CPAN mirror.
1444
1445As you did not allow me to connect to the internet you need to supply
1446a valid CPAN URL now.\n\n});
1447
1448 my @default = map {"file://$_"} grep {-e} "/home/ftp/pub/CPAN", "/home/ftp/pub/PAUSE";
1449 my $ans = prompt("Please enter the URL of your CPAN mirror",shift @default);
1450 if ($ans) {
1451 push @$urllist, $ans;
1452 next LOOP;
1453 }
1454 } else {
1455 last LOOP;
1456 }
1457 }
1458 if ($use_mby){
1459 read_mirrored_by($mby);
1460 } else {
1461 if (not defined $CPAN::Config->{connect_to_internet_ok}
1462 or not $CPAN::Config->{connect_to_internet_ok}) {
1463 $CPAN::Frontend->myprint("Configuration does not allow connecting to the internet.\n");
1464 }
1465 $CPAN::Frontend->myprint("Current set of CPAN URLs:\n");
1466 map { $CPAN::Frontend->myprint(" $_\n") } @$urllist;
1467 }
1468 bring_your_own();
1469 $CPAN::Config->{urllist} = $urllist;
1470}
1471
1472sub find_exe {
1473 my($exe,$path) = @_;
1474 my($dir);
1475 #warn "in find_exe exe[$exe] path[@$path]";
1476 for $dir (@$path) {
1477 my $abs = File::Spec->catfile($dir,$exe);
1478 if (($abs = MM->maybe_command($abs))) {
1479 return $abs;
1480 }
1481 }
1482}
1483
1484sub picklist {
1485 my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
1486 CPAN->debug("picklist('$items','$prompt','$default','$require_nonempty',".
1487 "'$empty_warning')") if $CPAN::DEBUG;
1488 $default ||= '';
1489
1490 my $pos = 0;
1491
1492 my @nums;
1493 SELECTION: while (1) {
1494
1495 # display, at most, 15 items at a time
1496 my $limit = $#{ $items } - $pos;
1497 $limit = 15 if $limit > 15;
1498
1499 # show the next $limit items, get the new position
1500 $pos = display_some($items, $limit, $pos, $default);
1501 $pos = 0 if $pos >= @$items;
1502
1503 my $num = prompt($prompt,$default);
1504
1505 @nums = split (' ', $num);
1506 {
1507 my %seen;
1508 @nums = grep { !$seen{$_}++ } @nums;
1509 }
1510 my $i = scalar @$items;
1511 unrangify(\@nums);
1512 if (grep (/\D/ || $_ < 1 || $_ > $i, @nums)) {
1513 $CPAN::Frontend->mywarn("invalid items entered, try again\n");
1514 if ("@nums" =~ /\D/) {
1515 $CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n");
1516 }
1517 next SELECTION;
1518 }
1519 if ($require_nonempty && !@nums) {
1520 $CPAN::Frontend->mywarn("$empty_warning\n");
1521 }
1522 $CPAN::Frontend->myprint("\n");
1523
1524 # a blank line continues...
1525 next SELECTION unless @nums;
1526 last;
1527 }
1528 for (@nums) { $_-- }
1529 @{$items}[@nums];
1530}
1531
1532sub unrangify ($) {
1533 my($nums) = $_[0];
1534 my @nums2 = ();
1535 while (@{$nums||[]}) {
1536 my $n = shift @$nums;
1537 if ($n =~ /^(\d+)-(\d+)$/) {
1538 my @range = $1 .. $2;
1539 # warn "range[@range]";
1540 push @nums2, @range;
1541 } else {
1542 push @nums2, $n;
1543 }
1544 }
1545 push @$nums, @nums2;
1546}
1547
1548sub display_some {
1549 my ($items, $limit, $pos, $default) = @_;
1550 $pos ||= 0;
1551
1552 my @displayable = @$items[$pos .. ($pos + $limit)];
1553 for my $item (@displayable) {
1554 $CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item);
1555 }
1556 my $hit_what = $default ? "SPACE RETURN" : "RETURN";
1557 $CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n",
1558 (@$items - $pos),
1559 $hit_what,
1560 ))
1561 if $pos < @$items;
1562 return $pos;
1563}
1564
1565sub read_mirrored_by {
1566 my $local = shift or return;
1567 my(%all,$url,$expected_size,$default,$ans,$host,
1568 $dst,$country,$continent,@location);
1569 my $fh = FileHandle->new;
1570 $fh->open($local) or die "Couldn't open $local: $!";
1571 local $/ = "\012";
1572 while (<$fh>) {
1573 ($host) = /^([\w\.\-]+)/ unless defined $host;
1574 next unless defined $host;
1575 next unless /\s+dst_(dst|location)/;
1576 /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
1577 ($continent, $country) = @location[-1,-2];
1578 $continent =~ s/\s\(.*//;
1579 $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
1580 /dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
1581 next unless $host && $dst && $continent && $country;
1582 $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
1583 undef $host;
1584 $dst=$continent=$country="";
1585 }
1586 $fh->close;
1587 $CPAN::Config->{urllist} ||= [];
1588 my @previous_urls = @{$CPAN::Config->{urllist}};
1589
1590 $CPAN::Frontend->myprint($prompts{urls_intro});
1591
1592 my (@cont, $cont, %cont, @countries, @urls, %seen);
1593 my $no_previous_warn =
1594 "Sorry! since you don't have any existing picks, you must make a\n" .
1595 "geographic selection.";
1596 my $offer_cont = [sort keys %all];
1597 if (@previous_urls) {
1598 push @$offer_cont, "(edit previous picks)";
1599 $default = @$offer_cont;
1600 }
1601 @cont = picklist($offer_cont,
1602 "Select your continent (or several nearby continents)",
1603 $default,
1604 ! @previous_urls,
1605 $no_previous_warn);
1606
1607
1608 foreach $cont (@cont) {
1609 my @c = sort keys %{$all{$cont}};
1610 @cont{@c} = map ($cont, 0..$#c);
1611 @c = map ("$_ ($cont)", @c) if @cont > 1;
1612 push (@countries, @c);
1613 }
1614 if (@previous_urls && @countries) {
1615 push @countries, "(edit previous picks)";
1616 $default = @countries;
1617 }
1618
1619 if (@countries) {
1620 @countries = picklist (\@countries,
1621 "Select your country (or several nearby countries)",
1622 $default,
1623 ! @previous_urls,
1624 $no_previous_warn);
1625 %seen = map (($_ => 1), @previous_urls);
1626 # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
1627 foreach $country (@countries) {
1628 next if $country =~ /edit previous picks/;
1629 (my $bare_country = $country) =~ s/ \(.*\)//;
1630 my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
1631 @u = grep (! $seen{$_}, @u);
1632 @u = map ("$_ ($bare_country)", @u)
1633 if @countries > 1;
1634 push (@urls, @u);
1635 }
1636 }
1637 push (@urls, map ("$_ (previous pick)", @previous_urls));
1638 my $prompt = "Select as many URLs as you like (by number),
1639put them on one line, separated by blanks, hyphenated ranges allowed
1640 e.g. '1 4 5' or '7 1-4 8'";
1641 if (@previous_urls) {
1642 $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
1643 (scalar @urls));
1644 $prompt .= "\n(or just hit RETURN to keep your previous picks)";
1645 }
1646
1647 @urls = picklist (\@urls, $prompt, $default);
1648 foreach (@urls) { s/ \(.*\)//; }
1649 push @$urllist, @urls;
1650}
1651
1652sub bring_your_own {
1653 my %seen = map (($_ => 1), @$urllist);
1654 my($ans,@urls);
1655 my $eacnt = 0; # empty answers
1656 do {
1657 my $prompt = "Enter another URL or RETURN to quit:";
1658 unless (%seen) {
1659 $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
1660
1661Please enter your CPAN site:};
1662 }
1663 $ans = prompt ($prompt, "");
1664
1665 if ($ans) {
1666 $ans =~ s|/?\z|/|; # has to end with one slash
1667 $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
1668 if ($ans =~ /^\w+:\/./) {
1669 push @urls, $ans unless $seen{$ans}++;
1670 } else {
1671 $CPAN::Frontend->
1672 myprint(sprintf(qq{"%s" doesn\'t look like an URL at first sight.
1673I\'ll ignore it for now.
1674You can add it to your %s
1675later if you\'re sure it\'s right.\n},
1676 $ans,
1677 $INC{'CPAN/MyConfig.pm'}
1678 || $INC{'CPAN/Config.pm'}
1679 || "configuration file",
1680 ));
1681 }
1682 } else {
1683 if (++$eacnt >= 5) {
1684 $CPAN::Frontend->
1685 mywarn("Giving up.\n");
1686 $CPAN::Frontend->mysleep(5);
1687 return;
1688 }
1689 }
1690 } while $ans || !%seen;
1691
1692 @$urllist = CPAN::_uniq(@$urllist, @urls);
1693 $CPAN::Config->{urllist} = $urllist;
1694 # xxx delete or comment these out when you're happy that it works
1695 $CPAN::Frontend->myprint("New set of picks:\n");
1696 for ( @$urllist ) { $CPAN::Frontend->myprint(" $_\n") };
1697}
1698
1699
1700sub _strip_spaces {
1701 $_[0] =~ s/^\s+//; # no leading spaces
1702 $_[0] =~ s/\s+\z//; # no trailing spaces
1703}
1704
1705sub prompt ($;$) {
1706 unless (defined &_real_prompt) {
1707 *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
1708 }
1709 my $ans = _real_prompt(@_);
1710
1711 _strip_spaces($ans);
1712
1713 return $ans;
1714}
1715
1716
1717sub prompt_no_strip ($;$) {
1718 return _real_prompt(@_);
1719}
1720
1721
1722
17231;