1# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- 2# vim: ts=4 sts=4 sw=4: 3package CPAN::FirstTime; 4use strict; 5 6use ExtUtils::MakeMaker (); 7use FileHandle (); 8use File::Basename (); 9use File::Path (); 10use File::Spec (); 11use CPAN::Mirrors (); 12use CPAN::Version (); 13use vars qw($VERSION $auto_config); 14$VERSION = "5.5317"; 15 16=head1 NAME 17 18CPAN::FirstTime - Utility for CPAN::Config file Initialization 19 20=head1 SYNOPSIS 21 22CPAN::FirstTime::init() 23 24=head1 DESCRIPTION 25 26The init routine asks a few questions and writes a CPAN/Config.pm or 27CPAN/MyConfig.pm file (depending on what it is currently using). 28 29In the following all questions and explanations regarding config 30variables are collected. 31 32=cut 33 34# down until the next =back the manpage must be parsed by the program 35# because the text is used in the init dialogues. 36 37my @podpara = split /\n\n/, <<'=back'; 38 39=over 2 40 41=item allow_installing_module_downgrades 42 43The CPAN shell can watch the C<blib/> directories that are built up 44before running C<make test> to determine whether the current 45distribution will end up with modules being overwritten with decreasing module version numbers. It 46can then let the build of this distro fail when it discovers a 47downgrade. 48 49Do you want to allow installing distros with decreasing module 50versions compared to what you have installed (yes, no, ask/yes, 51ask/no)? 52 53=item allow_installing_outdated_dists 54 55The CPAN shell can watch the C<blib/> directories that are built up 56before running C<make test> to determine whether the current 57distribution contains modules that are indexed with a distro with a 58higher distro-version number than the current one. It can 59then let the build of this distro fail when it would not represent the 60most up-to-date version of the distro. 61 62Note: choosing anything but 'yes' for this option will need 63CPAN::DistnameInfo being installed for taking effect. 64 65Do you want to allow installing distros that are not indexed as the 66highest distro-version for all contained modules (yes, no, ask/yes, 67ask/no)? 68 69=item auto_commit 70 71Normally CPAN.pm keeps config variables in memory and changes need to 72be saved in a separate 'o conf commit' command to make them permanent 73between sessions. If you set the 'auto_commit' option to true, changes 74to a config variable are always automatically committed to disk. 75 76Always commit changes to config variables to disk? 77 78=item build_cache 79 80CPAN.pm can limit the size of the disk area for keeping the build 81directories with all the intermediate files. 82 83Cache size for build directory (in MB)? 84 85=item build_dir 86 87Directory where the build process takes place? 88 89=item build_dir_reuse 90 91Until version 1.88 CPAN.pm never trusted the contents of the build_dir 92directory between sessions. Since 1.88_58 CPAN.pm has a YAML-based 93mechanism that makes it possible to share the contents of the 94build_dir/ directory between different sessions with the same version 95of perl. People who prefer to test things several days before 96installing will like this feature because it saves a lot of time. 97 98If you say yes to the following question, CPAN will try to store 99enough information about the build process so that it can pick up in 100future sessions at the same state of affairs as it left a previous 101session. 102 103Store and re-use state information about distributions between 104CPAN.pm sessions? 105 106=item build_requires_install_policy 107 108When a module declares another one as a 'build_requires' prerequisite 109this means that the other module is only needed for building or 110testing the module but need not be installed permanently. In this case 111you may wish to install that other module nonetheless or just keep it 112in the 'build_dir' directory to have it available only temporarily. 113Installing saves time on future installations but makes the perl 114installation bigger. 115 116You can choose if you want to always install (yes), never install (no) 117or be always asked. In the latter case you can set the default answer 118for the question to yes (ask/yes) or no (ask/no). 119 120Policy on installing 'build_requires' modules (yes, no, ask/yes, 121ask/no)? 122 123=item cache_metadata 124 125To considerably speed up the initial CPAN shell startup, it is 126possible to use Storable to create a cache of metadata. If Storable is 127not available, the normal index mechanism will be used. 128 129Note: this mechanism is not used when use_sqlite is on and SQLite is 130running. 131 132Cache metadata (yes/no)? 133 134=item check_sigs 135 136CPAN packages can be digitally signed by authors and thus verified 137with the security provided by strong cryptography. The exact mechanism 138is defined in the Module::Signature module. While this is generally 139considered a good thing, it is not always convenient to the end user 140to install modules that are signed incorrectly or where the key of the 141author is not available or where some prerequisite for 142Module::Signature has a bug and so on. 143 144With the check_sigs parameter you can turn signature checking on and 145off. The default is off for now because the whole tool chain for the 146functionality is not yet considered mature by some. The author of 147CPAN.pm would recommend setting it to true most of the time and 148turning it off only if it turns out to be annoying. 149 150Note that if you do not have Module::Signature installed, no signature 151checks will be performed at all. 152 153Always try to check and verify signatures if a SIGNATURE file is in 154the package and Module::Signature is installed (yes/no)? 155 156=item cleanup_after_install 157 158Users who install modules and do not intend to look back, can free 159occupied disk space quickly by letting CPAN.pm cleanup each build 160directory immediately after a successful install. 161 162Remove build directory after a successful install? (yes/no)? 163 164=item colorize_output 165 166When you have Term::ANSIColor installed, you can turn on colorized 167output to have some visual differences between normal CPAN.pm output, 168warnings, debugging output, and the output of the modules being 169installed. Set your favorite colors after some experimenting with the 170Term::ANSIColor module. 171 172Please note that on Windows platforms colorized output also requires 173the Win32::Console::ANSI module. 174 175Do you want to turn on colored output? 176 177=item colorize_print 178 179Color for normal output? 180 181=item colorize_warn 182 183Color for warnings? 184 185=item colorize_debug 186 187Color for debugging messages? 188 189=item commandnumber_in_prompt 190 191The prompt of the cpan shell can contain the current command number 192for easier tracking of the session or be a plain string. 193 194Do you want the command number in the prompt (yes/no)? 195 196=item connect_to_internet_ok 197 198If you have never defined your own C<urllist> in your configuration 199then C<CPAN.pm> will be hesitant to use the built in default sites for 200downloading. It will ask you once per session if a connection to the 201internet is OK and only if you say yes, it will try to connect. But to 202avoid this question, you can choose your favorite download sites once 203and get away with it. Or, if you have no favorite download sites 204answer yes to the following question. 205 206If no urllist has been chosen yet, would you prefer CPAN.pm to connect 207to the built-in default sites without asking? (yes/no)? 208 209=item ftp_passive 210 211Shall we always set the FTP_PASSIVE environment variable when dealing 212with ftp download (yes/no)? 213 214=item ftpstats_period 215 216Statistics about downloads are truncated by size and period 217simultaneously. 218 219How many days shall we keep statistics about downloads? 220 221=item ftpstats_size 222 223Statistics about downloads are truncated by size and period 224simultaneously. Setting this to zero or negative disables download 225statistics. 226 227How many items shall we keep in the statistics about downloads? 228 229=item getcwd 230 231CPAN.pm changes the current working directory often and needs to 232determine its own current working directory. Per default it uses 233Cwd::cwd but if this doesn't work on your system for some reason, 234alternatives can be configured according to the following table: 235 236 cwd Cwd::cwd 237 getcwd Cwd::getcwd 238 fastcwd Cwd::fastcwd 239 getdcwd Cwd::getdcwd 240 backtickcwd external command cwd 241 242Preferred method for determining the current working directory? 243 244=item halt_on_failure 245 246Normally, CPAN.pm continues processing the full list of targets and 247dependencies, even if one of them fails. However, you can specify 248that CPAN should halt after the first failure. (Note that optional 249recommended or suggested modules that fail will not cause a halt.) 250 251Do you want to halt on failure (yes/no)? 252 253=item histfile 254 255If you have one of the readline packages (Term::ReadLine::Perl, 256Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN 257shell will have history support. The next two questions deal with the 258filename of the history file and with its size. If you do not want to 259set this variable, please hit SPACE ENTER to the following question. 260 261File to save your history? 262 263=item histsize 264 265Number of lines to save? 266 267=item inactivity_timeout 268 269Sometimes you may wish to leave the processes run by CPAN alone 270without caring about them. Because the Makefile.PL or the Build.PL 271sometimes contains question you're expected to answer, you can set a 272timer that will kill a 'perl Makefile.PL' process after the specified 273time in seconds. 274 275If you set this value to 0, these processes will wait forever. This is 276the default and recommended setting. 277 278Timeout for inactivity during {Makefile,Build}.PL? 279 280=item index_expire 281 282The CPAN indexes are usually rebuilt once or twice per hour, but the 283typical CPAN mirror mirrors only once or twice per day. Depending on 284the quality of your mirror and your desire to be on the bleeding edge, 285you may want to set the following value to more or less than one day 286(which is the default). It determines after how many days CPAN.pm 287downloads new indexes. 288 289Let the index expire after how many days? 290 291=item inhibit_startup_message 292 293When the CPAN shell is started it normally displays a greeting message 294that contains the running version and the status of readline support. 295 296Do you want to turn this message off? 297 298=item keep_source_where 299 300Unless you are accessing the CPAN on your filesystem via a file: URL, 301CPAN.pm needs to keep the source files it downloads somewhere. Please 302supply a directory where the downloaded files are to be kept. 303 304Download target directory? 305 306=item load_module_verbosity 307 308When CPAN.pm loads a module it needs for some optional feature, it 309usually reports about module name and version. Choose 'v' to get this 310message, 'none' to suppress it. 311 312Verbosity level for loading modules (none or v)? 313 314=item makepl_arg 315 316Every Makefile.PL is run by perl in a separate process. Likewise we 317run 'make' and 'make install' in separate processes. If you have 318any parameters (e.g. PREFIX, UNINST or the like) you want to 319pass to the calls, please specify them here. 320 321If you don't understand this question, just press ENTER. 322 323Typical frequently used settings: 324 325 PREFIX=~/perl # non-root users (please see manual for more hints) 326 327Parameters for the 'perl Makefile.PL' command? 328 329=item make_arg 330 331Parameters for the 'make' command? Typical frequently used setting: 332 333 -j3 # dual processor system (on GNU make) 334 335Your choice: 336 337=item make_install_arg 338 339Parameters for the 'make install' command? 340Typical frequently used setting: 341 342 UNINST=1 # to always uninstall potentially conflicting files 343 # (but do NOT use with local::lib or INSTALL_BASE) 344 345Your choice: 346 347=item make_install_make_command 348 349Do you want to use a different make command for 'make install'? 350Cautious people will probably prefer: 351 352 su root -c make 353 or 354 sudo make 355 or 356 /path1/to/sudo -u admin_account /path2/to/make 357 358or some such. Your choice: 359 360=item mbuildpl_arg 361 362A Build.PL is run by perl in a separate process. Likewise we run 363'./Build' and './Build install' in separate processes. If you have any 364parameters you want to pass to the calls, please specify them here. 365 366Typical frequently used settings: 367 368 --install_base /home/xxx # different installation directory 369 370Parameters for the 'perl Build.PL' command? 371 372=item mbuild_arg 373 374Parameters for the './Build' command? Setting might be: 375 376 --extra_linker_flags -L/usr/foo/lib # non-standard library location 377 378Your choice: 379 380=item mbuild_install_arg 381 382Parameters for the './Build install' command? Typical frequently used 383setting: 384 385 --uninst 1 # uninstall conflicting files 386 # (but do NOT use with local::lib or INSTALL_BASE) 387 388Your choice: 389 390=item mbuild_install_build_command 391 392Do you want to use a different command for './Build install'? Sudo 393users will probably prefer: 394 395 su root -c ./Build 396 or 397 sudo ./Build 398 or 399 /path1/to/sudo -u admin_account ./Build 400 401or some such. Your choice: 402 403=item pager 404 405What is your favorite pager program? 406 407=item prefer_installer 408 409When you have Module::Build installed and a module comes with both a 410Makefile.PL and a Build.PL, which shall have precedence? 411 412The main two standard installer modules are the old and well 413established ExtUtils::MakeMaker (for short: EUMM) which uses the 414Makefile.PL. And the next generation installer Module::Build (MB) 415which works with the Build.PL (and often comes with a Makefile.PL 416too). If a module comes only with one of the two we will use that one 417but if both are supplied then a decision must be made between EUMM and 418MB. See also http://rt.cpan.org/Ticket/Display.html?id=29235 for a 419discussion about the right default. 420 421Or, as a third option you can choose RAND which will make a random 422decision (something regular CPAN testers will enjoy). 423 424In case you can choose between running a Makefile.PL or a Build.PL, 425which installer would you prefer (EUMM or MB or RAND)? 426 427=item prefs_dir 428 429CPAN.pm can store customized build environments based on regular 430expressions for distribution names. These are YAML files where the 431default options for CPAN.pm and the environment can be overridden and 432dialog sequences can be stored that can later be executed by an 433Expect.pm object. The CPAN.pm distribution comes with some prefab YAML 434files that cover sample distributions that can be used as blueprints 435to store your own prefs. Please check out the distroprefs/ directory of 436the CPAN.pm distribution to get a quick start into the prefs system. 437 438Directory where to store default options/environment/dialogs for 439building modules that need some customization? 440 441=item prerequisites_policy 442 443The CPAN module can detect when a module which you are trying to build 444depends on prerequisites. If this happens, it can build the 445prerequisites for you automatically ('follow'), ask you for 446confirmation ('ask'), or just ignore them ('ignore'). Choosing 447'follow' also sets PERL_AUTOINSTALL and PERL_EXTUTILS_AUTOINSTALL for 448"--defaultdeps" if not already set. 449 450Please set your policy to one of the three values. 451 452Policy on building prerequisites (follow, ask or ignore)? 453 454=item pushy_https 455 456Boolean. Defaults to true. If this option is true, the cpan shell will 457use https://cpan.org/ to download stuff from the CPAN. It will fall 458back to http://cpan.org/ if it can't handle https for some reason 459(missing modules, missing programs). Whenever it falls back to the 460http protocol, it will issue a warning. 461 462If this option is true, the option C<urllist> will be ignored. 463Consequently, if you want to work with local mirrors via your own 464configured list of URLs, you will have to choose no below. 465 466Do you want to turn the pushy_https behaviour on? 467 468=item randomize_urllist 469 470CPAN.pm can introduce some randomness when using hosts for download 471that are configured in the urllist parameter. Enter a numeric value 472between 0 and 1 to indicate how often you want to let CPAN.pm try a 473random host from the urllist. A value of one specifies to always use a 474random host as the first try. A value of zero means no randomness at 475all. Anything in between specifies how often, on average, a random 476host should be tried first. 477 478Randomize parameter 479 480=item recommends_policy 481 482(Experimental feature!) Some CPAN modules recommend additional, optional dependencies. These should 483generally be installed except in resource constrained environments. When this 484policy is true, recommended modules will be included with required modules. 485 486Include recommended modules? 487 488=item scan_cache 489 490By default, each time the CPAN module is started, cache scanning is 491performed to keep the cache size in sync ('atstart'). Alternatively, 492scanning and cleanup can happen when CPAN exits ('atexit'). To prevent 493any cache cleanup, answer 'never'. 494 495Perform cache scanning ('atstart', 'atexit' or 'never')? 496 497=item shell 498 499What is your favorite shell? 500 501=item show_unparsable_versions 502 503During the 'r' command CPAN.pm finds modules without version number. 504When the command finishes, it prints a report about this. If you 505want this report to be very verbose, say yes to the following 506variable. 507 508Show all individual modules that have no $VERSION? 509 510=item show_upload_date 511 512The 'd' and the 'm' command normally only show you information they 513have in their in-memory database and thus will never connect to the 514internet. If you set the 'show_upload_date' variable to true, 'm' and 515'd' will additionally show you the upload date of the module or 516distribution. Per default this feature is off because it may require a 517net connection to get at the upload date. 518 519Always try to show upload date with 'd' and 'm' command (yes/no)? 520 521=item show_zero_versions 522 523During the 'r' command CPAN.pm finds modules with a version number of 524zero. When the command finishes, it prints a report about this. If you 525want this report to be very verbose, say yes to the following 526variable. 527 528Show all individual modules that have a $VERSION of zero? 529 530=item suggests_policy 531 532(Experimental feature!) Some CPAN modules suggest additional, optional dependencies. These 'suggest' 533dependencies provide enhanced operation. When this policy is true, suggested 534modules will be included with required modules. 535 536Include suggested modules? 537 538=item tar_verbosity 539 540When CPAN.pm uses the tar command, which switch for the verbosity 541shall be used? Choose 'none' for quiet operation, 'v' for file 542name listing, 'vv' for full listing. 543 544Tar command verbosity level (none or v or vv)? 545 546=item term_is_latin 547 548The next option deals with the charset (a.k.a. character set) your 549terminal supports. In general, CPAN is English speaking territory, so 550the charset does not matter much but some CPAN have names that are 551outside the ASCII range. If your terminal supports UTF-8, you should 552say no to the next question. If it expects ISO-8859-1 (also known as 553LATIN1) then you should say yes. If it supports neither, your answer 554does not matter because you will not be able to read the names of some 555authors anyway. If you answer no, names will be output in UTF-8. 556 557Your terminal expects ISO-8859-1 (yes/no)? 558 559=item term_ornaments 560 561When using Term::ReadLine, you can turn ornaments on so that your 562input stands out against the output from CPAN.pm. 563 564Do you want to turn ornaments on? 565 566=item test_report 567 568The goal of the CPAN Testers project (http://testers.cpan.org/) is to 569test as many CPAN packages as possible on as many platforms as 570possible. This provides valuable feedback to module authors and 571potential users to identify bugs or platform compatibility issues and 572improves the overall quality and value of CPAN. 573 574One way you can contribute is to send test results for each module 575that you install. If you install the CPAN::Reporter module, you have 576the option to automatically generate and deliver test reports to CPAN 577Testers whenever you run tests on a CPAN package. 578 579See the CPAN::Reporter documentation for additional details and 580configuration settings. If your firewall blocks outgoing traffic, 581you may need to configure CPAN::Reporter before sending reports. 582 583Generate test reports if CPAN::Reporter is installed (yes/no)? 584 585=item perl5lib_verbosity 586 587When CPAN.pm extends @INC via PERL5LIB, it prints a list of 588directories added (or a summary of how many directories are 589added). Choose 'v' to get this message, 'none' to suppress it. 590 591Verbosity level for PERL5LIB changes (none or v)? 592 593=item prefer_external_tar 594 595Per default all untar operations are done with the perl module 596Archive::Tar; by setting this variable to true the external tar 597command is used if available; on Unix this is usually preferred 598because they have a reliable and fast gnutar implementation. 599 600Use the external tar program instead of Archive::Tar? 601 602=item trust_test_report_history 603 604When a distribution has already been tested by CPAN::Reporter on 605this machine, CPAN can skip the test phase and just rely on the 606test report history instead. 607 608Note that this will not apply to distributions that failed tests 609because of missing dependencies. Also, tests can be run 610regardless of the history using "force". 611 612Do you want to rely on the test report history (yes/no)? 613 614=item urllist_ping_external 615 616When automatic selection of the nearest cpan mirrors is performed, 617turn on the use of the external ping via Net::Ping::External. This is 618recommended in the case the local network has a transparent proxy. 619 620Do you want to use the external ping command when autoselecting 621mirrors? 622 623=item urllist_ping_verbose 624 625When automatic selection of the nearest cpan mirrors is performed, 626this option can be used to turn on verbosity during the selection 627process. 628 629Do you want to see verbosity turned on when autoselecting mirrors? 630 631=item use_prompt_default 632 633When this is true, CPAN will set PERL_MM_USE_DEFAULT to a true 634value. This causes ExtUtils::MakeMaker (and compatible) prompts 635to use default values instead of stopping to prompt you to answer 636questions. It also sets NONINTERACTIVE_TESTING to a true value to 637signal more generally that distributions should not try to 638interact with you. 639 640Do you want to use prompt defaults (yes/no)? 641 642=item use_sqlite 643 644CPAN::SQLite is a layer between the index files that are downloaded 645from the CPAN and CPAN.pm that speeds up metadata queries and reduces 646memory consumption of CPAN.pm considerably. 647 648Use CPAN::SQLite if available? (yes/no)? 649 650=item version_timeout 651 652This timeout prevents CPAN from hanging when trying to parse a 653pathologically coded $VERSION from a module. 654 655The default is 15 seconds. If you set this value to 0, no timeout 656will occur, but this is not recommended. 657 658Timeout for parsing module versions? 659 660=item yaml_load_code 661 662Both YAML.pm and YAML::Syck are capable of deserialising code. As this 663requires a string eval, which might be a security risk, you can use 664this option to enable or disable the deserialisation of code via 665CPAN::DeferredCode. (Note: This does not work under perl 5.6) 666 667Do you want to enable code deserialisation (yes/no)? 668 669=item yaml_module 670 671At the time of this writing (2009-03) there are three YAML 672implementations working: YAML, YAML::Syck, and YAML::XS. The latter 673two are faster but need a C compiler installed on your system. There 674may be more alternative YAML conforming modules. When I tried two 675other players, YAML::Tiny and YAML::Perl, they seemed not powerful 676enough to work with CPAN.pm. This may have changed in the meantime. 677 678Which YAML implementation would you prefer? 679 680=back 681 682=head1 LICENSE 683 684This program is free software; you can redistribute it and/or 685modify it under the same terms as Perl itself. 686 687=cut 688 689use vars qw( %prompts ); 690 691{ 692 693 my @prompts = ( 694 695auto_config => qq{ 696CPAN.pm requires configuration, but most of it can be done automatically. 697If you answer 'no' below, you will enter an interactive dialog for each 698configuration option instead. 699 700Would you like to configure as much as possible automatically?}, 701 702auto_pick => qq{ 703Would you like me to automatically choose some CPAN mirror 704sites for you? (This means connecting to the Internet)}, 705 706config_intro => qq{ 707 708The following questions are intended to help you with the 709configuration. The CPAN module needs a directory of its own to cache 710important index files and maybe keep a temporary mirror of CPAN files. 711This may be a site-wide or a personal directory. 712 713}, 714 715# cpan_home => qq{ }, 716 717cpan_home_where => qq{ 718 719First of all, I'd like to create this directory. Where? 720 721}, 722 723external_progs => qq{ 724 725The CPAN module will need a few external programs to work properly. 726Please correct me, if I guess the wrong path for a program. Don't 727panic if you do not have some of them, just press ENTER for those. To 728disable the use of a program, you can type a space followed by ENTER. 729 730}, 731 732proxy_intro => qq{ 733 734If you're accessing the net via proxies, you can specify them in the 735CPAN configuration or via environment variables. The variable in 736the \$CPAN::Config takes precedence. 737 738}, 739 740proxy_user => qq{ 741 742If your proxy is an authenticating proxy, you can store your username 743permanently. If you do not want that, just press ENTER. You will then 744be asked for your username in every future session. 745 746}, 747 748proxy_pass => qq{ 749 750Your password for the authenticating proxy can also be stored 751permanently on disk. If this violates your security policy, just press 752ENTER. You will then be asked for the password in every future 753session. 754 755}, 756 757urls_intro => qq{ 758Now you need to choose your CPAN mirror sites. You can let me 759pick mirrors for you, you can select them from a list or you 760can enter them by hand. 761}, 762 763urls_picker_intro => qq{First, pick a nearby continent and country by typing in the number(s) 764in front of the item(s) you want to select. You can pick several of 765each, separated by spaces. Then, you will be presented with a list of 766URLs of CPAN mirrors in the countries you selected, along with 767previously selected URLs. Select some of those URLs, or just keep the 768old list. Finally, you will be prompted for any extra URLs -- file:, 769ftp:, or http: -- that host a CPAN mirror. 770 771You should select more than one (just in case the first isn't available). 772 773}, 774 775password_warn => qq{ 776 777Warning: Term::ReadKey seems not to be available, your password will 778be echoed to the terminal! 779 780}, 781 782install_help => qq{ 783Warning: You do not have write permission for Perl library directories. 784 785To install modules, you need to configure a local Perl library directory or 786escalate your privileges. CPAN can help you by bootstrapping the local::lib 787module or by configuring itself to use 'sudo' (if available). You may also 788resolve this problem manually if you need to customize your setup. 789 790What approach do you want? (Choose 'local::lib', 'sudo' or 'manual') 791}, 792 793local_lib_installed => qq{ 794local::lib is installed. You must now add the following environment variables 795to your shell configuration files (or registry, if you are on Windows) and 796then restart your command line shell and CPAN before installing modules: 797 798}, 799 800 ); 801 802 die "Coding error in \@prompts declaration. Odd number of elements, above" 803 if (@prompts % 2); 804 805 %prompts = @prompts; 806 807 if (scalar(keys %prompts) != scalar(@prompts)/2) { 808 my %already; 809 for my $item (0..$#prompts) { 810 next if $item % 2; 811 die "$prompts[$item] is duplicated\n" if $already{$prompts[$item]}++; 812 } 813 } 814 815 shift @podpara; 816 while (@podpara) { 817 warn "Alert: cannot parse my own manpage for init dialog" unless $podpara[0] =~ s/^=item\s+//; 818 my $name = shift @podpara; 819 my @para; 820 while (@podpara && $podpara[0] !~ /^=item/) { 821 push @para, shift @podpara; 822 } 823 $prompts{$name} = pop @para; 824 if (@para) { 825 $prompts{$name . "_intro"} = join "", map { "$_\n\n" } @para; 826 } 827 } 828 829} 830 831sub init { 832 my($configpm, %args) = @_; 833 use Config; 834 # extra args after 'o conf init' 835 my $matcher = $args{args} && @{$args{args}} ? $args{args}[0] : ''; 836 if ($matcher =~ /^\/(.*)\/$/) { 837 # case /regex/ => take the first, ignore the rest 838 $matcher = $1; 839 shift @{$args{args}}; 840 if (@{$args{args}}) { 841 local $" = " "; 842 $CPAN::Frontend->mywarn("Ignoring excessive arguments '@{$args{args}}'"); 843 $CPAN::Frontend->mysleep(2); 844 } 845 } elsif (0 == length $matcher) { 846 } elsif (0 && $matcher eq "~") { # extremely buggy, but a nice idea 847 my @unconfigured = sort grep { not exists $CPAN::Config->{$_} 848 or not defined $CPAN::Config->{$_} 849 or not length $CPAN::Config->{$_} 850 } keys %$CPAN::Config; 851 $matcher = "\\b(".join("|", @unconfigured).")\\b"; 852 $CPAN::Frontend->mywarn("matcher[$matcher]"); 853 } else { 854 # case WORD... => all arguments must be valid 855 for my $arg (@{$args{args}}) { 856 unless (exists $CPAN::HandleConfig::keys{$arg}) { 857 $CPAN::Frontend->mywarn("'$arg' is not a valid configuration variable\n"); 858 return; 859 } 860 } 861 $matcher = "\\b(".join("|",@{$args{args}}).")\\b"; 862 } 863 CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG; 864 865 unless ($CPAN::VERSION) { 866 require CPAN::Nox; 867 } 868 require CPAN::HandleConfig; 869 CPAN::HandleConfig::require_myconfig_or_config(); 870 $CPAN::Config ||= {}; 871 local($/) = "\n"; 872 local($\) = ""; 873 local($|) = 1; 874 875 my($ans,$default); # why so half global? 876 877 # 878 #= Files, directories 879 # 880 881 local *_real_prompt; 882 if ( $args{autoconfig} ) { 883 $auto_config = 1; 884 } elsif ($matcher) { 885 $auto_config = 0; 886 } else { 887 my $_conf = prompt($prompts{auto_config}, "yes"); 888 $auto_config = ($_conf and $_conf =~ /^y/i) ? 1 : 0; 889 } 890 CPAN->debug("auto_config[$auto_config]") if $CPAN::DEBUG; 891 if ( $auto_config ) { 892 local $^W = 0; 893 # prototype should match that of &MakeMaker::prompt 894 my $current_second = time; 895 my $current_second_count = 0; 896 my $i_am_mad = 0; 897 # silent prompting -- just quietly use default 898 *_real_prompt = sub { return $_[1] }; 899 } 900 901 # 902 # bootstrap local::lib or sudo 903 # 904 unless ( $matcher 905 || _can_write_to_libdirs() || _using_installbase() || _using_sudo() 906 ) { 907 local $auto_config = 0; # We *must* ask, even under autoconfig 908 local *_real_prompt; # We *must* show prompt 909 my_prompt_loop(install_help => 'local::lib', $matcher, 910 'local::lib|sudo|manual'); 911 } 912 $CPAN::Config->{install_help} ||= ''; # Temporary to suppress warnings 913 914 if (!$matcher or q{ 915 build_dir 916 build_dir_reuse 917 cpan_home 918 keep_source_where 919 prefs_dir 920 } =~ /$matcher/) { 921 $CPAN::Frontend->myprint($prompts{config_intro}) unless $auto_config; 922 923 init_cpan_home($matcher); 924 925 my_dflt_prompt("keep_source_where", 926 File::Spec->catdir($CPAN::Config->{cpan_home},"sources"), 927 $matcher, 928 ); 929 my_dflt_prompt("build_dir", 930 File::Spec->catdir($CPAN::Config->{cpan_home},"build"), 931 $matcher 932 ); 933 my_yn_prompt(build_dir_reuse => 0, $matcher); 934 my_dflt_prompt("prefs_dir", 935 File::Spec->catdir($CPAN::Config->{cpan_home},"prefs"), 936 $matcher 937 ); 938 } 939 940 # 941 #= Config: auto_commit 942 # 943 944 my_yn_prompt(auto_commit => 0, $matcher); 945 946 # 947 #= Cache size, Index expire 948 # 949 my_dflt_prompt(build_cache => 100, $matcher); 950 951 my_dflt_prompt(index_expire => 1, $matcher); 952 my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|atexit|never'); 953 my_yn_prompt(cleanup_after_install => 0, $matcher); 954 955 # 956 #= cache_metadata 957 # 958 959 my_yn_prompt(cache_metadata => 1, $matcher); 960 my_yn_prompt(use_sqlite => 0, $matcher); 961 962 # 963 #= Do we follow PREREQ_PM? 964 # 965 966 my_prompt_loop(prerequisites_policy => 'follow', $matcher, 967 'follow|ask|ignore'); 968 my_prompt_loop(build_requires_install_policy => 'yes', $matcher, 969 'yes|no|ask/yes|ask/no'); 970 my_yn_prompt(recommends_policy => 1, $matcher); 971 my_yn_prompt(suggests_policy => 0, $matcher); 972 973 # 974 #= Module::Signature 975 # 976 my_yn_prompt(check_sigs => 0, $matcher); 977 978 # 979 #= CPAN::Reporter 980 # 981 if (!$matcher or 'test_report' =~ /$matcher/) { 982 my_yn_prompt(test_report => 0, $matcher); 983 if ( 984 $matcher && 985 $CPAN::Config->{test_report} && 986 $CPAN::META->has_inst("CPAN::Reporter") && 987 CPAN::Reporter->can('configure') 988 ) { 989 my $_conf = prompt("Would you like me configure CPAN::Reporter now?", "yes"); 990 if ($_conf =~ /^y/i) { 991 $CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n"); 992 CPAN::Reporter::configure(); 993 $CPAN::Frontend->myprint("\nReturning to CPAN configuration.\n"); 994 } 995 } 996 } 997 998 my_yn_prompt(trust_test_report_history => 0, $matcher); 999 1000 # 1001 #= YAML vs. YAML::Syck 1002 # 1003 if (!$matcher or "yaml_module" =~ /$matcher/) { 1004 my_dflt_prompt(yaml_module => "YAML", $matcher); 1005 my $old_v = $CPAN::Config->{load_module_verbosity}; 1006 $CPAN::Config->{load_module_verbosity} = q[none]; 1007 if (!$auto_config && !$CPAN::META->has_inst($CPAN::Config->{yaml_module})) { 1008 $CPAN::Frontend->mywarn 1009 ("Warning (maybe harmless): '$CPAN::Config->{yaml_module}' not installed.\n"); 1010 $CPAN::Frontend->mysleep(3); 1011 } 1012 $CPAN::Config->{load_module_verbosity} = $old_v; 1013 } 1014 1015 # 1016 #= YAML code deserialisation 1017 # 1018 my_yn_prompt(yaml_load_code => 0, $matcher); 1019 1020 # 1021 #= External programs 1022 # 1023 my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'}; 1024 $CPAN::Frontend->myprint($prompts{external_progs}) 1025 if !$matcher && !$auto_config; 1026 _init_external_progs($matcher, { 1027 path => \@path, 1028 progs => [ qw/make bzip2 gzip tar unzip gpg patch applypatch/ ], 1029 shortcut => 0 1030 }); 1031 _init_external_progs($matcher, { 1032 path => \@path, 1033 progs => [ qw/wget curl lynx ncftpget ncftp ftp/ ], 1034 shortcut => 1 1035 }); 1036 1037 { 1038 my $path = $CPAN::Config->{'pager'} || 1039 $ENV{PAGER} || find_exe("less",\@path) || 1040 find_exe("more",\@path) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 ) 1041 || "more"; 1042 my_dflt_prompt(pager => $path, $matcher); 1043 } 1044 1045 { 1046 my $path = $CPAN::Config->{'shell'}; 1047 if ($path && File::Spec->file_name_is_absolute($path)) { 1048 $CPAN::Frontend->mywarn("Warning: configured $path does not exist\n") 1049 unless -e $path; 1050 $path = ""; 1051 } 1052 $path ||= $ENV{SHELL}; 1053 $path ||= $ENV{COMSPEC} if $^O eq "MSWin32"; 1054 if ($^O eq 'MacOS') { 1055 $CPAN::Config->{'shell'} = 'not_here'; 1056 } else { 1057 $path ||= 'sh', $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only 1058 my_dflt_prompt(shell => $path, $matcher); 1059 } 1060 } 1061 1062 { 1063 my $tar = $CPAN::Config->{tar}; 1064 my $prefer_external_tar = $CPAN::Config->{prefer_external_tar}; # XXX not yet supported 1065 unless (defined $prefer_external_tar) { 1066 if ($^O =~ /(MSWin32|solaris)/) { 1067 # both have a record of broken tars 1068 $prefer_external_tar = 0; 1069 } elsif ($tar) { 1070 $prefer_external_tar = 1; 1071 } else { 1072 $prefer_external_tar = 0; 1073 } 1074 } 1075 my_yn_prompt(prefer_external_tar => $prefer_external_tar, $matcher); 1076 } 1077 1078 # 1079 # verbosity 1080 # 1081 1082 my_prompt_loop(tar_verbosity => 'none', $matcher, 1083 'none|v|vv'); 1084 my_prompt_loop(load_module_verbosity => 'none', $matcher, 1085 'none|v'); 1086 my_prompt_loop(perl5lib_verbosity => 'none', $matcher, 1087 'none|v'); 1088 my_yn_prompt(inhibit_startup_message => 0, $matcher); 1089 1090 # 1091 #= Installer, arguments to make etc. 1092 # 1093 1094 my_prompt_loop(prefer_installer => 'MB', $matcher, 'MB|EUMM|RAND'); 1095 1096 if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/) { 1097 my_dflt_prompt(makepl_arg => "", $matcher); 1098 my_dflt_prompt(make_arg => "", $matcher); 1099 if ( $CPAN::Config->{makepl_arg} =~ /LIBS=|INC=/ ) { 1100 $CPAN::Frontend->mywarn( 1101 "Warning: Using LIBS or INC in makepl_arg will likely break distributions\n" . 1102 "that specify their own LIBS or INC options in Makefile.PL.\n" 1103 ); 1104 } 1105 1106 } 1107 1108 require CPAN::HandleConfig; 1109 if (exists $CPAN::HandleConfig::keys{make_install_make_command}) { 1110 # as long as Windows needs $self->_build_command, we cannot 1111 # support sudo on windows :-) 1112 my $default = $CPAN::Config->{make} || ""; 1113 if ( $default && $CPAN::Config->{install_help} eq 'sudo' ) { 1114 if ( find_exe('sudo') ) { 1115 $default = "sudo $default"; 1116 delete $CPAN::Config->{make_install_make_command} 1117 unless $CPAN::Config->{make_install_make_command} =~ /sudo/; 1118 } 1119 else { 1120 $CPAN::Frontend->mywarnonce("Could not find 'sudo' in PATH\n"); 1121 } 1122 } 1123 my_dflt_prompt(make_install_make_command => $default, $matcher); 1124 } 1125 1126 my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "", 1127 $matcher); 1128 1129 my_dflt_prompt(mbuildpl_arg => "", $matcher); 1130 my_dflt_prompt(mbuild_arg => "", $matcher); 1131 1132 if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command} 1133 and $^O ne "MSWin32") { 1134 # as long as Windows needs $self->_build_command, we cannot 1135 # support sudo on windows :-) 1136 my $default = $^O eq 'VMS' ? '@Build.com' : "./Build"; 1137 if ( $CPAN::Config->{install_help} eq 'sudo' ) { 1138 if ( find_exe('sudo') ) { 1139 $default = "sudo $default"; 1140 delete $CPAN::Config->{mbuild_install_build_command} 1141 unless $CPAN::Config->{mbuild_install_build_command} =~ /sudo/; 1142 } 1143 else { 1144 $CPAN::Frontend->mywarnonce("Could not find 'sudo' in PATH\n"); 1145 } 1146 } 1147 my_dflt_prompt(mbuild_install_build_command => $default, $matcher); 1148 } 1149 1150 my_dflt_prompt(mbuild_install_arg => "", $matcher); 1151 1152 for my $o (qw( 1153 allow_installing_outdated_dists 1154 allow_installing_module_downgrades 1155 )) { 1156 my_prompt_loop($o => 'ask/no', $matcher, 1157 'yes|no|ask/yes|ask/no'); 1158 } 1159 1160 # 1161 #== use_prompt_default 1162 # 1163 my_yn_prompt(use_prompt_default => 0, $matcher); 1164 1165 # 1166 #= Alarm period 1167 # 1168 1169 my_dflt_prompt(inactivity_timeout => 0, $matcher); 1170 my_dflt_prompt(version_timeout => 15, $matcher); 1171 1172 # 1173 #== halt_on_failure 1174 # 1175 my_yn_prompt(halt_on_failure => 0, $matcher); 1176 1177 # 1178 #= Proxies 1179 # 1180 1181 my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/; 1182 my @proxy_user_vars = qw/proxy_user proxy_pass/; 1183 if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/) { 1184 $CPAN::Frontend->myprint($prompts{proxy_intro}) unless $auto_config; 1185 1186 for (@proxy_vars) { 1187 $prompts{$_} = "Your $_?"; 1188 my_dflt_prompt($_ => $ENV{$_}||"", $matcher); 1189 } 1190 1191 if ($CPAN::Config->{ftp_proxy} || 1192 $CPAN::Config->{http_proxy}) { 1193 1194 $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || ""; 1195 1196 $CPAN::Frontend->myprint($prompts{proxy_user}) unless $auto_config; 1197 1198 if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) { 1199 $CPAN::Frontend->myprint($prompts{proxy_pass}) unless $auto_config; 1200 1201 if ($CPAN::META->has_inst("Term::ReadKey")) { 1202 Term::ReadKey::ReadMode("noecho"); 1203 } else { 1204 $CPAN::Frontend->myprint($prompts{password_warn}) unless $auto_config; 1205 } 1206 $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?"); 1207 if ($CPAN::META->has_inst("Term::ReadKey")) { 1208 Term::ReadKey::ReadMode("restore"); 1209 } 1210 $CPAN::Frontend->myprint("\n\n") unless $auto_config; 1211 } 1212 } 1213 } 1214 1215 # 1216 #= how plugins work 1217 # 1218 1219 # XXX MISSING: my_array_prompt to be used with plugins. We did something like this near 1220 # git log -p fd68f8f5e33f4cecea4fdb7abc5ee19c12f138f0..test-notest-test-dependency 1221 # Need to do similar steps for plugin_list. As long as we do not support it here, people 1222 # must use the cpan shell prompt to write something like 1223 # o conf plugin_list push CPAN::Plugin::Specfile=dir,/tmp/foo-20141013,... 1224 # o conf commit 1225 1226 # 1227 #= how FTP works 1228 # 1229 1230 my_yn_prompt(ftp_passive => 1, $matcher); 1231 1232 # 1233 #= how cwd works 1234 # 1235 1236 my_prompt_loop(getcwd => 'cwd', $matcher, 1237 'cwd|getcwd|fastcwd|getdcwd|backtickcwd'); 1238 1239 # 1240 #= the CPAN shell itself (prompt, color) 1241 # 1242 1243 my_yn_prompt(commandnumber_in_prompt => 1, $matcher); 1244 my_yn_prompt(term_ornaments => 1, $matcher); 1245 if ("colorize_output colorize_print colorize_warn colorize_debug" =~ $matcher) { 1246 my_yn_prompt(colorize_output => 0, $matcher); 1247 if ($CPAN::Config->{colorize_output}) { 1248 if ($CPAN::META->has_inst("Term::ANSIColor")) { 1249 my $T="gYw"; 1250 $CPAN::Frontend->myprint( " on_ on_y ". 1251 " on_ma on_\n") unless $auto_config; 1252 $CPAN::Frontend->myprint( " on_black on_red green ellow ". 1253 "on_blue genta on_cyan white\n") unless $auto_config; 1254 1255 for my $FG ("", "bold", 1256 map {$_,"bold $_"} "black","red","green", 1257 "yellow","blue", 1258 "magenta", 1259 "cyan","white") { 1260 $CPAN::Frontend->myprint(sprintf( "%12s ", $FG)) unless $auto_config; 1261 for my $BG ("",map {"on_$_"} qw(black red green yellow 1262 blue magenta cyan white)) { 1263 $CPAN::Frontend->myprint( $FG||$BG ? 1264 Term::ANSIColor::colored(" $T ","$FG $BG") : " $T ") unless $auto_config; 1265 } 1266 $CPAN::Frontend->myprint( "\n" ) unless $auto_config; 1267 } 1268 $CPAN::Frontend->myprint( "\n" ) unless $auto_config; 1269 } 1270 for my $tuple ( 1271 ["colorize_print", "bold blue on_white"], 1272 ["colorize_warn", "bold red on_white"], 1273 ["colorize_debug", "black on_cyan"], 1274 ) { 1275 my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher); 1276 if ($CPAN::META->has_inst("Term::ANSIColor")) { 1277 eval { Term::ANSIColor::color($CPAN::Config->{$tuple->[0]})}; 1278 if ($@) { 1279 $CPAN::Config->{$tuple->[0]} = $tuple->[1]; 1280 $CPAN::Frontend->mywarn($@."setting to default '$tuple->[1]'\n"); 1281 } 1282 } 1283 } 1284 } 1285 } 1286 1287 # 1288 #== term_is_latin 1289 # 1290 1291 my_yn_prompt(term_is_latin => 1, $matcher); 1292 1293 # 1294 #== save history in file 'histfile' 1295 # 1296 1297 if (!$matcher or 'histfile histsize' =~ /$matcher/) { 1298 $CPAN::Frontend->myprint($prompts{histfile_intro}) unless $auto_config; 1299 defined($default = $CPAN::Config->{histfile}) or 1300 $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile"); 1301 my_dflt_prompt(histfile => $default, $matcher); 1302 1303 if ($CPAN::Config->{histfile}) { 1304 defined($default = $CPAN::Config->{histsize}) or $default = 100; 1305 my_dflt_prompt(histsize => $default, $matcher); 1306 } 1307 } 1308 1309 # 1310 #== do an ls on the m or the d command 1311 # 1312 my_yn_prompt(show_upload_date => 0, $matcher); 1313 1314 # 1315 #== verbosity at the end of the r command 1316 # 1317 if (!$matcher 1318 or 'show_unparsable_versions' =~ /$matcher/ 1319 or 'show_zero_versions' =~ /$matcher/ 1320 ) { 1321 my_yn_prompt(show_unparsable_versions => 0, $matcher); 1322 my_yn_prompt(show_zero_versions => 0, $matcher); 1323 } 1324 1325 # 1326 #= MIRRORED.BY and conf_sites() 1327 # 1328 1329 # Let's assume they want to use the internet and make them turn it 1330 # off if they really don't. 1331 my_yn_prompt("connect_to_internet_ok" => 1, $matcher); 1332 my_yn_prompt("pushy_https" => 1, $matcher); 1333 1334 # Allow matching but don't show during manual config 1335 if ($matcher) { 1336 if ("urllist_ping_external" =~ $matcher) { 1337 my_yn_prompt(urllist_ping_external => 0, $matcher); 1338 } 1339 if ("urllist_ping_verbose" =~ $matcher) { 1340 my_yn_prompt(urllist_ping_verbose => 0, $matcher); 1341 } 1342 if ("randomize_urllist" =~ $matcher) { 1343 my_dflt_prompt(randomize_urllist => 0, $matcher); 1344 } 1345 if ("ftpstats_size" =~ $matcher) { 1346 my_dflt_prompt(ftpstats_size => 99, $matcher); 1347 } 1348 if ("ftpstats_period" =~ $matcher) { 1349 my_dflt_prompt(ftpstats_period => 14, $matcher); 1350 } 1351 } 1352 1353 $CPAN::Config->{urllist} ||= []; 1354 1355 if ($auto_config) { 1356 if(@{ $CPAN::Config->{urllist} }) { 1357 $CPAN::Frontend->myprint( 1358 "Your 'urllist' is already configured. Type 'o conf init urllist' to change it.\n" 1359 ); 1360 } 1361 else { 1362 # Hint: as of 2021-11: to get http, use http://www.cpan.org/ 1363 $CPAN::Config->{urllist} = [ 'https://cpan.org/' ]; 1364 $CPAN::Frontend->myprint( 1365 "We initialized your 'urllist' to @{$CPAN::Config->{urllist}}. Type 'o conf init urllist' to change it.\n" 1366 ); 1367 } 1368 } 1369 elsif (!$matcher || "urllist" =~ $matcher) { 1370 _do_pick_mirrors(); 1371 } 1372 1373 if ($auto_config) { 1374 $CPAN::Frontend->myprint( 1375 "\nAutoconfiguration complete.\n" 1376 ); 1377 $auto_config = 0; # reset 1378 } 1379 1380 # bootstrap local::lib now if requested 1381 if ( $CPAN::Config->{install_help} eq 'local::lib' ) { 1382 if ( ! @{ $CPAN::Config->{urllist} } ) { 1383 $CPAN::Frontend->myprint( 1384 "\nALERT: Skipping local::lib bootstrap because 'urllist' is not configured.\n" 1385 ); 1386 } 1387 elsif (! $CPAN::Config->{make} ) { 1388 $CPAN::Frontend->mywarn( 1389 "\nALERT: Skipping local::lib bootstrap because 'make' is not configured.\n" 1390 ); 1391 _beg_for_make(); # repetitive, but we don't want users to miss it 1392 } 1393 else { 1394 $CPAN::Frontend->myprint("\nAttempting to bootstrap local::lib...\n"); 1395 $CPAN::Frontend->myprint("\nWriting $configpm for bootstrap...\n"); 1396 delete $CPAN::Config->{install_help}; # temporary only 1397 CPAN::HandleConfig->commit; 1398 my($dist, $locallib); 1399 $locallib = CPAN::Shell->expand('Module', 'local::lib'); 1400 if ( $locallib and $dist = $locallib->distribution ) { 1401 # this is a hack to force bootstrapping 1402 $dist->{prefs}{pl}{commandline} = "$^X Makefile.PL --bootstrap"; 1403 # Set @INC for this process so we find things as they bootstrap 1404 require lib; 1405 lib->import(_local_lib_inc_path()); 1406 eval { $dist->install }; 1407 } 1408 if ( ! $dist || (my $err = $@) ) { 1409 $err ||= 'Could not locate local::lib in the CPAN index'; 1410 $CPAN::Frontend->mywarn("Error bootstrapping local::lib: $@\n"); 1411 $CPAN::Frontend->myprint("From the CPAN Shell, you might try 'look local::lib' and \n" 1412 . "run 'perl Makefile --bootstrap' and see if that is successful. Then\n" 1413 . "restart your CPAN client\n" 1414 ); 1415 } 1416 else { 1417 _local_lib_config(); 1418 } 1419 } 1420 } 1421 1422 # install_help is temporary for configuration and not saved 1423 delete $CPAN::Config->{install_help}; 1424 1425 $CPAN::Frontend->myprint("\n"); 1426 if ($matcher && !$CPAN::Config->{auto_commit}) { 1427 $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ". 1428 "make the config permanent!\n"); 1429 } else { 1430 CPAN::HandleConfig->commit; 1431 } 1432 1433 if (! $matcher) { 1434 $CPAN::Frontend->myprint( 1435 "\nYou can re-run configuration any time with 'o conf init' in the CPAN shell\n" 1436 ); 1437 } 1438 1439} 1440 1441sub _local_lib_config { 1442 # Set environment stuff for this process 1443 require local::lib; 1444 1445 # Tell user about environment vars to set 1446 $CPAN::Frontend->myprint($prompts{local_lib_installed}); 1447 local $ENV{SHELL} = $CPAN::Config->{shell} || $ENV{SHELL}; 1448 my $shellvars = local::lib->environment_vars_string_for(_local_lib_path()); 1449 $CPAN::Frontend->myprint($shellvars); 1450 1451 # Set %ENV after getting string above 1452 my %env = local::lib->build_environment_vars_for(_local_lib_path(), 1); 1453 while ( my ($k, $v) = each %env ) { 1454 $ENV{$k} = $v; 1455 } 1456 1457 # Offer to mangle the shell config 1458 my $munged_rc; 1459 if ( my $rc = _find_shell_config() ) { 1460 local $auto_config = 0; # We *must* ask, even under autoconfig 1461 local *_real_prompt; # We *must* show prompt 1462 my $_conf = prompt( 1463 "\nWould you like me to append that to $rc now?", "yes" 1464 ); 1465 if ($_conf =~ /^y/i) { 1466 open my $fh, ">>", $rc; 1467 print {$fh} "\n$shellvars"; 1468 close $fh; 1469 $munged_rc++; 1470 } 1471 } 1472 1473 # Warn at exit time 1474 if ($munged_rc) { 1475 push @{$CPAN::META->_exit_messages}, << "HERE"; 1476 1477*** Remember to restart your shell before running cpan again *** 1478HERE 1479 } 1480 else { 1481 push @{$CPAN::META->_exit_messages}, << "HERE"; 1482 1483*** Remember to add these environment variables to your shell config 1484 and restart your shell before running cpan again *** 1485 1486$shellvars 1487HERE 1488 } 1489} 1490 1491{ 1492 my %shell_rc_map = ( 1493 map { $_ => ".${_}rc" } qw/ bash tcsh csh /, 1494 map { $_ => ".profile" } qw/dash ash sh/, 1495 zsh => ".zshenv", 1496 ); 1497 1498 sub _find_shell_config { 1499 my $shell = File::Basename::basename($CPAN::Config->{shell}); 1500 if ( my $rc = $shell_rc_map{$shell} ) { 1501 my $path = File::Spec->catfile($ENV{HOME}, $rc); 1502 return $path if -w $path; 1503 } 1504 } 1505} 1506 1507 1508sub _local_lib_inc_path { 1509 return File::Spec->catdir(_local_lib_path(), qw/lib perl5/); 1510} 1511 1512sub _local_lib_path { 1513 return File::Spec->catdir(_local_lib_home(), 'perl5'); 1514} 1515 1516# Adapted from resolve_home_path() in local::lib -- this is where 1517# local::lib thinks the user's home is 1518{ 1519 my $local_lib_home; 1520 sub _local_lib_home { 1521 $local_lib_home ||= File::Spec->rel2abs( do { 1522 if ($CPAN::META->has_usable("File::HomeDir") && File::HomeDir->VERSION >= 0.65) { 1523 File::HomeDir->my_home; 1524 } elsif (defined $ENV{HOME}) { 1525 $ENV{HOME}; 1526 } else { 1527 (getpwuid $<)[7] || "~"; 1528 } 1529 }); 1530 } 1531} 1532 1533sub _do_pick_mirrors { 1534 local *_real_prompt; 1535 *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt; 1536 $CPAN::Frontend->myprint($prompts{urls_intro}); 1537 # Only prompt for auto-pick if Net::Ping is new enough to do timings 1538 my $_conf = 'n'; 1539 if ( $CPAN::META->has_usable("Net::Ping") && CPAN::Version->vgt(Net::Ping->VERSION, '2.13')) { 1540 $_conf = prompt($prompts{auto_pick}, "yes"); 1541 } else { 1542 prompt("Autoselection disabled due to Net::Ping missing or insufficient. Please press ENTER"); 1543 } 1544 my @old_list = @{ $CPAN::Config->{urllist} }; 1545 if ( $_conf =~ /^y/i ) { 1546 conf_sites( auto_pick => 1 ) or bring_your_own(); 1547 } 1548 else { 1549 _print_urllist('Current') if @old_list; 1550 my $msg = scalar @old_list 1551 ? "\nWould you like to edit the urllist or pick new mirrors from a list?" 1552 : "\nWould you like to pick from the CPAN mirror list?" ; 1553 my $_conf = prompt($msg, "yes"); 1554 if ( $_conf =~ /^y/i ) { 1555 conf_sites(); 1556 } 1557 bring_your_own(); 1558 } 1559 _print_urllist('New'); 1560} 1561 1562sub _init_external_progs { 1563 my($matcher,$args) = @_; 1564 my $PATH = $args->{path}; 1565 my @external_progs = @{ $args->{progs} }; 1566 my $shortcut = $args->{shortcut}; 1567 my $showed_make_warning; 1568 1569 if (!$matcher or "@external_progs" =~ /$matcher/) { 1570 my $old_warn = $^W; 1571 local $^W if $^O eq 'MacOS'; 1572 local $^W = $old_warn; 1573 my $progname; 1574 for $progname (@external_progs) { 1575 next if $matcher && $progname !~ /$matcher/; 1576 if ($^O eq 'MacOS') { 1577 $CPAN::Config->{$progname} = 'not_here'; 1578 next; 1579 } 1580 1581 my $progcall = $progname; 1582 unless ($matcher) { 1583 # we really don't need ncftp if we have ncftpget, but 1584 # if they chose this dialog via matcher, they shall have it 1585 next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " "; 1586 } 1587 my $path = $CPAN::Config->{$progname} 1588 || $Config::Config{$progname} 1589 || ""; 1590 if (File::Spec->file_name_is_absolute($path)) { 1591 # testing existence is not good enough, some have these exe 1592 # extensions 1593 1594 # warn "Warning: configured $path does not exist\n" unless -e $path; 1595 # $path = ""; 1596 } elsif ($path =~ /^\s+$/) { 1597 # preserve disabled programs 1598 } else { 1599 $path = ''; 1600 } 1601 unless ($path) { 1602 # e.g. make -> nmake 1603 $progcall = $Config::Config{$progname} if $Config::Config{$progname}; 1604 } 1605 1606 $path ||= find_exe($progcall,$PATH); 1607 unless ($path) { # not -e $path, because find_exe already checked that 1608 local $"=";"; 1609 $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@$PATH]\n") unless $auto_config; 1610 _beg_for_make(), $showed_make_warning++ if $progname eq "make"; 1611 } 1612 $prompts{$progname} = "Where is your $progname program?"; 1613 $path = my_dflt_prompt($progname,$path,$matcher,1); # 1 => no strip spaces 1614 my $disabling = $path =~ m/^\s*$/; 1615 1616 # don't let them disable or misconfigure make without warning 1617 if ( $progname eq "make" && ( $disabling || ! _check_found($path) ) ) { 1618 if ( $disabling && $showed_make_warning ) { 1619 next; 1620 } 1621 else { 1622 _beg_for_make() unless $showed_make_warning++; 1623 undef $CPAN::Config->{$progname}; 1624 $CPAN::Frontend->mywarn("Press SPACE and ENTER to disable make (NOT RECOMMENDED)\n"); 1625 redo; 1626 } 1627 } 1628 elsif ( $disabling ) { 1629 next; 1630 } 1631 elsif ( _check_found( $CPAN::Config->{$progname} ) ) { 1632 last if $shortcut && !$matcher; 1633 } 1634 else { 1635 undef $CPAN::Config->{$progname}; 1636 $CPAN::Frontend->mywarn("Press SPACE and ENTER to disable $progname\n"); 1637 redo; 1638 } 1639 } 1640 } 1641} 1642 1643sub _check_found { 1644 my ($prog) = @_; 1645 if ( ! -f $prog ) { 1646 $CPAN::Frontend->mywarn("Warning: '$prog' does not exist\n") 1647 unless $auto_config; 1648 return; 1649 } 1650 elsif ( ! -x $prog ) { 1651 $CPAN::Frontend->mywarn("Warning: '$prog' is not executable\n") 1652 unless $auto_config; 1653 return; 1654 } 1655 return 1; 1656} 1657 1658sub _beg_for_make { 1659 $CPAN::Frontend->mywarn(<<"HERE"); 1660 1661ALERT: 'make' is an essential tool for building perl Modules. 1662Please make sure you have 'make' (or some equivalent) working. 1663 1664HERE 1665 if ($^O eq "MSWin32") { 1666 $CPAN::Frontend->mywarn(<<"HERE"); 1667Windows users may want to follow this procedure when back in the CPAN shell: 1668 1669 look YVES/scripts/alien_nmake.pl 1670 perl alien_nmake.pl 1671 1672This will install nmake on your system which can be used as a 'make' 1673substitute. 1674 1675HERE 1676 } 1677 1678 $CPAN::Frontend->mywarn(<<"HERE"); 1679You can then retry the 'make' configuration step with 1680 1681 o conf init make 1682 1683HERE 1684} 1685 1686sub init_cpan_home { 1687 my($matcher) = @_; 1688 if (!$matcher or 'cpan_home' =~ /$matcher/) { 1689 my $cpan_home = 1690 $CPAN::Config->{cpan_home} || CPAN::HandleConfig::cpan_home(); 1691 if (-d $cpan_home) { 1692 $CPAN::Frontend->myprint( 1693 "\nI see you already have a directory\n" . 1694 "\n$cpan_home\n" . 1695 "Shall we use it as the general CPAN build and cache directory?\n\n" 1696 ) unless $auto_config; 1697 } else { 1698 # no cpan-home, must prompt and get one 1699 $CPAN::Frontend->myprint($prompts{cpan_home_where}) unless $auto_config; 1700 } 1701 1702 my $default = $cpan_home; 1703 my $loop = 0; 1704 my($last_ans,$ans); 1705 $CPAN::Frontend->myprint(" <cpan_home>\n") unless $auto_config; 1706 PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) { 1707 if (File::Spec->file_name_is_absolute($ans)) { 1708 my @cpan_home = split /[\/\\]/, $ans; 1709 DIR: for my $dir (@cpan_home) { 1710 if ($dir =~ /^~/ and (!$last_ans or $ans ne $last_ans)) { 1711 $CPAN::Frontend 1712 ->mywarn("Warning: a tilde in the path will be ". 1713 "taken as a literal tilde. Please ". 1714 "confirm again if you want to keep it\n"); 1715 $last_ans = $default = $ans; 1716 next PROMPT; 1717 } 1718 } 1719 } else { 1720 require Cwd; 1721 my $cwd = Cwd::cwd(); 1722 my $absans = File::Spec->catdir($cwd,$ans); 1723 $CPAN::Frontend->mywarn("The path '$ans' is not an ". 1724 "absolute path. Please specify ". 1725 "an absolute path\n"); 1726 $default = $absans; 1727 next PROMPT; 1728 } 1729 eval { File::Path::mkpath($ans); }; # dies if it can't 1730 if ($@) { 1731 $CPAN::Frontend->mywarn("Couldn't create directory $ans.\n". 1732 "Please retry.\n"); 1733 next PROMPT; 1734 } 1735 if (-d $ans && -w _) { 1736 last PROMPT; 1737 } else { 1738 $CPAN::Frontend->mywarn("Couldn't find directory $ans\n". 1739 "or directory is not writable. Please retry.\n"); 1740 if (++$loop > 5) { 1741 $CPAN::Frontend->mydie("Giving up"); 1742 } 1743 } 1744 } 1745 $CPAN::Config->{cpan_home} = $ans; 1746 } 1747} 1748 1749sub my_dflt_prompt { 1750 my ($item, $dflt, $m, $no_strip) = @_; 1751 my $default = $CPAN::Config->{$item} || $dflt; 1752 1753 if (!$auto_config && (!$m || $item =~ /$m/)) { 1754 if (my $intro = $prompts{$item . "_intro"}) { 1755 $CPAN::Frontend->myprint($intro); 1756 } 1757 $CPAN::Frontend->myprint(" <$item>\n"); 1758 $CPAN::Config->{$item} = 1759 $no_strip ? prompt_no_strip($prompts{$item}, $default) 1760 : prompt( $prompts{$item}, $default); 1761 } else { 1762 $CPAN::Config->{$item} = $default; 1763 } 1764 return $CPAN::Config->{$item}; 1765} 1766 1767sub my_yn_prompt { 1768 my ($item, $dflt, $m) = @_; 1769 my $default; 1770 defined($default = $CPAN::Config->{$item}) or $default = $dflt; 1771 1772 if (!$auto_config && (!$m || $item =~ /$m/)) { 1773 if (my $intro = $prompts{$item . "_intro"}) { 1774 $CPAN::Frontend->myprint($intro); 1775 } 1776 $CPAN::Frontend->myprint(" <$item>\n"); 1777 my $ans = prompt($prompts{$item}, $default ? 'yes' : 'no'); 1778 $CPAN::Config->{$item} = ($ans =~ /^[y1]/i ? 1 : 0); 1779 } else { 1780 $CPAN::Config->{$item} = $default; 1781 } 1782} 1783 1784sub my_prompt_loop { 1785 my ($item, $dflt, $m, $ok) = @_; 1786 my $default = $CPAN::Config->{$item} || $dflt; 1787 my $ans; 1788 1789 if (!$auto_config && (!$m || $item =~ /$m/)) { 1790 my $intro = $prompts{$item . "_intro"}; 1791 $CPAN::Frontend->myprint($intro) if defined $intro; 1792 $CPAN::Frontend->myprint(" <$item>\n"); 1793 do { $ans = prompt($prompts{$item}, $default); 1794 } until $ans =~ /$ok/; 1795 $CPAN::Config->{$item} = $ans; 1796 } else { 1797 $CPAN::Config->{$item} = $default; 1798 } 1799} 1800 1801 1802# Here's the logic about the MIRRORED.BY file. There are a number of scenarios: 1803# (1) We have a cached MIRRORED.BY file 1804# (1a) We're auto-picking 1805# - Refresh it automatically if it's old 1806# (1b) Otherwise, ask if using cached is ok. If old, default to no. 1807# - If cached is not ok, get it from the Internet. If it succeeds we use 1808# the new file. Otherwise, we use the old file. 1809# (2) We don't have a copy at all 1810# (2a) If we are allowed to connect, we try to get a new copy. If it succeeds, 1811# we use it, otherwise, we warn about failure 1812# (2b) If we aren't allowed to connect, 1813 1814sub conf_sites { 1815 my %args = @_; 1816 # auto pick implies using the internet 1817 $CPAN::Config->{connect_to_internet_ok} = 1 if $args{auto_pick}; 1818 1819 my $m = 'MIRRORED.BY'; 1820 my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m); 1821 File::Path::mkpath(File::Basename::dirname($mby)); 1822 # Why are we using MIRRORED.BY from the current directory? 1823 # Is this for testing? -- dagolden, 2009-11-05 1824 if (-f $mby && -f $m && -M $m < -M $mby) { 1825 require File::Copy; 1826 File::Copy::copy($m,$mby) or die "Could not update $mby: $!"; 1827 } 1828 local $^T = time; 1829 # if we have a cached copy is not older than 60 days, we either 1830 # use it or refresh it or fall back to it if the refresh failed. 1831 if ($mby && -f $mby && -s _ > 0 ) { 1832 my $very_old = (-M $mby > 60); 1833 my $mtime = localtime((stat _)[9]); 1834 # if auto_pick, refresh anything old automatically 1835 if ( $args{auto_pick} ) { 1836 if ( $very_old ) { 1837 $CPAN::Frontend->myprint(qq{Trying to refresh your mirror list\n}); 1838 eval { CPAN::FTP->localize($m,$mby,3,1) } 1839 or $CPAN::Frontend->myprint(qq{Refresh failed. Using the old cached copy instead.\n}); 1840 $CPAN::Frontend->myprint("\n"); 1841 } 1842 } 1843 else { 1844 my $prompt = qq{Found a cached mirror list as of $mtime 1845 1846If you'd like to just use the cached copy, answer 'yes', below. 1847If you'd like an updated copy of the mirror list, answer 'no' and 1848I'll get a fresh one from the Internet. 1849 1850Shall I use the cached mirror list?}; 1851 my $ans = prompt($prompt, $very_old ? "no" : "yes"); 1852 if ($ans =~ /^n/i) { 1853 $CPAN::Frontend->myprint(qq{Trying to refresh your mirror list\n}); 1854 # you asked for it from the Internet 1855 $CPAN::Config->{connect_to_internet_ok} = 1; 1856 eval { CPAN::FTP->localize($m,$mby,3,1) } 1857 or $CPAN::Frontend->myprint(qq{Refresh failed. Using the old cached copy instead.\n}); 1858 $CPAN::Frontend->myprint("\n"); 1859 } 1860 } 1861 } 1862 # else there is no cached copy and we must fetch or fail 1863 else { 1864 # If they haven't agree to connect to the internet, ask again 1865 if ( ! $CPAN::Config->{connect_to_internet_ok} ) { 1866 my $prompt = q{You are missing a copy of the CPAN mirror list. 1867 1868May I connect to the Internet to get it?}; 1869 my $ans = prompt($prompt, "yes"); 1870 if ($ans =~ /^y/i) { 1871 $CPAN::Config->{connect_to_internet_ok} = 1; 1872 } 1873 } 1874 1875 # Now get it from the Internet or complain 1876 if ( $CPAN::Config->{connect_to_internet_ok} ) { 1877 $CPAN::Frontend->myprint(qq{Trying to fetch a mirror list from the Internet\n}); 1878 eval { CPAN::FTP->localize($m,$mby,3,1) } 1879 or $CPAN::Frontend->mywarn(<<'HERE'); 1880We failed to get a copy of the mirror list from the Internet. 1881You will need to provide CPAN mirror URLs yourself. 1882HERE 1883 $CPAN::Frontend->myprint("\n"); 1884 } 1885 else { 1886 $CPAN::Frontend->mywarn(<<'HERE'); 1887You will need to provide CPAN mirror URLs yourself or set 1888'o conf connect_to_internet_ok 1' and try again. 1889HERE 1890 } 1891 } 1892 1893 # if we finally have a good local MIRRORED.BY, get on with picking 1894 if (-f $mby && -s _ > 0){ 1895 $CPAN::Config->{urllist} = 1896 $args{auto_pick} ? auto_mirrored_by($mby) : choose_mirrored_by($mby); 1897 return 1; 1898 } 1899 1900 return; 1901} 1902 1903sub find_exe { 1904 my($exe,$path) = @_; 1905 $path ||= [split /$Config{'path_sep'}/, $ENV{'PATH'}]; 1906 my($dir); 1907 #warn "in find_exe exe[$exe] path[@$path]"; 1908 for $dir (@$path) { 1909 my $abs = File::Spec->catfile($dir,$exe); 1910 if (($abs = MM->maybe_command($abs))) { 1911 return $abs; 1912 } 1913 } 1914} 1915 1916sub picklist { 1917 my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_; 1918 CPAN->debug("picklist('$items','$prompt','$default','$require_nonempty',". 1919 "'$empty_warning')") if $CPAN::DEBUG; 1920 $default ||= ''; 1921 1922 my $pos = 0; 1923 1924 my @nums; 1925 SELECTION: while (1) { 1926 1927 # display, at most, 15 items at a time 1928 my $limit = $#{ $items } - $pos; 1929 $limit = 15 if $limit > 15; 1930 1931 # show the next $limit items, get the new position 1932 $pos = display_some($items, $limit, $pos, $default); 1933 $pos = 0 if $pos >= @$items; 1934 1935 my $num = prompt($prompt,$default); 1936 1937 @nums = split (' ', $num); 1938 { 1939 my %seen; 1940 @nums = grep { !$seen{$_}++ } @nums; 1941 } 1942 my $i = scalar @$items; 1943 unrangify(\@nums); 1944 if (0 == @nums) { 1945 # cannot allow nothing because nothing means paging! 1946 # return; 1947 } elsif (grep (/\D/ || $_ < 1 || $_ > $i, @nums)) { 1948 $CPAN::Frontend->mywarn("invalid items entered, try again\n"); 1949 if ("@nums" =~ /\D/) { 1950 $CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n"); 1951 } 1952 next SELECTION; 1953 } 1954 if ($require_nonempty && !@nums) { 1955 $CPAN::Frontend->mywarn("$empty_warning\n"); 1956 } 1957 1958 # a blank line continues... 1959 unless (@nums){ 1960 $CPAN::Frontend->mysleep(0.1); # prevent hot spinning process on the next bug 1961 next SELECTION; 1962 } 1963 last; 1964 } 1965 for (@nums) { $_-- } 1966 @{$items}[@nums]; 1967} 1968 1969sub unrangify ($) { 1970 my($nums) = $_[0]; 1971 my @nums2 = (); 1972 while (@{$nums||[]}) { 1973 my $n = shift @$nums; 1974 if ($n =~ /^(\d+)-(\d+)$/) { 1975 my @range = $1 .. $2; 1976 # warn "range[@range]"; 1977 push @nums2, @range; 1978 } else { 1979 push @nums2, $n; 1980 } 1981 } 1982 push @$nums, @nums2; 1983} 1984 1985sub display_some { 1986 my ($items, $limit, $pos, $default) = @_; 1987 $pos ||= 0; 1988 1989 my @displayable = @$items[$pos .. ($pos + $limit)]; 1990 for my $item (@displayable) { 1991 $CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item); 1992 } 1993 my $hit_what = $default ? "SPACE ENTER" : "ENTER"; 1994 $CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n", 1995 (@$items - $pos), 1996 $hit_what, 1997 )) 1998 if $pos < @$items; 1999 return $pos; 2000} 2001 2002sub auto_mirrored_by { 2003 my $local = shift or return; 2004 local $|=1; 2005 $CPAN::Frontend->myprint("Looking for CPAN mirrors near you (please be patient)\n"); 2006 my $mirrors = CPAN::Mirrors->new($local); 2007 2008 my $cnt = 0; 2009 my $callback_was_active = 0; 2010 my @best = $mirrors->best_mirrors( 2011 how_many => 3, 2012 callback => sub { 2013 $callback_was_active++; 2014 $CPAN::Frontend->myprint("."); 2015 if ($cnt++>60) { $cnt=0; $CPAN::Frontend->myprint("\n"); } 2016 }, 2017 $CPAN::Config->{urllist_ping_external} ? (external_ping => 1) : (), 2018 $CPAN::Config->{urllist_ping_verbose} ? (verbose => 1) : (), 2019 ); 2020 2021 my $urllist = [ 2022 map { $_->http } 2023 grep { $_ && ref $_ && $_->can('http') } 2024 @best 2025 ]; 2026 push @$urllist, grep { /^file:/ } @{$CPAN::Config->{urllist}}; 2027 $CPAN::Frontend->myprint(" done!\n\n") if $callback_was_active; 2028 2029 return $urllist 2030} 2031 2032sub choose_mirrored_by { 2033 my $local = shift or return; 2034 my ($default); 2035 my $mirrors = CPAN::Mirrors->new($local); 2036 my @previous_urls = @{$CPAN::Config->{urllist}}; 2037 2038 $CPAN::Frontend->myprint($prompts{urls_picker_intro}); 2039 2040 my (@cont, $cont, %cont, @countries, @urls, %seen); 2041 my $no_previous_warn = 2042 "Sorry! since you don't have any existing picks, you must make a\n" . 2043 "geographic selection."; 2044 my $offer_cont = [sort $mirrors->continents]; 2045 if (@previous_urls) { 2046 push @$offer_cont, "(edit previous picks)"; 2047 $default = @$offer_cont; 2048 } else { 2049 # cannot allow nothing because nothing means paging! 2050 # push @$offer_cont, "(none of the above)"; 2051 } 2052 @cont = picklist($offer_cont, 2053 "Select your continent (or several nearby continents)", 2054 $default, 2055 ! @previous_urls, 2056 $no_previous_warn); 2057 # cannot allow nothing because nothing means paging! 2058 # return unless @cont; 2059 2060 foreach $cont (@cont) { 2061 my @c = sort $mirrors->countries($cont); 2062 @cont{@c} = map ($cont, 0..$#c); 2063 @c = map ("$_ ($cont)", @c) if @cont > 1; 2064 push (@countries, @c); 2065 } 2066 if (@previous_urls && @countries) { 2067 push @countries, "(edit previous picks)"; 2068 $default = @countries; 2069 } 2070 2071 if (@countries) { 2072 @countries = picklist (\@countries, 2073 "Select your country (or several nearby countries)", 2074 $default, 2075 ! @previous_urls, 2076 $no_previous_warn); 2077 %seen = map (($_ => 1), @previous_urls); 2078 # hmmm, should take list of defaults from CPAN::Config->{'urllist'}... 2079 foreach my $country (@countries) { 2080 next if $country =~ /edit previous picks/; 2081 (my $bare_country = $country) =~ s/ \(.*\)//; 2082 my @u; 2083 for my $m ( $mirrors->mirrors($bare_country) ) { 2084 push @u, $m->ftp if $m->ftp; 2085 push @u, $m->http if $m->http; 2086 } 2087 @u = grep (! $seen{$_}, @u); 2088 @u = map ("$_ ($bare_country)", @u) 2089 if @countries > 1; 2090 push (@urls, sort @u); 2091 } 2092 } 2093 push (@urls, map ("$_ (previous pick)", @previous_urls)); 2094 my $prompt = "Select as many URLs as you like (by number), 2095put them on one line, separated by blanks, hyphenated ranges allowed 2096 e.g. '1 4 5' or '7 1-4 8'"; 2097 if (@previous_urls) { 2098 $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) .. 2099 (scalar @urls)); 2100 $prompt .= "\n(or just hit ENTER to keep your previous picks)"; 2101 } 2102 2103 @urls = picklist (\@urls, $prompt, $default); 2104 foreach (@urls) { s/ \(.*\)//; } 2105 return [ @urls ]; 2106} 2107 2108sub bring_your_own { 2109 my $urllist = [ @{$CPAN::Config->{urllist}} ]; 2110 my %seen = map (($_ => 1), @$urllist); 2111 my($ans,@urls); 2112 my $eacnt = 0; # empty answers 2113 $CPAN::Frontend->myprint(<<'HERE'); 2114Now you can enter your own CPAN URLs by hand. A local CPAN mirror can be 2115listed using a 'file:' URL like 'file:///path/to/cpan/' 2116 2117HERE 2118 do { 2119 my $prompt = "Enter another URL or ENTER to quit:"; 2120 unless (%seen) { 2121 $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from. 2122 2123Please enter your CPAN site:}; 2124 } 2125 $ans = prompt ($prompt, ""); 2126 2127 if ($ans) { 2128 $ans =~ s|/?\z|/|; # has to end with one slash 2129 # XXX This manipulation is odd. Shouldn't we check that $ans is 2130 # a directory before converting to file:///? And we need /// below, 2131 # too, don't we? -- dagolden, 2009-11-05 2132 $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file: 2133 if ($ans =~ /^\w+:\/./) { 2134 push @urls, $ans unless $seen{$ans}++; 2135 } else { 2136 $CPAN::Frontend-> 2137 myprint(sprintf(qq{"%s" doesn\'t look like an URL at first sight. 2138I\'ll ignore it for now. 2139You can add it to your %s 2140later if you\'re sure it\'s right.\n}, 2141 $ans, 2142 $INC{'CPAN/MyConfig.pm'} 2143 || $INC{'CPAN/Config.pm'} 2144 || "configuration file", 2145 )); 2146 } 2147 } else { 2148 if (++$eacnt >= 5) { 2149 $CPAN::Frontend-> 2150 mywarn("Giving up.\n"); 2151 $CPAN::Frontend->mysleep(5); 2152 return; 2153 } 2154 } 2155 } while $ans || !%seen; 2156 2157 @$urllist = CPAN::_uniq(@$urllist, @urls); 2158 $CPAN::Config->{urllist} = $urllist; 2159} 2160 2161sub _print_urllist { 2162 my ($which) = @_; 2163 $CPAN::Frontend->myprint("$which urllist\n"); 2164 for ( @{$CPAN::Config->{urllist} || []} ) { 2165 $CPAN::Frontend->myprint(" $_\n") 2166 }; 2167} 2168 2169sub _can_write_to_libdirs { 2170 return -w $Config{installprivlib} 2171 && -w $Config{installarchlib} 2172 && -w $Config{installsitelib} 2173 && -w $Config{installsitearch} 2174} 2175 2176sub _using_installbase { 2177 return 1 if $ENV{PERL_MM_OPT} && $ENV{PERL_MM_OPT} =~ /install_base/i; 2178 return 1 if grep { ($CPAN::Config->{$_}||q{}) =~ /install_base/i } 2179 qw(makepl_arg make_install_arg mbuildpl_arg mbuild_install_arg); 2180 return; 2181} 2182 2183sub _using_sudo { 2184 return 1 if grep { ($CPAN::Config->{$_}||q{}) =~ /sudo/ } 2185 qw(make_install_make_command mbuild_install_build_command); 2186 return; 2187} 2188 2189sub _strip_spaces { 2190 $_[0] =~ s/^\s+//; # no leading spaces 2191 $_[0] =~ s/\s+\z//; # no trailing spaces 2192} 2193 2194sub prompt ($;$) { 2195 unless (defined &_real_prompt) { 2196 *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt; 2197 } 2198 my $ans = _real_prompt(@_); 2199 2200 _strip_spaces($ans); 2201 $CPAN::Frontend->myprint("\n") unless $auto_config; 2202 2203 return $ans; 2204} 2205 2206 2207sub prompt_no_strip ($;$) { 2208 unless (defined &_real_prompt) { 2209 *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt; 2210 } 2211 return _real_prompt(@_); 2212} 2213 2214 2215 22161; 2217