[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/5.10.0/CPAN/ -> FirstTime.pm (source)

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


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1