1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2 package CPAN::Mirrored::By;
8 sub continent { shift->[0] }
9 sub country { shift->[1] }
10 sub url { shift->[2] }
12 package CPAN::FirstTime;
15 use ExtUtils::MakeMaker ();
17 use File::Basename ();
20 use vars qw($VERSION);
21 $VERSION = sprintf "%.2f", substr(q$Rev: 231 $,4)/100;
25 CPAN::FirstTime - Utility for CPAN::Config file Initialization
29 CPAN::FirstTime::init()
33 The init routine asks a few questions and writes a CPAN::Config
34 file. Nothing special.
39 my($configpm, %args) = @_;
43 unless ($CPAN::VERSION) {
46 eval {require CPAN::Config;};
60 CPAN is the world-wide archive of perl resources. It consists of about
61 100 sites that all replicate the same contents all around the globe.
62 Many countries have at least one CPAN site already. The resources
63 found on CPAN are easily accessible with the CPAN.pm module. If you
64 want to use CPAN.pm, you have to configure it properly.
66 If you do not want to enter a dialog now, you can answer 'no' to this
67 question and I\'ll try to autoconfigure. (Note: you can revisit this
68 dialog anytime later by typing 'o conf init' at the cpan prompt.)
74 local *_real_prompt = \&ExtUtils::MakeMaker::prompt;
75 if ( $args{autoconfig} ) {
78 $manual_conf = prompt("Are you ready for manual configuration?", "yes");
82 if ($manual_conf =~ /^y/i) {
86 $CPAN::Config->{urllist} ||= [];
89 # prototype should match that of &MakeMaker::prompt
90 *_real_prompt = sub ($;$) {
92 my($ret) = defined $a ? $a : "";
93 $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
94 eval { require Time::HiRes };
96 Time::HiRes::sleep(0.1);
102 $CPAN::Frontend->myprint(qq{
104 The following questions are intended to help you with the
105 configuration. The CPAN module needs a directory of its own to cache
106 important index files and maybe keep a temporary mirror of CPAN files.
107 This may be a site-wide directory or a personal directory.
111 my $cpan_home = $CPAN::Config->{cpan_home} || File::Spec->catdir($ENV{HOME}, ".cpan");
113 $CPAN::Frontend->myprint(qq{
115 I see you already have a directory
117 Shall we use it as the general CPAN build and cache directory?
121 $CPAN::Frontend->myprint(qq{
123 First of all, I\'d like to create this directory. Where?
128 $default = $cpan_home;
129 while ($ans = prompt("CPAN build and cache directory?",$default)) {
130 unless (File::Spec->file_name_is_absolute($ans)) {
132 my $cwd = Cwd::cwd();
133 my $absans = File::Spec->catdir($cwd,$ans);
134 warn "The path '$ans' is not an absolute path. Please specify an absolute path\n";
138 eval { File::Path::mkpath($ans); }; # dies if it can't
140 warn "Couldn't create directory $ans.
144 if (-d $ans && -w _) {
147 warn "Couldn't find directory $ans
148 or directory is not writable. Please retry.\n";
151 $CPAN::Config->{cpan_home} = $ans;
153 $CPAN::Frontend->myprint( qq{
155 If you like, I can cache the source files after I build them. Doing
156 so means that, if you ever rebuild that module in the future, the
157 files will be taken from the cache. The tradeoff is that it takes up
158 space. How much space would you like to allocate to this cache? (If
159 you don\'t want me to keep a cache, answer 0.)
163 $CPAN::Config->{keep_source_where} = File::Spec->catdir($CPAN::Config->{cpan_home},"sources");
164 $CPAN::Config->{build_dir} = File::Spec->catdir($CPAN::Config->{cpan_home},"build");
167 # Cache size, Index expire
170 $CPAN::Frontend->myprint( qq{
172 How big should the disk cache be for keeping the build directories
173 with all the intermediate files\?
177 $default = $CPAN::Config->{build_cache} || 100; # large enough to
180 $ans = prompt("Cache size for build directory (in MB)?", $default);
181 $CPAN::Config->{build_cache} = $ans;
183 # XXX This the time when we refetch the index files (in days)
184 $CPAN::Config->{'index_expire'} = 1;
186 $CPAN::Frontend->myprint( qq{
188 By default, each time the CPAN module is started, cache scanning is
189 performed to keep the cache size in sync. To prevent this, answer
194 $default = $CPAN::Config->{scan_cache} || 'atstart';
196 $ans = prompt("Perform cache scanning (atstart or never)?", $default);
197 } while ($ans ne 'atstart' && $ans ne 'never');
198 $CPAN::Config->{scan_cache} = $ans;
203 $CPAN::Frontend->myprint( qq{
205 To considerably speed up the initial CPAN shell startup, it is
206 possible to use Storable to create a cache of metadata. If Storable
207 is not available, the normal index mechanism will be used.
211 defined($default = $CPAN::Config->{cache_metadata}) or $default = 1;
213 $ans = prompt("Cache metadata (yes/no)?", ($default ? 'yes' : 'no'));
214 } while ($ans !~ /^[yn]/i);
215 $CPAN::Config->{cache_metadata} = ($ans =~ /^y/i ? 1 : 0);
220 $CPAN::Frontend->myprint( qq{
222 The next option deals with the charset (aka character set) your
223 terminal supports. In general, CPAN is English speaking territory, so
224 the charset does not matter much, but some of the aliens out there who
225 upload their software to CPAN bear names that are outside the ASCII
226 range. If your terminal supports UTF-8, you should say no to the next
227 question. If it supports ISO-8859-1 (also known as LATIN1) then you
228 should say yes. If it supports neither, your answer does not matter
229 because you will not be able to read the names of some authors
230 anyway. If you answer no, names will be output in UTF-8.
234 defined($default = $CPAN::Config->{term_is_latin}) or $default = 1;
236 $ans = prompt("Your terminal expects ISO-8859-1 (yes/no)?",
237 ($default ? 'yes' : 'no'));
238 } while ($ans !~ /^[yn]/i);
239 $CPAN::Config->{term_is_latin} = ($ans =~ /^y/i ? 1 : 0);
242 # save history in file histfile
244 $CPAN::Frontend->myprint( qq{
246 If you have one of the readline packages (Term::ReadLine::Perl,
247 Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN
248 shell will have history support. The next two questions deal with the
249 filename of the history file and with its size. If you do not want to
250 set this variable, please hit SPACE RETURN to the following question.
254 defined($default = $CPAN::Config->{histfile}) or
255 $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
256 $ans = prompt("File to save your history?", $default);
257 $CPAN::Config->{histfile} = $ans;
259 if ($CPAN::Config->{histfile}) {
260 defined($default = $CPAN::Config->{histsize}) or $default = 100;
261 $ans = prompt("Number of lines to save?", $default);
262 $CPAN::Config->{histsize} = $ans;
266 # do an ls on the m or the d command
268 $CPAN::Frontend->myprint( qq{
270 The 'd' and the 'm' command normally only show you information they
271 have in their in-memory database and thus will never connect to the
272 internet. If you set the 'show_upload_date' variable to true, 'm' and
273 'd' will additionally show you the upload date of the module or
274 distribution. Per default this feature is off because it may require a
275 net connection to get at the upload date.
279 defined($default = $CPAN::Config->{show_upload_date}) or
281 $ans = prompt("Always try to show upload date with 'd' and 'm' command?", $default);
282 $CPAN::Config->{show_upload_date} = $ans;
285 # prerequisites_policy
286 # Do we follow PREREQ_PM?
288 $CPAN::Frontend->myprint( qq{
290 The CPAN module can detect when a module which you are trying to build
291 depends on prerequisites. If this happens, it can build the
292 prerequisites for you automatically ('follow'), ask you for
293 confirmation ('ask'), or just ignore them ('ignore'). Please set your
294 policy to one of the three values.
298 $default = $CPAN::Config->{prerequisites_policy} || 'ask';
301 prompt("Policy on building prerequisites (follow, ask or ignore)?",
303 } while ($ans ne 'follow' && $ans ne 'ask' && $ans ne 'ignore');
304 $CPAN::Config->{prerequisites_policy} = $ans;
310 $CPAN::Frontend->myprint(qq{
312 The CPAN module will need a few external programs to work properly.
313 Please correct me, if I guess the wrong path for a program. Don\'t
314 panic if you do not have some of them, just press ENTER for those. To
315 disable the use of a download program, you can type a space followed
321 local $^W if $^O eq 'MacOS';
322 my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
323 local $^W = $old_warn;
325 for $progname (qw/gzip tar unzip make
326 curl lynx wget ncftpget ncftp ftp
329 if ($^O eq 'MacOS') {
330 $CPAN::Config->{$progname} = 'not_here';
333 my $progcall = $progname;
334 # we don't need ncftp if we have ncftpget
335 next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
336 my $path = $CPAN::Config->{$progname}
337 || $Config::Config{$progname}
339 if (File::Spec->file_name_is_absolute($path)) {
340 # testing existence is not good enough, some have these exe
343 # warn "Warning: configured $path does not exist\n" unless -e $path;
350 $progcall = $Config::Config{$progname} if $Config::Config{$progname};
353 $path ||= find_exe($progcall,[@path]);
354 $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH\n") unless
355 $path; # not -e $path, because find_exe already checked that
356 $ans = prompt("Where is your $progname program?",$path) || $path;
357 $CPAN::Config->{$progname} = $ans;
359 my $path = $CPAN::Config->{'pager'} ||
360 $ENV{PAGER} || find_exe("less",[@path]) ||
361 find_exe("more",[@path]) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
363 $ans = prompt("What is your favorite pager program?",$path);
364 $CPAN::Config->{'pager'} = $ans;
365 $path = $CPAN::Config->{'shell'};
366 if (File::Spec->file_name_is_absolute($path)) {
367 warn "Warning: configured $path does not exist\n" unless -e $path;
370 $path ||= $ENV{SHELL};
371 if ($^O eq 'MacOS') {
372 $CPAN::Config->{'shell'} = 'not_here';
374 $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
375 $ans = prompt("What is your favorite shell?",$path);
376 $CPAN::Config->{'shell'} = $ans;
380 # Arguments to make etc.
383 $CPAN::Frontend->myprint( qq{
385 Every Makefile.PL is run by perl in a separate process. Likewise we
386 run \'make\' and \'make install\' in separate processes. If you have
387 any parameters \(e.g. PREFIX, LIB, UNINST or the like\) you want to
388 pass to the calls, please specify them here.
390 If you don\'t understand this question, just press ENTER.
394 $default = $CPAN::Config->{makepl_arg} || "";
395 $CPAN::Config->{makepl_arg} =
396 prompt("Parameters for the 'perl Makefile.PL' command?
397 Typical frequently used settings:
399 PREFIX=~/perl non-root users (please see manual for more hints)
401 Your choice: ",$default);
402 $default = $CPAN::Config->{make_arg} || "";
403 $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?
404 Typical frequently used setting:
406 -j3 dual processor system
408 Your choice: ",$default);
410 $default = $CPAN::Config->{make_install_make_command} || $CPAN::Config->{make} || "";
411 $CPAN::Config->{make_install_make_command} =
412 prompt("Do you want to use a different make command for 'make install'?
413 Cautious people will probably prefer:
417 /path1/to/sudo -u admin_account /path2/to/make
419 or some such. Your choice: ",$default);
421 $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || "";
422 $CPAN::Config->{make_install_arg} =
423 prompt("Parameters for the 'make install' command?
424 Typical frequently used setting:
426 UNINST=1 to always uninstall potentially conflicting files
428 Your choice: ",$default);
434 $CPAN::Frontend->myprint( qq{
436 Sometimes you may wish to leave the processes run by CPAN alone
437 without caring about them. Because the Makefile.PL sometimes contains
438 question you\'re expected to answer, you can set a timer that will
439 kill a 'perl Makefile.PL' process after the specified time in seconds.
441 If you set this value to 0, these processes will wait forever. This is
442 the default and recommended setting.
446 $default = $CPAN::Config->{inactivity_timeout} || 0;
447 $CPAN::Config->{inactivity_timeout} =
448 prompt("Timeout for inactivity during Makefile.PL?",$default);
452 $CPAN::Frontend->myprint( qq{
454 If you\'re accessing the net via proxies, you can specify them in the
455 CPAN configuration or via environment variables. The variable in
456 the \$CPAN::Config takes precedence.
460 for (qw/ftp_proxy http_proxy no_proxy/) {
461 $default = $CPAN::Config->{$_} || $ENV{$_};
462 $CPAN::Config->{$_} = prompt("Your $_?",$default);
465 if ($CPAN::Config->{ftp_proxy} ||
466 $CPAN::Config->{http_proxy}) {
467 $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER;
468 $CPAN::Frontend->myprint( qq{
470 If your proxy is an authenticating proxy, you can store your username
471 permanently. If you do not want that, just press RETURN. You will then
472 be asked for your username in every future session.
475 if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
476 $CPAN::Frontend->myprint( qq{
478 Your password for the authenticating proxy can also be stored
479 permanently on disk. If this violates your security policy, just press
480 RETURN. You will then be asked for the password in every future
485 if ($CPAN::META->has_inst("Term::ReadKey")) {
486 Term::ReadKey::ReadMode("noecho");
488 $CPAN::Frontend->myprint( qq{
490 Warning: Term::ReadKey seems not to be available, your password will
491 be echoed to the terminal!
495 $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
496 if ($CPAN::META->has_inst("Term::ReadKey")) {
497 Term::ReadKey::ReadMode("restore");
499 $CPAN::Frontend->myprint("\n\n");
507 conf_sites() unless $fastread;
509 # We don't ask that now, it will be noticed in time, won't it?
510 $CPAN::Config->{'inhibit_startup_message'} = 0;
511 $CPAN::Config->{'getcwd'} = 'cwd';
513 $CPAN::Frontend->myprint("\n\n");
514 CPAN::Config->commit($configpm);
518 my $m = 'MIRRORED.BY';
519 my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
520 File::Path::mkpath(File::Basename::dirname($mby));
521 if (-f $mby && -f $m && -M $m < -M $mby) {
523 File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
527 my $overwrite_local = 0;
528 if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) {
529 my $mtime = localtime((stat _)[9]);
530 my $prompt = qq{Found $mby as of $mtime
532 I\'d use that as a database of CPAN sites. If that is OK for you,
533 please answer 'y', but if you want me to get a new database now,
534 please answer 'n' to the following question.
536 Shall I use the local database in $mby?};
537 my $ans = prompt($prompt,"y");
538 $overwrite_local = 1 unless $ans =~ /^y/i;
541 if ($overwrite_local) {
542 print qq{Trying to overwrite $mby
544 $mby = CPAN::FTP->localize($m,$mby,3);
545 $overwrite_local = 0;
546 } elsif ( ! -f $mby ){
547 print qq{You have no $mby
548 I\'m trying to fetch one
550 $mby = CPAN::FTP->localize($m,$mby,3);
551 } elsif (-M $mby > 60 && $loopcount == 0) {
552 print qq{Your $mby is older than 60 days,
553 I\'m trying to fetch one
555 $mby = CPAN::FTP->localize($m,$mby,3);
557 } elsif (-s $mby == 0) {
558 print qq{You have an empty $mby,
559 I\'m trying to fetch one
561 $mby = CPAN::FTP->localize($m,$mby,3);
566 read_mirrored_by($mby);
573 #warn "in find_exe exe[$exe] path[@$path]";
575 my $abs = File::Spec->catfile($dir,$exe);
576 if (($abs = MM->maybe_command($abs))) {
583 my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
591 # display, at most, 15 items at a time
592 my $limit = $#{ $items } - $pos;
593 $limit = 15 if $limit > 15;
595 # show the next $limit items, get the new position
596 $pos = display_some($items, $limit, $pos);
597 $pos = 0 if $pos >= @$items;
599 my $num = prompt($prompt,$default);
601 @nums = split (' ', $num);
602 my $i = scalar @$items;
603 (warn "invalid items entered, try again\n"), next
604 if grep (/\D/ || $_ < 1 || $_ > $i, @nums);
605 if ($require_nonempty) {
606 (warn "$empty_warning\n");
610 # a blank line continues...
619 my ($items, $limit, $pos) = @_;
622 my @displayable = @$items[$pos .. ($pos + $limit)];
623 for my $item (@displayable) {
624 printf "(%d) %s\n", ++$pos, $item;
626 printf("%d more items, hit SPACE RETURN to show them\n",
633 sub read_mirrored_by {
634 my $local = shift or return;
635 my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
636 my $fh = FileHandle->new;
637 $fh->open($local) or die "Couldn't open $local: $!";
640 ($host) = /^([\w\.\-]+)/ unless defined $host;
641 next unless defined $host;
642 next unless /\s+dst_(dst|location)/;
643 /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
644 ($continent, $country) = @location[-1,-2];
645 $continent =~ s/\s\(.*//;
646 $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
647 /dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
648 next unless $host && $dst && $continent && $country;
649 $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
651 $dst=$continent=$country="";
654 $CPAN::Config->{urllist} ||= [];
656 if (@previous_urls = @{$CPAN::Config->{urllist}}) {
657 $CPAN::Config->{urllist} = [];
662 Now we need to know where your favorite CPAN sites are located. Push
663 a few sites onto the array (just in case the first on the array won\'t
664 work). If you are mirroring CPAN to your local workstation, specify a
667 First, pick a nearby continent and country (you can pick several of
668 each, separated by spaces, or none if you just want to keep your
669 existing selections). Then, you will be presented with a list of URLs
670 of CPAN mirrors in the countries you selected, along with previously
671 selected URLs. Select some of those URLs, or just keep the old list.
672 Finally, you will be prompted for any extra URLs -- file:, ftp:, or
673 http: -- that host a CPAN mirror.
677 my (@cont, $cont, %cont, @countries, @urls, %seen);
678 my $no_previous_warn =
679 "Sorry! since you don't have any existing picks, you must make a\n" .
680 "geographic selection.";
681 @cont = picklist([sort keys %all],
682 "Select your continent (or several nearby continents)",
688 foreach $cont (@cont) {
689 my @c = sort keys %{$all{$cont}};
690 @cont{@c} = map ($cont, 0..$#c);
691 @c = map ("$_ ($cont)", @c) if @cont > 1;
692 push (@countries, @c);
696 @countries = picklist (\@countries,
697 "Select your country (or several nearby countries)",
701 %seen = map (($_ => 1), @previous_urls);
702 # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
703 foreach $country (@countries) {
704 (my $bare_country = $country) =~ s/ \(.*\)//;
705 my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
706 @u = grep (! $seen{$_}, @u);
707 @u = map ("$_ ($bare_country)", @u)
712 push (@urls, map ("$_ (previous pick)", @previous_urls));
713 my $prompt = "Select as many URLs as you like (by number),
714 put them on one line, separated by blanks, e.g. '1 4 5'";
715 if (@previous_urls) {
716 $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
718 $prompt .= "\n(or just hit RETURN to keep your previous picks)";
721 @urls = picklist (\@urls, $prompt, $default);
722 foreach (@urls) { s/ \(.*\)//; }
723 push @{$CPAN::Config->{urllist}}, @urls;
727 my %seen = map (($_ => 1), @{$CPAN::Config->{urllist}});
730 my $prompt = "Enter another URL or RETURN to quit:";
732 $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
734 Please enter your CPAN site:};
736 $ans = prompt ($prompt, "");
739 $ans =~ s|/?\z|/|; # has to end with one slash
740 $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
741 if ($ans =~ /^\w+:\/./) {
742 push @urls, $ans unless $seen{$ans}++;
744 printf(qq{"%s" doesn\'t look like an URL at first sight.
745 I\'ll ignore it for now.
746 You can add it to your %s
747 later if you\'re sure it\'s right.\n},
749 $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'} || "configuration file",
753 } while $ans || !%seen;
755 push @{$CPAN::Config->{urllist}}, @urls;
756 # xxx delete or comment these out when you're happy that it works
757 print "New set of picks:\n";
758 map { print " $_\n" } @{$CPAN::Config->{urllist}};
763 $_[0] =~ s/^\s+//; # no leading spaces
764 $_[0] =~ s/\s+\z//; # no trailing spaces
769 my $ans = _real_prompt(@_);
777 sub prompt_no_strip ($;$) {
778 return _real_prompt(@_);