Move all the de-tainting logic for runperl into test.pl.
[p5sagit/p5-mst-13.2.git] / lib / CPAN / FirstTime.pm
CommitLineData
8d97e4a1 1# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
5f05dabc 2package CPAN::Mirrored::By;
e82b9348 3use strict;
1a43333d 4use vars qw($VERSION);
4d1321a7 5$VERSION = sprintf "%.6f", substr(q$Rev: 561 $,4)/1000000 + 5.4;
5f05dabc 6
7sub new {
8 my($self,@arg) = @_;
9 bless [@arg], $self;
10}
da199366 11sub continent { shift->[0] }
12sub country { shift->[1] }
5f05dabc 13sub url { shift->[2] }
14
15package CPAN::FirstTime;
16
17use strict;
f915a99a 18use ExtUtils::MakeMaker ();
05454584 19use FileHandle ();
09d9d230 20use File::Basename ();
05454584 21use File::Path ();
5de3f0da 22use File::Spec;
5f05dabc 23use vars qw($VERSION);
4d1321a7 24$VERSION = sprintf "%.6f", substr(q$Rev: 561 $,4)/1000000 + 5.4;
5f05dabc 25
26=head1 NAME
27
28CPAN::FirstTime - Utility for CPAN::Config file Initialization
29
30=head1 SYNOPSIS
31
32CPAN::FirstTime::init()
33
34=head1 DESCRIPTION
35
c9869e1c 36The init routine asks a few questions and writes a CPAN/Config.pm or
37CPAN/MyConfig.pm file (depending on what it is currently using).
38
5f05dabc 39
40=cut
41
9ddc4ed0 42use vars qw( %prompts );
43
5f05dabc 44sub init {
554a9ef5 45 my($configpm, %args) = @_;
5f05dabc 46 use Config;
9ddc4ed0 47 # extra arg in 'o conf init make' selects only $item =~ /make/
48 my $matcher = $args{args} && @{$args{args}} ? $args{args}[0] : '';
c9869e1c 49 CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG;
554a9ef5 50
f610777f 51 unless ($CPAN::VERSION) {
52 require CPAN::Nox;
53 }
5f05dabc 54 eval {require CPAN::Config;};
55 $CPAN::Config ||= {};
da199366 56 local($/) = "\n";
57 local($\) = "";
13bc20ff 58 local($|) = 1;
da199366 59
5fc0f0f6 60 my($ans,$default);
f610777f 61
da199366 62 #
63 # Files, directories
64 #
65
9ddc4ed0 66 print $prompts{manual_config};
09d9d230 67
554a9ef5 68 my $manual_conf;
69
70 local *_real_prompt = \&ExtUtils::MakeMaker::prompt;
71 if ( $args{autoconfig} ) {
72 $manual_conf = "no";
73 } else {
74 $manual_conf = prompt("Are you ready for manual configuration?", "yes");
75 }
09d9d230 76 my $fastread;
77 {
f915a99a 78 if ($manual_conf =~ /^y/i) {
09d9d230 79 $fastread = 0;
09d9d230 80 } else {
81 $fastread = 1;
36263cb3 82 $CPAN::Config->{urllist} ||= [];
f915a99a 83
84 local $^W = 0;
c9d9b473 85 # prototype should match that of &MakeMaker::prompt
f915a99a 86 *_real_prompt = sub ($;$) {
09d9d230 87 my($q,$a) = @_;
88 my($ret) = defined $a ? $a : "";
554a9ef5 89 $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
90 eval { require Time::HiRes };
91 unless ($@) {
92 Time::HiRes::sleep(0.1);
93 }
09d9d230 94 $ret;
95 };
96 }
97 }
9ddc4ed0 98
c9869e1c 99 $CPAN::Frontend->myprint($prompts{config_intro})
100 if !$matcher or 'config_intro' =~ /$matcher/;
9ddc4ed0 101
102 my $cpan_home = $CPAN::Config->{cpan_home}
103 || File::Spec->catdir($ENV{HOME}, ".cpan");
5f05dabc 104
5f05dabc 105 if (-d $cpan_home) {
c9869e1c 106 if (!$matcher or 'config_intro' =~ /$matcher/) {
107 $CPAN::Frontend->myprint(qq{
5f05dabc 108
109I see you already have a directory
110 $cpan_home
111Shall we use it as the general CPAN build and cache directory?
112
554a9ef5 113});
c9869e1c 114 }
9ddc4ed0 115 } else {
c9869e1c 116 # no cpan-home, must prompt and get one
9ddc4ed0 117 $CPAN::Frontend->myprint($prompts{cpan_home_where});
5f05dabc 118 }
119
120 $default = $cpan_home;
05454584 121 while ($ans = prompt("CPAN build and cache directory?",$default)) {
5fc0f0f6 122 unless (File::Spec->file_name_is_absolute($ans)) {
123 require Cwd;
124 my $cwd = Cwd::cwd();
125 my $absans = File::Spec->catdir($cwd,$ans);
126 warn "The path '$ans' is not an absolute path. Please specify an absolute path\n";
127 $default = $absans;
128 next;
129 }
36263cb3 130 eval { File::Path::mkpath($ans); }; # dies if it can't
131 if ($@) {
9ddc4ed0 132 warn "Couldn't create directory $ans.\nPlease retry.\n";
36263cb3 133 next;
134 }
135 if (-d $ans && -w _) {
136 last;
137 } else {
9ddc4ed0 138 warn "Couldn't find directory $ans\n"
139 . "or directory is not writable. Please retry.\n";
36263cb3 140 }
10b2abe6 141 }
5f05dabc 142 $CPAN::Config->{cpan_home} = $ans;
f610777f 143
9ddc4ed0 144 $CPAN::Frontend->myprint($prompts{keep_source_where});
5f05dabc 145
9ddc4ed0 146 $CPAN::Config->{keep_source_where}
147 = File::Spec->catdir($CPAN::Config->{cpan_home},"sources");
5f05dabc 148
9ddc4ed0 149 $CPAN::Config->{build_dir}
150 = File::Spec->catdir($CPAN::Config->{cpan_home},"build");
5f05dabc 151
da199366 152 #
153 # Cache size, Index expire
154 #
155
c9869e1c 156 $CPAN::Frontend->myprint($prompts{build_cache_intro})
157 if !$matcher or 'build_cache_intro' =~ /$matcher/;
5f05dabc 158
9ddc4ed0 159 # large enough to build large dists like Tk
160 my_dflt_prompt(build_cache => 100, $matcher);
5f05dabc 161
162 # XXX This the time when we refetch the index files (in days)
163 $CPAN::Config->{'index_expire'} = 1;
164
c9869e1c 165 $CPAN::Frontend->myprint($prompts{scan_cache_intro})
166 if !$matcher or 'build_cache_intro' =~ /$matcher/;
167
9ddc4ed0 168 my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
f610777f 169
9d61fa1d 170 #
171 # cache_metadata
172 #
5e05dca5 173
c9869e1c 174 if (!$matcher or 'build_cache_intro' =~ /$matcher/) {
5e05dca5 175
c9869e1c 176 $CPAN::Frontend->myprint($prompts{cache_metadata});
5e05dca5 177
c9869e1c 178 defined($default = $CPAN::Config->{cache_metadata}) or $default = 1;
179 do {
180 $ans = prompt("Cache metadata (yes/no)?", ($default ? 'yes' : 'no'));
181 } while ($ans !~ /^[yn]/i);
182 $CPAN::Config->{cache_metadata} = ($ans =~ /^y/i ? 1 : 0);
183 }
f610777f 184 #
9d61fa1d 185 # term_is_latin
186 #
9d61fa1d 187
c9869e1c 188 $CPAN::Frontend->myprint($prompts{term_is_latin})
189 if !$matcher or 'term_is_latin' =~ /$matcher/;
9d61fa1d 190
191 defined($default = $CPAN::Config->{term_is_latin}) or $default = 1;
192 do {
193 $ans = prompt("Your terminal expects ISO-8859-1 (yes/no)?",
194 ($default ? 'yes' : 'no'));
f915a99a 195 } while ($ans !~ /^[yn]/i);
196 $CPAN::Config->{term_is_latin} = ($ans =~ /^y/i ? 1 : 0);
9d61fa1d 197
198 #
c9869e1c 199 # save history in file 'histfile'
5fc0f0f6 200 #
5fc0f0f6 201
c9869e1c 202 $CPAN::Frontend->myprint($prompts{histfile_intro});
5fc0f0f6 203
204 defined($default = $CPAN::Config->{histfile}) or
205 $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
206 $ans = prompt("File to save your history?", $default);
5fc0f0f6 207 $CPAN::Config->{histfile} = $ans;
208
209 if ($CPAN::Config->{histfile}) {
210 defined($default = $CPAN::Config->{histsize}) or $default = 100;
211 $ans = prompt("Number of lines to save?", $default);
212 $CPAN::Config->{histsize} = $ans;
213 }
214
215 #
554a9ef5 216 # do an ls on the m or the d command
217 #
9ddc4ed0 218 $CPAN::Frontend->myprint($prompts{show_upload_date_intro});
554a9ef5 219
220 defined($default = $CPAN::Config->{show_upload_date}) or
9ddc4ed0 221 $default = 'n';
222 $ans = prompt("Always try to show upload date with 'd' and 'm' command (yes/no)?",
223 ($default ? 'yes' : 'no'));
224 $CPAN::Config->{show_upload_date} = ($ans =~ /^[y1]/i ? 1 : 0);
225
226 #my_prompt_loop(show_upload_date => 'n', $matcher,
227 #'follow|ask|ignore');
554a9ef5 228
229 #
f610777f 230 # prerequisites_policy
231 # Do we follow PREREQ_PM?
232 #
f610777f 233
c9869e1c 234 $CPAN::Frontend->myprint($prompts{prerequisites_policy_intro})
235 if !$matcher or 'prerequisites_policy_intro' =~ /$matcher/;
f610777f 236
9ddc4ed0 237 my_prompt_loop(prerequisites_policy => 'ask', $matcher,
238 'follow|ask|ignore');
f610777f 239
f610777f 240
da199366 241 #
242 # External programs
243 #
244
c9869e1c 245 $CPAN::Frontend->myprint($prompts{external_progs})
246 if !$matcher or 'external_progs' =~ /$matcher/;
5f05dabc 247
f14b5cec 248 my $old_warn = $^W;
249 local $^W if $^O eq 'MacOS';
55e314ee 250 my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
f14b5cec 251 local $^W = $old_warn;
09d9d230 252 my $progname;
e82b9348 253 for $progname (qw/bzip2 gzip tar unzip make
554a9ef5 254 curl lynx wget ncftpget ncftp ftp
73beb80c 255 gpg/)
256 {
f14b5cec 257 if ($^O eq 'MacOS') {
258 $CPAN::Config->{$progname} = 'not_here';
259 next;
260 }
9ddc4ed0 261 next if $matcher && $progname !~ /$matcher/;
262
09d9d230 263 my $progcall = $progname;
2e2b7522 264 # we don't need ncftp if we have ncftpget
265 next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
266 my $path = $CPAN::Config->{$progname}
267 || $Config::Config{$progname}
268 || "";
5de3f0da 269 if (File::Spec->file_name_is_absolute($path)) {
2e2b7522 270 # testing existence is not good enough, some have these exe
271 # extensions
272
273 # warn "Warning: configured $path does not exist\n" unless -e $path;
274 # $path = "";
275 } else {
276 $path = '';
277 }
278 unless ($path) {
279 # e.g. make -> nmake
280 $progcall = $Config::Config{$progname} if $Config::Config{$progname};
281 }
09d9d230 282
2e2b7522 283 $path ||= find_exe($progcall,[@path]);
554a9ef5 284 $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH\n") unless
2e2b7522 285 $path; # not -e $path, because find_exe already checked that
286 $ans = prompt("Where is your $progname program?",$path) || $path;
287 $CPAN::Config->{$progname} = $ans;
5f05dabc 288 }
289 my $path = $CPAN::Config->{'pager'} ||
290 $ENV{PAGER} || find_exe("less",[@path]) ||
f14b5cec 291 find_exe("more",[@path]) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
292 || "more";
55e314ee 293 $ans = prompt("What is your favorite pager program?",$path);
5f05dabc 294 $CPAN::Config->{'pager'} = $ans;
55e314ee 295 $path = $CPAN::Config->{'shell'};
5de3f0da 296 if (File::Spec->file_name_is_absolute($path)) {
55e314ee 297 warn "Warning: configured $path does not exist\n" unless -e $path;
298 $path = "";
299 }
300 $path ||= $ENV{SHELL};
c9869e1c 301 $path ||= $ENV{COMSPEC} if $^O eq "MSWin32";
f14b5cec 302 if ($^O eq 'MacOS') {
303 $CPAN::Config->{'shell'} = 'not_here';
304 } else {
305 $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
306 $ans = prompt("What is your favorite shell?",$path);
307 $CPAN::Config->{'shell'} = $ans;
308 }
da199366 309
310 #
311 # Arguments to make etc.
312 #
313
c9869e1c 314 $CPAN::Frontend->myprint($prompts{prefer_installer_intro})
315 if !$matcher or 'prerequisites_policy_intro' =~ /$matcher/;
e82b9348 316
9ddc4ed0 317 my_prompt_loop(prefer_installer => 'EUMM', $matcher, 'MB|EUMM');
e82b9348 318
e82b9348 319
c9869e1c 320 $CPAN::Frontend->myprint($prompts{makepl_arg_intro})
321 if !$matcher or 'makepl_arg_intro' =~ /$matcher/;
e82b9348 322
9ddc4ed0 323 my_dflt_prompt(makepl_arg => "", $matcher);
e82b9348 324
9ddc4ed0 325 my_dflt_prompt(make_arg => "", $matcher);
e82b9348 326
44d21104 327 require CPAN::HandleConfig;
328 if (exists $CPAN::HandleConfig::keys{make_install_make_command}) {
329 # as long as Windows needs $self->_build_command, we cannot
330 # support sudo on windows :-)
331 my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "",
332 $matcher);
333 }
e82b9348 334
9ddc4ed0 335 my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "",
336 $matcher);
e82b9348 337
c9869e1c 338 $CPAN::Frontend->myprint($prompts{mbuildpl_arg_intro})
339 if !$matcher or 'mbuildpl_arg_intro' =~ /$matcher/;
e82b9348 340
9ddc4ed0 341 my_dflt_prompt(mbuildpl_arg => "", $matcher);
e82b9348 342
9ddc4ed0 343 my_dflt_prompt(mbuild_arg => "", $matcher);
e82b9348 344
44d21104 345 if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command}) {
346 # as long as Windows needs $self->_build_command, we cannot
347 # support sudo on windows :-)
348 my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher);
349 }
8d97e4a1 350
9ddc4ed0 351 my_dflt_prompt(mbuild_install_arg => "", $matcher);
5f05dabc 352
da199366 353 #
354 # Alarm period
355 #
356
c9869e1c 357 $CPAN::Frontend->myprint($prompts{inactivity_timeout_intro})
358 if !$matcher or 'inactivity_timeout_intro' =~ /$matcher/;
10b2abe6 359
9ddc4ed0 360 # my_dflt_prompt(inactivity_timeout => 0);
10b2abe6 361
362 $default = $CPAN::Config->{inactivity_timeout} || 0;
363 $CPAN::Config->{inactivity_timeout} =
9ddc4ed0 364 prompt("Timeout for inactivity during {Makefile,Build}.PL?",$default);
10b2abe6 365
09d9d230 366 # Proxies
da199366 367
c9869e1c 368 $CPAN::Frontend->myprint($prompts{proxy_intro})
369 if !$matcher or 'proxy_intro' =~ /$matcher/;
09d9d230 370
371 for (qw/ftp_proxy http_proxy no_proxy/) {
c9869e1c 372 next if $matcher and $_ =~ /$matcher/;
373
09d9d230 374 $default = $CPAN::Config->{$_} || $ENV{$_};
375 $CPAN::Config->{$_} = prompt("Your $_?",$default);
5f05dabc 376 }
377
c049f953 378 if ($CPAN::Config->{ftp_proxy} ||
379 $CPAN::Config->{http_proxy}) {
9ddc4ed0 380
c049f953 381 $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER;
c049f953 382
9ddc4ed0 383 $CPAN::Frontend->myprint($prompts{proxy_user});
c049f953 384
c049f953 385 if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
9ddc4ed0 386 $CPAN::Frontend->myprint($prompts{proxy_pass});
c049f953 387
388 if ($CPAN::META->has_inst("Term::ReadKey")) {
389 Term::ReadKey::ReadMode("noecho");
390 } else {
9ddc4ed0 391 $CPAN::Frontend->myprint($prompts{password_warn});
c049f953 392 }
f915a99a 393 $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
c049f953 394 if ($CPAN::META->has_inst("Term::ReadKey")) {
395 Term::ReadKey::ReadMode("restore");
396 }
397 $CPAN::Frontend->myprint("\n\n");
398 }
399 }
400
09d9d230 401 #
402 # MIRRORED.BY
403 #
404
405 conf_sites() unless $fastread;
406
ca79d794 407 # We don't ask these now, the defaults are very likely OK.
408 $CPAN::Config->{inhibit_startup_message} = 0;
409 $CPAN::Config->{getcwd} = 'cwd';
410 $CPAN::Config->{ftp_passive} = 1;
5f05dabc 411
554a9ef5 412 $CPAN::Frontend->myprint("\n\n");
e82b9348 413 CPAN::HandleConfig->commit($configpm);
5f05dabc 414}
415
9ddc4ed0 416sub my_dflt_prompt {
417 my ($item, $dflt, $m) = @_;
418 my $default = $CPAN::Config->{$item} || $dflt;
419
420 $DB::single = 1;
421 if (!$m || $item =~ /$m/) {
422 $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
423 } else {
424 $CPAN::Config->{$item} = $default;
425 }
426}
427
428sub my_prompt_loop {
429 my ($item, $dflt, $m, $ok) = @_;
430 my $default = $CPAN::Config->{$item} || $dflt;
431 my $ans;
432
433 $DB::single = 1;
434 if (!$m || $item =~ /$m/) {
435 do { $ans = prompt($prompts{$item}, $default);
436 } until $ans =~ /$ok/;
437 $CPAN::Config->{$item} = $ans;
438 } else {
439 $CPAN::Config->{$item} = $default;
440 }
441}
442
443
09d9d230 444sub conf_sites {
445 my $m = 'MIRRORED.BY';
5de3f0da 446 my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
09d9d230 447 File::Path::mkpath(File::Basename::dirname($mby));
448 if (-f $mby && -f $m && -M $m < -M $mby) {
449 require File::Copy;
450 File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
451 }
911a92db 452 my $loopcount = 0;
de34a54b 453 local $^T = time;
d8773709 454 my $overwrite_local = 0;
455 if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) {
456 my $mtime = localtime((stat _)[9]);
457 my $prompt = qq{Found $mby as of $mtime
458
c049f953 459I\'d use that as a database of CPAN sites. If that is OK for you,
460please answer 'y', but if you want me to get a new database now,
461please answer 'n' to the following question.
d8773709 462
c049f953 463Shall I use the local database in $mby?};
d8773709 464 my $ans = prompt($prompt,"y");
465 $overwrite_local = 1 unless $ans =~ /^y/i;
466 }
de34a54b 467 while ($mby) {
d8773709 468 if ($overwrite_local) {
9ddc4ed0 469 print qq{Trying to overwrite $mby\n};
d8773709 470 $mby = CPAN::FTP->localize($m,$mby,3);
471 $overwrite_local = 0;
472 } elsif ( ! -f $mby ){
9ddc4ed0 473 print qq{You have no $mby\n I\'m trying to fetch one\n};
36263cb3 474 $mby = CPAN::FTP->localize($m,$mby,3);
911a92db 475 } elsif (-M $mby > 60 && $loopcount == 0) {
9ddc4ed0 476 print qq{Your $mby is older than 60 days,\n I\'m trying to fetch one\n};
36263cb3 477 $mby = CPAN::FTP->localize($m,$mby,3);
911a92db 478 $loopcount++;
36263cb3 479 } elsif (-s $mby == 0) {
9ddc4ed0 480 print qq{You have an empty $mby,\n I\'m trying to fetch one\n};
36263cb3 481 $mby = CPAN::FTP->localize($m,$mby,3);
482 } else {
483 last;
484 }
09d9d230 485 }
486 read_mirrored_by($mby);
de34a54b 487 bring_your_own();
09d9d230 488}
489
5f05dabc 490sub find_exe {
491 my($exe,$path) = @_;
55e314ee 492 my($dir);
493 #warn "in find_exe exe[$exe] path[@$path]";
5f05dabc 494 for $dir (@$path) {
5de3f0da 495 my $abs = File::Spec->catfile($dir,$exe);
13bc20ff 496 if (($abs = MM->maybe_command($abs))) {
5f05dabc 497 return $abs;
498 }
499 }
500}
501
f610777f 502sub picklist {
503 my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
504 $default ||= '';
505
5fc0f0f6 506 my $pos = 0;
f610777f 507
508 my @nums;
509 while (1) {
ec385757 510
5fc0f0f6 511 # display, at most, 15 items at a time
512 my $limit = $#{ $items } - $pos;
513 $limit = 15 if $limit > 15;
514
515 # show the next $limit items, get the new position
516 $pos = display_some($items, $limit, $pos);
517 $pos = 0 if $pos >= @$items;
518
519 my $num = prompt($prompt,$default);
520
521 @nums = split (' ', $num);
522 my $i = scalar @$items;
523 (warn "invalid items entered, try again\n"), next
524 if grep (/\D/ || $_ < 1 || $_ > $i, @nums);
525 if ($require_nonempty) {
526 (warn "$empty_warning\n");
527 }
528 print "\n";
529
530 # a blank line continues...
531 next unless @nums;
532 last;
f610777f 533 }
f610777f 534 for (@nums) { $_-- }
535 @{$items}[@nums];
536}
537
ec385757 538sub display_some {
539 my ($items, $limit, $pos) = @_;
540 $pos ||= 0;
541
542 my @displayable = @$items[$pos .. ($pos + $limit)];
543 for my $item (@displayable) {
544 printf "(%d) %s\n", ++$pos, $item;
545 }
5fc0f0f6 546 printf("%d more items, hit SPACE RETURN to show them\n",
547 (@$items - $pos)
548 )
549 if $pos < @$items;
ec385757 550 return $pos;
551}
552
5f05dabc 553sub read_mirrored_by {
de34a54b 554 my $local = shift or return;
9ddc4ed0 555 my(%all,$url,$expected_size,$default,$ans,$host,
556 $dst,$country,$continent,@location);
05454584 557 my $fh = FileHandle->new;
558 $fh->open($local) or die "Couldn't open $local: $!";
f14b5cec 559 local $/ = "\012";
05454584 560 while (<$fh>) {
5f05dabc 561 ($host) = /^([\w\.\-]+)/ unless defined $host;
562 next unless defined $host;
563 next unless /\s+dst_(dst|location)/;
564 /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
565 ($continent, $country) = @location[-1,-2];
566 $continent =~ s/\s\(.*//;
f610777f 567 $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
5f05dabc 568 /dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
569 next unless $host && $dst && $continent && $country;
570 $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
571 undef $host;
572 $dst=$continent=$country="";
573 }
05454584 574 $fh->close;
5f05dabc 575 $CPAN::Config->{urllist} ||= [];
f610777f 576 my(@previous_urls);
577 if (@previous_urls = @{$CPAN::Config->{urllist}}) {
5f05dabc 578 $CPAN::Config->{urllist} = [];
5f05dabc 579 }
f610777f 580
9ddc4ed0 581 print $prompts{urls_intro};
5f05dabc 582
f610777f 583 my (@cont, $cont, %cont, @countries, @urls, %seen);
584 my $no_previous_warn =
585 "Sorry! since you don't have any existing picks, you must make a\n" .
586 "geographic selection.";
587 @cont = picklist([sort keys %all],
588 "Select your continent (or several nearby continents)",
589 '',
590 ! @previous_urls,
591 $no_previous_warn);
592
593
594 foreach $cont (@cont) {
595 my @c = sort keys %{$all{$cont}};
596 @cont{@c} = map ($cont, 0..$#c);
597 @c = map ("$_ ($cont)", @c) if @cont > 1;
598 push (@countries, @c);
5f05dabc 599 }
f610777f 600
601 if (@countries) {
602 @countries = picklist (\@countries,
603 "Select your country (or several nearby countries)",
604 '',
605 ! @previous_urls,
606 $no_previous_warn);
607 %seen = map (($_ => 1), @previous_urls);
608 # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
609 foreach $country (@countries) {
610 (my $bare_country = $country) =~ s/ \(.*\)//;
611 my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
612 @u = grep (! $seen{$_}, @u);
613 @u = map ("$_ ($bare_country)", @u)
614 if @countries > 1;
615 push (@urls, @u);
616 }
617 }
618 push (@urls, map ("$_ (previous pick)", @previous_urls));
5fc0f0f6 619 my $prompt = "Select as many URLs as you like (by number),
620put them on one line, separated by blanks, e.g. '1 4 5'";
f610777f 621 if (@previous_urls) {
622 $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
623 (scalar @urls));
624 $prompt .= "\n(or just hit RETURN to keep your previous picks)";
625 }
626
627 @urls = picklist (\@urls, $prompt, $default);
628 foreach (@urls) { s/ \(.*\)//; }
de34a54b 629 push @{$CPAN::Config->{urllist}}, @urls;
630}
f610777f 631
de34a54b 632sub bring_your_own {
633 my %seen = map (($_ => 1), @{$CPAN::Config->{urllist}});
634 my($ans,@urls);
f610777f 635 do {
de34a54b 636 my $prompt = "Enter another URL or RETURN to quit:";
637 unless (%seen) {
638 $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
639
640Please enter your CPAN site:};
641 }
642 $ans = prompt ($prompt, "");
f610777f 643
644 if ($ans) {
de34a54b 645 $ans =~ s|/?\z|/|; # has to end with one slash
f610777f 646 $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
647 if ($ans =~ /^\w+:\/./) {
8d97e4a1 648 push @urls, $ans unless $seen{$ans}++;
de34a54b 649 } else {
8d97e4a1 650 printf(qq{"%s" doesn\'t look like an URL at first sight.
651I\'ll ignore it for now.
652You can add it to your %s
653later if you\'re sure it\'s right.\n},
654 $ans,
655 $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'} || "configuration file",
656 );
f610777f 657 }
658 }
de34a54b 659 } while $ans || !%seen;
f610777f 660
661 push @{$CPAN::Config->{urllist}}, @urls;
662 # xxx delete or comment these out when you're happy that it works
663 print "New set of picks:\n";
664 map { print " $_\n" } @{$CPAN::Config->{urllist}};
5f05dabc 665}
666
f915a99a 667
668sub _strip_spaces {
669 $_[0] =~ s/^\s+//; # no leading spaces
670 $_[0] =~ s/\s+\z//; # no trailing spaces
671}
672
673
674sub prompt ($;$) {
675 my $ans = _real_prompt(@_);
676
677 _strip_spaces($ans);
678
679 return $ans;
680}
681
682
683sub prompt_no_strip ($;$) {
684 return _real_prompt(@_);
685}
686
687
9ddc4ed0 688BEGIN {
689
690my @prompts = (
691
692manual_config => qq[
693
694CPAN is the world-wide archive of perl resources. It consists of about
695100 sites that all replicate the same contents all around the globe.
696Many countries have at least one CPAN site already. The resources
697found on CPAN are easily accessible with the CPAN.pm module. If you
698want to use CPAN.pm, you have to configure it properly.
699
700If you do not want to enter a dialog now, you can answer 'no' to this
701question and I\'ll try to autoconfigure. (Note: you can revisit this
702dialog anytime later by typing 'o conf init' at the cpan prompt.)
703
704],
705
706config_intro => qq{
707
708The following questions are intended to help you with the
709configuration. The CPAN module needs a directory of its own to cache
710important index files and maybe keep a temporary mirror of CPAN files.
711This may be a site-wide directory or a personal directory.
712
713},
714
715# cpan_home => qq{ },
716
717cpan_home_where => qq{
718
719First of all, I\'d like to create this directory. Where?
720
721},
722
723keep_source_where => qq{
724
725If you like, I can cache the source files after I build them. Doing
726so means that, if you ever rebuild that module in the future, the
727files will be taken from the cache. The tradeoff is that it takes up
728space. How much space would you like to allocate to this cache? (If
729you don\'t want me to keep a cache, answer 0.)
730
731},
732
733build_cache_intro => qq{
734
735How big should the disk cache be for keeping the build directories
736with all the intermediate files\?
737
738},
739
740build_cache =>
741"Cache size for build directory (in MB)?",
742
743
744scan_cache_intro => qq{
745
746By default, each time the CPAN module is started, cache scanning is
747performed to keep the cache size in sync. To prevent this, answer
748'never'.
749
750},
751
752scan_cache => "Perform cache scanning (atstart or never)?",
753
754cache_metadata => qq{
755
756To considerably speed up the initial CPAN shell startup, it is
757possible to use Storable to create a cache of metadata. If Storable
758is not available, the normal index mechanism will be used.
759
760},
761
762term_is_latin => qq{
763
764The next option deals with the charset (aka character set) your
765terminal supports. In general, CPAN is English speaking territory, so
766the charset does not matter much, but some of the aliens out there who
767upload their software to CPAN bear names that are outside the ASCII
768range. If your terminal supports UTF-8, you should say no to the next
769question. If it supports ISO-8859-1 (also known as LATIN1) then you
770should say yes. If it supports neither, your answer does not matter
771because you will not be able to read the names of some authors
772anyway. If you answer no, names will be output in UTF-8.
773
774},
775
c9869e1c 776histfile_intro => qq{
9ddc4ed0 777
778If you have one of the readline packages (Term::ReadLine::Perl,
779Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN
780shell will have history support. The next two questions deal with the
781filename of the history file and with its size. If you do not want to
782set this variable, please hit SPACE RETURN to the following question.
783
784},
785
c9869e1c 786histfile => qq{File to save your history?},
787
9ddc4ed0 788show_upload_date_intro => qq{
789
790The 'd' and the 'm' command normally only show you information they
791have in their in-memory database and thus will never connect to the
792internet. If you set the 'show_upload_date' variable to true, 'm' and
793'd' will additionally show you the upload date of the module or
794distribution. Per default this feature is off because it may require a
795net connection to get at the upload date.
796
797},
798
799show_upload_date =>
800"Always try to show upload date with 'd' and 'm' command (yes/no)?",
801
802prerequisites_policy_intro => qq{
803
804The CPAN module can detect when a module which you are trying to build
805depends on prerequisites. If this happens, it can build the
806prerequisites for you automatically ('follow'), ask you for
807confirmation ('ask'), or just ignore them ('ignore'). Please set your
808policy to one of the three values.
809
810},
811
812prerequisites_policy =>
c9869e1c 813"Policy on building prerequisites (follow, ask or ignore)?",
9ddc4ed0 814
815external_progs => qq{
816
817The CPAN module will need a few external programs to work properly.
818Please correct me, if I guess the wrong path for a program. Don\'t
819panic if you do not have some of them, just press ENTER for those. To
820disable the use of a download program, you can type a space followed
821by ENTER.
822
823},
824
825prefer_installer_intro => qq{
826
827When you have Module::Build installed and a module comes with both a
828Makefile.PL and a Build.PL, which shall have precedence? The two
829installer modules we have are the old and well established
830ExtUtils::MakeMaker (for short: EUMM) understands the Makefile.PL and
831the next generation installer Module::Build (MB) works with the
832Build.PL.
833
834},
835
836prefer_installer =>
837qq{In case you could choose, which installer would you prefer (EUMM or MB)?},
838
839makepl_arg_intro => qq{
840
841Every Makefile.PL is run by perl in a separate process. Likewise we
842run \'make\' and \'make install\' in separate processes. If you have
843any parameters \(e.g. PREFIX, LIB, UNINST or the like\) you want to
844pass to the calls, please specify them here.
845
846If you don\'t understand this question, just press ENTER.
847},
848
849makepl_arg => qq{
850Parameters for the 'perl Makefile.PL' command?
851Typical frequently used settings:
852
853 PREFIX=~/perl # non-root users (please see manual for more hints)
854
855Your choice: },
856
857make_arg => qq{Parameters for the 'make' command?
858Typical frequently used setting:
859
860 -j3 # dual processor system
861
862Your choice: },
863
864
865make_install_make_command => qq{Do you want to use a different make command for 'make install'?
866Cautious people will probably prefer:
867
868 su root -c make
869or
870 sudo make
871or
872 /path1/to/sudo -u admin_account /path2/to/make
873
874or some such. Your choice: },
875
876
877make_install_arg => qq{Parameters for the 'make install' command?
878Typical frequently used setting:
879
880 UNINST=1 # to always uninstall potentially conflicting files
881
882Your choice: },
883
884
885mbuildpl_arg_intro => qq{
886
887The next questions deal with Module::Build support.
888
889A Build.PL is run by perl in a separate process. Likewise we run
890'./Build' and './Build install' in separate processes. If you have any
891parameters you want to pass to the calls, please specify them here.
892
893},
894
895mbuildpl_arg => qq{Parameters for the 'perl Build.PL' command?
896Typical frequently used settings:
897
898 --install_base /home/xxx # different installation directory
899
900Your choice: },
901
902mbuild_arg => qq{Parameters for the './Build' command?
903Setting might be:
904
905 --extra_linker_flags -L/usr/foo/lib # non-standard library location
906
907Your choice: },
908
909
910mbuild_install_build_command => qq{Do you want to use a different command for './Build install'?
911Sudo users will probably prefer:
912
913 su root -c ./Build
914or
915 sudo ./Build
916or
917 /path1/to/sudo -u admin_account ./Build
918
919or some such. Your choice: },
920
921
922mbuild_install_arg => qq{Parameters for the './Build install' command?
923Typical frequently used setting:
924
925 --uninst 1 # uninstall conflicting files
926
927Your choice: },
928
929
930
931inactivity_timeout_intro => qq{
932
933Sometimes you may wish to leave the processes run by CPAN alone
934without caring about them. Because the Makefile.PL sometimes contains
935question you\'re expected to answer, you can set a timer that will
936kill a 'perl Makefile.PL' process after the specified time in seconds.
937
938If you set this value to 0, these processes will wait forever. This is
939the default and recommended setting.
940
941},
942
943inactivity_timeout =>
944qq{Timeout for inactivity during {Makefile,Build}.PL? },
945
946
c9869e1c 947proxy_intro => qq{
9ddc4ed0 948
949If you\'re accessing the net via proxies, you can specify them in the
950CPAN configuration or via environment variables. The variable in
951the \$CPAN::Config takes precedence.
952
953},
954
955proxy_user => qq{
956
957If your proxy is an authenticating proxy, you can store your username
958permanently. If you do not want that, just press RETURN. You will then
959be asked for your username in every future session.
960
961},
962
963proxy_pass => qq{
964
965Your password for the authenticating proxy can also be stored
966permanently on disk. If this violates your security policy, just press
967RETURN. You will then be asked for the password in every future
968session.
969
970},
971
972urls_intro => qq{
973
974Now we need to know where your favorite CPAN sites are located. Push
975a few sites onto the array (just in case the first on the array won\'t
976work). If you are mirroring CPAN to your local workstation, specify a
977file: URL.
978
979First, pick a nearby continent and country (you can pick several of
980each, separated by spaces, or none if you just want to keep your
981existing selections). Then, you will be presented with a list of URLs
982of CPAN mirrors in the countries you selected, along with previously
983selected URLs. Select some of those URLs, or just keep the old list.
984Finally, you will be prompted for any extra URLs -- file:, ftp:, or
985http: -- that host a CPAN mirror.
986
987},
988
989password_warn => qq{
990
991Warning: Term::ReadKey seems not to be available, your password will
992be echoed to the terminal!
993
994},
995
996);
997
998die "Coding error in \@prompts declaration. Odd number of elements, above"
999 if (@prompts % 2);
1000
1001%prompts = @prompts;
1002
1003if (scalar(keys %prompts) != scalar(@prompts)/2) {
1004
1005 my %already;
1006
1007 for my $item (0..$#prompts) {
1008 next if $item % 2;
1009 die "$prompts[$item] is duplicated\n"
1010 if $already{$prompts[$item]}++;
1011 }
1012
1013}
1014
1015}
1016
5f05dabc 10171;