# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
package CPAN::Mirrored::By;
use strict;
-use vars qw($VERSION);
-$VERSION = sprintf "%.6f", substr(q$Rev: 825 $,4)/1000000 + 5.4;
-sub new {
+sub new {
my($self,@arg) = @_;
bless [@arg], $self;
}
sub url { shift->[2] }
package CPAN::FirstTime;
-
use strict;
+
use ExtUtils::MakeMaker ();
use FileHandle ();
use File::Basename ();
use File::Path ();
-use File::Spec;
+use File::Spec ();
use vars qw($VERSION $urllist);
-$VERSION = sprintf "%.6f", substr(q$Rev: 825 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 1379 $,4)/1000000 + 5.4;
=head1 NAME
The init routine asks a few questions and writes a CPAN/Config.pm or
CPAN/MyConfig.pm file (depending on what it is currently using).
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
=cut
sub init {
my($configpm, %args) = @_;
use Config;
- # extra arg in 'o conf init make' selects only $item =~ /make/
+ # extra args after 'o conf init'
my $matcher = $args{args} && @{$args{args}} ? $args{args}[0] : '';
- if ($matcher =~ /^\w+$/) {
- if (
- exists $CPAN::HandleConfig::keys{$matcher}
- ) {
- $matcher = "\\b$matcher\\b";
- } else {
- $CPAN::Frontend->myprint("'$matcher' is not a valid configuration variable");
- return;
+ if ($matcher =~ /^\/(.*)\/$/) {
+ # case /regex/ => take the first, ignore the rest
+ $matcher = $1;
+ shift @{$args{args}};
+ if (@{$args{args}}) {
+ local $" = " ";
+ $CPAN::Frontend->mywarn("Ignoring excessive arguments '@{$args{args}}'");
+ $CPAN::Frontend->mysleep(2);
}
+ } elsif (0 == length $matcher) {
+ } else {
+ # case WORD... => all arguments must be valid
+ for my $arg (@{$args{args}}) {
+ unless (exists $CPAN::HandleConfig::keys{$arg}) {
+ $CPAN::Frontend->mywarn("'$arg' is not a valid configuration variable\n");
+ return;
+ }
+ }
+ $matcher = "\\b(".join("|",@{$args{args}}).")\\b";
}
CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG;
my $current_second = time;
my $current_second_count = 0;
my $i_am_mad = 0;
- *_real_prompt = sub ($;$) {
+ *_real_prompt = sub {
my($q,$a) = @_;
my($ret) = defined $a ? $a : "";
$CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
}
}
- if (!$matcher or 'cpan_home keep_source_where build_dir' =~ /$matcher/){
+ if (!$matcher or q{
+ build_dir
+ build_dir_reuse
+ cpan_home
+ keep_source_where
+ prefs_dir
+ } =~ /$matcher/){
$CPAN::Frontend->myprint($prompts{config_intro});
if (!$matcher or 'cpan_home' =~ /$matcher/) {
}
$default = $cpan_home;
- while ($ans = prompt("CPAN build and cache directory?",$default)) {
- unless (File::Spec->file_name_is_absolute($ans)) {
+ my $loop = 0;
+ my $last_ans;
+ PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) {
+ if (File::Spec->file_name_is_absolute($ans)) {
+ my @cpan_home = split /[\/\\]/, $ans;
+ DIR: for my $dir (@cpan_home) {
+ if ($dir =~ /^~/ and (!$last_ans or $ans ne $last_ans)) {
+ $CPAN::Frontend
+ ->mywarn("Warning: a tilde in the path will be ".
+ "taken as a literal tilde. Please ".
+ "confirm again if you want to keep it\n");
+ $last_ans = $default = $ans;
+ next PROMPT;
+ }
+ }
+ } else {
require Cwd;
my $cwd = Cwd::cwd();
my $absans = File::Spec->catdir($cwd,$ans);
} else {
$CPAN::Frontend->mywarn("Couldn't find directory $ans\n".
"or directory is not writable. Please retry.\n");
+ if (++$loop > 5) {
+ $CPAN::Frontend->mydie("Giving up");
+ }
}
}
$CPAN::Config->{cpan_home} = $ans;
$matcher
);
}
+
+ if (!$matcher or 'build_dir_reuse' =~ /$matcher/) {
+ my_yn_prompt(build_dir_reuse => "y", $matcher);
+ }
+
+ if (!$matcher or 'prefs_dir' =~ /$matcher/) {
+ my_dflt_prompt("prefs_dir",
+ File::Spec->catdir($CPAN::Config->{cpan_home},"prefs"),
+ $matcher
+ );
+ }
}
#
#
if (!$matcher or 'build_cache' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{build_cache_intro});
-
# large enough to build large dists like Tk
my_dflt_prompt(build_cache => 100, $matcher);
}
if (!$matcher or 'index_expire' =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{index_expire_intro});
-
my_dflt_prompt(index_expire => 1, $matcher);
}
if (!$matcher or 'scan_cache' =~ /$matcher/){
$CPAN::Frontend->myprint($prompts{scan_cache_intro});
-
my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
}
#
my_yn_prompt(cache_metadata => 1, $matcher);
+ my_yn_prompt(use_sqlite => 0, $matcher);
#
#= Do we follow PREREQ_PM?
'follow|ask|ignore');
}
+ if (!$matcher or 'build_requires_install_policy' =~ /$matcher/){
+ $CPAN::Frontend->myprint($prompts{build_requires_install_policy_intro});
+
+ my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher,
+ 'yes|no|ask/yes|ask/no');
+ }
+
#
#= Module::Signature
#
}
#
+ #= YAML vs. YAML::Syck
+ #
+ if (!$matcher or "yaml_module" =~ /$matcher/) {
+ my_dflt_prompt(yaml_module => "YAML", $matcher);
+ }
+
+ #
#= External programs
#
my @external_progs = qw/bzip2 gzip tar unzip make
curl lynx wget ncftpget ncftp ftp
- gpg/;
+ gpg patch/;
my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
if (!$matcher or "@external_progs" =~ /$matcher/) {
$CPAN::Frontend->myprint($prompts{external_progs});
local $^W = $old_warn;
my $progname;
for $progname (@external_progs) {
+ next if $matcher && $progname !~ /$matcher/;
if ($^O eq 'MacOS') {
$CPAN::Config->{$progname} = 'not_here';
next;
}
- next if $matcher && $progname !~ /$matcher/;
my $progcall = $progname;
- # we don't need ncftp if we have ncftpget
- next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
+ unless ($matcher) {
+ # we really don't need ncftp if we have ncftpget, but
+ # if they chose this dialog via matcher, they shall have it
+ next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
+ }
my $path = $CPAN::Config->{$progname}
|| $Config::Config{$progname}
|| "";
$progcall = $Config::Config{$progname} if $Config::Config{$progname};
}
- $path ||= find_exe($progcall,[@path]);
- $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH\n") unless
- $path; # not -e $path, because find_exe already checked that
+ $path ||= find_exe($progcall,\@path);
+ {
+ local $"=";";
+ $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@path]\n") unless
+ $path; # not -e $path, because find_exe already checked that
+ }
$ans = prompt("Where is your $progname program?",$path) || $path;
$CPAN::Config->{$progname} = $ans;
}
if (!$matcher or 'pager' =~ /$matcher/) {
my $path = $CPAN::Config->{'pager'} ||
- $ENV{PAGER} || find_exe("less",[@path]) ||
- find_exe("more",[@path]) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
+ $ENV{PAGER} || find_exe("less",\@path) ||
+ find_exe("more",\@path) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
|| "more";
$ans = prompt("What is your favorite pager program?",$path);
$CPAN::Config->{'pager'} = $ans;
if (!$matcher or 'shell' =~ /$matcher/) {
my $path = $CPAN::Config->{'shell'};
- if (File::Spec->file_name_is_absolute($path)) {
+ if ($path && File::Spec->file_name_is_absolute($path)) {
$CPAN::Frontend->mywarn("Warning: configured $path does not exist\n")
unless -e $path;
$path = "";
}
if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{makepl_arg_intro});
-
my_dflt_prompt(makepl_arg => "", $matcher);
my_dflt_prompt(make_arg => "", $matcher);
}
$matcher);
if (!$matcher or 'mbuildpl_arg mbuild_arg' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{mbuildpl_arg_intro});
-
my_dflt_prompt(mbuildpl_arg => "", $matcher);
-
my_dflt_prompt(mbuild_arg => "", $matcher);
}
my_yn_prompt(colorize_output => 0, $matcher);
if ($CPAN::Config->{colorize_output}) {
for my $tuple (
- ["colorize_print", "bold blue"],
- ["colorize_warn", "bold red"],
+ ["colorize_print", "bold blue on_white"],
+ ["colorize_warn", "bold red on_white"],
) {
my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher);
if ($CPAN::META->has_inst("Term::ANSIColor")) {
*_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
conf_sites();
}
+ if ("randomize_urllist" =~ $matcher) {
+ my_dflt_prompt(randomize_urllist => 0, $matcher);
+ }
} elsif ($fastread) {
$CPAN::Frontend->myprint("Autoconfigured everything but 'urllist'.\n".
"Please call 'o conf init urllist' to configure ".
$DB::single = 1;
if (!$m || $item =~ /$m/) {
+ if (my $intro = $prompts{$item . "_intro"}) {
+ $CPAN::Frontend->myprint($intro);
+ }
$CPAN::Config->{$item} = prompt($prompts{$item}, $default);
} else {
$CPAN::Config->{$item} = $default;
@nums = grep { !$seen{$_}++ } @nums;
}
my $i = scalar @$items;
+ unrangify(\@nums);
if (grep (/\D/ || $_ < 1 || $_ > $i, @nums)){
$CPAN::Frontend->mywarn("invalid items entered, try again\n");
if ("@nums" =~ /\D/) {
- $CPAN::Frontend->mywarn("(we are expecting at least one number between 1 and $i)\n");
+ $CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n");
}
next SELECTION;
}
@{$items}[@nums];
}
+sub unrangify ($) {
+ my($nums) = $_[0];
+ my @nums2 = ();
+ while (@{$nums||[]}) {
+ my $n = shift @$nums;
+ if ($n =~ /^(\d+)-(\d+)$/) {
+ my @range = $1 .. $2;
+ # warn "range[@range]";
+ push @nums2, @range;
+ } else {
+ push @nums2, $n;
+ }
+ }
+ push @$nums, @nums2;
+}
+
sub display_some {
my ($items, $limit, $pos, $default) = @_;
$pos ||= 0;
}
push (@urls, map ("$_ (previous pick)", @previous_urls));
my $prompt = "Select as many URLs as you like (by number),
-put them on one line, separated by blanks, e.g. '1 4 5'";
+put them on one line, separated by blanks, hyphenated ranges allowed
+ e.g. '1 4 5' or '7 1-4 8'";
if (@previous_urls) {
$default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
(scalar @urls));
sub bring_your_own {
my %seen = map (($_ => 1), @$urllist);
my($ans,@urls);
+ my $eacnt = 0; # empty answers
do {
my $prompt = "Enter another URL or RETURN to quit:";
unless (%seen) {
|| "configuration file",
));
}
+ } else {
+ if (++$eacnt >= 5) {
+ $CPAN::Frontend->
+ mywarn("Giving up.\n");
+ $CPAN::Frontend->mysleep(5);
+ return;
+ }
}
} while $ans || !%seen;
The following questions are intended to help you with the
configuration. The CPAN module needs a directory of its own to cache
important index files and maybe keep a temporary mirror of CPAN files.
-This may be a site-wide directory or a personal directory.
+This may be a site-wide or a personal directory.
},
"Directory where the build process takes place?",
+build_dir_reuse_intro =>
+
+qq{Until version 1.88 CPAN.pm never trusted the contents of the
+build_dir directory between sessions. Since 1.88_58 CPAN.pm has a
+YAML-based mechanism that makes it possible to share the contents of
+the build_dir/ directory between different sessions with the same
+version of perl. People who prefer to test things several days before
+installing will like this feature because it safes a lot of time.
+
+If you say yes to the following question, CPAN will try to store
+enough information about the build process so that it can pick up in
+future sessions at the same state of affairs as it left a previous
+session.
+
+},
+
+build_dir_reuse =>
+
+qq{Store and re-use state information about distributions between
+CPAN.pm sessions?},
+
+prefs_dir_intro => qq{
+
+CPAN.pm can store customized build environments based on regular
+expressions for distribution names. These are YAML files where the
+default options for CPAN.pm and the environment can be overridden and
+dialog sequences can be stored that can later be executed by an
+Expect.pm object. The CPAN.pm distribution comes with some prefab YAML
+files that cover sample distributions that can be used as blueprints
+to store one own prefs. Please check out the distroprefs/ directory of
+the CPAN.pm distribution to get a quick start into the prefs system.
+
+},
+
+prefs_dir =>
+
+"Directory where to store default options/environment/dialogs for
+building modules that need some customization?",
+
scan_cache_intro => qq{
By default, each time the CPAN module is started, cache scanning is
possible to use Storable to create a cache of metadata. If Storable
is not available, the normal index mechanism will be used.
+Note: this mechanism is not used when use_sqlite is on and SQLLite is
+running.
+
},
cache_metadata => qq{Cache metadata (yes/no)?},
+use_sqlite_intro => qq{
+
+CPAN::SQLite is a layer between the index files that are downloaded
+from the CPAN and CPAN.pm that speeds up metadata queries and reduces
+memory consumption of CPAN.pm considereably.
+
+},
+
+use_sqlite => qq{Use CPAN::SQLite if available? (yes/no)?},
+
term_is_latin_intro => qq{
The next option deals with the charset (aka character set) your
colorize_warn => qq{Color for warnings?},
+build_requires_install_policy_intro => qq{
+
+When a module declares another one as a 'build_requires' prerequisite
+this means that the other module is only needed for building or
+testing the module but need not be installed permanently. In this case
+you may wish to install that other module nonetheless or just keep it
+in the 'build_dir' directory to have it available only temporarily.
+Installing saves time on future installations but makes the perl
+installation bigger.
+
+You can choose if you want to always install (yes), never install (no)
+or be always asked. In the latter case you can set the default answer
+for the question to yes (ask/yes) or no (ask/no).
+
+},
+
+build_requires_install_policy =>
+qq{Policy on installing 'build_requires' modules (yes, no, ask/yes,
+ask/no)?},
+
+yaml_module_intro => qq{
+
+At the time of this writing there are two competing YAML modules,
+YAML.pm and YAML::Syck. The latter is faster but needs a C compiler
+installed on your system. There may be more alternative YAML
+conforming modules but at the time of writing a potential third
+player, YAML::Tiny, is not yet sufficiently similar to the other two.
+
+},
+
+yaml_module => qq{Which YAML implementation would you prefer?},
+
+randomize_urllist_intro => qq{
+
+CPAN.pm can introduce some randomness when using hosts for download
+that are configured in the urllist parameter. Enter a numeric value
+between 0 and 1 to indicate how often you want to let CPAN.pm try a
+random host from the urllist. A value of one specifies to always use a
+random host as the first try. A value of zero means no randomness at
+all. Anything in between specifies how often, on average, a random
+host should be tried first.
+
+},
+
+randomize_urllist => "Randomize parameter",
+
);
die "Coding error in \@prompts declaration. Odd number of elements, above"