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