summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorSteve Peters <steve@fisharerojo.org>2006-10-14 23:18:29 +0000
committerSteve Peters <steve@fisharerojo.org>2006-10-14 23:18:29 +0000
commit1e8f9a0ace00bb04d0a9c26dcdcc93db65da08d8 (patch)
tree7fc540c5069d2057336b2c6b89beb11ee02bce6e /lib
parent1bd6a86e85991bbfc5b5a2502a5f6fce329aa510 (diff)
downloadperl-1e8f9a0ace00bb04d0a9c26dcdcc93db65da08d8.tar.gz
Upgrade to CPAN-1.88_54.
p4raw-id: //depot/perl@29020
Diffstat (limited to 'lib')
-rw-r--r--lib/CPAN.pm399
-rw-r--r--lib/CPAN/FirstTime.pm75
-rw-r--r--lib/CPAN/HandleConfig.pm9
3 files changed, 403 insertions, 80 deletions
diff --git a/lib/CPAN.pm b/lib/CPAN.pm
index 1864e0f348..eeb6dbbd38 100644
--- a/lib/CPAN.pm
+++ b/lib/CPAN.pm
@@ -1,7 +1,7 @@
# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
use strict;
package CPAN;
-$CPAN::VERSION = '1.88_53';
+$CPAN::VERSION = '1.88_54';
$CPAN::VERSION = eval $CPAN::VERSION;
use CPAN::HandleConfig;
@@ -337,6 +337,28 @@ Trying to chdir to "$cwd->[1]" instead.
}
}
+# CPAN::_yaml_loadfile
+sub _yaml_loadfile {
+ my($self,$local_file) = @_;
+ my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
+ if ($CPAN::META->has_inst($yaml_module)) {
+ my $code = UNIVERSAL::can($yaml_module, "LoadFile");
+ my $yaml;
+ eval { $yaml = $code->($local_file); };
+ if ($@) {
+ $CPAN::Frontend->mydie("Alert: While trying to parse YAML file\n".
+ " $local_file\n".
+ "with $yaml_module the following error was encountered:\n".
+ " $@\n"
+ );
+ }
+ return $yaml;
+ } else {
+ $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot parse '$local_file'\n");
+ }
+ return +{};
+}
+
package CPAN::CacheMgr;
use strict;
@CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
@@ -2491,7 +2513,6 @@ to find objects with matching identifiers.
}
for my $obj (@qcopy) {
$obj->color_cmd_tmps(0,0);
- delete $obj->{incommandcolor};
}
}
@@ -3711,7 +3732,8 @@ sub rd_authindex {
local($_);
push @lines, split /\012/ while <FH>;
my $i = 0;
- my $modulus = int(@lines/75) || 1;
+ my $modulus = int($#lines/75) || 1;
+ CPAN->debug(sprintf "modulus[%d]lines[%s]", $modulus, scalar @lines) if $CPAN::DEBUG;
foreach (@lines) {
my($userid,$fullname,$email) =
m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
@@ -3836,7 +3858,7 @@ happen.\a
CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
my(%exists);
my $i = 0;
- my $modulus = int(@lines/75) || 1;
+ my $modulus = int($#lines/75) || 1;
foreach (@lines) {
# before 1.56 we split into 3 and discarded the rest. From
# 1.57 we assign remaining text to $comment thus allowing to
@@ -3975,7 +3997,7 @@ sub rd_modlist {
Carp::confess($@) if $@;
return if $CPAN::Signal;
my $i = 0;
- my $until = keys %$ret;
+ my $until = keys(%$ret) - 1;
my $modulus = int($until/75) || 1;
CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
for (keys %$ret) {
@@ -4492,12 +4514,7 @@ sub fast_yaml {
$local_wanted)) {
$CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
}
- if ($CPAN::META->has_inst("YAML")) {
- my $yaml = YAML::LoadFile($local_file);
- return $yaml;
- } else {
- $CPAN::Frontend->mydie("Yaml not installed, cannot parse '$local_file'\n");
- }
+ my $yaml = CPAN->_yaml_loadfile($local_file);
}
#-> sub CPAN::Distribution::pretty_id
@@ -5534,13 +5551,21 @@ is part of the perl-%s distribution. To install that, you need to run
# $switch = "-MExtUtils::MakeMaker ".
# "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
# if $] > 5.00310;
+ my $makepl_arg = $self->make_x_arg("pl");
$system = sprintf("%s%s Makefile.PL%s",
$perl,
$switch ? " $switch" : "",
- $CPAN::Config->{makepl_arg} ? " $CPAN::Config->{makepl_arg}" : "",
+ $makepl_arg ? " $makepl_arg" : "",
);
}
- unless (exists $self->{writemakefile}) {
+ local %ENV = %ENV;
+ if (my $env = $self->prefs->{pl}{env}) {
+ for my $e (keys %$env) {
+ $ENV{$e} = $env->{$e};
+ }
+ }
+ if (exists $self->{writemakefile}) {
+ } else {
local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
my($ret,$pid);
$@ = "";
@@ -5594,13 +5619,17 @@ is part of the perl-%s distribution. To install that, you need to run
return;
}
} else {
- $ret = system($system);
- if ($ret != 0) {
- $self->{writemakefile} = CPAN::Distrostatus
- ->new("NO '$system' returned status $ret");
- $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
- return;
- }
+ if (my $expect = $self->prefs->{pl}{expect}) {
+ $ret = $self->run_via_expect($system,$expect);
+ } else {
+ $ret = system($system);
+ }
+ if ($ret != 0) {
+ $self->{writemakefile} = CPAN::Distrostatus
+ ->new("NO '$system' returned status $ret");
+ $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
+ return;
+ }
}
if (-f "Makefile" || -f "Build") {
$self->{writemakefile} = CPAN::Distrostatus->new("YES");
@@ -5625,6 +5654,10 @@ is part of the perl-%s distribution. To install that, you need to run
return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
}
}
+ if ($CPAN::Signal){
+ delete $self->{force_update};
+ return;
+ }
if ($self->{modulebuild}) {
unless (-f "Build") {
my $cwd = Cwd::cwd;
@@ -5636,6 +5669,19 @@ is part of the perl-%s distribution. To install that, you need to run
} else {
$system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
}
+ my $make_arg = $self->make_x_arg("make");
+ $system = sprintf("%s%s",
+ $system,
+ $make_arg ? " $make_arg" : "",
+ );
+ if (my $env = $self->prefs->{make}{env}) { # overriding the local
+ # ENV of PL, not the
+ # outer ENV, but
+ # unlikely to be a risk
+ for my $e (keys %$env) {
+ $ENV{$e} = $env->{$e};
+ }
+ }
if (system($system) == 0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
$self->{make} = CPAN::Distrostatus->new("YES");
@@ -5646,19 +5692,170 @@ is part of the perl-%s distribution. To install that, you need to run
}
}
+# CPAN::Distribution::run_via_expect
+sub run_via_expect {
+ my($self,$system,$expect) = @_;
+ CPAN->debug("system[$system]expect[$expect]") if $CPAN::DEBUG;
+ if ($CPAN::META->has_inst("Expect")) {
+ my $expo = Expect->new;
+ $expo->spawn($system);
+ EXPECT: for (my $i = 0; $i < $#$expect; $i+=2) {
+ my $regex = eval "qr{$expect->[$i]}";
+ my $send = $expect->[$i+1];
+ $expo->expect(10,
+ [ eof => sub {
+ my $but = $expo->clear_accum;
+ $CPAN::Frontend->mywarn("EOF (maybe harmless) system[$system]
+expected[$regex]\nbut[$but]\n\n");
+ last EXPECT;
+ } ],
+ [ timeout => sub {
+ my $but = $expo->clear_accum;
+ $CPAN::Frontend->mydie("TIMEOUT system[$system]
+expected[$regex]\nbut[$but]\n\n");
+ } ],
+ -re => $regex);
+ $expo->send($send);
+ }
+ $expo->soft_close;
+ return $expo->exitstatus();
+ } else {
+ $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
+ return system($system);
+ }
+}
+
+# CPAN::Distribution::_find_prefs
+sub _find_prefs {
+ my($self,$distro) = @_;
+ my $distroid = $distro->pretty_id;
+ CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
+ my $prefs_dir = $CPAN::Config->{prefs_dir};
+ eval { File::Path::mkpath($prefs_dir); };
+ if ($@) {
+ $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
+ }
+ my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
+ if ($CPAN::META->has_inst($yaml_module)) {
+ my $dh = DirHandle->new($prefs_dir)
+ or die Carp::croak("Couldn't open '$prefs_dir': $!");
+ DIRENT: for (sort $dh->read) {
+ next if $_ eq "." || $_ eq "..";
+ next unless /\.yml$/;
+ my $abs = File::Spec->catfile($prefs_dir, $_);
+ CPAN->debug("abs[$abs]") if $CPAN::DEBUG;
+ if (-f $abs) {
+ my $yaml = CPAN->_yaml_loadfile($abs);
+ my $ok = 1;
+ my $match = $yaml->{match} or
+ $CPAN::Frontend->mydie("Nonconforming YAML file '$abs': ".
+ "missing attribut 'match'. Please ".
+ "remove, cannot continue.");
+ for my $sub_attribute (keys %$match) {
+ my $qr = eval "qr{$yaml->{match}{$sub_attribute}}";
+ if ($sub_attribute eq "module") {
+ my $okm = 0;
+ my @modules = $distro->containsmods;
+ for my $module (@modules) {
+ $okm ||= $module =~ /$qr/;
+ last if $okm;
+ }
+ $ok &&= $okm;
+ } elsif ($sub_attribute eq "distribution") {
+ my $okd = $distroid =~ /$qr/;
+ $ok &&= $okd;
+ } else {
+ $CPAN::Frontend->mydie("Nonconforming YAML file '$abs': ".
+ "unknown sub_attribut '$sub_attribute'. ".
+ "Please ".
+ "remove, cannot continue.");
+ }
+ }
+ if ($ok) {
+ return {
+ prefs => $yaml,
+ prefs_file => $abs,
+ };
+ }
+ }
+ }
+ } else {
+ $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot read prefs '$prefs_dir'\n");
+ }
+ return;
+}
+
+# CPAN::Distribution::prefs
+sub prefs {
+ my($self) = @_;
+ if (exists $self->{prefs}) {
+ return $self->{prefs}; # XXX comment out during debugging
+ }
+ if ($CPAN::Config->{prefs_dir}) {
+ CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
+ my $prefs = $self->_find_prefs($self);
+ if ($prefs) {
+ for my $x (qw(prefs prefs_file)) {
+ $self->{$x} = $prefs->{$x};
+ }
+ my $basename = File::Basename::basename($self->{prefs_file});
+ my $filler1 = "_" x 22;
+ my $filler2 = int(66 - length($basename))/2;
+ $filler2 = 0 if $filler2 < 0;
+ $filler2 = " " x $filler2;
+ $CPAN::Frontend->myprint("
+$filler1 D i s t r o P r e f s $filler1
+$filler2 $basename $filler2
+");
+ $CPAN::Frontend->mysleep(1);
+ return $self->{prefs};
+ }
+ }
+ return +{};
+}
+
+# CPAN::Distribution::make_x_arg
+sub make_x_arg {
+ my($self, $whixh) = @_;
+ my $make_x_arg;
+ my $prefs = $self->prefs;
+ if (
+ $prefs
+ && exists $prefs->{$whixh}
+ && exists $prefs->{$whixh}{args}
+ && $prefs->{$whixh}{args}
+ ) {
+ $make_x_arg = join(" ",
+ map {CPAN::HandleConfig
+ ->safe_quote($_)} @{$prefs->{$whixh}{args}},
+ );
+ }
+ my $what = sprintf "make%s_arg", $whixh eq "make" ? "" : $whixh;
+ $make_x_arg ||= $CPAN::Config->{$what};
+ return $make_x_arg;
+}
+
+# CPAN::Distribution::_make_command
sub _make_command {
my ($self) = @_;
if ($self) {
return
- CPAN::HandleConfig
+ CPAN::HandleConfig
->safe_quote(
- $CPAN::Config->{make} || $Config::Config{make} || 'make'
+ $self->prefs->{cpanconfig}{make}
+ || $CPAN::Config->{make}
+ || $Config::Config{make}
+ || 'make'
);
} else {
# Old style call, without object. Deprecated
Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
return
- safe_quote(undef, $CPAN::Config->{make} || $Config::Config{make} || 'make');
+ safe_quote(undef,
+ $self->prefs->{cpanconfig}{make}
+ || $CPAN::Config->{make}
+ || $Config::Config{make}
+ || 'make');
}
}
@@ -5801,17 +5998,14 @@ sub read_yaml {
my $yaml = File::Spec->catfile($build_dir,"META.yml");
$self->debug("yaml[$yaml]") if $CPAN::DEBUG;
return unless -f $yaml;
- if ($CPAN::META->has_inst("YAML")) {
- eval { $self->{yaml_content} = YAML::LoadFile($yaml); };
- if ($@) {
- $CPAN::Frontend->mywarn("Error while parsing META.yml: $@");
- return;
- }
- if (not exists $self->{yaml_content}{dynamic_config}
- or $self->{yaml_content}{dynamic_config}
- ) {
- $self->{yaml_content} = undef;
- }
+ eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml); };
+ if ($@) {
+ return; # if we die, then we cannot read our own META.yml
+ }
+ if (not exists $self->{yaml_content}{dynamic_config}
+ or $self->{yaml_content}{dynamic_config}
+ ) {
+ $self->{yaml_content} = undef;
}
$self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
if $CPAN::DEBUG;
@@ -6023,9 +6217,18 @@ sub test {
} else {
$system = join " ", $self->_make_command(), "test";
}
- my $tests_ok;
- if ( $CPAN::Config->{test_report} &&
- $CPAN::META->has_inst("CPAN::Reporter") ) {
+ my($tests_ok);
+ local %ENV = %ENV;
+ if (my $env = $self->prefs->{test}{env}) {
+ for my $e (keys %$env) {
+ $ENV{$e} = $env->{$e};
+ }
+ }
+ my $expect = $self->prefs->{test}{expect};
+ if ($expect && @$expect) {
+ $tests_ok = $self->run_via_expect($system,$expect) == 0;
+ } elsif ( $CPAN::Config->{test_report} &&
+ $CPAN::META->has_inst("CPAN::Reporter") ) {
$tests_ok = CPAN::Reporter::test($self, $system);
} else {
$tests_ok = system($system) == 0;
@@ -6035,11 +6238,14 @@ sub test {
my @prereq;
for my $m (keys %{$self->{sponsored_mods}}) {
my $m_obj = CPAN::Shell->expand("Module",$m);
- if (!$m_obj->distribution->{make_test}
- ||
- $m_obj->distribution->{make_test}->failed){
- #$m_obj->dump;
- push @prereq, $m;
+ my $d_obj = $m_obj->distribution;
+ if ($d_obj) {
+ if (!$d_obj->{make_test}
+ ||
+ $d_obj->{make_test}->failed){
+ #$m_obj->dump;
+ push @prereq, $m;
+ }
}
}
if (@prereq){
@@ -6220,8 +6426,10 @@ sub install {
$CPAN::Config->{mbuild_install_arg},
);
} else {
- my($make_install_make_command) = $CPAN::Config->{make_install_make_command} ||
- $self->_make_command();
+ my($make_install_make_command) =
+ $self->prefs->{cpanconfig}{make_install_make_command}
+ || $CPAN::Config->{make_install_make_command}
+ || $self->_make_command();
$system = sprintf("%s install %s",
$make_install_make_command,
$CPAN::Config->{make_install_arg},
@@ -6229,14 +6437,16 @@ sub install {
}
my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
- $CPAN::Config->{build_requires_install_policy}||="ask/yes";
+ my $brip = $self->prefs->{cpanconfig}{build_requires_install_policy};
+ $brip ||= $CPAN::Config->{build_requires_install_policy};
+ $brip ||="ask/yes";
my $id = $self->id;
my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
my $want_install = "yes";
if ($reqtype eq "b") {
- if ($CPAN::Config->{build_requires_install_policy} eq "no") {
+ if ($brip eq "no") {
$want_install = "no";
- } elsif ($CPAN::Config->{build_requires_install_policy} =~ m|^ask/(.+)|) {
+ } elsif ($brip =~ m|^ask/(.+)|) {
my $default = $1;
$default = "yes" unless $default =~ /^(y|n)/i;
$want_install =
@@ -6269,12 +6479,16 @@ sub install {
} else {
$self->{install} = CPAN::Distrostatus->new("NO");
$CPAN::Frontend->mywarn(" $system -- NOT OK\n");
+ my $mimc =
+ $self->prefs->{cpanconfig}{make_install_make_command} ||
+ $CPAN::Config->{make_install_make_command};
if (
$makeout =~ /permission/s
&& $> > 0
&& (
- ! $CPAN::Config->{make_install_make_command}
- || $CPAN::Config->{make_install_make_command} eq $CPAN::Config->{make}
+ ! $mimc
+ || $mimc eq ($self->prefs->{cpanconfig}{make}
+ || $CPAN::Config->{make})
)
) {
$CPAN::Frontend->myprint(
@@ -7386,23 +7600,30 @@ Batch mode:
use CPAN;
- # modules:
+ # Modules:
+
+ cpan> install Acme::Meta # in the shell
+
+ CPAN::Shell->install("Acme::Meta"); # in perl
+
+ # Distributions:
+
+ cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell
+
+ CPAN::Shell->
+ install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl
+
+ # module objects:
- $mod = "Acme::Meta";
- install $mod;
- CPAN::Shell->install($mod); # same thing
- CPAN::Shell->expandany($mod)->install; # same thing
- CPAN::Shell->expand("Module",$mod)->install; # same thing
- CPAN::Shell->expand("Module",$mod)
- ->distribution->install; # same thing
+ $mo = CPAN::Shell->expandany($mod);
+ $mo = CPAN::Shell->expand("Module",$mod); # same thing
- # distributions:
+ # distribution objects:
- $distro = "NWCLARK/Acme-Meta-0.01.tar.gz";
- install $distro; # same thing
- CPAN::Shell->install($distro); # same thing
- CPAN::Shell->expandany($distro)->install; # same thing
- CPAN::Shell->expand("Distribution",$distro)->install; # same thing
+ $do = CPAN::Shell->expand("Module",$mod)->distribution;
+ $do = CPAN::Shell->expandany($distro); # same thing
+ $do = CPAN::Shell->expand("Distribution",
+ $distro); # same thing
=head1 STATUS
@@ -7732,8 +7953,7 @@ functionalities that are available in the shell.
# install my favorite programs if necessary:
for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
- my $obj = CPAN::Shell->expand('Module',$mod);
- $obj->install;
+ CPAN::Shell->install($mod);
}
# list all modules on my disk that have no VERSION number
@@ -7935,6 +8155,10 @@ any case and if this fails, the install will be canceled. The
cancellation can be avoided by letting C<force> run the C<install> for
you.
+This install method has only the power to install the distribution if
+there are no dependencies in the way. To install an object and all of
+its dependencies, use CPAN::Shell->install.
+
Note that install() gives no meaningful return value. See uptodate().
=item CPAN::Distribution::isa_perl()
@@ -7965,6 +8189,19 @@ isn't available, it converts it to plain text with external
command html2text and runs it through the pager specified
in C<$CPAN::Config->{pager}>
+=item CPAN::Distribution::prefs()
+
+Returns the hash reference from the first matching YAML file that the
+user has deposited in the C<prefs_dir/> directory. The first
+succeeding match wins. The files in the C<prefs_dir/> are processed
+alphabetically and the canonical distroname (e.g.
+AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
+stored in the $root->{match}{distribution} attribute value.
+Additionally all module names contained in a distribution are matched
+agains the regular expressions in the $root->{match}{module} attribute
+value. The two match values are ANDed together. Each of the two
+attributes are optional.
+
=item CPAN::Distribution::prereq_pm()
Returns the hash reference that has been announced by a distribution
@@ -8428,6 +8665,7 @@ defined:
prerequisites_policy
what to do if you are missing module prerequisites
('follow' automatically, 'ask' me, or 'ignore')
+ prefs_dir local directory to store per-distro build options
proxy_user username for accessing an authenticating proxy
proxy_pass password for accessing an authenticating proxy
scan_cache controls scanning of cache ('atstart' or 'never')
@@ -8443,6 +8681,7 @@ defined:
username your username if you CPAN server wants one
wait_list arrayref to a wait server to try (See CPAN::WAIT)
wget path to external prg
+ yaml_module which module to use to read/write YAML files
You can set and query each of these options interactively in the cpan
shell with the command set defined within the C<o conf> command:
@@ -8534,6 +8773,36 @@ site will be tried another time. This means that if you want to disallow
a site for the next transfer, it must be explicitly removed from
urllist.
+=head2 prefs_dir for avoiding interactive questions (ALPHA)
+
+(B<Note:> This feature has been introduced in CPAN.pm 1.8854 and is
+still considered experimental and may still be changed)
+
+The files in the directory specified in C<prefs_dir> are YAML files
+that specify how CPAN.pm shall treat distributions that deviate from
+the normal non-interactive model of building and installing CPAN
+modules.
+
+Some modules try to get some data from the user interactively thus
+disturbing the installation of large bundles like Phalanx100 or
+modules like Plagger.
+
+CPAN.pm can use YAML files to either pass additional arguments to one
+of the four commands, set environment variables or instantiate an
+Expect object that reads from the console, waits for some regular
+expression and enters some answer. Needless to say that for the latter
+option Expect.pm needs to be installed.
+
+CPAN.pm comes with a couple of such YAML files. The structure is
+currently not documented. Please see the distroprefs directory of the
+CPAN distribution for examples and follow the README in there.
+
+Please note that setting the environment variable PERL_MM_USE_DEFAULT
+to a true value can also get you a long way if you want to always pick
+the default answers. But this only works if the author of apackage
+used the prompt function provided by ExtUtils::MakeMaker and if the
+defaults are OK for you.
+
=head1 SECURITY
There's no strong security layer in CPAN.pm. CPAN.pm helps you to
diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm
index 692f6c9cd5..f04985b0d1 100644
--- a/lib/CPAN/FirstTime.pm
+++ b/lib/CPAN/FirstTime.pm
@@ -19,7 +19,7 @@ use File::Basename ();
use File::Path ();
use File::Spec;
use vars qw($VERSION $urllist);
-$VERSION = sprintf "%.6f", substr(q$Rev: 924 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 1012 $,4)/1000000 + 5.4;
=head1 NAME
@@ -144,7 +144,7 @@ sub init {
}
}
- if (!$matcher or 'cpan_home keep_source_where build_dir' =~ /$matcher/){
+ if (!$matcher or 'cpan_home keep_source_where build_dir prefs_dir' =~ /$matcher/){
$CPAN::Frontend->myprint($prompts{config_intro});
if (!$matcher or 'cpan_home' =~ /$matcher/) {
@@ -165,6 +165,7 @@ Shall we use it as the general CPAN build and cache directory?
}
$default = $cpan_home;
+ my $loop = 0;
while ($ans = prompt("CPAN build and cache directory?",$default)) {
unless (File::Spec->file_name_is_absolute($ans)) {
require Cwd;
@@ -187,6 +188,9 @@ Shall we use it as the general CPAN build and cache directory?
} 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;
@@ -205,6 +209,13 @@ Shall we use it as the general CPAN build and cache directory?
$matcher
);
}
+
+ if (!$matcher or 'prefs_dir' =~ /$matcher/) {
+ my_dflt_prompt("prefs_dir",
+ File::Spec->catdir($CPAN::Config->{cpan_home},"prefs"),
+ $matcher
+ );
+ }
}
#
@@ -212,21 +223,16 @@ Shall we use it as the general CPAN build and cache directory?
#
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');
}
@@ -278,6 +284,13 @@ Shall we use it as the general CPAN build and cache directory?
}
#
+ #= YAML vs. YAML::Syck
+ #
+ if (!$matcher or "yaml_module" =~ /$matcher/) {
+ my_dflt_prompt(yaml_module => "YAML", $matcher);
+ }
+
+ #
#= External programs
#
@@ -370,8 +383,6 @@ Shall we use it as the general CPAN build and cache directory?
}
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);
}
@@ -388,10 +399,7 @@ Shall we use it as the general CPAN build and cache directory?
$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);
}
@@ -574,6 +582,9 @@ sub my_dflt_prompt {
$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;
@@ -845,6 +856,7 @@ put them on one line, separated by blanks, hyphenated ranges allowed
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) {
@@ -871,6 +883,13 @@ later if you\'re sure it\'s right.\n},
|| "configuration file",
));
}
+ } else {
+ if (++$eacnt >= 5) {
+ $CPAN::Frontend->
+ mywarn("Giving up.\n");
+ $CPAN::Frontend->mysleep(5);
+ return;
+ }
}
} while $ans || !%seen;
@@ -929,7 +948,7 @@ config_intro => qq{
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.
},
@@ -961,6 +980,24 @@ build_dir =>
"Directory where the build process takes place?",
+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
@@ -1344,6 +1381,18 @@ 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?},
+
);
die "Coding error in \@prompts declaration. Odd number of elements, above"
diff --git a/lib/CPAN/HandleConfig.pm b/lib/CPAN/HandleConfig.pm
index 557aac5fed..b6af22b7c2 100644
--- a/lib/CPAN/HandleConfig.pm
+++ b/lib/CPAN/HandleConfig.pm
@@ -2,7 +2,7 @@ package CPAN::HandleConfig;
use strict;
use vars qw(%can %keys $VERSION);
-$VERSION = sprintf "%.6f", substr(q$Rev: 984 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 987 $,4)/1000000 + 5.4;
%can = (
commit => "Commit changes to disk",
@@ -11,6 +11,9 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 984 $,4)/1000000 + 5.4;
init => "Interactive setting of all options",
);
+# Q: where is the "How do I add a new config option" HOWTO?
+# A1: svn diff -r 757:758 # where dagolden added test_report
+# A2: svn diff -r 985:986 # where andk added yaml_module
%keys = map { $_ => undef } (
# allow_unauthenticated ?? some day...
"build_cache",
@@ -58,6 +61,7 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 984 $,4)/1000000 + 5.4;
"password",
"prefer_installer",
"prerequisites_policy",
+ "prefs_dir",
"proxy_pass",
"proxy_user",
"scan_cache",
@@ -72,6 +76,7 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 984 $,4)/1000000 + 5.4;
"username",
"wait_list",
"wget",
+ "yaml_module",
);
if ($^O eq "MSWin32") {
for my $k (qw(
@@ -581,7 +586,7 @@ package
use strict;
use vars qw($AUTOLOAD $VERSION);
-$VERSION = sprintf "%.2f", substr(q$Rev: 984 $,4)/100;
+$VERSION = sprintf "%.2f", substr(q$Rev: 987 $,4)/100;
# formerly CPAN::HandleConfig was known as CPAN::Config
sub AUTOLOAD {