lib/CPAN/FirstTime.pm

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