lib/CPAN/FirstTime.pm

   1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
   2 package CPAN::Mirrored::By;
   3
   4 sub new {
   5     my($self,@arg) = @_;
   6     bless [@arg], $self;
   7 }
   8 sub continent { shift->[0] }
   9 sub country { shift->[1] }
  10 sub url { shift->[2] }
  11
  12 package CPAN::FirstTime;
  13
  14 use strict;
  15 use ExtUtils::MakeMaker ();
  16 use FileHandle ();
  17 use File::Basename ();
  18 use File::Path ();
  19 use File::Spec;
  20 use vars qw($VERSION);
  21 $VERSION = sprintf "%.2f", substr(q$Rev: 231 $,4)/100;
  22
  23 =head1 NAME
  24
  25 CPAN::FirstTime - Utility for CPAN::Config file Initialization
  26
  27 =head1 SYNOPSIS
  28
  29 CPAN::FirstTime::init()
  30
  31 =head1 DESCRIPTION
  32
  33 The init routine asks a few questions and writes a CPAN::Config
  34 file. Nothing special.
  35
  36 =cut
  37
  38 sub init {
  39     my($configpm, %args) = @_;
  40
  41     use Config;
  42
  43     unless ($CPAN::VERSION) {
  44         require CPAN::Nox;
  45     }
  46     eval {require CPAN::Config;};
  47     $CPAN::Config ||= {};
  48     local($/) = "\n";
  49     local($\) = "";
  50     local($|) = 1;
  51
  52     my($ans,$default);
  53
  54     #
  55     # Files, directories
  56     #
  57
  58     print qq[
  59
  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.
  65
  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.)
  69
  70 ];
  71
  72     my $manual_conf;
  73
  74     local *_real_prompt = \&ExtUtils::MakeMaker::prompt;
  75     if ( $args{autoconfig} ) {
  76         $manual_conf = "no";
  77     } else {
  78         $manual_conf = prompt("Are you ready for manual configuration?", "yes");
  79     }
  80     my $fastread;
  81     {
  82       if ($manual_conf =~ /^y/i) {
  83         $fastread = 0;
  84       } else {
  85         $fastread = 1;
  86         $CPAN::Config->{urllist} ||= [];
  87
  88         local $^W = 0;
  89         # prototype should match that of &MakeMaker::prompt
  90         *_real_prompt = sub ($;$) {
  91           my($q,$a) = @_;
  92           my($ret) = defined $a ? $a : "";
  93           $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
  94           eval { require Time::HiRes };
  95           unless ($@) {
  96               Time::HiRes::sleep(0.1);
  97           }
  98           $ret;
  99         };
 100       }
 101     }
 102     $CPAN::Frontend->myprint(qq{
 103
 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.
 108
 109 });
 110
 111     my $cpan_home = $CPAN::Config->{cpan_home} || File::Spec->catdir($ENV{HOME}, ".cpan");
 112     if (-d $cpan_home) {
 113         $CPAN::Frontend->myprint(qq{
 114
 115 I see you already have a  directory
 116     $cpan_home
 117 Shall we use it as the general CPAN build and cache directory?
 118
 119 });
 120     } else {
 121         $CPAN::Frontend->myprint(qq{
 122
 123 First of all, I\'d like to create this directory. Where?
 124
 125 });
 126     }
 127
 128     $default = $cpan_home;
 129     while ($ans = prompt("CPAN build and cache directory?",$default)) {
 130       unless (File::Spec->file_name_is_absolute($ans)) {
 131         require Cwd;
 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";
 135         $default = $absans;
 136         next;
 137       }
 138       eval { File::Path::mkpath($ans); }; # dies if it can't
 139       if ($@) {
 140         warn "Couldn't create directory $ans.
 141 Please retry.\n";
 142         next;
 143       }
 144       if (-d $ans && -w _) {
 145         last;
 146       } else {
 147         warn "Couldn't find directory $ans
 148   or directory is not writable. Please retry.\n";
 149       }
 150     }
 151     $CPAN::Config->{cpan_home} = $ans;
 152
 153     $CPAN::Frontend->myprint( qq{
 154
 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.)
 160
 161 });
 162
 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");
 165
 166     #
 167     # Cache size, Index expire
 168     #
 169
 170     $CPAN::Frontend->myprint( qq{
 171
 172 How big should the disk cache be for keeping the build directories
 173 with all the intermediate files\?
 174
 175 });
 176
 177     $default = $CPAN::Config->{build_cache} || 100; # large enough to
 178                                                     # build large
 179                                                     # dists like Tk
 180     $ans = prompt("Cache size for build directory (in MB)?", $default);
 181     $CPAN::Config->{build_cache} = $ans;
 182
 183     # XXX This the time when we refetch the index files (in days)
 184     $CPAN::Config->{'index_expire'} = 1;
 185
 186     $CPAN::Frontend->myprint( qq{
 187
 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
 190 'never'.
 191
 192 });
 193
 194     $default = $CPAN::Config->{scan_cache} || 'atstart';
 195     do {
 196         $ans = prompt("Perform cache scanning (atstart or never)?", $default);
 197     } while ($ans ne 'atstart' && $ans ne 'never');
 198     $CPAN::Config->{scan_cache} = $ans;
 199
 200     #
 201     # cache_metadata
 202     #
 203         $CPAN::Frontend->myprint( qq{
 204
 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.
 208
 209 });
 210
 211     defined($default = $CPAN::Config->{cache_metadata}) or $default = 1;
 212     do {
 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);
 216
 217     #
 218     # term_is_latin
 219     #
 220         $CPAN::Frontend->myprint( qq{
 221
 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.
 231
 232 });
 233
 234     defined($default = $CPAN::Config->{term_is_latin}) or $default = 1;
 235     do {
 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);
 240
 241     #
 242     # save history in file histfile
 243     #
 244     $CPAN::Frontend->myprint( qq{
 245
 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.
 251
 252 });
 253
 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;
 258
 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;
 263     }
 264
 265     #
 266     # do an ls on the m or the d command
 267     #
 268     $CPAN::Frontend->myprint( qq{
 269
 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.
 276
 277 });
 278
 279     defined($default = $CPAN::Config->{show_upload_date}) or
 280         $default = 0;
 281     $ans = prompt("Always try to show upload date with 'd' and 'm' command?", $default);
 282     $CPAN::Config->{show_upload_date} = $ans;
 283
 284     #
 285     # prerequisites_policy
 286     # Do we follow PREREQ_PM?
 287     #
 288     $CPAN::Frontend->myprint( qq{
 289
 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.
 295
 296 });
 297
 298     $default = $CPAN::Config->{prerequisites_policy} || 'ask';
 299     do {
 300       $ans =
 301           prompt("Policy on building prerequisites (follow, ask or ignore)?",
 302                  $default);
 303     } while ($ans ne 'follow' && $ans ne 'ask' && $ans ne 'ignore');
 304     $CPAN::Config->{prerequisites_policy} = $ans;
 305
 306     #
 307     # External programs
 308     #
 309
 310     $CPAN::Frontend->myprint(qq{
 311
 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
 316 by ENTER.
 317
 318 });
 319
 320     my $old_warn = $^W;
 321     local $^W if $^O eq 'MacOS';
 322     my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
 323     local $^W = $old_warn;
 324     my $progname;
 325     for $progname (qw/gzip tar unzip make
 326                       curl lynx wget ncftpget ncftp ftp
 327                       gpg/)
 328     {
 329       if ($^O eq 'MacOS') {
 330           $CPAN::Config->{$progname} = 'not_here';
 331           next;
 332       }
 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}
 338               || "";
 339       if (File::Spec->file_name_is_absolute($path)) {
 340         # testing existence is not good enough, some have these exe
 341         # extensions
 342
 343         # warn "Warning: configured $path does not exist\n" unless -e $path;
 344         # $path = "";
 345       } else {
 346         $path = '';
 347       }
 348       unless ($path) {
 349         # e.g. make -> nmake
 350         $progcall = $Config::Config{$progname} if $Config::Config{$progname};
 351       }
 352
 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;
 358     }
 359     my $path = $CPAN::Config->{'pager'} ||
 360         $ENV{PAGER} || find_exe("less",[@path]) ||
 361             find_exe("more",[@path]) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
 362             || "more";
 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;
 368         $path = "";
 369     }
 370     $path ||= $ENV{SHELL};
 371     if ($^O eq 'MacOS') {
 372         $CPAN::Config->{'shell'} = 'not_here';
 373     } else {
 374         $path =~ s,\\,/,g if $^O eq 'os2';      # Cosmetic only
 375         $ans = prompt("What is your favorite shell?",$path);
 376         $CPAN::Config->{'shell'} = $ans;
 377     }
 378
 379     #
 380     # Arguments to make etc.
 381     #
 382
 383     $CPAN::Frontend->myprint( qq{
 384
 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.
 389
 390 If you don\'t understand this question, just press ENTER.
 391
 392 });
 393
 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:
 398
 399     PREFIX=~/perl       non-root users (please see manual for more hints)
 400
 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:
 405
 406     -j3              dual processor system
 407
 408 Your choice: ",$default);
 409
 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:
 414
 415     sudo make
 416 or
 417     /path1/to/sudo -u admin_account /path2/to/make
 418
 419 or some such. Your choice: ",$default);
 420
 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:
 425
 426     UNINST=1         to always uninstall potentially conflicting files
 427
 428 Your choice: ",$default);
 429
 430     #
 431     # Alarm period
 432     #
 433
 434     $CPAN::Frontend->myprint( qq{
 435
 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.
 440
 441 If you set this value to 0, these processes will wait forever. This is
 442 the default and recommended setting.
 443
 444 });
 445
 446     $default = $CPAN::Config->{inactivity_timeout} || 0;
 447     $CPAN::Config->{inactivity_timeout} =
 448         prompt("Timeout for inactivity during Makefile.PL?",$default);
 449
 450     # Proxies
 451
 452     $CPAN::Frontend->myprint( qq{
 453
 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.
 457
 458 });
 459
 460     for (qw/ftp_proxy http_proxy no_proxy/) {
 461         $default = $CPAN::Config->{$_} || $ENV{$_};
 462         $CPAN::Config->{$_} = prompt("Your $_?",$default);
 463     }
 464
 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{
 469
 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.
 473
 474 });
 475         if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
 476                         $CPAN::Frontend->myprint( qq{
 477
 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
 481 session.
 482
 483 });
 484
 485             if ($CPAN::META->has_inst("Term::ReadKey")) {
 486                 Term::ReadKey::ReadMode("noecho");
 487             } else {
 488                                 $CPAN::Frontend->myprint( qq{
 489
 490 Warning: Term::ReadKey seems not to be available, your password will
 491 be echoed to the terminal!
 492
 493 });
 494             }
 495             $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
 496             if ($CPAN::META->has_inst("Term::ReadKey")) {
 497                 Term::ReadKey::ReadMode("restore");
 498             }
 499             $CPAN::Frontend->myprint("\n\n");
 500         }
 501     }
 502
 503     #
 504     # MIRRORED.BY
 505     #
 506
 507     conf_sites() unless $fastread;
 508
 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';
 512
 513     $CPAN::Frontend->myprint("\n\n");
 514     CPAN::Config->commit($configpm);
 515 }
 516
 517 sub conf_sites {
 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) {
 522     require File::Copy;
 523     File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
 524   }
 525   my $loopcount = 0;
 526   local $^T = time;
 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
 531
 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.
 535
 536 Shall I use the local database in $mby?};
 537       my $ans = prompt($prompt,"y");
 538       $overwrite_local = 1 unless $ans =~ /^y/i;
 539   }
 540   while ($mby) {
 541     if ($overwrite_local) {
 542       print qq{Trying to overwrite $mby
 543 };
 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
 549 };
 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
 554 };
 555       $mby = CPAN::FTP->localize($m,$mby,3);
 556       $loopcount++;
 557     } elsif (-s $mby == 0) {
 558       print qq{You have an empty $mby,
 559   I\'m trying to fetch one
 560 };
 561       $mby = CPAN::FTP->localize($m,$mby,3);
 562     } else {
 563       last;
 564     }
 565   }
 566   read_mirrored_by($mby);
 567   bring_your_own();
 568 }
 569
 570 sub find_exe {
 571     my($exe,$path) = @_;
 572     my($dir);
 573     #warn "in find_exe exe[$exe] path[@$path]";
 574     for $dir (@$path) {
 575         my $abs = File::Spec->catfile($dir,$exe);
 576         if (($abs = MM->maybe_command($abs))) {
 577             return $abs;
 578         }
 579     }
 580 }
 581
 582 sub picklist {
 583     my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
 584     $default ||= '';
 585
 586     my $pos = 0;
 587
 588     my @nums;
 589     while (1) {
 590
 591         # display, at most, 15 items at a time
 592         my $limit = $#{ $items } - $pos;
 593         $limit = 15 if $limit > 15;
 594
 595         # show the next $limit items, get the new position
 596         $pos = display_some($items, $limit, $pos);
 597         $pos = 0 if $pos >= @$items;
 598
 599         my $num = prompt($prompt,$default);
 600
 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");
 607         }
 608         print "\n";
 609
 610         # a blank line continues...
 611         next unless @nums;
 612         last;
 613     }
 614     for (@nums) { $_-- }
 615     @{$items}[@nums];
 616 }
 617
 618 sub display_some {
 619         my ($items, $limit, $pos) = @_;
 620         $pos ||= 0;
 621
 622         my @displayable = @$items[$pos .. ($pos + $limit)];
 623     for my $item (@displayable) {
 624                 printf "(%d) %s\n", ++$pos, $item;
 625     }
 626         printf("%d more items, hit SPACE RETURN to show them\n",
 627                (@$items - $pos)
 628               )
 629             if $pos < @$items;
 630         return $pos;
 631 }
 632
 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: $!";
 638     local $/ = "\012";
 639     while (<$fh>) {
 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);
 650         undef $host;
 651         $dst=$continent=$country="";
 652     }
 653     $fh->close;
 654     $CPAN::Config->{urllist} ||= [];
 655     my(@previous_urls);
 656     if (@previous_urls = @{$CPAN::Config->{urllist}}) {
 657         $CPAN::Config->{urllist} = [];
 658     }
 659
 660     print qq{
 661
 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
 665 file: URL.
 666
 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.
 674
 675 };
 676
 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)",
 683                      '',
 684                      ! @previous_urls,
 685                      $no_previous_warn);
 686
 687
 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);
 693     }
 694
 695     if (@countries) {
 696         @countries = picklist (\@countries,
 697                                "Select your country (or several nearby countries)",
 698                                '',
 699                                ! @previous_urls,
 700                                $no_previous_warn);
 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)
 708                if @countries > 1;
 709             push (@urls, @u);
 710         }
 711     }
 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) ..
 717                              (scalar @urls));
 718        $prompt .= "\n(or just hit RETURN to keep your previous picks)";
 719     }
 720
 721     @urls = picklist (\@urls, $prompt, $default);
 722     foreach (@urls) { s/ \(.*\)//; }
 723     push @{$CPAN::Config->{urllist}}, @urls;
 724 }
 725
 726 sub bring_your_own {
 727     my %seen = map (($_ => 1), @{$CPAN::Config->{urllist}});
 728     my($ans,@urls);
 729     do {
 730         my $prompt = "Enter another URL or RETURN to quit:";
 731         unless (%seen) {
 732             $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
 733
 734 Please enter your CPAN site:};
 735         }
 736         $ans = prompt ($prompt, "");
 737
 738         if ($ans) {
 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}++;
 743             } else {
 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},
 748                        $ans,
 749                        $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'} || "configuration file",
 750                       );
 751             }
 752         }
 753     } while $ans || !%seen;
 754
 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}};
 759 }
 760
 761
 762 sub _strip_spaces {
 763     $_[0] =~ s/^\s+//;  # no leading spaces
 764     $_[0] =~ s/\s+\z//; # no trailing spaces
 765 }
 766
 767
 768 sub prompt ($;$) {
 769     my $ans = _real_prompt(@_);
 770
 771     _strip_spaces($ans);
 772
 773     return $ans;
 774 }
 775
 776
 777 sub prompt_no_strip ($;$) {
 778     return _real_prompt(@_);
 779 }
 780
 781
 782 1;