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