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