lib/CPAN/FirstTime.pm

   1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
   2 package CPAN::Mirrored::By;
   3 use strict;
   4
   5 sub new {
   6     my($self,@arg) = @_;
   7     bless [@arg], $self;
   8 }
   9 sub continent { shift->[0] }
  10 sub country { shift->[1] }
  11 sub url { shift->[2] }
  12
  13 package CPAN::FirstTime;
  14
  15 use strict;
  16 use ExtUtils::MakeMaker ();
  17 use FileHandle ();
  18 use File::Basename ();
  19 use File::Path ();
  20 use File::Spec;
  21 use vars qw($VERSION);
  22 $VERSION = sprintf "%.2f", substr(q$Rev: 286 $,4)/100;
  23
  24 =head1 NAME
  25
  26 CPAN::FirstTime - Utility for CPAN::Config file Initialization
  27
  28 =head1 SYNOPSIS
  29
  30 CPAN::FirstTime::init()
  31
  32 =head1 DESCRIPTION
  33
  34 The init routine asks a few questions and writes a CPAN::Config
  35 file. Nothing special.
  36
  37 =cut
  38
  39 sub init {
  40     my($configpm, %args) = @_;
  41
  42     use Config;
  43
  44     unless ($CPAN::VERSION) {
  45         require CPAN::Nox;
  46     }
  47     eval {require CPAN::Config;};
  48     $CPAN::Config ||= {};
  49     local($/) = "\n";
  50     local($\) = "";
  51     local($|) = 1;
  52
  53     my($ans,$default);
  54
  55     #
  56     # Files, directories
  57     #
  58
  59     print qq[
  60
  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.
  66
  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.)
  70
  71 ];
  72
  73     my $manual_conf;
  74
  75     local *_real_prompt = \&ExtUtils::MakeMaker::prompt;
  76     if ( $args{autoconfig} ) {
  77         $manual_conf = "no";
  78     } else {
  79         $manual_conf = prompt("Are you ready for manual configuration?", "yes");
  80     }
  81     my $fastread;
  82     {
  83       if ($manual_conf =~ /^y/i) {
  84         $fastread = 0;
  85       } else {
  86         $fastread = 1;
  87         $CPAN::Config->{urllist} ||= [];
  88
  89         local $^W = 0;
  90         # prototype should match that of &MakeMaker::prompt
  91         *_real_prompt = sub ($;$) {
  92           my($q,$a) = @_;
  93           my($ret) = defined $a ? $a : "";
  94           $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
  95           eval { require Time::HiRes };
  96           unless ($@) {
  97               Time::HiRes::sleep(0.1);
  98           }
  99           $ret;
 100         };
 101       }
 102     }
 103     $CPAN::Frontend->myprint(qq{
 104
 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.
 109
 110 });
 111
 112     my $cpan_home = $CPAN::Config->{cpan_home} || File::Spec->catdir($ENV{HOME}, ".cpan");
 113     if (-d $cpan_home) {
 114         $CPAN::Frontend->myprint(qq{
 115
 116 I see you already have a  directory
 117     $cpan_home
 118 Shall we use it as the general CPAN build and cache directory?
 119
 120 });
 121     } else {
 122         $CPAN::Frontend->myprint(qq{
 123
 124 First of all, I\'d like to create this directory. Where?
 125
 126 });
 127     }
 128
 129     $default = $cpan_home;
 130     while ($ans = prompt("CPAN build and cache directory?",$default)) {
 131       unless (File::Spec->file_name_is_absolute($ans)) {
 132         require Cwd;
 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";
 136         $default = $absans;
 137         next;
 138       }
 139       eval { File::Path::mkpath($ans); }; # dies if it can't
 140       if ($@) {
 141         warn "Couldn't create directory $ans.
 142 Please retry.\n";
 143         next;
 144       }
 145       if (-d $ans && -w _) {
 146         last;
 147       } else {
 148         warn "Couldn't find directory $ans
 149   or directory is not writable. Please retry.\n";
 150       }
 151     }
 152     $CPAN::Config->{cpan_home} = $ans;
 153
 154     $CPAN::Frontend->myprint( qq{
 155
 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.)
 161
 162 });
 163
 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");
 166
 167     #
 168     # Cache size, Index expire
 169     #
 170
 171     $CPAN::Frontend->myprint( qq{
 172
 173 How big should the disk cache be for keeping the build directories
 174 with all the intermediate files\?
 175
 176 });
 177
 178     $default = $CPAN::Config->{build_cache} || 100; # large enough to
 179                                                     # build large
 180                                                     # dists like Tk
 181     $ans = prompt("Cache size for build directory (in MB)?", $default);
 182     $CPAN::Config->{build_cache} = $ans;
 183
 184     # XXX This the time when we refetch the index files (in days)
 185     $CPAN::Config->{'index_expire'} = 1;
 186
 187     $CPAN::Frontend->myprint( qq{
 188
 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
 191 'never'.
 192
 193 });
 194
 195     $default = $CPAN::Config->{scan_cache} || 'atstart';
 196     do {
 197         $ans = prompt("Perform cache scanning (atstart or never)?", $default);
 198     } while ($ans ne 'atstart' && $ans ne 'never');
 199     $CPAN::Config->{scan_cache} = $ans;
 200
 201     #
 202     # cache_metadata
 203     #
 204         $CPAN::Frontend->myprint( qq{
 205
 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.
 209
 210 });
 211
 212     defined($default = $CPAN::Config->{cache_metadata}) or $default = 1;
 213     do {
 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);
 217
 218     #
 219     # term_is_latin
 220     #
 221         $CPAN::Frontend->myprint( qq{
 222
 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.
 232
 233 });
 234
 235     defined($default = $CPAN::Config->{term_is_latin}) or $default = 1;
 236     do {
 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);
 241
 242     #
 243     # save history in file histfile
 244     #
 245     $CPAN::Frontend->myprint( qq{
 246
 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.
 252
 253 });
 254
 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;
 259
 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;
 264     }
 265
 266     #
 267     # do an ls on the m or the d command
 268     #
 269     $CPAN::Frontend->myprint( qq{
 270
 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.
 277
 278 });
 279
 280     defined($default = $CPAN::Config->{show_upload_date}) or
 281         $default = 0;
 282     $ans = prompt("Always try to show upload date with 'd' and 'm' command?", $default);
 283     $CPAN::Config->{show_upload_date} = $ans;
 284
 285     #
 286     # prerequisites_policy
 287     # Do we follow PREREQ_PM?
 288     #
 289     $CPAN::Frontend->myprint( qq{
 290
 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.
 296
 297 });
 298
 299     $default = $CPAN::Config->{prerequisites_policy} || 'ask';
 300     do {
 301       $ans =
 302           prompt("Policy on building prerequisites (follow, ask or ignore)?",
 303                  $default);
 304     } while ($ans ne 'follow' && $ans ne 'ask' && $ans ne 'ignore');
 305     $CPAN::Config->{prerequisites_policy} = $ans;
 306
 307     #
 308     # External programs
 309     #
 310
 311     $CPAN::Frontend->myprint(qq{
 312
 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
 317 by ENTER.
 318
 319 });
 320
 321     my $old_warn = $^W;
 322     local $^W if $^O eq 'MacOS';
 323     my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
 324     local $^W = $old_warn;
 325     my $progname;
 326     for $progname (qw/bzip2 gzip tar unzip make
 327                       curl lynx wget ncftpget ncftp ftp
 328                       gpg/)
 329     {
 330       if ($^O eq 'MacOS') {
 331           $CPAN::Config->{$progname} = 'not_here';
 332           next;
 333       }
 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}
 339               || "";
 340       if (File::Spec->file_name_is_absolute($path)) {
 341         # testing existence is not good enough, some have these exe
 342         # extensions
 343
 344         # warn "Warning: configured $path does not exist\n" unless -e $path;
 345         # $path = "";
 346       } else {
 347         $path = '';
 348       }
 349       unless ($path) {
 350         # e.g. make -> nmake
 351         $progcall = $Config::Config{$progname} if $Config::Config{$progname};
 352       }
 353
 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;
 359     }
 360     my $path = $CPAN::Config->{'pager'} ||
 361         $ENV{PAGER} || find_exe("less",[@path]) ||
 362             find_exe("more",[@path]) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
 363             || "more";
 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;
 369         $path = "";
 370     }
 371     $path ||= $ENV{SHELL};
 372     if ($^O eq 'MacOS') {
 373         $CPAN::Config->{'shell'} = 'not_here';
 374     } else {
 375         $path =~ s,\\,/,g if $^O eq 'os2';      # Cosmetic only
 376         $ans = prompt("What is your favorite shell?",$path);
 377         $CPAN::Config->{'shell'} = $ans;
 378     }
 379
 380     #
 381     # Arguments to make etc.
 382     #
 383
 384     $CPAN::Frontend->myprint( qq{
 385
 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
 391 Build.PL.
 392
 393 });
 394
 395     $default = $CPAN::Config->{prefer_installer} || "";
 396     do {
 397       $ans =
 398           prompt("In case you could choose, which installer would you prefer (EUMM or MB)?",
 399                  $default);
 400     } while (uc $ans ne 'MB' && uc $ans ne 'EUMM');
 401     $CPAN::Config->{prefer_installer} = $ans;
 402
 403     $CPAN::Frontend->myprint( qq{
 404
 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.
 409
 410 If you don\'t understand this question, just press ENTER.
 411
 412 });
 413
 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:
 418
 419     PREFIX=~/perl    # non-root users (please see manual for more hints)
 420
 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:
 425
 426     -j3              # dual processor system
 427
 428 Your choice: ",$default);
 429
 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:
 434
 435     sudo make
 436 or
 437     /path1/to/sudo -u admin_account /path2/to/make
 438
 439 or some such. Your choice: ",$default);
 440
 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:
 445
 446     UNINST=1         # to always uninstall potentially conflicting files
 447
 448 Your choice: ",$default);
 449
 450     $CPAN::Frontend->myprint( qq{
 451
 452 The next questions deal with Module::Build support.
 453
 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.
 457
 458 });
 459
 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:
 464
 465     --install_base /home/xxx             # different installation directory
 466
 467 Your choice: ",$default);
 468     $default = $CPAN::Config->{mbuild_arg} || "";
 469     $CPAN::Config->{mbuild_arg} = prompt("Parameters for the './Build' command?
 470 Setting might be:
 471
 472     --extra_linker_flags -L/usr/foo/lib  # non-standard library location
 473
 474 Your choice: ",$default);
 475
 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:
 480
 481     sudo ./Build
 482 or
 483     /path1/to/sudo -u admin_account ./Build
 484
 485 or some such. Your choice: ",$default);
 486
 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:
 491
 492     --uninst 1                           # uninstall conflicting files
 493
 494 Your choice: ",$default);
 495
 496     #
 497     # Alarm period
 498     #
 499
 500     $CPAN::Frontend->myprint( qq{
 501
 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.
 506
 507 If you set this value to 0, these processes will wait forever. This is
 508 the default and recommended setting.
 509
 510 });
 511
 512     $default = $CPAN::Config->{inactivity_timeout} || 0;
 513     $CPAN::Config->{inactivity_timeout} =
 514         prompt("Timeout for inactivity during {Makefile,Build}.PL?",$default);
 515
 516     # Proxies
 517
 518     $CPAN::Frontend->myprint( qq{
 519
 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.
 523
 524 });
 525
 526     for (qw/ftp_proxy http_proxy no_proxy/) {
 527         $default = $CPAN::Config->{$_} || $ENV{$_};
 528         $CPAN::Config->{$_} = prompt("Your $_?",$default);
 529     }
 530
 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{
 535
 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.
 539
 540 });
 541         if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
 542                         $CPAN::Frontend->myprint( qq{
 543
 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
 547 session.
 548
 549 });
 550
 551             if ($CPAN::META->has_inst("Term::ReadKey")) {
 552                 Term::ReadKey::ReadMode("noecho");
 553             } else {
 554                                 $CPAN::Frontend->myprint( qq{
 555
 556 Warning: Term::ReadKey seems not to be available, your password will
 557 be echoed to the terminal!
 558
 559 });
 560             }
 561             $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
 562             if ($CPAN::META->has_inst("Term::ReadKey")) {
 563                 Term::ReadKey::ReadMode("restore");
 564             }
 565             $CPAN::Frontend->myprint("\n\n");
 566         }
 567     }
 568
 569     #
 570     # MIRRORED.BY
 571     #
 572
 573     conf_sites() unless $fastread;
 574
 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';
 578
 579     $CPAN::Frontend->myprint("\n\n");
 580     CPAN::HandleConfig->commit($configpm);
 581 }
 582
 583 sub conf_sites {
 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) {
 588     require File::Copy;
 589     File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
 590   }
 591   my $loopcount = 0;
 592   local $^T = time;
 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
 597
 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.
 601
 602 Shall I use the local database in $mby?};
 603       my $ans = prompt($prompt,"y");
 604       $overwrite_local = 1 unless $ans =~ /^y/i;
 605   }
 606   while ($mby) {
 607     if ($overwrite_local) {
 608       print qq{Trying to overwrite $mby
 609 };
 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
 615 };
 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
 620 };
 621       $mby = CPAN::FTP->localize($m,$mby,3);
 622       $loopcount++;
 623     } elsif (-s $mby == 0) {
 624       print qq{You have an empty $mby,
 625   I\'m trying to fetch one
 626 };
 627       $mby = CPAN::FTP->localize($m,$mby,3);
 628     } else {
 629       last;
 630     }
 631   }
 632   read_mirrored_by($mby);
 633   bring_your_own();
 634 }
 635
 636 sub find_exe {
 637     my($exe,$path) = @_;
 638     my($dir);
 639     #warn "in find_exe exe[$exe] path[@$path]";
 640     for $dir (@$path) {
 641         my $abs = File::Spec->catfile($dir,$exe);
 642         if (($abs = MM->maybe_command($abs))) {
 643             return $abs;
 644         }
 645     }
 646 }
 647
 648 sub picklist {
 649     my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
 650     $default ||= '';
 651
 652     my $pos = 0;
 653
 654     my @nums;
 655     while (1) {
 656
 657         # display, at most, 15 items at a time
 658         my $limit = $#{ $items } - $pos;
 659         $limit = 15 if $limit > 15;
 660
 661         # show the next $limit items, get the new position
 662         $pos = display_some($items, $limit, $pos);
 663         $pos = 0 if $pos >= @$items;
 664
 665         my $num = prompt($prompt,$default);
 666
 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");
 673         }
 674         print "\n";
 675
 676         # a blank line continues...
 677         next unless @nums;
 678         last;
 679     }
 680     for (@nums) { $_-- }
 681     @{$items}[@nums];
 682 }
 683
 684 sub display_some {
 685         my ($items, $limit, $pos) = @_;
 686         $pos ||= 0;
 687
 688         my @displayable = @$items[$pos .. ($pos + $limit)];
 689     for my $item (@displayable) {
 690                 printf "(%d) %s\n", ++$pos, $item;
 691     }
 692         printf("%d more items, hit SPACE RETURN to show them\n",
 693                (@$items - $pos)
 694               )
 695             if $pos < @$items;
 696         return $pos;
 697 }
 698
 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: $!";
 704     local $/ = "\012";
 705     while (<$fh>) {
 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);
 716         undef $host;
 717         $dst=$continent=$country="";
 718     }
 719     $fh->close;
 720     $CPAN::Config->{urllist} ||= [];
 721     my(@previous_urls);
 722     if (@previous_urls = @{$CPAN::Config->{urllist}}) {
 723         $CPAN::Config->{urllist} = [];
 724     }
 725
 726     print qq{
 727
 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
 731 file: URL.
 732
 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.
 740
 741 };
 742
 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)",
 749                      '',
 750                      ! @previous_urls,
 751                      $no_previous_warn);
 752
 753
 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);
 759     }
 760
 761     if (@countries) {
 762         @countries = picklist (\@countries,
 763                                "Select your country (or several nearby countries)",
 764                                '',
 765                                ! @previous_urls,
 766                                $no_previous_warn);
 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)
 774                if @countries > 1;
 775             push (@urls, @u);
 776         }
 777     }
 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) ..
 783                              (scalar @urls));
 784        $prompt .= "\n(or just hit RETURN to keep your previous picks)";
 785     }
 786
 787     @urls = picklist (\@urls, $prompt, $default);
 788     foreach (@urls) { s/ \(.*\)//; }
 789     push @{$CPAN::Config->{urllist}}, @urls;
 790 }
 791
 792 sub bring_your_own {
 793     my %seen = map (($_ => 1), @{$CPAN::Config->{urllist}});
 794     my($ans,@urls);
 795     do {
 796         my $prompt = "Enter another URL or RETURN to quit:";
 797         unless (%seen) {
 798             $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
 799
 800 Please enter your CPAN site:};
 801         }
 802         $ans = prompt ($prompt, "");
 803
 804         if ($ans) {
 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}++;
 809             } else {
 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},
 814                        $ans,
 815                        $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'} || "configuration file",
 816                       );
 817             }
 818         }
 819     } while $ans || !%seen;
 820
 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}};
 825 }
 826
 827
 828 sub _strip_spaces {
 829     $_[0] =~ s/^\s+//;  # no leading spaces
 830     $_[0] =~ s/\s+\z//; # no trailing spaces
 831 }
 832
 833
 834 sub prompt ($;$) {
 835     my $ans = _real_prompt(@_);
 836
 837     _strip_spaces($ans);
 838
 839     return $ans;
 840 }
 841
 842
 843 sub prompt_no_strip ($;$) {
 844     return _real_prompt(@_);
 845 }
 846
 847
 848 1;