ext/CPAN/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 (2009-03) there are three YAML
 555 implementations working: YAML, YAML::Syck, and YAML::XS. The latter
 556 two are faster but need a C compiler installed on your system. There
 557 may be more alternative YAML conforming modules. When I tried two
 558 other players, YAML::Tiny and YAML::Perl, they seemed not powerful
 559 enough to work with CPAN.pm. This may have changed in the meantime.
 560
 561 Which YAML implementation would you prefer?
 562
 563 =back
 564
 565 =head1 LICENSE
 566
 567 This program is free software; you can redistribute it and/or
 568 modify it under the same terms as Perl itself.
 569
 570 =cut
 571
 572 use vars qw( %prompts );
 573
 574 {
 575
 576     my @prompts = (
 577
 578 manual_config => qq[
 579
 580 CPAN is the world-wide archive of perl resources. It consists of about
 581 300 sites that all replicate the same contents around the globe. Many
 582 countries have at least one CPAN site already. The resources found on
 583 CPAN are easily accessible with the CPAN.pm module. If you want to use
 584 CPAN.pm, lots of things have to be configured. Fortunately, most of
 585 them can be determined automatically. If you prefer the automatic
 586 configuration, answer 'yes' below.
 587
 588 If you prefer to enter a dialog instead, you can answer 'no' to this
 589 question and I'll let you configure in small steps one thing after the
 590 other. (Note: you can revisit this dialog anytime later by typing 'o
 591 conf init' at the cpan prompt.)
 592 ],
 593
 594 config_intro => qq{
 595
 596 The following questions are intended to help you with the
 597 configuration. The CPAN module needs a directory of its own to cache
 598 important index files and maybe keep a temporary mirror of CPAN files.
 599 This may be a site-wide or a personal directory.
 600
 601 },
 602
 603 # cpan_home => qq{ },
 604
 605 cpan_home_where => qq{
 606
 607 First of all, I'd like to create this directory. Where?
 608
 609 },
 610
 611 external_progs => qq{
 612
 613 The CPAN module will need a few external programs to work properly.
 614 Please correct me, if I guess the wrong path for a program. Don't
 615 panic if you do not have some of them, just press ENTER for those. To
 616 disable the use of a program, you can type a space followed by ENTER.
 617
 618 },
 619
 620 proxy_intro => qq{
 621
 622 If you're accessing the net via proxies, you can specify them in the
 623 CPAN configuration or via environment variables. The variable in
 624 the \$CPAN::Config takes precedence.
 625
 626 },
 627
 628 proxy_user => qq{
 629
 630 If your proxy is an authenticating proxy, you can store your username
 631 permanently. If you do not want that, just press RETURN. You will then
 632 be asked for your username in every future session.
 633
 634 },
 635
 636 proxy_pass => qq{
 637
 638 Your password for the authenticating proxy can also be stored
 639 permanently on disk. If this violates your security policy, just press
 640 RETURN. You will then be asked for the password in every future
 641 session.
 642
 643 },
 644
 645 urls_intro => qq{
 646
 647 Now we need to know where your favorite CPAN sites are located. Push
 648 a few sites onto the array (just in case the first on the array won\'t
 649 work). If you are mirroring CPAN to your local workstation, specify a
 650 file: URL.
 651
 652 First, pick a nearby continent and country by typing in the number(s)
 653 in front of the item(s) you want to select. You can pick several of
 654 each, separated by spaces. Then, you will be presented with a list of
 655 URLs of CPAN mirrors in the countries you selected, along with
 656 previously selected URLs. Select some of those URLs, or just keep the
 657 old list. Finally, you will be prompted for any extra URLs -- file:,
 658 ftp:, or http: -- that host a CPAN mirror.
 659
 660 },
 661
 662 password_warn => qq{
 663
 664 Warning: Term::ReadKey seems not to be available, your password will
 665 be echoed to the terminal!
 666
 667 },
 668
 669               );
 670
 671     die "Coding error in \@prompts declaration.  Odd number of elements, above"
 672         if (@prompts % 2);
 673
 674     %prompts = @prompts;
 675
 676     if (scalar(keys %prompts) != scalar(@prompts)/2) {
 677         my %already;
 678         for my $item (0..$#prompts) {
 679             next if $item % 2;
 680             die "$prompts[$item] is duplicated\n" if $already{$prompts[$item]}++;
 681         }
 682     }
 683
 684     shift @podpara;
 685     while (@podpara) {
 686         warn "Alert: cannot parse my own manpage for init dialog" unless $podpara[0] =~ s/^=item\s+//;
 687         my $name = shift @podpara;
 688         my @para;
 689         while (@podpara && $podpara[0] !~ /^=item/) {
 690             push @para, shift @podpara;
 691         }
 692         $prompts{$name} = pop @para;
 693         if (@para) {
 694             $prompts{$name . "_intro"} = join "", map { "$_\n\n" } @para;
 695         }
 696     }
 697
 698 }
 699
 700 sub init {
 701     my($configpm, %args) = @_;
 702     use Config;
 703     # extra args after 'o conf init'
 704     my $matcher = $args{args} && @{$args{args}} ? $args{args}[0] : '';
 705     if ($matcher =~ /^\/(.*)\/$/) {
 706         # case /regex/ => take the first, ignore the rest
 707         $matcher = $1;
 708         shift @{$args{args}};
 709         if (@{$args{args}}) {
 710             local $" = " ";
 711             $CPAN::Frontend->mywarn("Ignoring excessive arguments '@{$args{args}}'");
 712             $CPAN::Frontend->mysleep(2);
 713         }
 714     } elsif (0 == length $matcher) {
 715     } elsif (0 && $matcher eq "~") { # extremely buggy, but a nice idea
 716         my @unconfigured = grep { not exists $CPAN::Config->{$_}
 717                                       or not defined $CPAN::Config->{$_}
 718                                           or not length $CPAN::Config->{$_}
 719                                   } keys %$CPAN::Config;
 720         $matcher = "\\b(".join("|", @unconfigured).")\\b";
 721         $CPAN::Frontend->mywarn("matcher[$matcher]");
 722     } else {
 723         # case WORD... => all arguments must be valid
 724         for my $arg (@{$args{args}}) {
 725             unless (exists $CPAN::HandleConfig::keys{$arg}) {
 726                 $CPAN::Frontend->mywarn("'$arg' is not a valid configuration variable\n");
 727                 return;
 728             }
 729         }
 730         $matcher = "\\b(".join("|",@{$args{args}}).")\\b";
 731     }
 732     CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG;
 733
 734     unless ($CPAN::VERSION) {
 735         require CPAN::Nox;
 736     }
 737     require CPAN::HandleConfig;
 738     CPAN::HandleConfig::require_myconfig_or_config();
 739     $CPAN::Config ||= {};
 740     local($/) = "\n";
 741     local($\) = "";
 742     local($|) = 1;
 743
 744     my($ans,$default); # why so half global?
 745
 746     #
 747     #= Files, directories
 748     #
 749
 750     unless ($matcher) {
 751         $CPAN::Frontend->myprint($prompts{manual_config});
 752     }
 753
 754     my $manual_conf;
 755
 756     local *_real_prompt;
 757     if ( $args{autoconfig} ) {
 758         $manual_conf = "no";
 759     } elsif ($matcher) {
 760         $manual_conf = "yes";
 761     } else {
 762         my $_conf = prompt("Would you like me to configure as much as possible ".
 763                            "automatically?", "yes");
 764         $manual_conf = ($_conf and $_conf =~ /^y/i) ? "no" : "yes";
 765     }
 766     CPAN->debug("manual_conf[$manual_conf]") if $CPAN::DEBUG;
 767     my $fastread;
 768     {
 769         if ($manual_conf =~ /^y/i) {
 770             $fastread = 0;
 771         } else {
 772             $fastread = 1;
 773             $CPAN::Config->{urllist} ||= [];
 774             $CPAN::Config->{connect_to_internet_ok} ||= 1;
 775
 776             local $^W = 0;
 777             # prototype should match that of &MakeMaker::prompt
 778             my $current_second = time;
 779             my $current_second_count = 0;
 780             my $i_am_mad = 0;
 781             *_real_prompt = sub {
 782                 my($q,$a) = @_;
 783                 my($ret) = defined $a ? $a : "";
 784                 $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
 785                 eval { require Time::HiRes };
 786                 unless ($@) {
 787                     if (time == $current_second) {
 788                         $current_second_count++;
 789                         if ($current_second_count > 20) {
 790                             # I don't like more than 20 prompts per second
 791                             $i_am_mad++;
 792                         }
 793                     } else {
 794                         $current_second = time;
 795                         $current_second_count = 0;
 796                         $i_am_mad-- if $i_am_mad>0;
 797                     }
 798                     if ($i_am_mad>0) {
 799                         #require Carp;
 800                         #Carp::cluck("SLEEEEEEEEPIIIIIIIIIIINGGGGGGGGGGG");
 801                         Time::HiRes::sleep(0.1);
 802                     }
 803                 }
 804                 $ret;
 805             };
 806         }
 807     }
 808
 809     if (!$matcher or q{
 810                        build_dir
 811                        build_dir_reuse
 812                        cpan_home
 813                        keep_source_where
 814                        prefs_dir
 815                       } =~ /$matcher/) {
 816         $CPAN::Frontend->myprint($prompts{config_intro});
 817
 818         init_cpan_home($matcher);
 819
 820         my_dflt_prompt("keep_source_where",
 821                        File::Spec->catdir($CPAN::Config->{cpan_home},"sources"),
 822                        $matcher,
 823                       );
 824         my_dflt_prompt("build_dir",
 825                        File::Spec->catdir($CPAN::Config->{cpan_home},"build"),
 826                        $matcher
 827                       );
 828         my_yn_prompt(build_dir_reuse => 0, $matcher);
 829         my_dflt_prompt("prefs_dir",
 830                        File::Spec->catdir($CPAN::Config->{cpan_home},"prefs"),
 831                        $matcher
 832                       );
 833     }
 834
 835     #
 836     #= Config: auto_commit
 837     #
 838
 839     my_yn_prompt(auto_commit => 0, $matcher);
 840
 841     #
 842     #= Cache size, Index expire
 843     #
 844     my_dflt_prompt(build_cache => 100, $matcher);
 845
 846     my_dflt_prompt(index_expire => 1, $matcher);
 847     my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
 848
 849     #
 850     #= cache_metadata
 851     #
 852
 853     my_yn_prompt(cache_metadata => 1, $matcher);
 854     my_yn_prompt(use_sqlite => 0, $matcher);
 855
 856     #
 857     #= Do we follow PREREQ_PM?
 858     #
 859
 860     my_prompt_loop(prerequisites_policy => 'ask', $matcher,
 861                    'follow|ask|ignore');
 862     my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher,
 863                    'yes|no|ask/yes|ask/no');
 864
 865     #
 866     #= Module::Signature
 867     #
 868     my_yn_prompt(check_sigs => 0, $matcher);
 869
 870     #
 871     #= CPAN::Reporter
 872     #
 873     if (!$matcher or 'test_report' =~ /$matcher/) {
 874         my_yn_prompt(test_report => 0, $matcher);
 875         if (
 876             $CPAN::Config->{test_report} &&
 877             $CPAN::META->has_inst("CPAN::Reporter") &&
 878             CPAN::Reporter->can('configure')
 879            ) {
 880             $CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n");
 881             CPAN::Reporter::configure();
 882             $CPAN::Frontend->myprint("\nReturning to CPAN configuration.\n");
 883         }
 884     }
 885
 886     my_yn_prompt(trust_test_report_history => 0, $matcher);
 887
 888     #
 889     #= YAML vs. YAML::Syck
 890     #
 891     if (!$matcher or "yaml_module" =~ /$matcher/) {
 892         my_dflt_prompt(yaml_module => "YAML", $matcher);
 893         unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
 894             $CPAN::Frontend->mywarn
 895                 ("Warning (maybe harmless): '$CPAN::Config->{yaml_module}' not installed.\n");
 896             $CPAN::Frontend->mysleep(3);
 897         }
 898     }
 899
 900     #
 901     #= YAML code deserialisation
 902     #
 903     my_yn_prompt(yaml_load_code => 0, $matcher);
 904
 905     #
 906     #= External programs
 907     #
 908     my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
 909     _init_external_progs($matcher,\@path);
 910
 911     {
 912         my $path = $CPAN::Config->{'pager'} ||
 913             $ENV{PAGER} || find_exe("less",\@path) ||
 914                 find_exe("more",\@path) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
 915                     || "more";
 916         my_dflt_prompt(pager => $path, $matcher);
 917     }
 918
 919     {
 920         my $path = $CPAN::Config->{'shell'};
 921         if ($path && File::Spec->file_name_is_absolute($path)) {
 922             $CPAN::Frontend->mywarn("Warning: configured $path does not exist\n")
 923                 unless -e $path;
 924             $path = "";
 925         }
 926         $path ||= $ENV{SHELL};
 927         $path ||= $ENV{COMSPEC} if $^O eq "MSWin32";
 928         if ($^O eq 'MacOS') {
 929             $CPAN::Config->{'shell'} = 'not_here';
 930         } else {
 931             $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
 932             my_dflt_prompt(shell => $path, $matcher);
 933         }
 934     }
 935
 936     #
 937     # verbosity
 938     #
 939
 940     my_prompt_loop(tar_verbosity => 'v', $matcher,
 941                    'none|v|vv');
 942     my_prompt_loop(load_module_verbosity => 'v', $matcher,
 943                    'none|v');
 944     my_prompt_loop(perl5lib_verbosity => 'v', $matcher,
 945                    'none|v');
 946     my_yn_prompt(inhibit_startup_message => 0, $matcher);
 947
 948     #
 949     #= Installer, arguments to make etc.
 950     #
 951
 952     my_prompt_loop(prefer_installer => 'MB', $matcher, 'MB|EUMM|RAND');
 953
 954     if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/) {
 955         my_dflt_prompt(makepl_arg => "", $matcher);
 956         my_dflt_prompt(make_arg => "", $matcher);
 957         if ( $CPAN::Config->{makepl_arg} =~ /LIBS=|INC=/ ) {
 958             $CPAN::Frontend->mywarn(
 959                 "Warning: Using LIBS or INC in makepl_arg will likely break distributions\n" .
 960                 "that specify their own LIBS or INC options in Makefile.PL.\n"
 961             );
 962         }
 963
 964     }
 965
 966     require CPAN::HandleConfig;
 967     if (exists $CPAN::HandleConfig::keys{make_install_make_command}) {
 968         # as long as Windows needs $self->_build_command, we cannot
 969         # support sudo on windows :-)
 970         my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "",
 971                        $matcher);
 972     }
 973
 974     my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "",
 975                    $matcher);
 976
 977     my_dflt_prompt(mbuildpl_arg => "", $matcher);
 978     my_dflt_prompt(mbuild_arg => "", $matcher);
 979
 980     if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command}
 981         and $^O ne "MSWin32") {
 982         # as long as Windows needs $self->_build_command, we cannot
 983         # support sudo on windows :-)
 984         my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher);
 985     }
 986
 987     my_dflt_prompt(mbuild_install_arg => "", $matcher);
 988
 989     #
 990     #= Alarm period
 991     #
 992
 993     my_dflt_prompt(inactivity_timeout => 0, $matcher);
 994
 995     #
 996     #== halt_on_failure
 997     #
 998     my_yn_prompt(halt_on_failure => 0, $matcher);
 999
1000     #
1001     #= Proxies
1002     #
1003
1004     my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/;
1005     my @proxy_user_vars = qw/proxy_user proxy_pass/;
1006     if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/) {
1007         $CPAN::Frontend->myprint($prompts{proxy_intro});
1008
1009         for (@proxy_vars) {
1010             $prompts{$_} = "Your $_?";
1011             my_dflt_prompt($_ => $ENV{$_}||"", $matcher);
1012         }
1013
1014         if ($CPAN::Config->{ftp_proxy} ||
1015             $CPAN::Config->{http_proxy}) {
1016
1017             $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || "";
1018
1019             $CPAN::Frontend->myprint($prompts{proxy_user});
1020
1021             if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
1022                 $CPAN::Frontend->myprint($prompts{proxy_pass});
1023
1024                 if ($CPAN::META->has_inst("Term::ReadKey")) {
1025                     Term::ReadKey::ReadMode("noecho");
1026                 } else {
1027                     $CPAN::Frontend->myprint($prompts{password_warn});
1028                 }
1029                 $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
1030                 if ($CPAN::META->has_inst("Term::ReadKey")) {
1031                     Term::ReadKey::ReadMode("restore");
1032                 }
1033                 $CPAN::Frontend->myprint("\n\n");
1034             }
1035         }
1036     }
1037
1038     #
1039     #= how FTP works
1040     #
1041
1042     my_yn_prompt(ftp_passive => 1, $matcher);
1043
1044     #
1045     #= how cwd works
1046     #
1047
1048     my_prompt_loop(getcwd => 'cwd', $matcher,
1049                    'cwd|getcwd|fastcwd|backtickcwd');
1050
1051     #
1052     #= the CPAN shell itself (prompt, color)
1053     #
1054
1055     my_yn_prompt(commandnumber_in_prompt => 1, $matcher);
1056     my_yn_prompt(term_ornaments => 1, $matcher);
1057     if ("colorize_output colorize_print colorize_warn colorize_debug" =~ $matcher) {
1058         my_yn_prompt(colorize_output => 0, $matcher);
1059         if ($CPAN::Config->{colorize_output}) {
1060             if ($CPAN::META->has_inst("Term::ANSIColor")) {
1061                 my $T="gYw";
1062                 print "                                      on_  on_y ".
1063                     "        on_ma           on_\n";
1064                 print "                   on_black on_red  green ellow ".
1065                     "on_blue genta on_cyan white\n";
1066
1067                 for my $FG ("", "bold",
1068                             map {$_,"bold $_"} "black","red","green",
1069                             "yellow","blue",
1070                             "magenta",
1071                             "cyan","white") {
1072                     printf "%12s ", $FG;
1073                     for my $BG ("",map {"on_$_"} qw(black red green yellow
1074                                                     blue magenta cyan white)) {
1075                         print $FG||$BG ?
1076                             Term::ANSIColor::colored("  $T  ","$FG $BG") : "  $T  ";
1077                     }
1078                     print "\n";
1079                 }
1080                 print "\n";
1081             }
1082             for my $tuple (
1083                            ["colorize_print", "bold blue on_white"],
1084                            ["colorize_warn", "bold red on_white"],
1085                            ["colorize_debug", "black on_cyan"],
1086                           ) {
1087                 my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher);
1088                 if ($CPAN::META->has_inst("Term::ANSIColor")) {
1089                     eval { Term::ANSIColor::color($CPAN::Config->{$tuple->[0]})};
1090                     if ($@) {
1091                         $CPAN::Config->{$tuple->[0]} = $tuple->[1];
1092                         $CPAN::Frontend->mywarn($@."setting to default '$tuple->[1]'\n");
1093                     }
1094                 }
1095             }
1096         }
1097     }
1098
1099     #
1100     #== term_is_latin
1101     #
1102
1103     my_yn_prompt(term_is_latin => 1, $matcher);
1104
1105     #
1106     #== save history in file 'histfile'
1107     #
1108
1109     if (!$matcher or 'histfile histsize' =~ /$matcher/) {
1110         $CPAN::Frontend->myprint($prompts{histfile_intro});
1111         defined($default = $CPAN::Config->{histfile}) or
1112             $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
1113         my_dflt_prompt(histfile => $default, $matcher);
1114
1115         if ($CPAN::Config->{histfile}) {
1116             defined($default = $CPAN::Config->{histsize}) or $default = 100;
1117             my_dflt_prompt(histsize => $default, $matcher);
1118         }
1119     }
1120
1121     #
1122     #== do an ls on the m or the d command
1123     #
1124     my_yn_prompt(show_upload_date => 0, $matcher);
1125
1126     #
1127     #== verbosity at the end of the r command
1128     #
1129     if (!$matcher
1130         or 'show_unparsable_versions' =~ /$matcher/
1131         or 'show_zero_versions' =~ /$matcher/
1132        ) {
1133         $CPAN::Frontend->myprint($prompts{show_unparsable_or_zero_versions_intro});
1134         my_yn_prompt(show_unparsable_versions => 0, $matcher);
1135         my_yn_prompt(show_zero_versions => 0, $matcher);
1136     }
1137
1138     #
1139     #= MIRRORED.BY and conf_sites()
1140     #
1141
1142     # remember, this is only triggered if no urllist is given, so 0 is
1143     # fair and protects the default site from being overloaded and
1144     # gives the user more chances to select his own urllist.
1145     my_yn_prompt("connect_to_internet_ok" => 0, $matcher);
1146     if ($matcher) {
1147         if ("urllist" =~ $matcher) {
1148             # conf_sites would go into endless loop with the smash prompt
1149             local *_real_prompt;
1150             *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
1151             conf_sites();
1152         }
1153         if ("randomize_urllist" =~ $matcher) {
1154             my_dflt_prompt(randomize_urllist => 0, $matcher);
1155         }
1156         if ("ftpstats_size" =~ $matcher) {
1157             my_dflt_prompt(ftpstats_size => 99, $matcher);
1158         }
1159         if ("ftpstats_period" =~ $matcher) {
1160             my_dflt_prompt(ftpstats_period => 14, $matcher);
1161         }
1162     } elsif ($fastread) {
1163         $CPAN::Frontend->myprint("Autoconfigured everything but 'urllist'.\n".
1164                                  "Please call 'o conf init urllist' to configure ".
1165                                  "your CPAN server(s) now!\n\n");
1166     } else {
1167         conf_sites();
1168     }
1169
1170     $CPAN::Frontend->myprint("\n\n");
1171     if ($matcher && !$CPAN::Config->{auto_commit}) {
1172         $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ".
1173                                  "make the config permanent!\n\n");
1174     } else {
1175         CPAN::HandleConfig->commit($configpm);
1176     }
1177 }
1178
1179 sub _init_external_progs {
1180     my($matcher,$PATH) = @_;
1181     my @external_progs = qw/bzip2 gzip tar unzip
1182
1183                             make
1184
1185                             curl lynx wget ncftpget ncftp ftp
1186
1187                             gpg
1188
1189                             patch applypatch
1190                             /;
1191     if (!$matcher or "@external_progs" =~ /$matcher/) {
1192         $CPAN::Frontend->myprint($prompts{external_progs});
1193
1194         my $old_warn = $^W;
1195         local $^W if $^O eq 'MacOS';
1196         local $^W = $old_warn;
1197         my $progname;
1198         for $progname (@external_progs) {
1199             next if $matcher && $progname !~ /$matcher/;
1200             if ($^O eq 'MacOS') {
1201                 $CPAN::Config->{$progname} = 'not_here';
1202                 next;
1203             }
1204
1205             my $progcall = $progname;
1206             unless ($matcher) {
1207                 # we really don't need ncftp if we have ncftpget, but
1208                 # if they chose this dialog via matcher, they shall have it
1209                 next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
1210             }
1211             my $path = $CPAN::Config->{$progname}
1212                 || $Config::Config{$progname}
1213                     || "";
1214             if (File::Spec->file_name_is_absolute($path)) {
1215                 # testing existence is not good enough, some have these exe
1216                 # extensions
1217
1218                 # warn "Warning: configured $path does not exist\n" unless -e $path;
1219                 # $path = "";
1220             } elsif ($path =~ /^\s+$/) {
1221                 # preserve disabled programs
1222             } else {
1223                 $path = '';
1224             }
1225             unless ($path) {
1226                 # e.g. make -> nmake
1227                 $progcall = $Config::Config{$progname} if $Config::Config{$progname};
1228             }
1229
1230             $path ||= find_exe($progcall,$PATH);
1231             unless ($path) { # not -e $path, because find_exe already checked that
1232                 local $"=";";
1233                 $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@$PATH]\n");
1234                 if ($progname eq "make") {
1235                     $CPAN::Frontend->mywarn("ALERT: 'make' is an essential tool for ".
1236                                             "building perl Modules. Please make sure you ".
1237                                             "have 'make' (or some equivalent) ".
1238                                             "working.\n"
1239                                            );
1240                     if ($^O eq "MSWin32") {
1241                         $CPAN::Frontend->mywarn("
1242 Windows users may want to follow this procedure when back in the CPAN shell:
1243
1244     look YVES/scripts/alien_nmake.pl
1245     perl alien_nmake.pl
1246
1247 This will install nmake on your system which can be used as a 'make'
1248 substitute. You can then revisit this dialog with
1249
1250     o conf init make
1251
1252 ");
1253                     }
1254                 }
1255             }
1256             $prompts{$progname} = "Where is your $progname program?";
1257             my_dflt_prompt($progname,$path,$matcher);
1258         }
1259     }
1260 }
1261
1262 sub init_cpan_home {
1263     my($matcher) = @_;
1264     if (!$matcher or 'cpan_home' =~ /$matcher/) {
1265         my $cpan_home = $CPAN::Config->{cpan_home}
1266             || File::Spec->catdir(CPAN::HandleConfig::home(), ".cpan");
1267
1268         if (-d $cpan_home) {
1269             $CPAN::Frontend->myprint(qq{
1270
1271 I see you already have a  directory
1272     $cpan_home
1273 Shall we use it as the general CPAN build and cache directory?
1274
1275 });
1276         } else {
1277             # no cpan-home, must prompt and get one
1278             $CPAN::Frontend->myprint($prompts{cpan_home_where});
1279         }
1280
1281         my $default = $cpan_home;
1282         my $loop = 0;
1283         my($last_ans,$ans);
1284         $CPAN::Frontend->myprint(" <cpan_home>\n");
1285     PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) {
1286             print "\n";
1287             if (File::Spec->file_name_is_absolute($ans)) {
1288                 my @cpan_home = split /[\/\\]/, $ans;
1289             DIR: for my $dir (@cpan_home) {
1290                     if ($dir =~ /^~/ and (!$last_ans or $ans ne $last_ans)) {
1291                         $CPAN::Frontend
1292                             ->mywarn("Warning: a tilde in the path will be ".
1293                                      "taken as a literal tilde. Please ".
1294                                      "confirm again if you want to keep it\n");
1295                         $last_ans = $default = $ans;
1296                         next PROMPT;
1297                     }
1298                 }
1299             } else {
1300                 require Cwd;
1301                 my $cwd = Cwd::cwd();
1302                 my $absans = File::Spec->catdir($cwd,$ans);
1303                 $CPAN::Frontend->mywarn("The path '$ans' is not an ".
1304                                         "absolute path. Please specify ".
1305                                         "an absolute path\n");
1306                 $default = $absans;
1307                 next PROMPT;
1308             }
1309             eval { File::Path::mkpath($ans); }; # dies if it can't
1310             if ($@) {
1311                 $CPAN::Frontend->mywarn("Couldn't create directory $ans.\n".
1312                                         "Please retry.\n");
1313                 next PROMPT;
1314             }
1315             if (-d $ans && -w _) {
1316                 last PROMPT;
1317             } else {
1318                 $CPAN::Frontend->mywarn("Couldn't find directory $ans\n".
1319                                         "or directory is not writable. Please retry.\n");
1320                 if (++$loop > 5) {
1321                     $CPAN::Frontend->mydie("Giving up");
1322                 }
1323             }
1324         }
1325         $CPAN::Config->{cpan_home} = $ans;
1326     }
1327 }
1328
1329 sub my_dflt_prompt {
1330     my ($item, $dflt, $m) = @_;
1331     my $default = $CPAN::Config->{$item} || $dflt;
1332
1333     if (!$m || $item =~ /$m/) {
1334         if (my $intro = $prompts{$item . "_intro"}) {
1335             $CPAN::Frontend->myprint($intro);
1336         }
1337         $CPAN::Frontend->myprint(" <$item>\n");
1338         $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
1339         print "\n";
1340     } else {
1341         $CPAN::Config->{$item} = $default;
1342     }
1343 }
1344
1345 sub my_yn_prompt {
1346     my ($item, $dflt, $m) = @_;
1347     my $default;
1348     defined($default = $CPAN::Config->{$item}) or $default = $dflt;
1349
1350     # $DB::single = 1;
1351     if (!$m || $item =~ /$m/) {
1352         if (my $intro = $prompts{$item . "_intro"}) {
1353             $CPAN::Frontend->myprint($intro);
1354         }
1355         $CPAN::Frontend->myprint(" <$item>\n");
1356         my $ans = prompt($prompts{$item}, $default ? 'yes' : 'no');
1357         $CPAN::Config->{$item} = ($ans =~ /^[y1]/i ? 1 : 0);
1358         print "\n";
1359     } else {
1360         $CPAN::Config->{$item} = $default;
1361     }
1362 }
1363
1364 sub my_prompt_loop {
1365     my ($item, $dflt, $m, $ok) = @_;
1366     my $default = $CPAN::Config->{$item} || $dflt;
1367     my $ans;
1368
1369     if (!$m || $item =~ /$m/) {
1370         $CPAN::Frontend->myprint($prompts{$item . "_intro"});
1371         $CPAN::Frontend->myprint(" <$item>\n");
1372         do { $ans = prompt($prompts{$item}, $default);
1373         } until $ans =~ /$ok/;
1374         $CPAN::Config->{$item} = $ans;
1375         print "\n";
1376     } else {
1377         $CPAN::Config->{$item} = $default;
1378     }
1379 }
1380
1381
1382 sub conf_sites {
1383     my $m = 'MIRRORED.BY';
1384     my $use_mby;
1385     my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
1386     File::Path::mkpath(File::Basename::dirname($mby));
1387     if (-f $mby && -f $m && -M $m < -M $mby) {
1388         $use_mby = 1;
1389         require File::Copy;
1390         File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
1391     }
1392     local $^T = time;
1393     my $overwrite_local = 0;
1394     if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) {
1395         $use_mby = 1;
1396         my $mtime = localtime((stat _)[9]);
1397         my $prompt = qq{Found $mby as of $mtime
1398
1399 I'd use that as a database of CPAN sites. If that is OK for you,
1400 please answer 'y', but if you want me to get a new database from the
1401 internet now, please answer 'n' to the following question.
1402
1403 Shall I use the local database in $mby?};
1404         my $ans = prompt($prompt,"y");
1405         if ($ans =~ /^y/i) {
1406             $CPAN::Config->{connect_to_internet_ok} = 1;
1407         } else {
1408             $overwrite_local = 1;
1409         }
1410     }
1411     local $urllist = $CPAN::Config->{urllist};
1412     my $better_mby;
1413  LOOP: while () { # multiple errors possible
1414         if ($use_mby
1415             or (defined $CPAN::Config->{connect_to_internet_ok}
1416                 and $CPAN::Config->{connect_to_internet_ok})){
1417             if ($overwrite_local) {
1418                 $CPAN::Frontend->myprint(qq{Trying to overwrite $mby\n});
1419                 $better_mby = CPAN::FTP->localize($m,$mby,3);
1420                 $overwrite_local = 0;
1421                 $use_mby=1 if $mby;
1422             } elsif ( ! -f $mby ) {
1423                 $CPAN::Frontend->myprint(qq{You have no $mby\n  I'm trying to fetch one\n});
1424                 $better_mby = CPAN::FTP->localize($m,$mby,3);
1425                 $use_mby=1 if $mby;
1426             } elsif ( -M $mby > 60 ) {
1427                 $CPAN::Frontend->myprint(qq{Your $mby is older than 60 days,\n  I'm trying }.
1428                                          qq{to fetch a new one\n});
1429                 $better_mby = CPAN::FTP->localize($m,$mby,3);
1430                 $use_mby=1 if $mby;
1431             } elsif (-s $mby == 0) {
1432                 $CPAN::Frontend->myprint(qq{You have an empty $mby,\n  I'm trying to fetch a better one\n});
1433                 $better_mby = CPAN::FTP->localize($m,$mby,3);
1434                 $use_mby=1 if $mby;
1435             } else {
1436                 last LOOP;
1437             }
1438             if ($better_mby) {
1439                 $mby = $better_mby;
1440             }
1441         } elsif (not @{$urllist||[]}
1442                  and (not defined $CPAN::Config->{connect_to_internet_ok}
1443                       or not $CPAN::Config->{connect_to_internet_ok})) {
1444             $CPAN::Frontend->myprint(qq{CPAN needs access to at least one CPAN mirror.
1445
1446 As you did not allow me to connect to the internet you need to supply
1447 a valid CPAN URL now.\n\n});
1448
1449             my @default = map {"file://$_"} grep {-e} "/home/ftp/pub/CPAN", "/home/ftp/pub/PAUSE";
1450             my $ans = prompt("Please enter the URL of your CPAN mirror",shift @default);
1451             if ($ans) {
1452                 push @$urllist, $ans;
1453                 next LOOP;
1454             }
1455         } else {
1456             last LOOP;
1457         }
1458     }
1459     if ($use_mby){
1460         read_mirrored_by($mby);
1461     } else {
1462         if (not defined $CPAN::Config->{connect_to_internet_ok}
1463             or not $CPAN::Config->{connect_to_internet_ok}) {
1464             $CPAN::Frontend->myprint("Configuration does not allow connecting to the internet.\n");
1465         }
1466         $CPAN::Frontend->myprint("Current set of CPAN URLs:\n");
1467         map { $CPAN::Frontend->myprint("  $_\n") } @$urllist;
1468     }
1469     bring_your_own();
1470     $CPAN::Config->{urllist} = $urllist;
1471 }
1472
1473 sub find_exe {
1474     my($exe,$path) = @_;
1475     my($dir);
1476     #warn "in find_exe exe[$exe] path[@$path]";
1477     for $dir (@$path) {
1478         my $abs = File::Spec->catfile($dir,$exe);
1479         if (($abs = MM->maybe_command($abs))) {
1480             return $abs;
1481         }
1482     }
1483 }
1484
1485 sub picklist {
1486     my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
1487     CPAN->debug("picklist('$items','$prompt','$default','$require_nonempty',".
1488                 "'$empty_warning')") if $CPAN::DEBUG;
1489     $default ||= '';
1490
1491     my $pos = 0;
1492
1493     my @nums;
1494   SELECTION: while (1) {
1495
1496         # display, at most, 15 items at a time
1497         my $limit = $#{ $items } - $pos;
1498         $limit = 15 if $limit > 15;
1499
1500         # show the next $limit items, get the new position
1501         $pos = display_some($items, $limit, $pos, $default);
1502         $pos = 0 if $pos >= @$items;
1503
1504         my $num = prompt($prompt,$default);
1505
1506         @nums = split (' ', $num);
1507         {
1508             my %seen;
1509             @nums = grep { !$seen{$_}++ } @nums;
1510         }
1511         my $i = scalar @$items;
1512         unrangify(\@nums);
1513         if (0 == @nums) {
1514             # cannot allow nothing because nothing means paging!
1515             # return;
1516         } elsif (grep (/\D/ || $_ < 1 || $_ > $i, @nums)) {
1517             $CPAN::Frontend->mywarn("invalid items entered, try again\n");
1518             if ("@nums" =~ /\D/) {
1519                 $CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n");
1520             }
1521             next SELECTION;
1522         }
1523         if ($require_nonempty && !@nums) {
1524             $CPAN::Frontend->mywarn("$empty_warning\n");
1525         }
1526         $CPAN::Frontend->myprint("\n");
1527
1528         # a blank line continues...
1529         unless (@nums){
1530             $CPAN::Frontend->mysleep(0.1); # prevent hot spinning process on the next bug
1531             next SELECTION;
1532         }
1533         last;
1534     }
1535     for (@nums) { $_-- }
1536     @{$items}[@nums];
1537 }
1538
1539 sub unrangify ($) {
1540     my($nums) = $_[0];
1541     my @nums2 = ();
1542     while (@{$nums||[]}) {
1543         my $n = shift @$nums;
1544         if ($n =~ /^(\d+)-(\d+)$/) {
1545             my @range = $1 .. $2;
1546             # warn "range[@range]";
1547             push @nums2, @range;
1548         } else {
1549             push @nums2, $n;
1550         }
1551     }
1552     push @$nums, @nums2;
1553 }
1554
1555 sub display_some {
1556     my ($items, $limit, $pos, $default) = @_;
1557     $pos ||= 0;
1558
1559     my @displayable = @$items[$pos .. ($pos + $limit)];
1560     for my $item (@displayable) {
1561         $CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item);
1562     }
1563     my $hit_what = $default ? "SPACE RETURN" : "RETURN";
1564     $CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n",
1565                                      (@$items - $pos),
1566                                      $hit_what,
1567                                     ))
1568         if $pos < @$items;
1569     return $pos;
1570 }
1571
1572 sub read_mirrored_by {
1573     my $local = shift or return;
1574     my(%all,$url,$expected_size,$default,$ans,$host,
1575        $dst,$country,$continent,@location);
1576     my $fh = FileHandle->new;
1577     $fh->open($local) or die "Couldn't open $local: $!";
1578     local $/ = "\012";
1579     while (<$fh>) {
1580         ($host) = /^([\w\.\-]+)/ unless defined $host;
1581         next unless defined $host;
1582         next unless /\s+dst_(dst|location)/;
1583         /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
1584             ($continent, $country) = @location[-1,-2];
1585         $continent =~ s/\s\(.*//;
1586         $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
1587         /dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
1588         next unless $host && $dst && $continent && $country;
1589         $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
1590         undef $host;
1591         $dst=$continent=$country="";
1592     }
1593     $fh->close;
1594     $CPAN::Config->{urllist} ||= [];
1595     my @previous_urls = @{$CPAN::Config->{urllist}};
1596
1597     $CPAN::Frontend->myprint($prompts{urls_intro});
1598
1599     my (@cont, $cont, %cont, @countries, @urls, %seen);
1600     my $no_previous_warn =
1601         "Sorry! since you don't have any existing picks, you must make a\n" .
1602             "geographic selection.";
1603     my $offer_cont = [sort keys %all];
1604     if (@previous_urls) {
1605         push @$offer_cont, "(edit previous picks)";
1606         $default = @$offer_cont;
1607     } else {
1608         # cannot allow nothing because nothing means paging!
1609         # push @$offer_cont, "(none of the above)";
1610     }
1611     @cont = picklist($offer_cont,
1612                      "Select your continent (or several nearby continents)",
1613                      $default,
1614                      ! @previous_urls,
1615                      $no_previous_warn);
1616     # cannot allow nothing because nothing means paging!
1617     # return unless @cont;
1618
1619     foreach $cont (@cont) {
1620         my @c = sort keys %{$all{$cont}};
1621         @cont{@c} = map ($cont, 0..$#c);
1622         @c = map ("$_ ($cont)", @c) if @cont > 1;
1623         push (@countries, @c);
1624     }
1625     if (@previous_urls && @countries) {
1626         push @countries, "(edit previous picks)";
1627         $default = @countries;
1628     }
1629
1630     if (@countries) {
1631         @countries = picklist (\@countries,
1632                                "Select your country (or several nearby countries)",
1633                                $default,
1634                                ! @previous_urls,
1635                                $no_previous_warn);
1636         %seen = map (($_ => 1), @previous_urls);
1637         # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
1638         foreach $country (@countries) {
1639             next if $country =~ /edit previous picks/;
1640             (my $bare_country = $country) =~ s/ \(.*\)//;
1641             my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
1642             @u = grep (! $seen{$_}, @u);
1643             @u = map ("$_ ($bare_country)", @u)
1644                 if @countries > 1;
1645             push (@urls, @u);
1646         }
1647     }
1648     push (@urls, map ("$_ (previous pick)", @previous_urls));
1649     my $prompt = "Select as many URLs as you like (by number),
1650 put them on one line, separated by blanks, hyphenated ranges allowed
1651  e.g. '1 4 5' or '7 1-4 8'";
1652     if (@previous_urls) {
1653         $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
1654                          (scalar @urls));
1655         $prompt .= "\n(or just hit RETURN to keep your previous picks)";
1656     }
1657
1658     @urls = picklist (\@urls, $prompt, $default);
1659     foreach (@urls) { s/ \(.*\)//; }
1660     if (@urls) {
1661         $urllist = \@urls;
1662     } else {
1663         push @$urllist, @urls;
1664     }
1665 }
1666
1667 sub bring_your_own {
1668     my %seen = map (($_ => 1), @$urllist);
1669     my($ans,@urls);
1670     my $eacnt = 0; # empty answers
1671     do {
1672         my $prompt = "Enter another URL or RETURN to quit:";
1673         unless (%seen) {
1674             $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
1675
1676 Please enter your CPAN site:};
1677         }
1678         $ans = prompt ($prompt, "");
1679
1680         if ($ans) {
1681             $ans =~ s|/?\z|/|; # has to end with one slash
1682             $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
1683             if ($ans =~ /^\w+:\/./) {
1684                 push @urls, $ans unless $seen{$ans}++;
1685             } else {
1686                 $CPAN::Frontend->
1687                     myprint(sprintf(qq{"%s" doesn\'t look like an URL at first sight.
1688 I\'ll ignore it for now.
1689 You can add it to your %s
1690 later if you\'re sure it\'s right.\n},
1691                                    $ans,
1692                                    $INC{'CPAN/MyConfig.pm'}
1693                                    || $INC{'CPAN/Config.pm'}
1694                                    || "configuration file",
1695                                   ));
1696             }
1697         } else {
1698             if (++$eacnt >= 5) {
1699                 $CPAN::Frontend->
1700                     mywarn("Giving up.\n");
1701                 $CPAN::Frontend->mysleep(5);
1702                 return;
1703             }
1704         }
1705     } while $ans || !%seen;
1706
1707     @$urllist = CPAN::_uniq(@$urllist, @urls);
1708     $CPAN::Config->{urllist} = $urllist;
1709     # xxx delete or comment these out when you're happy that it works
1710     $CPAN::Frontend->myprint("New urllist\n");
1711     for ( @$urllist ) { $CPAN::Frontend->myprint("  $_\n") };
1712 }
1713
1714
1715 sub _strip_spaces {
1716     $_[0] =~ s/^\s+//;  # no leading spaces
1717     $_[0] =~ s/\s+\z//; # no trailing spaces
1718 }
1719
1720 sub prompt ($;$) {
1721     unless (defined &_real_prompt) {
1722         *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
1723     }
1724     my $ans = _real_prompt(@_);
1725
1726     _strip_spaces($ans);
1727
1728     return $ans;
1729 }
1730
1731
1732 sub prompt_no_strip ($;$) {
1733     return _real_prompt(@_);
1734 }
1735
1736
1737
1738 1;