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