1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2 package CPAN::Mirrored::By;
9 sub continent { shift->[0] }
10 sub country { shift->[1] }
11 sub url { shift->[2] }
13 package CPAN::FirstTime;
16 use ExtUtils::MakeMaker ();
18 use File::Basename ();
21 use vars qw($VERSION);
22 $VERSION = sprintf "%.2f", substr(q$Rev: 286 $,4)/100;
26 CPAN::FirstTime - Utility for CPAN::Config file Initialization
30 CPAN::FirstTime::init()
34 The init routine asks a few questions and writes a CPAN::Config
35 file. Nothing special.
40 my($configpm, %args) = @_;
44 unless ($CPAN::VERSION) {
47 eval {require CPAN::Config;};
61 CPAN is the world-wide archive of perl resources. It consists of about
62 100 sites that all replicate the same contents all around the globe.
63 Many countries have at least one CPAN site already. The resources
64 found on CPAN are easily accessible with the CPAN.pm module. If you
65 want to use CPAN.pm, you have to configure it properly.
67 If you do not want to enter a dialog now, you can answer 'no' to this
68 question and I\'ll try to autoconfigure. (Note: you can revisit this
69 dialog anytime later by typing 'o conf init' at the cpan prompt.)
75 local *_real_prompt = \&ExtUtils::MakeMaker::prompt;
76 if ( $args{autoconfig} ) {
79 $manual_conf = prompt("Are you ready for manual configuration?", "yes");
83 if ($manual_conf =~ /^y/i) {
87 $CPAN::Config->{urllist} ||= [];
90 # prototype should match that of &MakeMaker::prompt
91 *_real_prompt = sub ($;$) {
93 my($ret) = defined $a ? $a : "";
94 $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
95 eval { require Time::HiRes };
97 Time::HiRes::sleep(0.1);
103 $CPAN::Frontend->myprint(qq{
105 The following questions are intended to help you with the
106 configuration. The CPAN module needs a directory of its own to cache
107 important index files and maybe keep a temporary mirror of CPAN files.
108 This may be a site-wide directory or a personal directory.
112 my $cpan_home = $CPAN::Config->{cpan_home} || File::Spec->catdir($ENV{HOME}, ".cpan");
114 $CPAN::Frontend->myprint(qq{
116 I see you already have a directory
118 Shall we use it as the general CPAN build and cache directory?
122 $CPAN::Frontend->myprint(qq{
124 First of all, I\'d like to create this directory. Where?
129 $default = $cpan_home;
130 while ($ans = prompt("CPAN build and cache directory?",$default)) {
131 unless (File::Spec->file_name_is_absolute($ans)) {
133 my $cwd = Cwd::cwd();
134 my $absans = File::Spec->catdir($cwd,$ans);
135 warn "The path '$ans' is not an absolute path. Please specify an absolute path\n";
139 eval { File::Path::mkpath($ans); }; # dies if it can't
141 warn "Couldn't create directory $ans.
145 if (-d $ans && -w _) {
148 warn "Couldn't find directory $ans
149 or directory is not writable. Please retry.\n";
152 $CPAN::Config->{cpan_home} = $ans;
154 $CPAN::Frontend->myprint( qq{
156 If you like, I can cache the source files after I build them. Doing
157 so means that, if you ever rebuild that module in the future, the
158 files will be taken from the cache. The tradeoff is that it takes up
159 space. How much space would you like to allocate to this cache? (If
160 you don\'t want me to keep a cache, answer 0.)
164 $CPAN::Config->{keep_source_where} = File::Spec->catdir($CPAN::Config->{cpan_home},"sources");
165 $CPAN::Config->{build_dir} = File::Spec->catdir($CPAN::Config->{cpan_home},"build");
168 # Cache size, Index expire
171 $CPAN::Frontend->myprint( qq{
173 How big should the disk cache be for keeping the build directories
174 with all the intermediate files\?
178 $default = $CPAN::Config->{build_cache} || 100; # large enough to
181 $ans = prompt("Cache size for build directory (in MB)?", $default);
182 $CPAN::Config->{build_cache} = $ans;
184 # XXX This the time when we refetch the index files (in days)
185 $CPAN::Config->{'index_expire'} = 1;
187 $CPAN::Frontend->myprint( qq{
189 By default, each time the CPAN module is started, cache scanning is
190 performed to keep the cache size in sync. To prevent this, answer
195 $default = $CPAN::Config->{scan_cache} || 'atstart';
197 $ans = prompt("Perform cache scanning (atstart or never)?", $default);
198 } while ($ans ne 'atstart' && $ans ne 'never');
199 $CPAN::Config->{scan_cache} = $ans;
204 $CPAN::Frontend->myprint( qq{
206 To considerably speed up the initial CPAN shell startup, it is
207 possible to use Storable to create a cache of metadata. If Storable
208 is not available, the normal index mechanism will be used.
212 defined($default = $CPAN::Config->{cache_metadata}) or $default = 1;
214 $ans = prompt("Cache metadata (yes/no)?", ($default ? 'yes' : 'no'));
215 } while ($ans !~ /^[yn]/i);
216 $CPAN::Config->{cache_metadata} = ($ans =~ /^y/i ? 1 : 0);
221 $CPAN::Frontend->myprint( qq{
223 The next option deals with the charset (aka character set) your
224 terminal supports. In general, CPAN is English speaking territory, so
225 the charset does not matter much, but some of the aliens out there who
226 upload their software to CPAN bear names that are outside the ASCII
227 range. If your terminal supports UTF-8, you should say no to the next
228 question. If it supports ISO-8859-1 (also known as LATIN1) then you
229 should say yes. If it supports neither, your answer does not matter
230 because you will not be able to read the names of some authors
231 anyway. If you answer no, names will be output in UTF-8.
235 defined($default = $CPAN::Config->{term_is_latin}) or $default = 1;
237 $ans = prompt("Your terminal expects ISO-8859-1 (yes/no)?",
238 ($default ? 'yes' : 'no'));
239 } while ($ans !~ /^[yn]/i);
240 $CPAN::Config->{term_is_latin} = ($ans =~ /^y/i ? 1 : 0);
243 # save history in file histfile
245 $CPAN::Frontend->myprint( qq{
247 If you have one of the readline packages (Term::ReadLine::Perl,
248 Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN
249 shell will have history support. The next two questions deal with the
250 filename of the history file and with its size. If you do not want to
251 set this variable, please hit SPACE RETURN to the following question.
255 defined($default = $CPAN::Config->{histfile}) or
256 $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
257 $ans = prompt("File to save your history?", $default);
258 $CPAN::Config->{histfile} = $ans;
260 if ($CPAN::Config->{histfile}) {
261 defined($default = $CPAN::Config->{histsize}) or $default = 100;
262 $ans = prompt("Number of lines to save?", $default);
263 $CPAN::Config->{histsize} = $ans;
267 # do an ls on the m or the d command
269 $CPAN::Frontend->myprint( qq{
271 The 'd' and the 'm' command normally only show you information they
272 have in their in-memory database and thus will never connect to the
273 internet. If you set the 'show_upload_date' variable to true, 'm' and
274 'd' will additionally show you the upload date of the module or
275 distribution. Per default this feature is off because it may require a
276 net connection to get at the upload date.
280 defined($default = $CPAN::Config->{show_upload_date}) or
282 $ans = prompt("Always try to show upload date with 'd' and 'm' command?", $default);
283 $CPAN::Config->{show_upload_date} = $ans;
286 # prerequisites_policy
287 # Do we follow PREREQ_PM?
289 $CPAN::Frontend->myprint( qq{
291 The CPAN module can detect when a module which you are trying to build
292 depends on prerequisites. If this happens, it can build the
293 prerequisites for you automatically ('follow'), ask you for
294 confirmation ('ask'), or just ignore them ('ignore'). Please set your
295 policy to one of the three values.
299 $default = $CPAN::Config->{prerequisites_policy} || 'ask';
302 prompt("Policy on building prerequisites (follow, ask or ignore)?",
304 } while ($ans ne 'follow' && $ans ne 'ask' && $ans ne 'ignore');
305 $CPAN::Config->{prerequisites_policy} = $ans;
311 $CPAN::Frontend->myprint(qq{
313 The CPAN module will need a few external programs to work properly.
314 Please correct me, if I guess the wrong path for a program. Don\'t
315 panic if you do not have some of them, just press ENTER for those. To
316 disable the use of a download program, you can type a space followed
322 local $^W if $^O eq 'MacOS';
323 my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
324 local $^W = $old_warn;
326 for $progname (qw/bzip2 gzip tar unzip make
327 curl lynx wget ncftpget ncftp ftp
330 if ($^O eq 'MacOS') {
331 $CPAN::Config->{$progname} = 'not_here';
334 my $progcall = $progname;
335 # we don't need ncftp if we have ncftpget
336 next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
337 my $path = $CPAN::Config->{$progname}
338 || $Config::Config{$progname}
340 if (File::Spec->file_name_is_absolute($path)) {
341 # testing existence is not good enough, some have these exe
344 # warn "Warning: configured $path does not exist\n" unless -e $path;
351 $progcall = $Config::Config{$progname} if $Config::Config{$progname};
354 $path ||= find_exe($progcall,[@path]);
355 $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH\n") unless
356 $path; # not -e $path, because find_exe already checked that
357 $ans = prompt("Where is your $progname program?",$path) || $path;
358 $CPAN::Config->{$progname} = $ans;
360 my $path = $CPAN::Config->{'pager'} ||
361 $ENV{PAGER} || find_exe("less",[@path]) ||
362 find_exe("more",[@path]) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
364 $ans = prompt("What is your favorite pager program?",$path);
365 $CPAN::Config->{'pager'} = $ans;
366 $path = $CPAN::Config->{'shell'};
367 if (File::Spec->file_name_is_absolute($path)) {
368 warn "Warning: configured $path does not exist\n" unless -e $path;
371 $path ||= $ENV{SHELL};
372 if ($^O eq 'MacOS') {
373 $CPAN::Config->{'shell'} = 'not_here';
375 $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
376 $ans = prompt("What is your favorite shell?",$path);
377 $CPAN::Config->{'shell'} = $ans;
381 # Arguments to make etc.
384 $CPAN::Frontend->myprint( qq{
386 When you have Module::Build installed and a module comes with both a
387 Makefile.PL and a Build.PL, which shall have precedence? The two
388 installer modules we have are the old and well established
389 ExtUtils::MakeMaker (for short: EUMM) understands the Makefile.PL and
390 the next generation installer Module::Build (MB) works with the
395 $default = $CPAN::Config->{prefer_installer} || "";
398 prompt("In case you could choose, which installer would you prefer (EUMM or MB)?",
400 } while (uc $ans ne 'MB' && uc $ans ne 'EUMM');
401 $CPAN::Config->{prefer_installer} = $ans;
403 $CPAN::Frontend->myprint( qq{
405 Every Makefile.PL is run by perl in a separate process. Likewise we
406 run \'make\' and \'make install\' in separate processes. If you have
407 any parameters \(e.g. PREFIX, LIB, UNINST or the like\) you want to
408 pass to the calls, please specify them here.
410 If you don\'t understand this question, just press ENTER.
414 $default = $CPAN::Config->{makepl_arg} || "";
415 $CPAN::Config->{makepl_arg} =
416 prompt("Parameters for the 'perl Makefile.PL' command?
417 Typical frequently used settings:
419 PREFIX=~/perl # non-root users (please see manual for more hints)
421 Your choice: ",$default);
422 $default = $CPAN::Config->{make_arg} || "";
423 $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?
424 Typical frequently used setting:
426 -j3 # dual processor system
428 Your choice: ",$default);
430 $default = $CPAN::Config->{make_install_make_command} || $CPAN::Config->{make} || "";
431 $CPAN::Config->{make_install_make_command} =
432 prompt("Do you want to use a different make command for 'make install'?
433 Cautious people will probably prefer:
437 /path1/to/sudo -u admin_account /path2/to/make
439 or some such. Your choice: ",$default);
441 $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || "";
442 $CPAN::Config->{make_install_arg} =
443 prompt("Parameters for the 'make install' command?
444 Typical frequently used setting:
446 UNINST=1 # to always uninstall potentially conflicting files
448 Your choice: ",$default);
450 $CPAN::Frontend->myprint( qq{
452 The next questions deal with Module::Build support.
454 A Build.PL is run by perl in a separate process. Likewise we run
455 './Build' and './Build install' in separate processes. If you have any
456 parameters you want to pass to the calls, please specify them here.
460 $default = $CPAN::Config->{mbuildpl_arg} || "";
461 $CPAN::Config->{mbuildpl_arg} =
462 prompt("Parameters for the 'perl Build.PL' command?
463 Typical frequently used settings:
465 --install_base /home/xxx # different installation directory
467 Your choice: ",$default);
468 $default = $CPAN::Config->{mbuild_arg} || "";
469 $CPAN::Config->{mbuild_arg} = prompt("Parameters for the './Build' command?
472 --extra_linker_flags -L/usr/foo/lib # non-standard library location
474 Your choice: ",$default);
476 $default = $CPAN::Config->{mbuild_install_build_command} || "./Build";
477 $CPAN::Config->{mbuild_install_build_command} =
478 prompt("Do you want to use a different command for './Build install'?
479 Sudo users will probably prefer:
483 /path1/to/sudo -u admin_account ./Build
485 or some such. Your choice: ",$default);
487 $default = $CPAN::Config->{mbuild_install_arg} || "";
488 $CPAN::Config->{mbuild_install_arg} =
489 prompt("Parameters for the './Build install' command?
490 Typical frequently used setting:
492 --uninst 1 # uninstall conflicting files
494 Your choice: ",$default);
500 $CPAN::Frontend->myprint( qq{
502 Sometimes you may wish to leave the processes run by CPAN alone
503 without caring about them. Because the Makefile.PL sometimes contains
504 question you\'re expected to answer, you can set a timer that will
505 kill a 'perl Makefile.PL' process after the specified time in seconds.
507 If you set this value to 0, these processes will wait forever. This is
508 the default and recommended setting.
512 $default = $CPAN::Config->{inactivity_timeout} || 0;
513 $CPAN::Config->{inactivity_timeout} =
514 prompt("Timeout for inactivity during {Makefile,Build}.PL?",$default);
518 $CPAN::Frontend->myprint( qq{
520 If you\'re accessing the net via proxies, you can specify them in the
521 CPAN configuration or via environment variables. The variable in
522 the \$CPAN::Config takes precedence.
526 for (qw/ftp_proxy http_proxy no_proxy/) {
527 $default = $CPAN::Config->{$_} || $ENV{$_};
528 $CPAN::Config->{$_} = prompt("Your $_?",$default);
531 if ($CPAN::Config->{ftp_proxy} ||
532 $CPAN::Config->{http_proxy}) {
533 $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER;
534 $CPAN::Frontend->myprint( qq{
536 If your proxy is an authenticating proxy, you can store your username
537 permanently. If you do not want that, just press RETURN. You will then
538 be asked for your username in every future session.
541 if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
542 $CPAN::Frontend->myprint( qq{
544 Your password for the authenticating proxy can also be stored
545 permanently on disk. If this violates your security policy, just press
546 RETURN. You will then be asked for the password in every future
551 if ($CPAN::META->has_inst("Term::ReadKey")) {
552 Term::ReadKey::ReadMode("noecho");
554 $CPAN::Frontend->myprint( qq{
556 Warning: Term::ReadKey seems not to be available, your password will
557 be echoed to the terminal!
561 $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
562 if ($CPAN::META->has_inst("Term::ReadKey")) {
563 Term::ReadKey::ReadMode("restore");
565 $CPAN::Frontend->myprint("\n\n");
573 conf_sites() unless $fastread;
575 # We don't ask that now, it will be noticed in time, won't it?
576 $CPAN::Config->{'inhibit_startup_message'} = 0;
577 $CPAN::Config->{'getcwd'} = 'cwd';
579 $CPAN::Frontend->myprint("\n\n");
580 CPAN::HandleConfig->commit($configpm);
584 my $m = 'MIRRORED.BY';
585 my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
586 File::Path::mkpath(File::Basename::dirname($mby));
587 if (-f $mby && -f $m && -M $m < -M $mby) {
589 File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
593 my $overwrite_local = 0;
594 if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) {
595 my $mtime = localtime((stat _)[9]);
596 my $prompt = qq{Found $mby as of $mtime
598 I\'d use that as a database of CPAN sites. If that is OK for you,
599 please answer 'y', but if you want me to get a new database now,
600 please answer 'n' to the following question.
602 Shall I use the local database in $mby?};
603 my $ans = prompt($prompt,"y");
604 $overwrite_local = 1 unless $ans =~ /^y/i;
607 if ($overwrite_local) {
608 print qq{Trying to overwrite $mby
610 $mby = CPAN::FTP->localize($m,$mby,3);
611 $overwrite_local = 0;
612 } elsif ( ! -f $mby ){
613 print qq{You have no $mby
614 I\'m trying to fetch one
616 $mby = CPAN::FTP->localize($m,$mby,3);
617 } elsif (-M $mby > 60 && $loopcount == 0) {
618 print qq{Your $mby is older than 60 days,
619 I\'m trying to fetch one
621 $mby = CPAN::FTP->localize($m,$mby,3);
623 } elsif (-s $mby == 0) {
624 print qq{You have an empty $mby,
625 I\'m trying to fetch one
627 $mby = CPAN::FTP->localize($m,$mby,3);
632 read_mirrored_by($mby);
639 #warn "in find_exe exe[$exe] path[@$path]";
641 my $abs = File::Spec->catfile($dir,$exe);
642 if (($abs = MM->maybe_command($abs))) {
649 my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
657 # display, at most, 15 items at a time
658 my $limit = $#{ $items } - $pos;
659 $limit = 15 if $limit > 15;
661 # show the next $limit items, get the new position
662 $pos = display_some($items, $limit, $pos);
663 $pos = 0 if $pos >= @$items;
665 my $num = prompt($prompt,$default);
667 @nums = split (' ', $num);
668 my $i = scalar @$items;
669 (warn "invalid items entered, try again\n"), next
670 if grep (/\D/ || $_ < 1 || $_ > $i, @nums);
671 if ($require_nonempty) {
672 (warn "$empty_warning\n");
676 # a blank line continues...
685 my ($items, $limit, $pos) = @_;
688 my @displayable = @$items[$pos .. ($pos + $limit)];
689 for my $item (@displayable) {
690 printf "(%d) %s\n", ++$pos, $item;
692 printf("%d more items, hit SPACE RETURN to show them\n",
699 sub read_mirrored_by {
700 my $local = shift or return;
701 my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
702 my $fh = FileHandle->new;
703 $fh->open($local) or die "Couldn't open $local: $!";
706 ($host) = /^([\w\.\-]+)/ unless defined $host;
707 next unless defined $host;
708 next unless /\s+dst_(dst|location)/;
709 /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
710 ($continent, $country) = @location[-1,-2];
711 $continent =~ s/\s\(.*//;
712 $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
713 /dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
714 next unless $host && $dst && $continent && $country;
715 $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
717 $dst=$continent=$country="";
720 $CPAN::Config->{urllist} ||= [];
722 if (@previous_urls = @{$CPAN::Config->{urllist}}) {
723 $CPAN::Config->{urllist} = [];
728 Now we need to know where your favorite CPAN sites are located. Push
729 a few sites onto the array (just in case the first on the array won\'t
730 work). If you are mirroring CPAN to your local workstation, specify a
733 First, pick a nearby continent and country (you can pick several of
734 each, separated by spaces, or none if you just want to keep your
735 existing selections). Then, you will be presented with a list of URLs
736 of CPAN mirrors in the countries you selected, along with previously
737 selected URLs. Select some of those URLs, or just keep the old list.
738 Finally, you will be prompted for any extra URLs -- file:, ftp:, or
739 http: -- that host a CPAN mirror.
743 my (@cont, $cont, %cont, @countries, @urls, %seen);
744 my $no_previous_warn =
745 "Sorry! since you don't have any existing picks, you must make a\n" .
746 "geographic selection.";
747 @cont = picklist([sort keys %all],
748 "Select your continent (or several nearby continents)",
754 foreach $cont (@cont) {
755 my @c = sort keys %{$all{$cont}};
756 @cont{@c} = map ($cont, 0..$#c);
757 @c = map ("$_ ($cont)", @c) if @cont > 1;
758 push (@countries, @c);
762 @countries = picklist (\@countries,
763 "Select your country (or several nearby countries)",
767 %seen = map (($_ => 1), @previous_urls);
768 # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
769 foreach $country (@countries) {
770 (my $bare_country = $country) =~ s/ \(.*\)//;
771 my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
772 @u = grep (! $seen{$_}, @u);
773 @u = map ("$_ ($bare_country)", @u)
778 push (@urls, map ("$_ (previous pick)", @previous_urls));
779 my $prompt = "Select as many URLs as you like (by number),
780 put them on one line, separated by blanks, e.g. '1 4 5'";
781 if (@previous_urls) {
782 $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
784 $prompt .= "\n(or just hit RETURN to keep your previous picks)";
787 @urls = picklist (\@urls, $prompt, $default);
788 foreach (@urls) { s/ \(.*\)//; }
789 push @{$CPAN::Config->{urllist}}, @urls;
793 my %seen = map (($_ => 1), @{$CPAN::Config->{urllist}});
796 my $prompt = "Enter another URL or RETURN to quit:";
798 $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
800 Please enter your CPAN site:};
802 $ans = prompt ($prompt, "");
805 $ans =~ s|/?\z|/|; # has to end with one slash
806 $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
807 if ($ans =~ /^\w+:\/./) {
808 push @urls, $ans unless $seen{$ans}++;
810 printf(qq{"%s" doesn\'t look like an URL at first sight.
811 I\'ll ignore it for now.
812 You can add it to your %s
813 later if you\'re sure it\'s right.\n},
815 $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'} || "configuration file",
819 } while $ans || !%seen;
821 push @{$CPAN::Config->{urllist}}, @urls;
822 # xxx delete or comment these out when you're happy that it works
823 print "New set of picks:\n";
824 map { print " $_\n" } @{$CPAN::Config->{urllist}};
829 $_[0] =~ s/^\s+//; # no leading spaces
830 $_[0] =~ s/\s+\z//; # no trailing spaces
835 my $ans = _real_prompt(@_);
843 sub prompt_no_strip ($;$) {
844 return _real_prompt(@_);