This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to CPAN-CPAN-1.87_64
[perl5.git] / lib / CPAN / FirstTime.pm
1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2 package CPAN::Mirrored::By;
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = sprintf "%.6f", substr(q$Rev: 848 $,4)/1000000 + 5.4;
6
7 sub new { 
8     my($self,@arg) = @_;
9     bless [@arg], $self;
10 }
11 sub continent { shift->[0] }
12 sub country { shift->[1] }
13 sub url { shift->[2] }
14
15 package CPAN::FirstTime;
16
17 use strict;
18 use ExtUtils::MakeMaker ();
19 use FileHandle ();
20 use File::Basename ();
21 use File::Path ();
22 use File::Spec;
23 use vars qw($VERSION $urllist);
24 $VERSION = sprintf "%.6f", substr(q$Rev: 848 $,4)/1000000 + 5.4;
25
26 =head1 NAME
27
28 CPAN::FirstTime - Utility for CPAN::Config file Initialization
29
30 =head1 SYNOPSIS
31
32 CPAN::FirstTime::init()
33
34 =head1 DESCRIPTION
35
36 The init routine asks a few questions and writes a CPAN/Config.pm or
37 CPAN/MyConfig.pm file (depending on what it is currently using).
38
39 =head1 LICENSE
40
41 This program is free software; you can redistribute it and/or
42 modify it under the same terms as Perl itself.
43
44 =cut
45
46 use vars qw( %prompts );
47
48 sub init {
49     my($configpm, %args) = @_;
50     use Config;
51     # extra args after 'o conf init'
52     my $matcher = $args{args} && @{$args{args}} ? $args{args}[0] : '';
53     if ($matcher =~ /^\/(.*)\/$/) {
54         # case /regex/ => take the first, ignore the rest
55         $matcher = $1;
56         shift @{$args{args}};
57         if (@{$args{args}}) {
58             local $" = " ";
59             $CPAN::Frontend->mywarn("Ignoring excessive arguments '@{$args{args}}'");
60             $CPAN::Frontend->mysleep(2);
61         }
62     } elsif (0 == length $matcher) {
63     } else {
64         # case WORD... => all arguments must be valid
65         for my $arg (@{$args{args}}) {
66             unless (exists $CPAN::HandleConfig::keys{$arg}) {
67                 $CPAN::Frontend->mywarn("'$arg' is not a valid configuration variable");
68                 return;
69             }
70         }
71         $matcher = "\\b(".join("|",@{$args{args}}).")\\b";
72     }
73     CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG;
74
75     unless ($CPAN::VERSION) {
76         require CPAN::Nox;
77     }
78     require CPAN::HandleConfig;
79     CPAN::HandleConfig::require_myconfig_or_config();
80     $CPAN::Config ||= {};
81     local($/) = "\n";
82     local($\) = "";
83     local($|) = 1;
84
85     my($ans,$default);
86
87     #
88     #= Files, directories
89     #
90
91     unless ($matcher) {
92         $CPAN::Frontend->myprint($prompts{manual_config});
93     }
94
95     my $manual_conf;
96
97     local *_real_prompt;
98     if ( $args{autoconfig} ) {
99         $manual_conf = "no";
100     } elsif ($matcher) {
101         $manual_conf = "yes";
102     } else {
103         my $_conf = prompt("Would you like me to configure as much as possible ".
104                            "automatically?", "yes");
105         $manual_conf = ($_conf and $_conf =~ /^y/i) ? "no" : "yes";
106     }
107     CPAN->debug("manual_conf[$manual_conf]") if $CPAN::DEBUG;
108     my $fastread;
109     {
110       if ($manual_conf =~ /^y/i) {
111         $fastread = 0;
112       } else {
113         $fastread = 1;
114         $CPAN::Config->{urllist} ||= [];
115
116         local $^W = 0;
117         # prototype should match that of &MakeMaker::prompt
118         my $current_second = time;
119         my $current_second_count = 0;
120         my $i_am_mad = 0;
121         *_real_prompt = sub ($;$) {
122           my($q,$a) = @_;
123           my($ret) = defined $a ? $a : "";
124           $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
125           eval { require Time::HiRes };
126           unless ($@) {
127               if (time == $current_second) {
128                   $current_second_count++;
129                   if ($current_second_count > 20) {
130                       # I don't like more than 20 prompts per second
131                       $i_am_mad++;
132                   }
133               } else {
134                   $current_second = time;
135                   $current_second_count = 0;
136                   $i_am_mad-- if $i_am_mad>0;
137               }
138               if ($i_am_mad>0){
139                   #require Carp;
140                   #Carp::cluck("SLEEEEEEEEPIIIIIIIIIIINGGGGGGGGGGG");
141                   Time::HiRes::sleep(0.1);
142               }
143           }
144           $ret;
145         };
146       }
147     }
148
149     if (!$matcher or 'cpan_home keep_source_where build_dir' =~ /$matcher/){
150         $CPAN::Frontend->myprint($prompts{config_intro});
151
152         if (!$matcher or 'cpan_home' =~ /$matcher/) {
153             my $cpan_home = $CPAN::Config->{cpan_home}
154                 || File::Spec->catdir($ENV{HOME}, ".cpan");
155
156             if (-d $cpan_home) {
157                 $CPAN::Frontend->myprint(qq{
158
159 I see you already have a  directory
160     $cpan_home
161 Shall we use it as the general CPAN build and cache directory?
162
163 });
164             } else {
165                 # no cpan-home, must prompt and get one
166                 $CPAN::Frontend->myprint($prompts{cpan_home_where});
167             }
168
169             $default = $cpan_home;
170             while ($ans = prompt("CPAN build and cache directory?",$default)) {
171                 unless (File::Spec->file_name_is_absolute($ans)) {
172                     require Cwd;
173                     my $cwd = Cwd::cwd();
174                     my $absans = File::Spec->catdir($cwd,$ans);
175                     $CPAN::Frontend->mywarn("The path '$ans' is not an ".
176                                             "absolute path. Please specify ".
177                                             "an absolute path\n");
178                     $default = $absans;
179                     next;
180                 }
181                 eval { File::Path::mkpath($ans); }; # dies if it can't
182                 if ($@) {
183                     $CPAN::Frontend->mywarn("Couldn't create directory $ans.\n".
184                                             "Please retry.\n");
185                     next;
186                 }
187                 if (-d $ans && -w _) {
188                     last;
189                 } else {
190                     $CPAN::Frontend->mywarn("Couldn't find directory $ans\n".
191                                             "or directory is not writable. Please retry.\n");
192                 }
193             }
194             $CPAN::Config->{cpan_home} = $ans;
195         }
196
197         if (!$matcher or 'keep_source_where' =~ /$matcher/) {
198             my_dflt_prompt("keep_source_where",
199                            File::Spec->catdir($CPAN::Config->{cpan_home},"sources"),
200                            $matcher,
201                           );
202         }
203
204         if (!$matcher or 'build_dir' =~ /$matcher/) {
205             my_dflt_prompt("build_dir",
206                            File::Spec->catdir($CPAN::Config->{cpan_home},"build"),
207                            $matcher
208                           );
209         }
210     }
211
212     #
213     #= Cache size, Index expire
214     #
215
216     if (!$matcher or 'build_cache' =~ /$matcher/){
217         $CPAN::Frontend->myprint($prompts{build_cache_intro});
218
219         # large enough to build large dists like Tk
220         my_dflt_prompt(build_cache => 100, $matcher);
221     }
222
223     if (!$matcher or 'index_expire' =~ /$matcher/) {
224         $CPAN::Frontend->myprint($prompts{index_expire_intro});
225
226         my_dflt_prompt(index_expire => 1, $matcher);
227     }
228
229     if (!$matcher or 'scan_cache' =~ /$matcher/){
230         $CPAN::Frontend->myprint($prompts{scan_cache_intro});
231
232         my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
233     }
234
235     #
236     #= cache_metadata
237     #
238
239     my_yn_prompt(cache_metadata => 1, $matcher);
240
241     #
242     #= Do we follow PREREQ_PM?
243     #
244
245     if (!$matcher or 'prerequisites_policy' =~ /$matcher/){
246         $CPAN::Frontend->myprint($prompts{prerequisites_policy_intro});
247
248         my_prompt_loop(prerequisites_policy => 'ask', $matcher,
249                        'follow|ask|ignore');
250     }
251
252     #
253     #= Module::Signature
254     #
255     if (!$matcher or 'check_sigs' =~ /$matcher/) {
256         my_yn_prompt(check_sigs => 0, $matcher);
257     }
258
259     #
260     #= CPAN::Reporter
261     #
262     if (!$matcher or 'test_report' =~ /$matcher/) {
263         my_yn_prompt(test_report => 0, $matcher);
264         if (
265             $CPAN::Config->{test_report} && 
266             $CPAN::META->has_inst("CPAN::Reporter") &&
267             CPAN::Reporter->can('configure')
268            ) {
269             $CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n");
270             CPAN::Reporter::configure();
271             $CPAN::Frontend->myprint("\nReturning to CPAN configuration.\n");
272         }
273     }
274
275     #
276     #= External programs
277     #
278
279     my @external_progs = qw/bzip2 gzip tar unzip make
280                       curl lynx wget ncftpget ncftp ftp
281                       gpg/;
282     my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
283     if (!$matcher or "@external_progs" =~ /$matcher/) {
284         $CPAN::Frontend->myprint($prompts{external_progs});
285
286         my $old_warn = $^W;
287         local $^W if $^O eq 'MacOS';
288         local $^W = $old_warn;
289         my $progname;
290         for $progname (@external_progs) {
291             if ($^O eq 'MacOS') {
292                 $CPAN::Config->{$progname} = 'not_here';
293                 next;
294             }
295             next if $matcher && $progname !~ /$matcher/;
296
297             my $progcall = $progname;
298             # we don't need ncftp if we have ncftpget
299             next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
300             my $path = $CPAN::Config->{$progname}
301                 || $Config::Config{$progname}
302                     || "";
303             if (File::Spec->file_name_is_absolute($path)) {
304                 # testing existence is not good enough, some have these exe
305                 # extensions
306
307                 # warn "Warning: configured $path does not exist\n" unless -e $path;
308                 # $path = "";
309             } elsif ($path =~ /^\s+$/) {
310                 # preserve disabled programs
311             } else {
312                 $path = '';
313             }
314             unless ($path) {
315                 # e.g. make -> nmake
316                 $progcall = $Config::Config{$progname} if $Config::Config{$progname};
317             }
318
319             $path ||= find_exe($progcall,[@path]);
320             $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH\n") unless
321                 $path; # not -e $path, because find_exe already checked that
322             $ans = prompt("Where is your $progname program?",$path) || $path;
323             $CPAN::Config->{$progname} = $ans;
324         }
325     }
326
327     if (!$matcher or 'pager' =~ /$matcher/) {
328         my $path = $CPAN::Config->{'pager'} || 
329             $ENV{PAGER} || find_exe("less",[@path]) || 
330                 find_exe("more",[@path]) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
331                     || "more";
332         $ans = prompt("What is your favorite pager program?",$path);
333         $CPAN::Config->{'pager'} = $ans;
334     }
335
336     if (!$matcher or 'shell' =~ /$matcher/) {
337         my $path = $CPAN::Config->{'shell'};
338         if (File::Spec->file_name_is_absolute($path)) {
339             $CPAN::Frontend->mywarn("Warning: configured $path does not exist\n")
340                 unless -e $path;
341             $path = "";
342         }
343         $path ||= $ENV{SHELL};
344         $path ||= $ENV{COMSPEC} if $^O eq "MSWin32";
345         if ($^O eq 'MacOS') {
346             $CPAN::Config->{'shell'} = 'not_here';
347         } else {
348             $path =~ s,\\,/,g if $^O eq 'os2';  # Cosmetic only
349             $ans = prompt("What is your favorite shell?",$path);
350             $CPAN::Config->{'shell'} = $ans;
351         }
352     }
353
354     #
355     #= Installer, arguments to make etc.
356     #
357
358     if (!$matcher or 'prefer_installer' =~ /$matcher/){
359         $CPAN::Frontend->myprint($prompts{prefer_installer_intro});
360
361         my_prompt_loop(prefer_installer => 'EUMM', $matcher, 'MB|EUMM');
362     }
363
364     if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/){
365         $CPAN::Frontend->myprint($prompts{makepl_arg_intro});
366
367         my_dflt_prompt(makepl_arg => "", $matcher);
368         my_dflt_prompt(make_arg => "", $matcher);
369     }
370
371     require CPAN::HandleConfig;
372     if (exists $CPAN::HandleConfig::keys{make_install_make_command}) {
373         # as long as Windows needs $self->_build_command, we cannot
374         # support sudo on windows :-)
375         my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "",
376                        $matcher);
377     }
378
379     my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "", 
380                    $matcher);
381
382     if (!$matcher or 'mbuildpl_arg mbuild_arg' =~ /$matcher/){
383         $CPAN::Frontend->myprint($prompts{mbuildpl_arg_intro});
384
385         my_dflt_prompt(mbuildpl_arg => "", $matcher);
386
387         my_dflt_prompt(mbuild_arg => "", $matcher);
388     }
389
390     if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command}) {
391         # as long as Windows needs $self->_build_command, we cannot
392         # support sudo on windows :-)
393         my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher);
394     }
395
396     my_dflt_prompt(mbuild_install_arg => "", $matcher);
397
398     #
399     #= Alarm period
400     #
401
402     if (!$matcher or 'inactivity_timeout' =~ /$matcher/) {
403         $CPAN::Frontend->myprint($prompts{inactivity_timeout_intro});
404         $default = $CPAN::Config->{inactivity_timeout} || 0;
405         $CPAN::Config->{inactivity_timeout} =
406             prompt("Timeout for inactivity during {Makefile,Build}.PL?",$default);
407     }
408
409     #
410     #= Proxies
411     #
412
413     my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/;
414     my @proxy_user_vars = qw/proxy_user proxy_pass/;
415     if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/){
416         $CPAN::Frontend->myprint($prompts{proxy_intro});
417
418         for (@proxy_vars) {
419             if (!$matcher or /$matcher/){
420                 $default = $CPAN::Config->{$_} || $ENV{$_} || "";
421                 $CPAN::Config->{$_} = prompt("Your $_?",$default);
422             }
423         }
424
425         if ($CPAN::Config->{ftp_proxy} ||
426             $CPAN::Config->{http_proxy}) {
427
428             $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || "";
429
430             $CPAN::Frontend->myprint($prompts{proxy_user});
431
432             if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
433                 $CPAN::Frontend->myprint($prompts{proxy_pass});
434
435                 if ($CPAN::META->has_inst("Term::ReadKey")) {
436                     Term::ReadKey::ReadMode("noecho");
437                 } else {
438                     $CPAN::Frontend->myprint($prompts{password_warn});
439                 }
440                 $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
441                 if ($CPAN::META->has_inst("Term::ReadKey")) {
442                     Term::ReadKey::ReadMode("restore");
443                 }
444                 $CPAN::Frontend->myprint("\n\n");
445             }
446         }
447     }
448
449     #
450     #= how FTP works
451     #
452
453     my_yn_prompt(ftp_passive => 1, $matcher);
454
455     #
456     #= how cwd works
457     #
458
459     if (!$matcher or 'getcwd' =~ /$matcher/){
460         $CPAN::Frontend->myprint($prompts{getcwd_intro});
461
462         my_prompt_loop(getcwd => 'cwd', $matcher,
463                        'cwd|getcwd|fastcwd|backtickcwd');
464     }
465
466     #
467     #= the CPAN shell itself
468     #
469
470     my_yn_prompt(commandnumber_in_prompt => 1, $matcher);
471     my_yn_prompt(term_ornaments => 1, $matcher);
472     if ("colorize_output colorize_print colorize_warn" =~ $matcher) {
473         my_yn_prompt(colorize_output => 0, $matcher);
474         if ($CPAN::Config->{colorize_output}) {
475             for my $tuple (
476                            ["colorize_print", "bold blue"],
477                            ["colorize_warn", "bold red"],
478                           ) {
479                 my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher);
480                 if ($CPAN::META->has_inst("Term::ANSIColor")) {
481                     eval { Term::ANSIColor::color($CPAN::Config->{$tuple->[0]})};
482                     if ($@) {
483                         $CPAN::Config->{$tuple->[0]} = $tuple->[1];
484                         $CPAN::Frontend->mywarn($@."setting to default '$tuple->[1]'\n");
485                     }
486                 }
487             }
488         }
489     }
490
491     #
492     #== term_is_latin
493     #
494
495     if (!$matcher or 'term_is_latin' =~ /$matcher/){
496         $CPAN::Frontend->myprint($prompts{term_is_latin});
497         my_yn_prompt(term_is_latin => 1, $matcher);
498     }
499
500     #
501     #== save history in file 'histfile'
502     #
503
504     if (!$matcher or 'histfile histsize' =~ /$matcher/) {
505         $CPAN::Frontend->myprint($prompts{histfile_intro});
506         defined($default = $CPAN::Config->{histfile}) or
507             $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
508         $ans = prompt("File to save your history?", $default);
509         $CPAN::Config->{histfile} = $ans;
510
511         if ($CPAN::Config->{histfile}) {
512             defined($default = $CPAN::Config->{histsize}) or $default = 100;
513             $ans = prompt("Number of lines to save?", $default);
514             $CPAN::Config->{histsize} = $ans;
515         }
516     }
517
518     #
519     #== do an ls on the m or the d command
520     #
521     if (!$matcher or 'show_upload_date' =~ /$matcher/) {
522         $CPAN::Frontend->myprint($prompts{show_upload_date_intro});
523
524         defined($default = $CPAN::Config->{show_upload_date}) or
525             $default = 'n';
526         $ans = prompt("Always try to show upload date with 'd' and 'm' command (yes/no)?",
527                       ($default ? 'yes' : 'no'));
528         $CPAN::Config->{show_upload_date} = ($ans =~ /^[y1]/i ? 1 : 0);
529     }
530
531     #
532     #= MIRRORED.BY and conf_sites()
533     #
534
535     if ($matcher){
536         if ("urllist" =~ $matcher) {
537             # conf_sites would go into endless loop with the smash prompt
538             local *_real_prompt;
539             *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
540             conf_sites();
541         }
542     } elsif ($fastread) {
543         $CPAN::Frontend->myprint("Autoconfigured everything but 'urllist'.\n".
544                                  "Please call 'o conf init urllist' to configure ".
545                                  "your CPAN server(s) now!");
546     } else {
547         conf_sites();
548     }
549
550     # We don't ask this one now, it's plain silly and maybe is not
551     # even used correctly everywhere.
552     $CPAN::Config->{inhibit_startup_message} = 0;
553
554     $CPAN::Frontend->myprint("\n\n");
555     if ($matcher) {
556         $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ".
557                                  "make the config permanent!\n\n");
558     } else {
559         CPAN::HandleConfig->commit($configpm);
560     }
561 }
562
563 sub my_dflt_prompt {
564     my ($item, $dflt, $m) = @_;
565     my $default = $CPAN::Config->{$item} || $dflt;
566
567     $DB::single = 1;
568     if (!$m || $item =~ /$m/) {
569         $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
570     } else {
571         $CPAN::Config->{$item} = $default;
572     }
573 }
574
575 sub my_yn_prompt {
576     my ($item, $dflt, $m) = @_;
577     my $default;
578     defined($default = $CPAN::Config->{$item}) or $default = $dflt;
579
580     $DB::single = 1;
581     if (!$m || $item =~ /$m/) {
582         if (my $intro = $prompts{$item . "_intro"}) {
583             $CPAN::Frontend->myprint($intro);
584         }
585         my $ans = prompt($prompts{$item}, $default ? 'yes' : 'no');
586         $CPAN::Config->{$item} = ($ans =~ /^[y1]/i ? 1 : 0);
587     } else {
588         $CPAN::Config->{$item} = $default;
589     }
590 }
591
592 sub my_prompt_loop {
593     my ($item, $dflt, $m, $ok) = @_;
594     my $default = $CPAN::Config->{$item} || $dflt;
595     my $ans;
596
597     $DB::single = 1;
598     if (!$m || $item =~ /$m/) {
599         do { $ans = prompt($prompts{$item}, $default);
600         } until $ans =~ /$ok/;
601         $CPAN::Config->{$item} = $ans;
602     } else {
603         $CPAN::Config->{$item} = $default;
604     }
605 }
606
607
608 sub conf_sites {
609   my $m = 'MIRRORED.BY';
610   my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
611   File::Path::mkpath(File::Basename::dirname($mby));
612   if (-f $mby && -f $m && -M $m < -M $mby) {
613     require File::Copy;
614     File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
615   }
616   my $loopcount = 0;
617   local $^T = time;
618   my $overwrite_local = 0;
619   if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) {
620       my $mtime = localtime((stat _)[9]);
621       my $prompt = qq{Found $mby as of $mtime
622
623 I\'d use that as a database of CPAN sites. If that is OK for you,
624 please answer 'y', but if you want me to get a new database now,
625 please answer 'n' to the following question.
626
627 Shall I use the local database in $mby?};
628       my $ans = prompt($prompt,"y");
629       $overwrite_local = 1 unless $ans =~ /^y/i;
630   }
631   while ($mby) {
632     if ($overwrite_local) {
633       $CPAN::Frontend->myprint(qq{Trying to overwrite $mby\n});
634       $mby = CPAN::FTP->localize($m,$mby,3);
635       $overwrite_local = 0;
636     } elsif ( ! -f $mby ){
637       $CPAN::Frontend->myprint(qq{You have no $mby\n  I\'m trying to fetch one\n});
638       $mby = CPAN::FTP->localize($m,$mby,3);
639     } elsif (-M $mby > 60 && $loopcount == 0) {
640         $CPAN::Frontend->myprint(qq{Your $mby is older than 60 days,\n  I\'m trying }.
641                                  qq{to fetch one\n});
642         $mby = CPAN::FTP->localize($m,$mby,3);
643         $loopcount++;
644     } elsif (-s $mby == 0) {
645       $CPAN::Frontend->myprint(qq{You have an empty $mby,\n  I\'m trying to fetch one\n});
646       $mby = CPAN::FTP->localize($m,$mby,3);
647     } else {
648       last;
649     }
650   }
651   local $urllist = [];
652   read_mirrored_by($mby);
653   bring_your_own();
654   $CPAN::Config->{urllist} = $urllist;
655 }
656
657 sub find_exe {
658     my($exe,$path) = @_;
659     my($dir);
660     #warn "in find_exe exe[$exe] path[@$path]";
661     for $dir (@$path) {
662         my $abs = File::Spec->catfile($dir,$exe);
663         if (($abs = MM->maybe_command($abs))) {
664             return $abs;
665         }
666     }
667 }
668
669 sub picklist {
670     my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
671     CPAN->debug("picklist('$items','$prompt','$default','$require_nonempty',".
672                 "'$empty_warning')") if $CPAN::DEBUG;
673     $default ||= '';
674
675     my $pos = 0;
676
677     my @nums;
678   SELECTION: while (1) {
679
680         # display, at most, 15 items at a time
681         my $limit = $#{ $items } - $pos;
682         $limit = 15 if $limit > 15;
683
684         # show the next $limit items, get the new position
685         $pos = display_some($items, $limit, $pos, $default);
686         $pos = 0 if $pos >= @$items;
687
688         my $num = prompt($prompt,$default);
689
690         @nums = split (' ', $num);
691         {
692             my %seen;
693             @nums = grep { !$seen{$_}++ } @nums;
694         }
695         my $i = scalar @$items;
696         unrangify(\@nums);
697         if (grep (/\D/ || $_ < 1 || $_ > $i, @nums)){
698             $CPAN::Frontend->mywarn("invalid items entered, try again\n");
699             if ("@nums" =~ /\D/) {
700                 $CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n");
701             }
702             next SELECTION;
703         }
704         if ($require_nonempty && !@nums) {
705             $CPAN::Frontend->mywarn("$empty_warning\n");
706         }
707         $CPAN::Frontend->myprint("\n");
708
709         # a blank line continues...
710         next SELECTION unless @nums;
711         last;
712     }
713     for (@nums) { $_-- }
714     @{$items}[@nums];
715 }
716
717 sub unrangify ($) {
718     my($nums) = $_[0];
719     my @nums2 = ();
720     while (@{$nums||[]}) {
721         my $n = shift @$nums;
722         if ($n =~ /^(\d+)-(\d+)$/) {
723             my @range = $1 .. $2;
724             # warn "range[@range]";
725             push @nums2, @range;
726         } else {
727             push @nums2, $n;
728         }
729     }
730     push @$nums, @nums2;
731 }
732
733 sub display_some {
734     my ($items, $limit, $pos, $default) = @_;
735     $pos ||= 0;
736
737     my @displayable = @$items[$pos .. ($pos + $limit)];
738     for my $item (@displayable) {
739         $CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item);
740     }
741     my $hit_what = $default ? "SPACE RETURN" : "RETURN";
742     $CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n",
743                                      (@$items - $pos),
744                                      $hit_what,
745                                     ))
746         if $pos < @$items;
747     return $pos;
748 }
749
750 sub read_mirrored_by {
751     my $local = shift or return;
752     my(%all,$url,$expected_size,$default,$ans,$host,
753        $dst,$country,$continent,@location);
754     my $fh = FileHandle->new;
755     $fh->open($local) or die "Couldn't open $local: $!";
756     local $/ = "\012";
757     while (<$fh>) {
758         ($host) = /^([\w\.\-]+)/ unless defined $host;
759         next unless defined $host;
760         next unless /\s+dst_(dst|location)/;
761         /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
762             ($continent, $country) = @location[-1,-2];
763         $continent =~ s/\s\(.*//;
764         $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
765         /dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
766         next unless $host && $dst && $continent && $country;
767         $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
768         undef $host;
769         $dst=$continent=$country="";
770     }
771     $fh->close;
772     $CPAN::Config->{urllist} ||= [];
773     my @previous_urls = @{$CPAN::Config->{urllist}};
774
775     $CPAN::Frontend->myprint($prompts{urls_intro});
776
777     my (@cont, $cont, %cont, @countries, @urls, %seen);
778     my $no_previous_warn =
779         "Sorry! since you don't have any existing picks, you must make a\n" .
780             "geographic selection.";
781     my $offer_cont = [sort keys %all];
782     if (@previous_urls) {
783         push @$offer_cont, "(edit previous picks)";
784         $default = @$offer_cont;
785     }
786     @cont = picklist($offer_cont,
787                      "Select your continent (or several nearby continents)",
788                      $default,
789                      ! @previous_urls,
790                      $no_previous_warn);
791
792
793     foreach $cont (@cont) {
794         my @c = sort keys %{$all{$cont}};
795         @cont{@c} = map ($cont, 0..$#c);
796         @c = map ("$_ ($cont)", @c) if @cont > 1;
797         push (@countries, @c);
798     }
799     if (@previous_urls && @countries) {
800         push @countries, "(edit previous picks)";
801         $default = @countries;
802     }
803
804     if (@countries) {
805         @countries = picklist (\@countries,
806                                "Select your country (or several nearby countries)",
807                                $default,
808                                ! @previous_urls,
809                                $no_previous_warn);
810         %seen = map (($_ => 1), @previous_urls);
811         # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
812         foreach $country (@countries) {
813             next if $country =~ /edit previous picks/;
814             (my $bare_country = $country) =~ s/ \(.*\)//;
815             my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
816             @u = grep (! $seen{$_}, @u);
817             @u = map ("$_ ($bare_country)", @u)
818                 if @countries > 1;
819             push (@urls, @u);
820         }
821     }
822     push (@urls, map ("$_ (previous pick)", @previous_urls));
823     my $prompt = "Select as many URLs as you like (by number),
824 put them on one line, separated by blanks, hyphenated ranges allowed
825  e.g. '1 4 5' or '7 1-4 8'";
826     if (@previous_urls) {
827         $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
828                          (scalar @urls));
829         $prompt .= "\n(or just hit RETURN to keep your previous picks)";
830     }
831
832     @urls = picklist (\@urls, $prompt, $default);
833     foreach (@urls) { s/ \(.*\)//; }
834     push @$urllist, @urls;
835 }
836
837 sub bring_your_own {
838     my %seen = map (($_ => 1), @$urllist);
839     my($ans,@urls);
840     do {
841         my $prompt = "Enter another URL or RETURN to quit:";
842         unless (%seen) {
843             $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
844
845 Please enter your CPAN site:};
846         }
847         $ans = prompt ($prompt, "");
848
849         if ($ans) {
850             $ans =~ s|/?\z|/|; # has to end with one slash
851             $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
852             if ($ans =~ /^\w+:\/./) {
853                 push @urls, $ans unless $seen{$ans}++;
854             } else {
855                 $CPAN::Frontend->
856                     myprint(sprintf(qq{"%s" doesn\'t look like an URL at first sight.
857 I\'ll ignore it for now.
858 You can add it to your %s
859 later if you\'re sure it\'s right.\n},
860                                    $ans,
861                                    $INC{'CPAN/MyConfig.pm'}
862                                    || $INC{'CPAN/Config.pm'}
863                                    || "configuration file",
864                                   ));
865             }
866         }
867     } while $ans || !%seen;
868
869     push @$urllist, @urls;
870     # xxx delete or comment these out when you're happy that it works
871     $CPAN::Frontend->myprint("New set of picks:\n");
872     map { $CPAN::Frontend->myprint("  $_\n") } @$urllist;
873 }
874
875
876 sub _strip_spaces {
877     $_[0] =~ s/^\s+//;  # no leading spaces
878     $_[0] =~ s/\s+\z//; # no trailing spaces
879 }
880
881 sub prompt ($;$) {
882     unless (defined &_real_prompt) {
883         *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
884     }
885     my $ans = _real_prompt(@_);
886
887     _strip_spaces($ans);
888
889     return $ans;
890 }
891
892
893 sub prompt_no_strip ($;$) {
894     return _real_prompt(@_);
895 }
896
897
898 BEGIN {
899
900 my @prompts = (
901
902 manual_config => qq[
903
904 CPAN is the world-wide archive of perl resources. It consists of about
905 300 sites that all replicate the same contents around the globe. Many
906 countries have at least one CPAN site already. The resources found on
907 CPAN are easily accessible with the CPAN.pm module. If you want to use
908 CPAN.pm, lots of things have to be configured. Fortunately, most of
909 them can be determined automatically. If you prefer the automatic
910 configuration, answer 'yes' below.
911
912 If you prefer to enter a dialog instead, you can answer 'no' to this
913 question and I'll let you configure in small steps one thing after the
914 other. (Note: you can revisit this dialog anytime later by typing 'o
915 conf init' at the cpan prompt.)
916
917 ],
918
919 config_intro => qq{
920
921 The following questions are intended to help you with the
922 configuration. The CPAN module needs a directory of its own to cache
923 important index files and maybe keep a temporary mirror of CPAN files.
924 This may be a site-wide directory or a personal directory.
925
926 },
927
928 # cpan_home => qq{ },
929
930 cpan_home_where => qq{
931
932 First of all, I\'d like to create this directory. Where?
933
934 },
935
936 keep_source_where => qq{
937
938 Unless you are accessing the CPAN via the filesystem directly CPAN.pm
939 needs to keep the source files it downloads somewhere. Please supply a
940 directory where the downloaded files are to be kept.},
941
942 build_cache_intro => qq{
943
944 How big should the disk cache be for keeping the build directories
945 with all the intermediate files\?
946
947 },
948
949 build_cache =>
950 "Cache size for build directory (in MB)?",
951
952 build_dir =>
953
954 "Directory where the build process takes place?",
955
956 scan_cache_intro => qq{
957
958 By default, each time the CPAN module is started, cache scanning is
959 performed to keep the cache size in sync. To prevent this, answer
960 'never'.
961
962 },
963
964 scan_cache => "Perform cache scanning (atstart or never)?",
965
966 cache_metadata_intro => qq{
967
968 To considerably speed up the initial CPAN shell startup, it is
969 possible to use Storable to create a cache of metadata. If Storable
970 is not available, the normal index mechanism will be used.
971
972 },
973
974 cache_metadata => qq{Cache metadata (yes/no)?},
975
976 term_is_latin_intro => qq{
977
978 The next option deals with the charset (aka character set) your
979 terminal supports. In general, CPAN is English speaking territory, so
980 the charset does not matter much, but some of the aliens out there who
981 upload their software to CPAN bear names that are outside the ASCII
982 range. If your terminal supports UTF-8, you should say no to the next
983 question.  If it supports ISO-8859-1 (also known as LATIN1) then you
984 should say yes.  If it supports neither, your answer does not matter
985 because you will not be able to read the names of some authors
986 anyway. If you answer no, names will be output in UTF-8.
987
988 },
989
990 term_is_latin => qq{Your terminal expects ISO-8859-1 (yes/no)?},
991
992 histfile_intro => qq{
993
994 If you have one of the readline packages (Term::ReadLine::Perl,
995 Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN
996 shell will have history support. The next two questions deal with the
997 filename of the history file and with its size. If you do not want to
998 set this variable, please hit SPACE RETURN to the following question.
999
1000 },
1001
1002 histfile => qq{File to save your history?},
1003
1004 show_upload_date_intro => qq{
1005
1006 The 'd' and the 'm' command normally only show you information they
1007 have in their in-memory database and thus will never connect to the
1008 internet. If you set the 'show_upload_date' variable to true, 'm' and
1009 'd' will additionally show you the upload date of the module or
1010 distribution. Per default this feature is off because it may require a
1011 net connection to get at the upload date.
1012
1013 },
1014
1015 show_upload_date =>
1016 "Always try to show upload date with 'd' and 'm' command (yes/no)?",
1017
1018 prerequisites_policy_intro => qq{
1019
1020 The CPAN module can detect when a module which you are trying to build
1021 depends on prerequisites. If this happens, it can build the
1022 prerequisites for you automatically ('follow'), ask you for
1023 confirmation ('ask'), or just ignore them ('ignore'). Please set your
1024 policy to one of the three values.
1025
1026 },
1027
1028 prerequisites_policy =>
1029 "Policy on building prerequisites (follow, ask or ignore)?",
1030
1031 check_sigs_intro  => qq{
1032
1033 CPAN packages can be digitally signed by authors and thus verified
1034 with the security provided by strong cryptography. The exact mechanism
1035 is defined in the Module::Signature module. While this is generally
1036 considered a good thing, it is not always convenient to the end user
1037 to install modules that are signed incorrectly or where the key of the
1038 author is not available or where some prerequisite for
1039 Module::Signature has a bug and so on.
1040
1041 With the check_sigs parameter you can turn signature checking on and
1042 off. The default is off for now because the whole tool chain for the
1043 functionality is not yet considered mature by some. The author of
1044 CPAN.pm would recommend setting it to true most of the time and
1045 turning it off only if it turns out to be annoying.
1046
1047 Note that if you do not have Module::Signature installed, no signature
1048 checks will be performed at all.
1049
1050 },
1051
1052 check_sigs =>
1053 qq{Always try to check and verify signatures if a SIGNATURE file is in the package
1054 and Module::Signature is installed (yes/no)?},
1055
1056 test_report_intro =>
1057 qq{
1058
1059 The goal of the CPAN Testers project (http://testers.cpan.org/) is to
1060 test as many CPAN packages as possible on as many platforms as
1061 possible.  This provides valuable feedback to module authors and
1062 potential users to identify bugs or platform compatibility issues and
1063 improves the overall quality and value of CPAN.
1064
1065 One way you can contribute is to send test results for each module
1066 that you install.  If you install the CPAN::Reporter module, you have
1067 the option to automatically generate and email test reports to CPAN
1068 Testers whenever you run tests on a CPAN package.
1069
1070 See the CPAN::Reporter documentation for additional details and
1071 configuration settings.  If your firewall blocks outgoing email,
1072 you will need to configure CPAN::Reporter before sending reports.
1073
1074 },
1075
1076 test_report =>
1077 qq{Email test reports if CPAN::Reporter is installed (yes/no)?},
1078
1079 external_progs => qq{
1080
1081 The CPAN module will need a few external programs to work properly.
1082 Please correct me, if I guess the wrong path for a program. Don\'t
1083 panic if you do not have some of them, just press ENTER for those. To
1084 disable the use of a program, you can type a space followed by ENTER.
1085
1086 },
1087
1088 prefer_installer_intro => qq{
1089
1090 When you have Module::Build installed and a module comes with both a
1091 Makefile.PL and a Build.PL, which shall have precedence? The two
1092 installer modules we have are the old and well established
1093 ExtUtils::MakeMaker (for short: EUMM) which uses the Makefile.PL and
1094 the next generation installer Module::Build (MB) works with the
1095 Build.PL.
1096
1097 },
1098
1099 prefer_installer =>
1100 qq{In case you could choose, which installer would you prefer (EUMM or MB)?},
1101
1102 makepl_arg_intro => qq{
1103
1104 Every Makefile.PL is run by perl in a separate process. Likewise we
1105 run \'make\' and \'make install\' in separate processes. If you have
1106 any parameters \(e.g. PREFIX, LIB, UNINST or the like\) you want to
1107 pass to the calls, please specify them here.
1108
1109 If you don\'t understand this question, just press ENTER.
1110 },
1111
1112 makepl_arg => qq{
1113 Parameters for the 'perl Makefile.PL' command?
1114 Typical frequently used settings:
1115
1116     PREFIX=~/perl    # non-root users (please see manual for more hints)
1117
1118 Your choice: },
1119
1120 make_arg => qq{Parameters for the 'make' command?
1121 Typical frequently used setting:
1122
1123     -j3              # dual processor system
1124
1125 Your choice: },
1126
1127
1128 make_install_make_command => qq{Do you want to use a different make command for 'make install'?
1129 Cautious people will probably prefer:
1130
1131     su root -c make
1132 or
1133     sudo make
1134 or
1135     /path1/to/sudo -u admin_account /path2/to/make
1136
1137 or some such. Your choice: },
1138
1139
1140 make_install_arg => qq{Parameters for the 'make install' command?
1141 Typical frequently used setting:
1142
1143     UNINST=1         # to always uninstall potentially conflicting files
1144
1145 Your choice: },
1146
1147
1148 mbuildpl_arg_intro => qq{
1149
1150 The next questions deal with Module::Build support.
1151
1152 A Build.PL is run by perl in a separate process. Likewise we run
1153 './Build' and './Build install' in separate processes. If you have any
1154 parameters you want to pass to the calls, please specify them here.
1155
1156 },
1157
1158 mbuildpl_arg => qq{Parameters for the 'perl Build.PL' command?
1159 Typical frequently used settings:
1160
1161     --install_base /home/xxx             # different installation directory
1162
1163 Your choice: },
1164
1165 mbuild_arg => qq{Parameters for the './Build' command?
1166 Setting might be:
1167
1168     --extra_linker_flags -L/usr/foo/lib  # non-standard library location
1169
1170 Your choice: },
1171
1172
1173 mbuild_install_build_command => qq{Do you want to use a different command for './Build install'?
1174 Sudo users will probably prefer:
1175
1176     su root -c ./Build
1177 or
1178     sudo ./Build
1179 or
1180     /path1/to/sudo -u admin_account ./Build
1181
1182 or some such. Your choice: },
1183
1184
1185 mbuild_install_arg => qq{Parameters for the './Build install' command?
1186 Typical frequently used setting:
1187
1188     --uninst 1                           # uninstall conflicting files
1189
1190 Your choice: },
1191
1192
1193
1194 inactivity_timeout_intro => qq{
1195
1196 Sometimes you may wish to leave the processes run by CPAN alone
1197 without caring about them. Because the Makefile.PL or the Build.PL
1198 sometimes contains question you\'re expected to answer, you can set a
1199 timer that will kill a 'perl Makefile.PL' process after the specified
1200 time in seconds.
1201
1202 If you set this value to 0, these processes will wait forever. This is
1203 the default and recommended setting.
1204
1205 },
1206
1207 inactivity_timeout => 
1208 qq{Timeout for inactivity during {Makefile,Build}.PL? },
1209
1210
1211 proxy_intro => qq{
1212
1213 If you\'re accessing the net via proxies, you can specify them in the
1214 CPAN configuration or via environment variables. The variable in
1215 the \$CPAN::Config takes precedence.
1216
1217 },
1218
1219 proxy_user => qq{
1220
1221 If your proxy is an authenticating proxy, you can store your username
1222 permanently. If you do not want that, just press RETURN. You will then
1223 be asked for your username in every future session.
1224
1225 },
1226
1227 proxy_pass => qq{
1228
1229 Your password for the authenticating proxy can also be stored
1230 permanently on disk. If this violates your security policy, just press
1231 RETURN. You will then be asked for the password in every future
1232 session.
1233
1234 },
1235
1236 urls_intro => qq{
1237
1238 Now we need to know where your favorite CPAN sites are located. Push
1239 a few sites onto the array (just in case the first on the array won\'t
1240 work). If you are mirroring CPAN to your local workstation, specify a
1241 file: URL.
1242
1243 First, pick a nearby continent and country by typing in the number(s)
1244 in front of the item(s) you want to select. You can pick several of
1245 each, separated by spaces. Then, you will be presented with a list of
1246 URLs of CPAN mirrors in the countries you selected, along with
1247 previously selected URLs. Select some of those URLs, or just keep the
1248 old list. Finally, you will be prompted for any extra URLs -- file:,
1249 ftp:, or http: -- that host a CPAN mirror.
1250
1251 },
1252
1253 password_warn => qq{
1254
1255 Warning: Term::ReadKey seems not to be available, your password will
1256 be echoed to the terminal!
1257
1258 },
1259
1260 commandnumber_in_prompt => qq{
1261
1262 The prompt of the cpan shell can contain the current command number
1263 for easier tracking of the session or be a plain string. Do you want
1264 the command number in the prompt (yes/no)?},
1265
1266 ftp_passive => qq{
1267
1268 Shall we always set FTP_PASSIVE envariable when dealing with ftp
1269 download (yes/no)?},
1270
1271 # taken from the manpage:
1272 getcwd_intro => qq{
1273
1274 CPAN.pm changes the current working directory often and needs to
1275 determine its own current working directory. Per default it uses
1276 Cwd::cwd but if this doesn't work on your system for some reason,
1277 alternatives can be configured according to the following table:
1278
1279     cwd         Cwd::cwd
1280     getcwd      Cwd::getcwd
1281     fastcwd     Cwd::fastcwd
1282     backtickcwd external command cwd
1283
1284 },
1285
1286 getcwd => qq{Preferred method for determining the current working directory?},
1287
1288 index_expire_intro => qq{
1289
1290 The CPAN indexes are usually rebuilt once or twice per hour, but the
1291 typical CPAN mirror mirrors only once or twice per day. Depending on
1292 the quality of your mirror and your desire to be on the bleeding edge,
1293 you may want to set the following value to more or less than one day
1294 (which is the default). It determines after how many days CPAN.pm
1295 downloads new indexes.
1296
1297 },
1298
1299 index_expire => qq{Let the index expire after how many days?},
1300
1301 term_ornaments => qq{
1302
1303 When using Term::ReadLine, you can turn ornaments on so that your
1304 input stands out against the output from CPAN.pm. Do you want to turn
1305 ornaments on?},
1306
1307 colorize_output => qq{
1308
1309 When you have Term::ANSIColor installed, you can turn on colorized
1310 output to have some visual differences between normal CPAN.pm output,
1311 warnings, and the output of the modules being installed. Set your
1312 favorite colors after some experimenting with the Term::ANSIColor
1313 module. Do you want to turn on colored output?},
1314
1315 colorize_print => qq{Color for normal output?},
1316
1317 colorize_warn => qq{Color for warnings?},
1318
1319 );
1320
1321 die "Coding error in \@prompts declaration.  Odd number of elements, above"
1322   if (@prompts % 2);
1323
1324 %prompts = @prompts;
1325
1326 if (scalar(keys %prompts) != scalar(@prompts)/2) {
1327     my %already;
1328     for my $item (0..$#prompts) {
1329         next if $item % 2;
1330         die "$prompts[$item] is duplicated\n" if $already{$prompts[$item]}++;
1331     }
1332 }
1333
1334 } # EOBEGIN
1335
1336 1;