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