lib/CPAN/FirstTime.pm

   1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
   2 package CPAN::Mirrored::By;
   3 use strict;
   4 use vars qw($VERSION);
   5 $VERSION = sprintf "%.2f", substr(q$Rev: 469 $,4)/100;
   6
   7 sub new {
   8     my($self,@arg) = @_;
   9     bless [@arg], $self;
  10 }
  11 sub continent { shift->[0] }
  12 sub country { shift->[1] }
  13 sub url { shift->[2] }
  14
  15 package CPAN::FirstTime;
  16
  17 use strict;
  18 use ExtUtils::MakeMaker ();
  19 use FileHandle ();
  20 use File::Basename ();
  21 use File::Path ();
  22 use File::Spec;
  23 use vars qw($VERSION);
  24 $VERSION = sprintf "%.2f", substr(q$Rev: 469 $,4)/100;
  25
  26 =head1 NAME
  27
  28 CPAN::FirstTime - Utility for CPAN::Config file Initialization
  29
  30 =head1 SYNOPSIS
  31
  32 CPAN::FirstTime::init()
  33
  34 =head1 DESCRIPTION
  35
  36 The init routine asks a few questions and writes a CPAN/Config.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     my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "",
 328                    $matcher);
 329
 330     my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "",
 331                    $matcher);
 332
 333     $CPAN::Frontend->myprint($prompts{mbuildpl_arg_intro})
 334       if !$matcher or 'mbuildpl_arg_intro' =~ /$matcher/;
 335
 336     my_dflt_prompt(mbuildpl_arg => "", $matcher);
 337
 338     my_dflt_prompt(mbuild_arg => "", $matcher);
 339
 340     my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher);
 341
 342     my_dflt_prompt(mbuild_install_arg => "", $matcher);
 343
 344     #
 345     # Alarm period
 346     #
 347
 348     $CPAN::Frontend->myprint($prompts{inactivity_timeout_intro})
 349       if !$matcher or 'inactivity_timeout_intro' =~ /$matcher/;
 350
 351     # my_dflt_prompt(inactivity_timeout => 0);
 352
 353     $default = $CPAN::Config->{inactivity_timeout} || 0;
 354     $CPAN::Config->{inactivity_timeout} =
 355       prompt("Timeout for inactivity during {Makefile,Build}.PL?",$default);
 356
 357     # Proxies
 358
 359     $CPAN::Frontend->myprint($prompts{proxy_intro})
 360       if !$matcher or 'proxy_intro' =~ /$matcher/;
 361
 362     for (qw/ftp_proxy http_proxy no_proxy/) {
 363         next if $matcher and $_ =~ /$matcher/;
 364
 365         $default = $CPAN::Config->{$_} || $ENV{$_};
 366         $CPAN::Config->{$_} = prompt("Your $_?",$default);
 367     }
 368
 369     if ($CPAN::Config->{ftp_proxy} ||
 370         $CPAN::Config->{http_proxy}) {
 371
 372         $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER;
 373
 374                 $CPAN::Frontend->myprint($prompts{proxy_user});
 375
 376         if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
 377             $CPAN::Frontend->myprint($prompts{proxy_pass});
 378
 379             if ($CPAN::META->has_inst("Term::ReadKey")) {
 380                 Term::ReadKey::ReadMode("noecho");
 381             } else {
 382                 $CPAN::Frontend->myprint($prompts{password_warn});
 383             }
 384             $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
 385             if ($CPAN::META->has_inst("Term::ReadKey")) {
 386                 Term::ReadKey::ReadMode("restore");
 387             }
 388             $CPAN::Frontend->myprint("\n\n");
 389         }
 390     }
 391
 392     #
 393     # MIRRORED.BY
 394     #
 395
 396     conf_sites() unless $fastread;
 397
 398     # We don't ask these now, the defaults are very likely OK.
 399     $CPAN::Config->{inhibit_startup_message} = 0;
 400     $CPAN::Config->{getcwd}                  = 'cwd';
 401     $CPAN::Config->{ftp_passive}             = 1;
 402
 403     $CPAN::Frontend->myprint("\n\n");
 404     CPAN::HandleConfig->commit($configpm);
 405 }
 406
 407 sub my_dflt_prompt {
 408     my ($item, $dflt, $m) = @_;
 409     my $default = $CPAN::Config->{$item} || $dflt;
 410
 411     $DB::single = 1;
 412     if (!$m || $item =~ /$m/) {
 413         $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
 414     } else {
 415         $CPAN::Config->{$item} = $default;
 416     }
 417 }
 418
 419 sub my_prompt_loop {
 420     my ($item, $dflt, $m, $ok) = @_;
 421     my $default = $CPAN::Config->{$item} || $dflt;
 422     my $ans;
 423
 424     $DB::single = 1;
 425     if (!$m || $item =~ /$m/) {
 426         do { $ans = prompt($prompts{$item}, $default);
 427         } until $ans =~ /$ok/;
 428         $CPAN::Config->{$item} = $ans;
 429     } else {
 430         $CPAN::Config->{$item} = $default;
 431     }
 432 }
 433
 434
 435 sub conf_sites {
 436   my $m = 'MIRRORED.BY';
 437   my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
 438   File::Path::mkpath(File::Basename::dirname($mby));
 439   if (-f $mby && -f $m && -M $m < -M $mby) {
 440     require File::Copy;
 441     File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
 442   }
 443   my $loopcount = 0;
 444   local $^T = time;
 445   my $overwrite_local = 0;
 446   if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) {
 447       my $mtime = localtime((stat _)[9]);
 448       my $prompt = qq{Found $mby as of $mtime
 449
 450 I\'d use that as a database of CPAN sites. If that is OK for you,
 451 please answer 'y', but if you want me to get a new database now,
 452 please answer 'n' to the following question.
 453
 454 Shall I use the local database in $mby?};
 455       my $ans = prompt($prompt,"y");
 456       $overwrite_local = 1 unless $ans =~ /^y/i;
 457   }
 458   while ($mby) {
 459     if ($overwrite_local) {
 460       print qq{Trying to overwrite $mby\n};
 461       $mby = CPAN::FTP->localize($m,$mby,3);
 462       $overwrite_local = 0;
 463     } elsif ( ! -f $mby ){
 464       print qq{You have no $mby\n  I\'m trying to fetch one\n};
 465       $mby = CPAN::FTP->localize($m,$mby,3);
 466     } elsif (-M $mby > 60 && $loopcount == 0) {
 467       print qq{Your $mby is older than 60 days,\n  I\'m trying to fetch one\n};
 468       $mby = CPAN::FTP->localize($m,$mby,3);
 469       $loopcount++;
 470     } elsif (-s $mby == 0) {
 471       print qq{You have an empty $mby,\n  I\'m trying to fetch one\n};
 472       $mby = CPAN::FTP->localize($m,$mby,3);
 473     } else {
 474       last;
 475     }
 476   }
 477   read_mirrored_by($mby);
 478   bring_your_own();
 479 }
 480
 481 sub find_exe {
 482     my($exe,$path) = @_;
 483     my($dir);
 484     #warn "in find_exe exe[$exe] path[@$path]";
 485     for $dir (@$path) {
 486         my $abs = File::Spec->catfile($dir,$exe);
 487         if (($abs = MM->maybe_command($abs))) {
 488             return $abs;
 489         }
 490     }
 491 }
 492
 493 sub picklist {
 494     my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
 495     $default ||= '';
 496
 497     my $pos = 0;
 498
 499     my @nums;
 500     while (1) {
 501
 502         # display, at most, 15 items at a time
 503         my $limit = $#{ $items } - $pos;
 504         $limit = 15 if $limit > 15;
 505
 506         # show the next $limit items, get the new position
 507         $pos = display_some($items, $limit, $pos);
 508         $pos = 0 if $pos >= @$items;
 509
 510         my $num = prompt($prompt,$default);
 511
 512         @nums = split (' ', $num);
 513         my $i = scalar @$items;
 514         (warn "invalid items entered, try again\n"), next
 515             if grep (/\D/ || $_ < 1 || $_ > $i, @nums);
 516         if ($require_nonempty) {
 517             (warn "$empty_warning\n");
 518         }
 519         print "\n";
 520
 521         # a blank line continues...
 522         next unless @nums;
 523         last;
 524     }
 525     for (@nums) { $_-- }
 526     @{$items}[@nums];
 527 }
 528
 529 sub display_some {
 530         my ($items, $limit, $pos) = @_;
 531         $pos ||= 0;
 532
 533         my @displayable = @$items[$pos .. ($pos + $limit)];
 534     for my $item (@displayable) {
 535                 printf "(%d) %s\n", ++$pos, $item;
 536     }
 537         printf("%d more items, hit SPACE RETURN to show them\n",
 538                (@$items - $pos)
 539               )
 540             if $pos < @$items;
 541         return $pos;
 542 }
 543
 544 sub read_mirrored_by {
 545     my $local = shift or return;
 546     my(%all,$url,$expected_size,$default,$ans,$host,
 547        $dst,$country,$continent,@location);
 548     my $fh = FileHandle->new;
 549     $fh->open($local) or die "Couldn't open $local: $!";
 550     local $/ = "\012";
 551     while (<$fh>) {
 552         ($host) = /^([\w\.\-]+)/ unless defined $host;
 553         next unless defined $host;
 554         next unless /\s+dst_(dst|location)/;
 555         /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
 556             ($continent, $country) = @location[-1,-2];
 557         $continent =~ s/\s\(.*//;
 558         $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
 559         /dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
 560         next unless $host && $dst && $continent && $country;
 561         $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
 562         undef $host;
 563         $dst=$continent=$country="";
 564     }
 565     $fh->close;
 566     $CPAN::Config->{urllist} ||= [];
 567     my(@previous_urls);
 568     if (@previous_urls = @{$CPAN::Config->{urllist}}) {
 569         $CPAN::Config->{urllist} = [];
 570     }
 571
 572     print $prompts{urls_intro};
 573
 574     my (@cont, $cont, %cont, @countries, @urls, %seen);
 575     my $no_previous_warn =
 576        "Sorry! since you don't have any existing picks, you must make a\n" .
 577        "geographic selection.";
 578     @cont = picklist([sort keys %all],
 579                      "Select your continent (or several nearby continents)",
 580                      '',
 581                      ! @previous_urls,
 582                      $no_previous_warn);
 583
 584
 585     foreach $cont (@cont) {
 586         my @c = sort keys %{$all{$cont}};
 587         @cont{@c} = map ($cont, 0..$#c);
 588         @c = map ("$_ ($cont)", @c) if @cont > 1;
 589         push (@countries, @c);
 590     }
 591
 592     if (@countries) {
 593         @countries = picklist (\@countries,
 594                                "Select your country (or several nearby countries)",
 595                                '',
 596                                ! @previous_urls,
 597                                $no_previous_warn);
 598         %seen = map (($_ => 1), @previous_urls);
 599         # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
 600         foreach $country (@countries) {
 601             (my $bare_country = $country) =~ s/ \(.*\)//;
 602             my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
 603             @u = grep (! $seen{$_}, @u);
 604             @u = map ("$_ ($bare_country)", @u)
 605                if @countries > 1;
 606             push (@urls, @u);
 607         }
 608     }
 609     push (@urls, map ("$_ (previous pick)", @previous_urls));
 610     my $prompt = "Select as many URLs as you like (by number),
 611 put them on one line, separated by blanks, e.g. '1 4 5'";
 612     if (@previous_urls) {
 613        $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
 614                              (scalar @urls));
 615        $prompt .= "\n(or just hit RETURN to keep your previous picks)";
 616     }
 617
 618     @urls = picklist (\@urls, $prompt, $default);
 619     foreach (@urls) { s/ \(.*\)//; }
 620     push @{$CPAN::Config->{urllist}}, @urls;
 621 }
 622
 623 sub bring_your_own {
 624     my %seen = map (($_ => 1), @{$CPAN::Config->{urllist}});
 625     my($ans,@urls);
 626     do {
 627         my $prompt = "Enter another URL or RETURN to quit:";
 628         unless (%seen) {
 629             $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
 630
 631 Please enter your CPAN site:};
 632         }
 633         $ans = prompt ($prompt, "");
 634
 635         if ($ans) {
 636             $ans =~ s|/?\z|/|; # has to end with one slash
 637             $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
 638             if ($ans =~ /^\w+:\/./) {
 639                 push @urls, $ans unless $seen{$ans}++;
 640             } else {
 641                 printf(qq{"%s" doesn\'t look like an URL at first sight.
 642 I\'ll ignore it for now.
 643 You can add it to your %s
 644 later if you\'re sure it\'s right.\n},
 645                        $ans,
 646                        $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'} || "configuration file",
 647                       );
 648             }
 649         }
 650     } while $ans || !%seen;
 651
 652     push @{$CPAN::Config->{urllist}}, @urls;
 653     # xxx delete or comment these out when you're happy that it works
 654     print "New set of picks:\n";
 655     map { print "  $_\n" } @{$CPAN::Config->{urllist}};
 656 }
 657
 658
 659 sub _strip_spaces {
 660     $_[0] =~ s/^\s+//;  # no leading spaces
 661     $_[0] =~ s/\s+\z//; # no trailing spaces
 662 }
 663
 664
 665 sub prompt ($;$) {
 666     my $ans = _real_prompt(@_);
 667
 668     _strip_spaces($ans);
 669
 670     return $ans;
 671 }
 672
 673
 674 sub prompt_no_strip ($;$) {
 675     return _real_prompt(@_);
 676 }
 677
 678
 679 BEGIN {
 680
 681 my @prompts = (
 682
 683 manual_config => qq[
 684
 685 CPAN is the world-wide archive of perl resources. It consists of about
 686 100 sites that all replicate the same contents all around the globe.
 687 Many countries have at least one CPAN site already. The resources
 688 found on CPAN are easily accessible with the CPAN.pm module. If you
 689 want to use CPAN.pm, you have to configure it properly.
 690
 691 If you do not want to enter a dialog now, you can answer 'no' to this
 692 question and I\'ll try to autoconfigure. (Note: you can revisit this
 693 dialog anytime later by typing 'o conf init' at the cpan prompt.)
 694
 695 ],
 696
 697 config_intro => qq{
 698
 699 The following questions are intended to help you with the
 700 configuration. The CPAN module needs a directory of its own to cache
 701 important index files and maybe keep a temporary mirror of CPAN files.
 702 This may be a site-wide directory or a personal directory.
 703
 704 },
 705
 706 # cpan_home => qq{ },
 707
 708 cpan_home_where => qq{
 709
 710 First of all, I\'d like to create this directory. Where?
 711
 712 },
 713
 714 keep_source_where => qq{
 715
 716 If you like, I can cache the source files after I build them.  Doing
 717 so means that, if you ever rebuild that module in the future, the
 718 files will be taken from the cache. The tradeoff is that it takes up
 719 space.  How much space would you like to allocate to this cache?  (If
 720 you don\'t want me to keep a cache, answer 0.)
 721
 722 },
 723
 724 build_cache_intro => qq{
 725
 726 How big should the disk cache be for keeping the build directories
 727 with all the intermediate files\?
 728
 729 },
 730
 731 build_cache =>
 732 "Cache size for build directory (in MB)?",
 733
 734
 735 scan_cache_intro => qq{
 736
 737 By default, each time the CPAN module is started, cache scanning is
 738 performed to keep the cache size in sync. To prevent this, answer
 739 'never'.
 740
 741 },
 742
 743 scan_cache => "Perform cache scanning (atstart or never)?",
 744
 745 cache_metadata => qq{
 746
 747 To considerably speed up the initial CPAN shell startup, it is
 748 possible to use Storable to create a cache of metadata. If Storable
 749 is not available, the normal index mechanism will be used.
 750
 751 },
 752
 753 term_is_latin => qq{
 754
 755 The next option deals with the charset (aka character set) your
 756 terminal supports. In general, CPAN is English speaking territory, so
 757 the charset does not matter much, but some of the aliens out there who
 758 upload their software to CPAN bear names that are outside the ASCII
 759 range. If your terminal supports UTF-8, you should say no to the next
 760 question.  If it supports ISO-8859-1 (also known as LATIN1) then you
 761 should say yes.  If it supports neither, your answer does not matter
 762 because you will not be able to read the names of some authors
 763 anyway. If you answer no, names will be output in UTF-8.
 764
 765 },
 766
 767 histfile_intro => qq{
 768
 769 If you have one of the readline packages (Term::ReadLine::Perl,
 770 Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN
 771 shell will have history support. The next two questions deal with the
 772 filename of the history file and with its size. If you do not want to
 773 set this variable, please hit SPACE RETURN to the following question.
 774
 775 },
 776
 777 histfile => qq{File to save your history?},
 778
 779 show_upload_date_intro => qq{
 780
 781 The 'd' and the 'm' command normally only show you information they
 782 have in their in-memory database and thus will never connect to the
 783 internet. If you set the 'show_upload_date' variable to true, 'm' and
 784 'd' will additionally show you the upload date of the module or
 785 distribution. Per default this feature is off because it may require a
 786 net connection to get at the upload date.
 787
 788 },
 789
 790 show_upload_date =>
 791 "Always try to show upload date with 'd' and 'm' command (yes/no)?",
 792
 793 prerequisites_policy_intro => qq{
 794
 795 The CPAN module can detect when a module which you are trying to build
 796 depends on prerequisites. If this happens, it can build the
 797 prerequisites for you automatically ('follow'), ask you for
 798 confirmation ('ask'), or just ignore them ('ignore'). Please set your
 799 policy to one of the three values.
 800
 801 },
 802
 803 prerequisites_policy =>
 804 "Policy on building prerequisites (follow, ask or ignore)?",
 805
 806 external_progs => qq{
 807
 808 The CPAN module will need a few external programs to work properly.
 809 Please correct me, if I guess the wrong path for a program. Don\'t
 810 panic if you do not have some of them, just press ENTER for those. To
 811 disable the use of a download program, you can type a space followed
 812 by ENTER.
 813
 814 },
 815
 816 prefer_installer_intro => qq{
 817
 818 When you have Module::Build installed and a module comes with both a
 819 Makefile.PL and a Build.PL, which shall have precedence? The two
 820 installer modules we have are the old and well established
 821 ExtUtils::MakeMaker (for short: EUMM) understands the Makefile.PL and
 822 the next generation installer Module::Build (MB) works with the
 823 Build.PL.
 824
 825 },
 826
 827 prefer_installer =>
 828 qq{In case you could choose, which installer would you prefer (EUMM or MB)?},
 829
 830 makepl_arg_intro => qq{
 831
 832 Every Makefile.PL is run by perl in a separate process. Likewise we
 833 run \'make\' and \'make install\' in separate processes. If you have
 834 any parameters \(e.g. PREFIX, LIB, UNINST or the like\) you want to
 835 pass to the calls, please specify them here.
 836
 837 If you don\'t understand this question, just press ENTER.
 838 },
 839
 840 makepl_arg => qq{
 841 Parameters for the 'perl Makefile.PL' command?
 842 Typical frequently used settings:
 843
 844     PREFIX=~/perl    # non-root users (please see manual for more hints)
 845
 846 Your choice: },
 847
 848 make_arg => qq{Parameters for the 'make' command?
 849 Typical frequently used setting:
 850
 851     -j3              # dual processor system
 852
 853 Your choice: },
 854
 855
 856 make_install_make_command => qq{Do you want to use a different make command for 'make install'?
 857 Cautious people will probably prefer:
 858
 859     su root -c make
 860 or
 861     sudo make
 862 or
 863     /path1/to/sudo -u admin_account /path2/to/make
 864
 865 or some such. Your choice: },
 866
 867
 868 make_install_arg => qq{Parameters for the 'make install' command?
 869 Typical frequently used setting:
 870
 871     UNINST=1         # to always uninstall potentially conflicting files
 872
 873 Your choice: },
 874
 875
 876 mbuildpl_arg_intro => qq{
 877
 878 The next questions deal with Module::Build support.
 879
 880 A Build.PL is run by perl in a separate process. Likewise we run
 881 './Build' and './Build install' in separate processes. If you have any
 882 parameters you want to pass to the calls, please specify them here.
 883
 884 },
 885
 886 mbuildpl_arg => qq{Parameters for the 'perl Build.PL' command?
 887 Typical frequently used settings:
 888
 889     --install_base /home/xxx             # different installation directory
 890
 891 Your choice: },
 892
 893 mbuild_arg => qq{Parameters for the './Build' command?
 894 Setting might be:
 895
 896     --extra_linker_flags -L/usr/foo/lib  # non-standard library location
 897
 898 Your choice: },
 899
 900
 901 mbuild_install_build_command => qq{Do you want to use a different command for './Build install'?
 902 Sudo users will probably prefer:
 903
 904     su root -c ./Build
 905 or
 906     sudo ./Build
 907 or
 908     /path1/to/sudo -u admin_account ./Build
 909
 910 or some such. Your choice: },
 911
 912
 913 mbuild_install_arg => qq{Parameters for the './Build install' command?
 914 Typical frequently used setting:
 915
 916     --uninst 1                           # uninstall conflicting files
 917
 918 Your choice: },
 919
 920
 921
 922 inactivity_timeout_intro => qq{
 923
 924 Sometimes you may wish to leave the processes run by CPAN alone
 925 without caring about them. Because the Makefile.PL sometimes contains
 926 question you\'re expected to answer, you can set a timer that will
 927 kill a 'perl Makefile.PL' process after the specified time in seconds.
 928
 929 If you set this value to 0, these processes will wait forever. This is
 930 the default and recommended setting.
 931
 932 },
 933
 934 inactivity_timeout =>
 935 qq{Timeout for inactivity during {Makefile,Build}.PL? },
 936
 937
 938 proxy_intro => qq{
 939
 940 If you\'re accessing the net via proxies, you can specify them in the
 941 CPAN configuration or via environment variables. The variable in
 942 the \$CPAN::Config takes precedence.
 943
 944 },
 945
 946 proxy_user => qq{
 947
 948 If your proxy is an authenticating proxy, you can store your username
 949 permanently. If you do not want that, just press RETURN. You will then
 950 be asked for your username in every future session.
 951
 952 },
 953
 954 proxy_pass => qq{
 955
 956 Your password for the authenticating proxy can also be stored
 957 permanently on disk. If this violates your security policy, just press
 958 RETURN. You will then be asked for the password in every future
 959 session.
 960
 961 },
 962
 963 urls_intro => qq{
 964
 965 Now we need to know where your favorite CPAN sites are located. Push
 966 a few sites onto the array (just in case the first on the array won\'t
 967 work). If you are mirroring CPAN to your local workstation, specify a
 968 file: URL.
 969
 970 First, pick a nearby continent and country (you can pick several of
 971 each, separated by spaces, or none if you just want to keep your
 972 existing selections). Then, you will be presented with a list of URLs
 973 of CPAN mirrors in the countries you selected, along with previously
 974 selected URLs. Select some of those URLs, or just keep the old list.
 975 Finally, you will be prompted for any extra URLs -- file:, ftp:, or
 976 http: -- that host a CPAN mirror.
 977
 978 },
 979
 980 password_warn => qq{
 981
 982 Warning: Term::ReadKey seems not to be available, your password will
 983 be echoed to the terminal!
 984
 985 },
 986
 987 );
 988
 989 die "Coding error in \@prompts declaration.  Odd number of elements, above"
 990   if (@prompts % 2);
 991
 992 %prompts = @prompts;
 993
 994 if (scalar(keys %prompts) != scalar(@prompts)/2) {
 995
 996     my %already;
 997
 998     for my $item (0..$#prompts) {
 999         next if $item % 2;
1000         die "$prompts[$item] is duplicated\n"
1001           if $already{$prompts[$item]}++;
1002     }
1003
1004 }
1005
1006 }
1007
1008 1;