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