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