lib/CPAN/FirstTime.pm

   1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
   2 package CPAN::Mirrored::By;
   3 use strict;
   4
   5 sub new {
   6     my($self,@arg) = @_;
   7     bless [@arg], $self;
   8 }
   9 sub continent { shift->[0] }
  10 sub country { shift->[1] }
  11 sub url { shift->[2] }
  12
  13 package CPAN::FirstTime;
  14 use strict;
  15
  16 use ExtUtils::MakeMaker ();
  17 use FileHandle ();
  18 use File::Basename ();
  19 use File::Path ();
  20 use File::Spec ();
  21 use vars qw($VERSION $urllist);
  22 $VERSION = "5.53";
  23
  24 =head1 NAME
  25
  26 CPAN::FirstTime - Utility for CPAN::Config file Initialization
  27
  28 =head1 SYNOPSIS
  29
  30 CPAN::FirstTime::init()
  31
  32 =head1 DESCRIPTION
  33
  34 The init routine asks a few questions and writes a CPAN/Config.pm or
  35 CPAN/MyConfig.pm file (depending on what it is currently using).
  36
  37 In the following all questions and explanations regarding config
  38 variables are collected.
  39
  40 =cut
  41
  42 # down until the next =back the manpage must be parsed by the program
  43 # because the text is used in the init dialogues.
  44
  45 my @podpara = split /\n\n/, <<'=back';
  46
  47 =over 2
  48
  49 =item auto_commit
  50
  51 Normally CPAN.pm keeps config variables in memory and changes need to
  52 be saved in a separate 'o conf commit' command to make them permanent
  53 between sessions. If you set the 'auto_commit' option to true, changes
  54 to a config variable are always automatically committed to disk.
  55
  56 Always commit changes to config variables to disk?
  57
  58 =item build_cache
  59
  60 CPAN.pm can limit the size of the disk area for keeping the build
  61 directories with all the intermediate files.
  62
  63 Cache size for build directory (in MB)?
  64
  65 =item build_dir
  66
  67 Directory where the build process takes place?
  68
  69 =item build_dir_reuse
  70
  71 Until version 1.88 CPAN.pm never trusted the contents of the build_dir
  72 directory between sessions. Since 1.88_58 CPAN.pm has a YAML-based
  73 mechanism that makes it possible to share the contents of the
  74 build_dir/ directory between different sessions with the same version
  75 of perl. People who prefer to test things several days before
  76 installing will like this feature because it safes a lot of time.
  77
  78 If you say yes to the following question, CPAN will try to store
  79 enough information about the build process so that it can pick up in
  80 future sessions at the same state of affairs as it left a previous
  81 session.
  82
  83 Store and re-use state information about distributions between
  84 CPAN.pm sessions?
  85
  86 =item build_requires_install_policy
  87
  88 When a module declares another one as a 'build_requires' prerequisite
  89 this means that the other module is only needed for building or
  90 testing the module but need not be installed permanently. In this case
  91 you may wish to install that other module nonetheless or just keep it
  92 in the 'build_dir' directory to have it available only temporarily.
  93 Installing saves time on future installations but makes the perl
  94 installation bigger.
  95
  96 You can choose if you want to always install (yes), never install (no)
  97 or be always asked. In the latter case you can set the default answer
  98 for the question to yes (ask/yes) or no (ask/no).
  99
 100 Policy on installing 'build_requires' modules (yes, no, ask/yes,
 101 ask/no)?
 102
 103 =item cache_metadata
 104
 105 To considerably speed up the initial CPAN shell startup, it is
 106 possible to use Storable to create a cache of metadata. If Storable is
 107 not available, the normal index mechanism will be used.
 108
 109 Note: this mechanism is not used when use_sqlite is on and SQLLite is
 110 running.
 111
 112 Cache metadata (yes/no)?
 113
 114 =item check_sigs
 115
 116 CPAN packages can be digitally signed by authors and thus verified
 117 with the security provided by strong cryptography. The exact mechanism
 118 is defined in the Module::Signature module. While this is generally
 119 considered a good thing, it is not always convenient to the end user
 120 to install modules that are signed incorrectly or where the key of the
 121 author is not available or where some prerequisite for
 122 Module::Signature has a bug and so on.
 123
 124 With the check_sigs parameter you can turn signature checking on and
 125 off. The default is off for now because the whole tool chain for the
 126 functionality is not yet considered mature by some. The author of
 127 CPAN.pm would recommend setting it to true most of the time and
 128 turning it off only if it turns out to be annoying.
 129
 130 Note that if you do not have Module::Signature installed, no signature
 131 checks will be performed at all.
 132
 133 Always try to check and verify signatures if a SIGNATURE file is in
 134 the package and Module::Signature is installed (yes/no)?
 135
 136 =item colorize_output
 137
 138 When you have Term::ANSIColor installed, you can turn on colorized
 139 output to have some visual differences between normal CPAN.pm output,
 140 warnings, debugging output, and the output of the modules being
 141 installed. Set your favorite colors after some experimenting with the
 142 Term::ANSIColor module.
 143
 144 Do you want to turn on colored output?
 145
 146 =item colorize_print
 147
 148 Color for normal output?
 149
 150 =item colorize_warn
 151
 152 Color for warnings?
 153
 154 =item colorize_debug
 155
 156 Color for debugging messages?
 157
 158 =item commandnumber_in_prompt
 159
 160 The prompt of the cpan shell can contain the current command number
 161 for easier tracking of the session or be a plain string.
 162
 163 Do you want the command number in the prompt (yes/no)?
 164
 165 =item connect_to_internet_ok
 166
 167 If you have never defined your own C<urllist> in your configuration
 168 then C<CPAN.pm> will be hesitant to use the built in default sites for
 169 downloading. It will ask you once per session if a connection to the
 170 internet is OK and only if you say yes, it will try to connect. But to
 171 avoid this question, you can choose your favorite download sites once
 172 and get away with it. Or, if you have no favorite download sites
 173 answer yes to the following question.
 174
 175 If no urllist has been chosen yet, would you prefer CPAN.pm to connect
 176 to the built-in default sites without asking? (yes/no)?
 177
 178 =item ftp_passive
 179
 180 Shall we always set the FTP_PASSIVE environment variable when dealing
 181 with ftp download (yes/no)?
 182
 183 =item ftpstats_period
 184
 185 Statistics about downloads are truncated by size and period
 186 simultaneously.
 187
 188 How many days shall we keep statistics about downloads?
 189
 190 =item ftpstats_size
 191
 192 Statistics about downloads are truncated by size and period
 193 simultaneously.
 194
 195 How many items shall we keep in the statistics about downloads?
 196
 197 =item getcwd
 198
 199 CPAN.pm changes the current working directory often and needs to
 200 determine its own current working directory. Per default it uses
 201 Cwd::cwd but if this doesn't work on your system for some reason,
 202 alternatives can be configured according to the following table:
 203
 204     cwd         Cwd::cwd
 205     getcwd      Cwd::getcwd
 206     fastcwd     Cwd::fastcwd
 207     backtickcwd external command cwd
 208
 209 Preferred method for determining the current working directory?
 210
 211 =item halt_on_failure
 212
 213 Normaly, CPAN.pm continues processing the full list of targets and
 214 dependencies, even if one of them fails.  However, you can specify
 215 that CPAN should halt after the first failure.
 216
 217 Do you want to halt on failure (yes/no)?
 218
 219 =item histfile
 220
 221 If you have one of the readline packages (Term::ReadLine::Perl,
 222 Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN
 223 shell will have history support. The next two questions deal with the
 224 filename of the history file and with its size. If you do not want to
 225 set this variable, please hit SPACE RETURN to the following question.
 226
 227 File to save your history?
 228
 229 =item histsize
 230
 231 Number of lines to save?
 232
 233 =item inactivity_timeout
 234
 235 Sometimes you may wish to leave the processes run by CPAN alone
 236 without caring about them. Because the Makefile.PL or the Build.PL
 237 sometimes contains question you're expected to answer, you can set a
 238 timer that will kill a 'perl Makefile.PL' process after the specified
 239 time in seconds.
 240
 241 If you set this value to 0, these processes will wait forever. This is
 242 the default and recommended setting.
 243
 244 Timeout for inactivity during {Makefile,Build}.PL?
 245
 246 =item index_expire
 247
 248 The CPAN indexes are usually rebuilt once or twice per hour, but the
 249 typical CPAN mirror mirrors only once or twice per day. Depending on
 250 the quality of your mirror and your desire to be on the bleeding edge,
 251 you may want to set the following value to more or less than one day
 252 (which is the default). It determines after how many days CPAN.pm
 253 downloads new indexes.
 254
 255 Let the index expire after how many days?
 256
 257 =item inhibit_startup_message
 258
 259 When the CPAN shell is started it normally displays a greeting message
 260 that contains the running version and the status of readline support.
 261
 262 Do you want to turn this message off?
 263
 264 =item keep_source_where
 265
 266 Unless you are accessing the CPAN on your filesystem via a file: URL,
 267 CPAN.pm needs to keep the source files it downloads somewhere. Please
 268 supply a directory where the downloaded files are to be kept.
 269
 270 Download target directory?
 271
 272 =item load_module_verbosity
 273
 274 When CPAN.pm loads a module it needs for some optional feature, it
 275 usually reports about module name and version. Choose 'v' to get this
 276 message, 'none' to suppress it.
 277
 278 Verbosity level for loading modules (none or v)?
 279
 280 =item makepl_arg
 281
 282 Every Makefile.PL is run by perl in a separate process. Likewise we
 283 run 'make' and 'make install' in separate processes. If you have
 284 any parameters (e.g. PREFIX, UNINST or the like) you want to
 285 pass to the calls, please specify them here.
 286
 287 If you don't understand this question, just press ENTER.
 288
 289 Typical frequently used settings:
 290
 291     PREFIX=~/perl    # non-root users (please see manual for more hints)
 292
 293 Parameters for the 'perl Makefile.PL' command?
 294
 295 =item make_arg
 296
 297 Parameters for the 'make' command? Typical frequently used setting:
 298
 299     -j3              # dual processor system (on GNU make)
 300
 301 Your choice:
 302
 303 =item make_install_arg
 304
 305 Parameters for the 'make install' command?
 306 Typical frequently used setting:
 307
 308     UNINST=1         # to always uninstall potentially conflicting files
 309
 310 Your choice:
 311
 312 =item make_install_make_command
 313
 314 Do you want to use a different make command for 'make install'?
 315 Cautious people will probably prefer:
 316
 317     su root -c make
 318  or
 319     sudo make
 320  or
 321     /path1/to/sudo -u admin_account /path2/to/make
 322
 323 or some such. Your choice:
 324
 325 =item mbuildpl_arg
 326
 327 A Build.PL is run by perl in a separate process. Likewise we run
 328 './Build' and './Build install' in separate processes. If you have any
 329 parameters you want to pass to the calls, please specify them here.
 330
 331 Typical frequently used settings:
 332
 333     --install_base /home/xxx             # different installation directory
 334
 335 Parameters for the 'perl Build.PL' command?
 336
 337 =item mbuild_arg
 338
 339 Parameters for the './Build' command? Setting might be:
 340
 341     --extra_linker_flags -L/usr/foo/lib  # non-standard library location
 342
 343 Your choice:
 344
 345 =item mbuild_install_arg
 346
 347 Parameters for the './Build install' command? Typical frequently used
 348 setting:
 349
 350     --uninst 1                           # uninstall conflicting files
 351
 352 Your choice:
 353
 354 =item mbuild_install_build_command
 355
 356 Do you want to use a different command for './Build install'? Sudo
 357 users will probably prefer:
 358
 359     su root -c ./Build
 360  or
 361     sudo ./Build
 362  or
 363     /path1/to/sudo -u admin_account ./Build
 364
 365 or some such. Your choice:
 366
 367 =item pager
 368
 369 What is your favorite pager program?
 370
 371 =item prefer_installer
 372
 373 When you have Module::Build installed and a module comes with both a
 374 Makefile.PL and a Build.PL, which shall have precedence?
 375
 376 The main two standard installer modules are the old and well
 377 established ExtUtils::MakeMaker (for short: EUMM) which uses the
 378 Makefile.PL. And the next generation installer Module::Build (MB)
 379 which works with the Build.PL (and often comes with a Makefile.PL
 380 too). If a module comes only with one of the two we will use that one
 381 but if both are supplied then a decision must be made between EUMM and
 382 MB. See also http://rt.cpan.org/Ticket/Display.html?id=29235 for a
 383 discussion about the right default.
 384
 385 Or, as a third option you can choose RAND which will make a random
 386 decision (something regular CPAN testers will enjoy).
 387
 388 In case you can choose between running a Makefile.PL or a Build.PL,
 389 which installer would you prefer (EUMM or MB or RAND)?
 390
 391 =item prefs_dir
 392
 393 CPAN.pm can store customized build environments based on regular
 394 expressions for distribution names. These are YAML files where the
 395 default options for CPAN.pm and the environment can be overridden and
 396 dialog sequences can be stored that can later be executed by an
 397 Expect.pm object. The CPAN.pm distribution comes with some prefab YAML
 398 files that cover sample distributions that can be used as blueprints
 399 to store one own prefs. Please check out the distroprefs/ directory of
 400 the CPAN.pm distribution to get a quick start into the prefs system.
 401
 402 Directory where to store default options/environment/dialogs for
 403 building modules that need some customization?
 404
 405 =item prerequisites_policy
 406
 407 The CPAN module can detect when a module which you are trying to build
 408 depends on prerequisites. If this happens, it can build the
 409 prerequisites for you automatically ('follow'), ask you for
 410 confirmation ('ask'), or just ignore them ('ignore'). Please set your
 411 policy to one of the three values.
 412
 413 Policy on building prerequisites (follow, ask or ignore)?
 414
 415 =item randomize_urllist
 416
 417 CPAN.pm can introduce some randomness when using hosts for download
 418 that are configured in the urllist parameter. Enter a numeric value
 419 between 0 and 1 to indicate how often you want to let CPAN.pm try a
 420 random host from the urllist. A value of one specifies to always use a
 421 random host as the first try. A value of zero means no randomness at
 422 all. Anything in between specifies how often, on average, a random
 423 host should be tried first.
 424
 425 Randomize parameter
 426
 427 =item scan_cache
 428
 429 By default, each time the CPAN module is started, cache scanning is
 430 performed to keep the cache size in sync. To prevent this, answer
 431 'never'.
 432
 433 Perform cache scanning (atstart or never)?
 434
 435 =item shell
 436
 437 What is your favorite shell?
 438
 439 =item show_unparsable_versions
 440
 441 During the 'r' command CPAN.pm finds modules without version number.
 442 When the command finishes, it prints a report about this. If you
 443 want this report to be very verbose, say yes to the following
 444 variable.
 445
 446 Show all individual modules that have no $VERSION?
 447
 448 =item show_upload_date
 449
 450 The 'd' and the 'm' command normally only show you information they
 451 have in their in-memory database and thus will never connect to the
 452 internet. If you set the 'show_upload_date' variable to true, 'm' and
 453 'd' will additionally show you the upload date of the module or
 454 distribution. Per default this feature is off because it may require a
 455 net connection to get at the upload date.
 456
 457 Always try to show upload date with 'd' and 'm' command (yes/no)?
 458
 459 =item show_zero_versions
 460
 461 During the 'r' command CPAN.pm finds modules with a version number of
 462 zero. When the command finishes, it prints a report about this. If you
 463 want this report to be very verbose, say yes to the following
 464 variable.
 465
 466 Show all individual modules that have a $VERSION of zero?
 467
 468 =item tar_verbosity
 469
 470 When CPAN.pm uses the tar command, which switch for the verbosity
 471 shall be used? Choose 'none' for quiet operation, 'v' for file
 472 name listing, 'vv' for full listing.
 473
 474 Tar command verbosity level (none or v or vv)?
 475
 476 =item term_is_latin
 477
 478 The next option deals with the charset (aka character set) your
 479 terminal supports. In general, CPAN is English speaking territory, so
 480 the charset does not matter much but some CPAN have names that are
 481 outside the ASCII range. If your terminal supports UTF-8, you should
 482 say no to the next question. If it expects ISO-8859-1 (also known as
 483 LATIN1) then you should say yes. If it supports neither, your answer
 484 does not matter because you will not be able to read the names of some
 485 authors anyway. If you answer no, names will be output in UTF-8.
 486
 487 Your terminal expects ISO-8859-1 (yes/no)?
 488
 489 =item term_ornaments
 490
 491 When using Term::ReadLine, you can turn ornaments on so that your
 492 input stands out against the output from CPAN.pm.
 493
 494 Do you want to turn ornaments on?
 495
 496 =item test_report
 497
 498 The goal of the CPAN Testers project (http://testers.cpan.org/) is to
 499 test as many CPAN packages as possible on as many platforms as
 500 possible.  This provides valuable feedback to module authors and
 501 potential users to identify bugs or platform compatibility issues and
 502 improves the overall quality and value of CPAN.
 503
 504 One way you can contribute is to send test results for each module
 505 that you install.  If you install the CPAN::Reporter module, you have
 506 the option to automatically generate and email test reports to CPAN
 507 Testers whenever you run tests on a CPAN package.
 508
 509 See the CPAN::Reporter documentation for additional details and
 510 configuration settings.  If your firewall blocks outgoing email,
 511 you will need to configure CPAN::Reporter before sending reports.
 512
 513 Email test reports if CPAN::Reporter is installed (yes/no)?
 514
 515 =item perl5lib_verbosity
 516
 517 When CPAN.pm extends @INC via PERL5LIB, it prints a list of
 518 directories added (or a summary of how many directories are
 519 added).  Choose 'v' to get this message, 'none' to suppress it.
 520
 521 Verbosity level for PERL5LIB changes (none or v)?
 522
 523 =item trust_test_report_history
 524
 525 When a distribution has already been tested by CPAN::Reporter on
 526 this machine, CPAN can skip the test phase and just rely on the
 527 test report history instead.
 528
 529 Note that this will not apply to distributions that failed tests
 530 because of missing dependencies.  Also, tests can be run
 531 regardless of the history using "force".
 532
 533 Do you want to rely on the test report history (yes/no)?
 534
 535 =item use_sqlite
 536
 537 CPAN::SQLite is a layer between the index files that are downloaded
 538 from the CPAN and CPAN.pm that speeds up metadata queries and reduces
 539 memory consumption of CPAN.pm considerably.
 540
 541 Use CPAN::SQLite if available? (yes/no)?
 542
 543 =item yaml_load_code
 544
 545 Both YAML.pm and YAML::Syck are capable of deserialising code. As this
 546 requires a string eval, which might be a security risk, you can use
 547 this option to enable or disable the deserialisation of code via
 548 CPAN::DeferredCode. (Note: This does not work under perl 5.6)
 549
 550 Do you want to enable code deserialisation (yes/no)?
 551
 552 =item yaml_module
 553
 554 At the time of this writing there are two competing YAML modules,
 555 YAML.pm and YAML::Syck. The latter is faster but needs a C compiler
 556 installed on your system. There may be more alternative YAML
 557 conforming modules but at the time of writing a potential third
 558 player, YAML::Tiny, seemed not powerful enough to work with CPAN.pm.
 559
 560 Which YAML implementation would you prefer?
 561
 562 =back
 563
 564 =head1 LICENSE
 565
 566 This program is free software; you can redistribute it and/or
 567 modify it under the same terms as Perl itself.
 568
 569 =cut
 570
 571 use vars qw( %prompts );
 572
 573 {
 574
 575     my @prompts = (
 576
 577 manual_config => qq[
 578
 579 CPAN is the world-wide archive of perl resources. It consists of about
 580 300 sites that all replicate the same contents around the globe. Many
 581 countries have at least one CPAN site already. The resources found on
 582 CPAN are easily accessible with the CPAN.pm module. If you want to use
 583 CPAN.pm, lots of things have to be configured. Fortunately, most of
 584 them can be determined automatically. If you prefer the automatic
 585 configuration, answer 'yes' below.
 586
 587 If you prefer to enter a dialog instead, you can answer 'no' to this
 588 question and I'll let you configure in small steps one thing after the
 589 other. (Note: you can revisit this dialog anytime later by typing 'o
 590 conf init' at the cpan prompt.)
 591 ],
 592
 593 config_intro => qq{
 594
 595 The following questions are intended to help you with the
 596 configuration. The CPAN module needs a directory of its own to cache
 597 important index files and maybe keep a temporary mirror of CPAN files.
 598 This may be a site-wide or a personal directory.
 599
 600 },
 601
 602 # cpan_home => qq{ },
 603
 604 cpan_home_where => qq{
 605
 606 First of all, I'd like to create this directory. Where?
 607
 608 },
 609
 610 external_progs => qq{
 611
 612 The CPAN module will need a few external programs to work properly.
 613 Please correct me, if I guess the wrong path for a program. Don't
 614 panic if you do not have some of them, just press ENTER for those. To
 615 disable the use of a program, you can type a space followed by ENTER.
 616
 617 },
 618
 619 proxy_intro => qq{
 620
 621 If you're accessing the net via proxies, you can specify them in the
 622 CPAN configuration or via environment variables. The variable in
 623 the \$CPAN::Config takes precedence.
 624
 625 },
 626
 627 proxy_user => qq{
 628
 629 If your proxy is an authenticating proxy, you can store your username
 630 permanently. If you do not want that, just press RETURN. You will then
 631 be asked for your username in every future session.
 632
 633 },
 634
 635 proxy_pass => qq{
 636
 637 Your password for the authenticating proxy can also be stored
 638 permanently on disk. If this violates your security policy, just press
 639 RETURN. You will then be asked for the password in every future
 640 session.
 641
 642 },
 643
 644 urls_intro => qq{
 645
 646 Now we need to know where your favorite CPAN sites are located. Push
 647 a few sites onto the array (just in case the first on the array won\'t
 648 work). If you are mirroring CPAN to your local workstation, specify a
 649 file: URL.
 650
 651 First, pick a nearby continent and country by typing in the number(s)
 652 in front of the item(s) you want to select. You can pick several of
 653 each, separated by spaces. Then, you will be presented with a list of
 654 URLs of CPAN mirrors in the countries you selected, along with
 655 previously selected URLs. Select some of those URLs, or just keep the
 656 old list. Finally, you will be prompted for any extra URLs -- file:,
 657 ftp:, or http: -- that host a CPAN mirror.
 658
 659 },
 660
 661 password_warn => qq{
 662
 663 Warning: Term::ReadKey seems not to be available, your password will
 664 be echoed to the terminal!
 665
 666 },
 667
 668               );
 669
 670     die "Coding error in \@prompts declaration.  Odd number of elements, above"
 671         if (@prompts % 2);
 672
 673     %prompts = @prompts;
 674
 675     if (scalar(keys %prompts) != scalar(@prompts)/2) {
 676         my %already;
 677         for my $item (0..$#prompts) {
 678             next if $item % 2;
 679             die "$prompts[$item] is duplicated\n" if $already{$prompts[$item]}++;
 680         }
 681     }
 682
 683     shift @podpara;
 684     while (@podpara) {
 685         warn "Alert: cannot parse my own manpage for init dialog" unless $podpara[0] =~ s/^=item\s+//;
 686         my $name = shift @podpara;
 687         my @para;
 688         while (@podpara && $podpara[0] !~ /^=item/) {
 689             push @para, shift @podpara;
 690         }
 691         $prompts{$name} = pop @para;
 692         if (@para) {
 693             $prompts{$name . "_intro"} = join "", map { "$_\n\n" } @para;
 694         }
 695     }
 696
 697 }
 698
 699 sub init {
 700     my($configpm, %args) = @_;
 701     use Config;
 702     # extra args after 'o conf init'
 703     my $matcher = $args{args} && @{$args{args}} ? $args{args}[0] : '';
 704     if ($matcher =~ /^\/(.*)\/$/) {
 705         # case /regex/ => take the first, ignore the rest
 706         $matcher = $1;
 707         shift @{$args{args}};
 708         if (@{$args{args}}) {
 709             local $" = " ";
 710             $CPAN::Frontend->mywarn("Ignoring excessive arguments '@{$args{args}}'");
 711             $CPAN::Frontend->mysleep(2);
 712         }
 713     } elsif (0 == length $matcher) {
 714     } elsif (0 && $matcher eq "~") { # extremely buggy, but a nice idea
 715         my @unconfigured = grep { not exists $CPAN::Config->{$_}
 716                                       or not defined $CPAN::Config->{$_}
 717                                           or not length $CPAN::Config->{$_}
 718                                   } keys %$CPAN::Config;
 719         $matcher = "\\b(".join("|", @unconfigured).")\\b";
 720         $CPAN::Frontend->mywarn("matcher[$matcher]");
 721     } else {
 722         # case WORD... => all arguments must be valid
 723         for my $arg (@{$args{args}}) {
 724             unless (exists $CPAN::HandleConfig::keys{$arg}) {
 725                 $CPAN::Frontend->mywarn("'$arg' is not a valid configuration variable\n");
 726                 return;
 727             }
 728         }
 729         $matcher = "\\b(".join("|",@{$args{args}}).")\\b";
 730     }
 731     CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG;
 732
 733     unless ($CPAN::VERSION) {
 734         require CPAN::Nox;
 735     }
 736     require CPAN::HandleConfig;
 737     CPAN::HandleConfig::require_myconfig_or_config();
 738     $CPAN::Config ||= {};
 739     local($/) = "\n";
 740     local($\) = "";
 741     local($|) = 1;
 742
 743     my($ans,$default); # why so half global?
 744
 745     #
 746     #= Files, directories
 747     #
 748
 749     unless ($matcher) {
 750         $CPAN::Frontend->myprint($prompts{manual_config});
 751     }
 752
 753     my $manual_conf;
 754
 755     local *_real_prompt;
 756     if ( $args{autoconfig} ) {
 757         $manual_conf = "no";
 758     } elsif ($matcher) {
 759         $manual_conf = "yes";
 760     } else {
 761         my $_conf = prompt("Would you like me to configure as much as possible ".
 762                            "automatically?", "yes");
 763         $manual_conf = ($_conf and $_conf =~ /^y/i) ? "no" : "yes";
 764     }
 765     CPAN->debug("manual_conf[$manual_conf]") if $CPAN::DEBUG;
 766     my $fastread;
 767     {
 768         if ($manual_conf =~ /^y/i) {
 769             $fastread = 0;
 770         } else {
 771             $fastread = 1;
 772             $CPAN::Config->{urllist} ||= [];
 773
 774             local $^W = 0;
 775             # prototype should match that of &MakeMaker::prompt
 776             my $current_second = time;
 777             my $current_second_count = 0;
 778             my $i_am_mad = 0;
 779             *_real_prompt = sub {
 780                 my($q,$a) = @_;
 781                 my($ret) = defined $a ? $a : "";
 782                 $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
 783                 eval { require Time::HiRes };
 784                 unless ($@) {
 785                     if (time == $current_second) {
 786                         $current_second_count++;
 787                         if ($current_second_count > 20) {
 788                             # I don't like more than 20 prompts per second
 789                             $i_am_mad++;
 790                         }
 791                     } else {
 792                         $current_second = time;
 793                         $current_second_count = 0;
 794                         $i_am_mad-- if $i_am_mad>0;
 795                     }
 796                     if ($i_am_mad>0) {
 797                         #require Carp;
 798                         #Carp::cluck("SLEEEEEEEEPIIIIIIIIIIINGGGGGGGGGGG");
 799                         Time::HiRes::sleep(0.1);
 800                     }
 801                 }
 802                 $ret;
 803             };
 804         }
 805     }
 806
 807     if (!$matcher or q{
 808                        build_dir
 809                        build_dir_reuse
 810                        cpan_home
 811                        keep_source_where
 812                        prefs_dir
 813                       } =~ /$matcher/) {
 814         $CPAN::Frontend->myprint($prompts{config_intro});
 815
 816         init_cpan_home($matcher);
 817
 818         my_dflt_prompt("keep_source_where",
 819                        File::Spec->catdir($CPAN::Config->{cpan_home},"sources"),
 820                        $matcher,
 821                       );
 822         my_dflt_prompt("build_dir",
 823                        File::Spec->catdir($CPAN::Config->{cpan_home},"build"),
 824                        $matcher
 825                       );
 826         my_yn_prompt(build_dir_reuse => 0, $matcher);
 827         my_dflt_prompt("prefs_dir",
 828                        File::Spec->catdir($CPAN::Config->{cpan_home},"prefs"),
 829                        $matcher
 830                       );
 831     }
 832
 833     #
 834     #= Config: auto_commit
 835     #
 836
 837     my_yn_prompt(auto_commit => 0, $matcher);
 838
 839     #
 840     #= Cache size, Index expire
 841     #
 842     my_dflt_prompt(build_cache => 100, $matcher);
 843
 844     my_dflt_prompt(index_expire => 1, $matcher);
 845     my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
 846
 847     #
 848     #= cache_metadata
 849     #
 850
 851     my_yn_prompt(cache_metadata => 1, $matcher);
 852     my_yn_prompt(use_sqlite => 0, $matcher);
 853
 854     #
 855     #= Do we follow PREREQ_PM?
 856     #
 857
 858     my_prompt_loop(prerequisites_policy => 'ask', $matcher,
 859                    'follow|ask|ignore');
 860     my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher,
 861                    'yes|no|ask/yes|ask/no');
 862
 863     #
 864     #= Module::Signature
 865     #
 866     my_yn_prompt(check_sigs => 0, $matcher);
 867
 868     #
 869     #= CPAN::Reporter
 870     #
 871     if (!$matcher or 'test_report' =~ /$matcher/) {
 872         my_yn_prompt(test_report => 0, $matcher);
 873         if (
 874             $CPAN::Config->{test_report} &&
 875             $CPAN::META->has_inst("CPAN::Reporter") &&
 876             CPAN::Reporter->can('configure')
 877            ) {
 878             $CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n");
 879             CPAN::Reporter::configure();
 880             $CPAN::Frontend->myprint("\nReturning to CPAN configuration.\n");
 881         }
 882     }
 883
 884     my_yn_prompt(trust_test_report_history => 0, $matcher);
 885
 886     #
 887     #= YAML vs. YAML::Syck
 888     #
 889     if (!$matcher or "yaml_module" =~ /$matcher/) {
 890         my_dflt_prompt(yaml_module => "YAML", $matcher);
 891         unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
 892             $CPAN::Frontend->mywarn
 893                 ("Warning (maybe harmless): '$CPAN::Config->{yaml_module}' not installed.\n");
 894             $CPAN::Frontend->mysleep(3);
 895         }
 896     }
 897
 898     #
 899     #= YAML code deserialisation
 900     #
 901     my_yn_prompt(yaml_load_code => 0, $matcher);
 902
 903     #
 904     #= External programs
 905     #
 906     my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
 907     _init_external_progs($matcher,\@path);
 908
 909     {
 910         my $path = $CPAN::Config->{'pager'} ||
 911             $ENV{PAGER} || find_exe("less",\@path) ||
 912                 find_exe("more",\@path) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
 913                     || "more";
 914         my_dflt_prompt(pager => $path, $matcher);
 915     }
 916
 917     {
 918         my $path = $CPAN::Config->{'shell'};
 919         if ($path && File::Spec->file_name_is_absolute($path)) {
 920             $CPAN::Frontend->mywarn("Warning: configured $path does not exist\n")
 921                 unless -e $path;
 922             $path = "";
 923         }
 924         $path ||= $ENV{SHELL};
 925         $path ||= $ENV{COMSPEC} if $^O eq "MSWin32";
 926         if ($^O eq 'MacOS') {
 927             $CPAN::Config->{'shell'} = 'not_here';
 928         } else {
 929             $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
 930             my_dflt_prompt(shell => $path, $matcher);
 931         }
 932     }
 933
 934     #
 935     # verbosity
 936     #
 937
 938     my_prompt_loop(tar_verbosity => 'v', $matcher,
 939                    'none|v|vv');
 940     my_prompt_loop(load_module_verbosity => 'v', $matcher,
 941                    'none|v');
 942     my_prompt_loop(perl5lib_verbosity => 'v', $matcher,
 943                    'none|v');
 944     my_yn_prompt(inhibit_startup_message => 0, $matcher);
 945
 946     #
 947     #= Installer, arguments to make etc.
 948     #
 949
 950     my_prompt_loop(prefer_installer => 'MB', $matcher, 'MB|EUMM|RAND');
 951
 952     if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/) {
 953         my_dflt_prompt(makepl_arg => "", $matcher);
 954         my_dflt_prompt(make_arg => "", $matcher);
 955         if ( $CPAN::Config->{makepl_arg} =~ /LIBS=|INC=/ ) {
 956             $CPAN::Frontend->mywarn(
 957                 "Warning: Using LIBS or INC in makepl_arg will likely break distributions\n" .
 958                 "that specify their own LIBS or INC options in Makefile.PL.\n"
 959             );
 960         }
 961
 962     }
 963
 964     require CPAN::HandleConfig;
 965     if (exists $CPAN::HandleConfig::keys{make_install_make_command}) {
 966         # as long as Windows needs $self->_build_command, we cannot
 967         # support sudo on windows :-)
 968         my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "",
 969                        $matcher);
 970     }
 971
 972     my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "",
 973                    $matcher);
 974
 975     my_dflt_prompt(mbuildpl_arg => "", $matcher);
 976     my_dflt_prompt(mbuild_arg => "", $matcher);
 977
 978     if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command}
 979         and $^O ne "MSWin32") {
 980         # as long as Windows needs $self->_build_command, we cannot
 981         # support sudo on windows :-)
 982         my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher);
 983     }
 984
 985     my_dflt_prompt(mbuild_install_arg => "", $matcher);
 986
 987     #
 988     #= Alarm period
 989     #
 990
 991     my_dflt_prompt(inactivity_timeout => 0, $matcher);
 992
 993     #
 994     #== halt_on_failure
 995     #
 996     my_yn_prompt(halt_on_failure => 0, $matcher);
 997
 998     #
 999     #= Proxies
1000     #
1001
1002     my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/;
1003     my @proxy_user_vars = qw/proxy_user proxy_pass/;
1004     if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/) {
1005         $CPAN::Frontend->myprint($prompts{proxy_intro});
1006
1007         for (@proxy_vars) {
1008             $prompts{$_} = "Your $_?";
1009             my_dflt_prompt($_ => $ENV{$_}||"", $matcher);
1010         }
1011
1012         if ($CPAN::Config->{ftp_proxy} ||
1013             $CPAN::Config->{http_proxy}) {
1014
1015             $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || "";
1016
1017             $CPAN::Frontend->myprint($prompts{proxy_user});
1018
1019             if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
1020                 $CPAN::Frontend->myprint($prompts{proxy_pass});
1021
1022                 if ($CPAN::META->has_inst("Term::ReadKey")) {
1023                     Term::ReadKey::ReadMode("noecho");
1024                 } else {
1025                     $CPAN::Frontend->myprint($prompts{password_warn});
1026                 }
1027                 $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
1028                 if ($CPAN::META->has_inst("Term::ReadKey")) {
1029                     Term::ReadKey::ReadMode("restore");
1030                 }
1031                 $CPAN::Frontend->myprint("\n\n");
1032             }
1033         }
1034     }
1035
1036     #
1037     #= how FTP works
1038     #
1039
1040     my_yn_prompt(ftp_passive => 1, $matcher);
1041
1042     #
1043     #= how cwd works
1044     #
1045
1046     my_prompt_loop(getcwd => 'cwd', $matcher,
1047                    'cwd|getcwd|fastcwd|backtickcwd');
1048
1049     #
1050     #= the CPAN shell itself (prompt, color)
1051     #
1052
1053     my_yn_prompt(commandnumber_in_prompt => 1, $matcher);
1054     my_yn_prompt(term_ornaments => 1, $matcher);
1055     if ("colorize_output colorize_print colorize_warn colorize_debug" =~ $matcher) {
1056         my_yn_prompt(colorize_output => 0, $matcher);
1057         if ($CPAN::Config->{colorize_output}) {
1058             if ($CPAN::META->has_inst("Term::ANSIColor")) {
1059                 my $T="gYw";
1060                 print "                                      on_  on_y ".
1061                     "        on_ma           on_\n";
1062                 print "                   on_black on_red  green ellow ".
1063                     "on_blue genta on_cyan white\n";
1064
1065                 for my $FG ("", "bold",
1066                             map {$_,"bold $_"} "black","red","green",
1067                             "yellow","blue",
1068                             "magenta",
1069                             "cyan","white") {
1070                     printf "%12s ", $FG;
1071                     for my $BG ("",map {"on_$_"} qw(black red green yellow
1072                                                     blue magenta cyan white)) {
1073                         print $FG||$BG ?
1074                             Term::ANSIColor::colored("  $T  ","$FG $BG") : "  $T  ";
1075                     }
1076                     print "\n";
1077                 }
1078                 print "\n";
1079             }
1080             for my $tuple (
1081                            ["colorize_print", "bold blue on_white"],
1082                            ["colorize_warn", "bold red on_white"],
1083                            ["colorize_debug", "black on_cyan"],
1084                           ) {
1085                 my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher);
1086                 if ($CPAN::META->has_inst("Term::ANSIColor")) {
1087                     eval { Term::ANSIColor::color($CPAN::Config->{$tuple->[0]})};
1088                     if ($@) {
1089                         $CPAN::Config->{$tuple->[0]} = $tuple->[1];
1090                         $CPAN::Frontend->mywarn($@."setting to default '$tuple->[1]'\n");
1091                     }
1092                 }
1093             }
1094         }
1095     }
1096
1097     #
1098     #== term_is_latin
1099     #
1100
1101     my_yn_prompt(term_is_latin => 1, $matcher);
1102
1103     #
1104     #== save history in file 'histfile'
1105     #
1106
1107     if (!$matcher or 'histfile histsize' =~ /$matcher/) {
1108         $CPAN::Frontend->myprint($prompts{histfile_intro});
1109         defined($default = $CPAN::Config->{histfile}) or
1110             $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
1111         my_dflt_prompt(histfile => $default, $matcher);
1112
1113         if ($CPAN::Config->{histfile}) {
1114             defined($default = $CPAN::Config->{histsize}) or $default = 100;
1115             my_dflt_prompt(histsize => $default, $matcher);
1116         }
1117     }
1118
1119     #
1120     #== do an ls on the m or the d command
1121     #
1122     my_yn_prompt(show_upload_date => 0, $matcher);
1123
1124     #
1125     #== verbosity at the end of the r command
1126     #
1127     if (!$matcher
1128         or 'show_unparsable_versions' =~ /$matcher/
1129         or 'show_zero_versions' =~ /$matcher/
1130        ) {
1131         $CPAN::Frontend->myprint($prompts{show_unparsable_or_zero_versions_intro});
1132         my_yn_prompt(show_unparsable_versions => 0, $matcher);
1133         my_yn_prompt(show_zero_versions => 0, $matcher);
1134     }
1135
1136     #
1137     #= MIRRORED.BY and conf_sites()
1138     #
1139
1140     # remember, this is only triggered if no urllist is given, so 0 is
1141     # fair and protects the default site from being overloaded and
1142     # gives the user more chances to select his own urllist.
1143     my_yn_prompt("connect_to_internet_ok" => 0, $matcher);
1144     if ($matcher) {
1145         if ("urllist" =~ $matcher) {
1146             # conf_sites would go into endless loop with the smash prompt
1147             local *_real_prompt;
1148             *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
1149             conf_sites();
1150         }
1151         if ("randomize_urllist" =~ $matcher) {
1152             my_dflt_prompt(randomize_urllist => 0, $matcher);
1153         }
1154         if ("ftpstats_size" =~ $matcher) {
1155             my_dflt_prompt(ftpstats_size => 99, $matcher);
1156         }
1157         if ("ftpstats_period" =~ $matcher) {
1158             my_dflt_prompt(ftpstats_period => 14, $matcher);
1159         }
1160     } elsif ($fastread) {
1161         $CPAN::Frontend->myprint("Autoconfigured everything but 'urllist'.\n".
1162                                  "Please call 'o conf init urllist' to configure ".
1163                                  "your CPAN server(s) now!\n\n");
1164     } else {
1165         conf_sites();
1166     }
1167
1168     $CPAN::Frontend->myprint("\n\n");
1169     if ($matcher && !$CPAN::Config->{auto_commit}) {
1170         $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ".
1171                                  "make the config permanent!\n\n");
1172     } else {
1173         CPAN::HandleConfig->commit($configpm);
1174     }
1175 }
1176
1177 sub _init_external_progs {
1178     my($matcher,$PATH) = @_;
1179     my @external_progs = qw/bzip2 gzip tar unzip
1180
1181                             make
1182
1183                             curl lynx wget ncftpget ncftp ftp
1184
1185                             gpg
1186
1187                             patch applypatch
1188                             /;
1189     if (!$matcher or "@external_progs" =~ /$matcher/) {
1190         $CPAN::Frontend->myprint($prompts{external_progs});
1191
1192         my $old_warn = $^W;
1193         local $^W if $^O eq 'MacOS';
1194         local $^W = $old_warn;
1195         my $progname;
1196         for $progname (@external_progs) {
1197             next if $matcher && $progname !~ /$matcher/;
1198             if ($^O eq 'MacOS') {
1199                 $CPAN::Config->{$progname} = 'not_here';
1200                 next;
1201             }
1202
1203             my $progcall = $progname;
1204             unless ($matcher) {
1205                 # we really don't need ncftp if we have ncftpget, but
1206                 # if they chose this dialog via matcher, they shall have it
1207                 next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
1208             }
1209             my $path = $CPAN::Config->{$progname}
1210                 || $Config::Config{$progname}
1211                     || "";
1212             if (File::Spec->file_name_is_absolute($path)) {
1213                 # testing existence is not good enough, some have these exe
1214                 # extensions
1215
1216                 # warn "Warning: configured $path does not exist\n" unless -e $path;
1217                 # $path = "";
1218             } elsif ($path =~ /^\s+$/) {
1219                 # preserve disabled programs
1220             } else {
1221                 $path = '';
1222             }
1223             unless ($path) {
1224                 # e.g. make -> nmake
1225                 $progcall = $Config::Config{$progname} if $Config::Config{$progname};
1226             }
1227
1228             $path ||= find_exe($progcall,$PATH);
1229             unless ($path) { # not -e $path, because find_exe already checked that
1230                 local $"=";";
1231                 $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@$PATH]\n");
1232                 if ($progname eq "make") {
1233                     $CPAN::Frontend->mywarn("ALERT: 'make' is an essential tool for ".
1234                                             "building perl Modules. Please make sure you ".
1235                                             "have 'make' (or some equivalent) ".
1236                                             "working.\n"
1237                                            );
1238                     if ($^O eq "MSWin32") {
1239                         $CPAN::Frontend->mywarn("
1240 Windows users may want to follow this procedure when back in the CPAN shell:
1241
1242     look YVES/scripts/alien_nmake.pl
1243     perl alien_nmake.pl
1244
1245 This will install nmake on your system which can be used as a 'make'
1246 substitute. You can then revisit this dialog with
1247
1248     o conf init make
1249
1250 ");
1251                     }
1252                 }
1253             }
1254             $prompts{$progname} = "Where is your $progname program?";
1255             my_dflt_prompt($progname,$path,$matcher);
1256         }
1257     }
1258 }
1259
1260 sub init_cpan_home {
1261     my($matcher) = @_;
1262     if (!$matcher or 'cpan_home' =~ /$matcher/) {
1263         my $cpan_home = $CPAN::Config->{cpan_home}
1264             || File::Spec->catdir(CPAN::HandleConfig::home(), ".cpan");
1265
1266         if (-d $cpan_home) {
1267             $CPAN::Frontend->myprint(qq{
1268
1269 I see you already have a  directory
1270     $cpan_home
1271 Shall we use it as the general CPAN build and cache directory?
1272
1273 });
1274         } else {
1275             # no cpan-home, must prompt and get one
1276             $CPAN::Frontend->myprint($prompts{cpan_home_where});
1277         }
1278
1279         my $default = $cpan_home;
1280         my $loop = 0;
1281         my($last_ans,$ans);
1282         $CPAN::Frontend->myprint(" <cpan_home>\n");
1283     PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) {
1284             print "\n";
1285             if (File::Spec->file_name_is_absolute($ans)) {
1286                 my @cpan_home = split /[\/\\]/, $ans;
1287             DIR: for my $dir (@cpan_home) {
1288                     if ($dir =~ /^~/ and (!$last_ans or $ans ne $last_ans)) {
1289                         $CPAN::Frontend
1290                             ->mywarn("Warning: a tilde in the path will be ".
1291                                      "taken as a literal tilde. Please ".
1292                                      "confirm again if you want to keep it\n");
1293                         $last_ans = $default = $ans;
1294                         next PROMPT;
1295                     }
1296                 }
1297             } else {
1298                 require Cwd;
1299                 my $cwd = Cwd::cwd();
1300                 my $absans = File::Spec->catdir($cwd,$ans);
1301                 $CPAN::Frontend->mywarn("The path '$ans' is not an ".
1302                                         "absolute path. Please specify ".
1303                                         "an absolute path\n");
1304                 $default = $absans;
1305                 next PROMPT;
1306             }
1307             eval { File::Path::mkpath($ans); }; # dies if it can't
1308             if ($@) {
1309                 $CPAN::Frontend->mywarn("Couldn't create directory $ans.\n".
1310                                         "Please retry.\n");
1311                 next PROMPT;
1312             }
1313             if (-d $ans && -w _) {
1314                 last PROMPT;
1315             } else {
1316                 $CPAN::Frontend->mywarn("Couldn't find directory $ans\n".
1317                                         "or directory is not writable. Please retry.\n");
1318                 if (++$loop > 5) {
1319                     $CPAN::Frontend->mydie("Giving up");
1320                 }
1321             }
1322         }
1323         $CPAN::Config->{cpan_home} = $ans;
1324     }
1325 }
1326
1327 sub my_dflt_prompt {
1328     my ($item, $dflt, $m) = @_;
1329     my $default = $CPAN::Config->{$item} || $dflt;
1330
1331     if (!$m || $item =~ /$m/) {
1332         if (my $intro = $prompts{$item . "_intro"}) {
1333             $CPAN::Frontend->myprint($intro);
1334         }
1335         $CPAN::Frontend->myprint(" <$item>\n");
1336         $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
1337         print "\n";
1338     } else {
1339         $CPAN::Config->{$item} = $default;
1340     }
1341 }
1342
1343 sub my_yn_prompt {
1344     my ($item, $dflt, $m) = @_;
1345     my $default;
1346     defined($default = $CPAN::Config->{$item}) or $default = $dflt;
1347
1348     # $DB::single = 1;
1349     if (!$m || $item =~ /$m/) {
1350         if (my $intro = $prompts{$item . "_intro"}) {
1351             $CPAN::Frontend->myprint($intro);
1352         }
1353         $CPAN::Frontend->myprint(" <$item>\n");
1354         my $ans = prompt($prompts{$item}, $default ? 'yes' : 'no');
1355         $CPAN::Config->{$item} = ($ans =~ /^[y1]/i ? 1 : 0);
1356         print "\n";
1357     } else {
1358         $CPAN::Config->{$item} = $default;
1359     }
1360 }
1361
1362 sub my_prompt_loop {
1363     my ($item, $dflt, $m, $ok) = @_;
1364     my $default = $CPAN::Config->{$item} || $dflt;
1365     my $ans;
1366
1367     if (!$m || $item =~ /$m/) {
1368         $CPAN::Frontend->myprint($prompts{$item . "_intro"});
1369         $CPAN::Frontend->myprint(" <$item>\n");
1370         do { $ans = prompt($prompts{$item}, $default);
1371         } until $ans =~ /$ok/;
1372         $CPAN::Config->{$item} = $ans;
1373         print "\n";
1374     } else {
1375         $CPAN::Config->{$item} = $default;
1376     }
1377 }
1378
1379
1380 sub conf_sites {
1381     my $m = 'MIRRORED.BY';
1382     my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
1383     File::Path::mkpath(File::Basename::dirname($mby));
1384     if (-f $mby && -f $m && -M $m < -M $mby) {
1385         require File::Copy;
1386         File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
1387     }
1388     my $loopcount = 0;
1389     local $^T = time;
1390     my $overwrite_local = 0;
1391     if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) {
1392         my $mtime = localtime((stat _)[9]);
1393         my $prompt = qq{Found $mby as of $mtime
1394
1395 I\'d use that as a database of CPAN sites. If that is OK for you,
1396 please answer 'y', but if you want me to get a new database now,
1397 please answer 'n' to the following question.
1398
1399 Shall I use the local database in $mby?};
1400         my $ans = prompt($prompt,"y");
1401         $overwrite_local = 1 unless $ans =~ /^y/i;
1402     }
1403     while ($mby) {
1404         if ($overwrite_local) {
1405             $CPAN::Frontend->myprint(qq{Trying to overwrite $mby\n});
1406             $mby = CPAN::FTP->localize($m,$mby,3);
1407             $overwrite_local = 0;
1408         } elsif ( ! -f $mby ) {
1409             $CPAN::Frontend->myprint(qq{You have no $mby\n  I\'m trying to fetch one\n});
1410             $mby = CPAN::FTP->localize($m,$mby,3);
1411         } elsif (-M $mby > 60 && $loopcount == 0) {
1412             $CPAN::Frontend->myprint(qq{Your $mby is older than 60 days,\n  I\'m trying }.
1413                                      qq{to fetch one\n});
1414             $mby = CPAN::FTP->localize($m,$mby,3);
1415             $loopcount++;
1416         } elsif (-s $mby == 0) {
1417             $CPAN::Frontend->myprint(qq{You have an empty $mby,\n  I\'m trying to fetch one\n});
1418             $mby = CPAN::FTP->localize($m,$mby,3);
1419         } else {
1420             last;
1421         }
1422     }
1423     local $urllist = [];
1424     read_mirrored_by($mby);
1425     bring_your_own();
1426     $CPAN::Config->{urllist} = $urllist;
1427 }
1428
1429 sub find_exe {
1430     my($exe,$path) = @_;
1431     my($dir);
1432     #warn "in find_exe exe[$exe] path[@$path]";
1433     for $dir (@$path) {
1434         my $abs = File::Spec->catfile($dir,$exe);
1435         if (($abs = MM->maybe_command($abs))) {
1436             return $abs;
1437         }
1438     }
1439 }
1440
1441 sub picklist {
1442     my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
1443     CPAN->debug("picklist('$items','$prompt','$default','$require_nonempty',".
1444                 "'$empty_warning')") if $CPAN::DEBUG;
1445     $default ||= '';
1446
1447     my $pos = 0;
1448
1449     my @nums;
1450   SELECTION: while (1) {
1451
1452         # display, at most, 15 items at a time
1453         my $limit = $#{ $items } - $pos;
1454         $limit = 15 if $limit > 15;
1455
1456         # show the next $limit items, get the new position
1457         $pos = display_some($items, $limit, $pos, $default);
1458         $pos = 0 if $pos >= @$items;
1459
1460         my $num = prompt($prompt,$default);
1461
1462         @nums = split (' ', $num);
1463         {
1464             my %seen;
1465             @nums = grep { !$seen{$_}++ } @nums;
1466         }
1467         my $i = scalar @$items;
1468         unrangify(\@nums);
1469         if (grep (/\D/ || $_ < 1 || $_ > $i, @nums)) {
1470             $CPAN::Frontend->mywarn("invalid items entered, try again\n");
1471             if ("@nums" =~ /\D/) {
1472                 $CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n");
1473             }
1474             next SELECTION;
1475         }
1476         if ($require_nonempty && !@nums) {
1477             $CPAN::Frontend->mywarn("$empty_warning\n");
1478         }
1479         $CPAN::Frontend->myprint("\n");
1480
1481         # a blank line continues...
1482         next SELECTION unless @nums;
1483         last;
1484     }
1485     for (@nums) { $_-- }
1486     @{$items}[@nums];
1487 }
1488
1489 sub unrangify ($) {
1490     my($nums) = $_[0];
1491     my @nums2 = ();
1492     while (@{$nums||[]}) {
1493         my $n = shift @$nums;
1494         if ($n =~ /^(\d+)-(\d+)$/) {
1495             my @range = $1 .. $2;
1496             # warn "range[@range]";
1497             push @nums2, @range;
1498         } else {
1499             push @nums2, $n;
1500         }
1501     }
1502     push @$nums, @nums2;
1503 }
1504
1505 sub display_some {
1506     my ($items, $limit, $pos, $default) = @_;
1507     $pos ||= 0;
1508
1509     my @displayable = @$items[$pos .. ($pos + $limit)];
1510     for my $item (@displayable) {
1511         $CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item);
1512     }
1513     my $hit_what = $default ? "SPACE RETURN" : "RETURN";
1514     $CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n",
1515                                      (@$items - $pos),
1516                                      $hit_what,
1517                                     ))
1518         if $pos < @$items;
1519     return $pos;
1520 }
1521
1522 sub read_mirrored_by {
1523     my $local = shift or return;
1524     my(%all,$url,$expected_size,$default,$ans,$host,
1525        $dst,$country,$continent,@location);
1526     my $fh = FileHandle->new;
1527     $fh->open($local) or die "Couldn't open $local: $!";
1528     local $/ = "\012";
1529     while (<$fh>) {
1530         ($host) = /^([\w\.\-]+)/ unless defined $host;
1531         next unless defined $host;
1532         next unless /\s+dst_(dst|location)/;
1533         /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
1534             ($continent, $country) = @location[-1,-2];
1535         $continent =~ s/\s\(.*//;
1536         $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
1537         /dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
1538         next unless $host && $dst && $continent && $country;
1539         $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
1540         undef $host;
1541         $dst=$continent=$country="";
1542     }
1543     $fh->close;
1544     $CPAN::Config->{urllist} ||= [];
1545     my @previous_urls = @{$CPAN::Config->{urllist}};
1546
1547     $CPAN::Frontend->myprint($prompts{urls_intro});
1548
1549     my (@cont, $cont, %cont, @countries, @urls, %seen);
1550     my $no_previous_warn =
1551         "Sorry! since you don't have any existing picks, you must make a\n" .
1552             "geographic selection.";
1553     my $offer_cont = [sort keys %all];
1554     if (@previous_urls) {
1555         push @$offer_cont, "(edit previous picks)";
1556         $default = @$offer_cont;
1557     }
1558     @cont = picklist($offer_cont,
1559                      "Select your continent (or several nearby continents)",
1560                      $default,
1561                      ! @previous_urls,
1562                      $no_previous_warn);
1563
1564
1565     foreach $cont (@cont) {
1566         my @c = sort keys %{$all{$cont}};
1567         @cont{@c} = map ($cont, 0..$#c);
1568         @c = map ("$_ ($cont)", @c) if @cont > 1;
1569         push (@countries, @c);
1570     }
1571     if (@previous_urls && @countries) {
1572         push @countries, "(edit previous picks)";
1573         $default = @countries;
1574     }
1575
1576     if (@countries) {
1577         @countries = picklist (\@countries,
1578                                "Select your country (or several nearby countries)",
1579                                $default,
1580                                ! @previous_urls,
1581                                $no_previous_warn);
1582         %seen = map (($_ => 1), @previous_urls);
1583         # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
1584         foreach $country (@countries) {
1585             next if $country =~ /edit previous picks/;
1586             (my $bare_country = $country) =~ s/ \(.*\)//;
1587             my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
1588             @u = grep (! $seen{$_}, @u);
1589             @u = map ("$_ ($bare_country)", @u)
1590                 if @countries > 1;
1591             push (@urls, @u);
1592         }
1593     }
1594     push (@urls, map ("$_ (previous pick)", @previous_urls));
1595     my $prompt = "Select as many URLs as you like (by number),
1596 put them on one line, separated by blanks, hyphenated ranges allowed
1597  e.g. '1 4 5' or '7 1-4 8'";
1598     if (@previous_urls) {
1599         $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
1600                          (scalar @urls));
1601         $prompt .= "\n(or just hit RETURN to keep your previous picks)";
1602     }
1603
1604     @urls = picklist (\@urls, $prompt, $default);
1605     foreach (@urls) { s/ \(.*\)//; }
1606     push @$urllist, @urls;
1607 }
1608
1609 sub bring_your_own {
1610     my %seen = map (($_ => 1), @$urllist);
1611     my($ans,@urls);
1612     my $eacnt = 0; # empty answers
1613     do {
1614         my $prompt = "Enter another URL or RETURN to quit:";
1615         unless (%seen) {
1616             $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
1617
1618 Please enter your CPAN site:};
1619         }
1620         $ans = prompt ($prompt, "");
1621
1622         if ($ans) {
1623             $ans =~ s|/?\z|/|; # has to end with one slash
1624             $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
1625             if ($ans =~ /^\w+:\/./) {
1626                 push @urls, $ans unless $seen{$ans}++;
1627             } else {
1628                 $CPAN::Frontend->
1629                     myprint(sprintf(qq{"%s" doesn\'t look like an URL at first sight.
1630 I\'ll ignore it for now.
1631 You can add it to your %s
1632 later if you\'re sure it\'s right.\n},
1633                                    $ans,
1634                                    $INC{'CPAN/MyConfig.pm'}
1635                                    || $INC{'CPAN/Config.pm'}
1636                                    || "configuration file",
1637                                   ));
1638             }
1639         } else {
1640             if (++$eacnt >= 5) {
1641                 $CPAN::Frontend->
1642                     mywarn("Giving up.\n");
1643                 $CPAN::Frontend->mysleep(5);
1644                 return;
1645             }
1646         }
1647     } while $ans || !%seen;
1648
1649     push @$urllist, @urls;
1650     # xxx delete or comment these out when you're happy that it works
1651     $CPAN::Frontend->myprint("New set of picks:\n");
1652     map { $CPAN::Frontend->myprint("  $_\n") } @$urllist;
1653 }
1654
1655
1656 sub _strip_spaces {
1657     $_[0] =~ s/^\s+//;  # no leading spaces
1658     $_[0] =~ s/\s+\z//; # no trailing spaces
1659 }
1660
1661 sub prompt ($;$) {
1662     unless (defined &_real_prompt) {
1663         *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
1664     }
1665     my $ans = _real_prompt(@_);
1666
1667     _strip_spaces($ans);
1668
1669     return $ans;
1670 }
1671
1672
1673 sub prompt_no_strip ($;$) {
1674     return _real_prompt(@_);
1675 }
1676
1677
1678
1679 1;