summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/CPAN/HandleConfig.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPAN/HandleConfig.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/CPAN/HandleConfig.pm307
1 files changed, 177 insertions, 130 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPAN/HandleConfig.pm b/Master/tlpkg/tlperl/lib/CPAN/HandleConfig.pm
index 76cd81eee8b..58ccbe50e5d 100644
--- a/Master/tlpkg/tlperl/lib/CPAN/HandleConfig.pm
+++ b/Master/tlpkg/tlperl/lib/CPAN/HandleConfig.pm
@@ -1,8 +1,12 @@
package CPAN::HandleConfig;
use strict;
use vars qw(%can %keys $loading $VERSION);
+use File::Path ();
+use File::Spec ();
+use File::Basename ();
+use Carp ();
-$VERSION = "5.5001"; # see also CPAN::Config::VERSION at end of file
+$VERSION = "5.5003"; # see also CPAN::Config::VERSION at end of file
%can = (
commit => "Commit changes to disk",
@@ -12,8 +16,8 @@ $VERSION = "5.5001"; # see also CPAN::Config::VERSION at end of file
);
# 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
+# A1: svn diff -r 757:758 # where dagolden added test_report [git e997b71de88f1019a1472fc13cb97b1b7f96610f]
+# A2: svn diff -r 985:986 # where andk added yaml_module [git 312b6d9b12b1bdec0b6e282d853482145475021f]
# A3: 1. add new config option to %keys below
# 2. add a Pod description in CPAN::FirstTime; it should include a
# prompt line; see others for examples
@@ -78,6 +82,7 @@ $VERSION = "5.5001"; # see also CPAN::Config::VERSION at end of file
"patch",
"patches_dir",
"perl5lib_verbosity",
+ "prefer_external_tar",
"prefer_installer",
"prefs_dir",
"prerequisites_policy",
@@ -254,6 +259,8 @@ sub prettyprint {
}
}
+# generally, this should be called without arguments so that the currently
+# loaded config file is where changes are committed.
sub commit {
my($self,@args) = @_;
CPAN->debug("args[@args]") if $CPAN::DEBUG;
@@ -264,7 +271,9 @@ sub commit {
" !undef \$CPAN::RUN_DEGRADED\n"
);
}
- my $configpm;
+ my ($configpm, $must_reload);
+
+ # XXX does anything do this? can it be simplified? -- dagolden, 2011-01-19
if (@args) {
if ($args[0] eq "args") {
# we have not signed that contract
@@ -272,31 +281,50 @@ sub commit {
$configpm = $args[0];
}
}
- unless (defined $configpm) {
- $configpm ||= $INC{"CPAN/MyConfig.pm"};
- $configpm ||= $INC{"CPAN/Config.pm"};
- $configpm || Carp::confess(q{
-CPAN::Config::commit called without an argument.
-Please specify a filename where to save the configuration or try
-"o conf init" to have an interactive course through configing.
-});
+
+ # use provided name or the current config or create a new MyConfig
+ $configpm ||= require_myconfig_or_config() || make_new_config();
+
+ # commit to MyConfig if we can't write to Config
+ if ( ! -w $configpm && $configpm =~ m{CPAN/Config\.pm} ) {
+ my $myconfig = _new_config_name();
+ $CPAN::Frontend->mywarn(
+ "Your $configpm file\n".
+ "is not writable. I will attempt to write your configuration to\n" .
+ "$myconfig instead.\n\n"
+ );
+ $configpm = make_new_config();
+ $must_reload++; # so it gets loaded as $INC{'CPAN/MyConfig.pm'}
}
+
+ # XXX why not just "-w $configpm"? -- dagolden, 2011-01-19
my($mode);
if (-f $configpm) {
$mode = (stat $configpm)[2];
if ($mode && ! -w _) {
- Carp::confess("$configpm is not writable");
+ _die_cant_write_config($configpm);
}
}
+ $self->_write_config_file($configpm);
+ require_myconfig_or_config() if $must_reload;
+
+ #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
+ #chmod $mode, $configpm;
+###why was that so? $self->defaults;
+ $CPAN::Frontend->myprint("commit: wrote '$configpm'\n");
+ $CPAN::CONFIG_DIRTY = 0;
+ 1;
+}
+
+sub _write_config_file {
+ my ($self, $configpm) = @_;
my $msg;
- my $home = home();
- $msg = <<EOF unless $configpm =~ /MyConfig/;
+ $msg = <<EOF if $configpm =~ m{CPAN/Config\.pm};
# This is CPAN.pm's systemwide configuration file. This file provides
# defaults for users, and the values can be changed in a per-user
-# configuration file. The user-config file is being looked for as
-# $home/.cpan/CPAN/MyConfig.pm.
+# configuration file.
EOF
$msg ||= "\n";
@@ -317,18 +345,13 @@ EOF
",\n"
);
}
-
$fh->print("};\n1;\n__END__\n");
close $fh;
- #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
- #chmod $mode, $configpm;
-###why was that so? $self->defaults;
- $CPAN::Frontend->myprint("commit: wrote '$configpm'\n");
- $CPAN::CONFIG_DIRTY = 0;
- 1;
+ return;
}
+
# stolen from MakeMaker; not taking the original because it is buggy;
# bugreport will have to say: keys of hashes remain unquoted and can
# produce syntax errors
@@ -438,154 +461,177 @@ else: quote it with the correct quote type for the box we're on
sub init {
my($self,@args) = @_;
CPAN->debug("self[$self]args[".join(",",@args)."]");
- $self->load(doit => 1, @args);
+ $self->load(do_init => 1, @args);
1;
}
-# This is a piece of repeated code that is abstracted here for
-# maintainability. RMB
+# Loads CPAN::MyConfig or fall-back to CPAN::Config. Will not reload a file
+# if already loaded. Returns the path to the file %INC or else the empty string
#
-sub _configpmtest {
- my($configpmdir, $configpmtest) = @_;
- if (-w $configpmtest) {
- return $configpmtest;
- } elsif (-w $configpmdir) {
- #_#_# following code dumped core on me with 5.003_11, a.k.
- my $configpm_bak = "$configpmtest.bak";
- unlink $configpm_bak if -f $configpm_bak;
- if( -f $configpmtest ) {
- if( rename $configpmtest, $configpm_bak ) {
- $CPAN::Frontend->mywarn(<<END);
-Old configuration file $configpmtest
- moved to $configpm_bak
-END
+# Note -- if CPAN::Config were loaded and CPAN::MyConfig subsequently
+# created, calling this again will leave *both* in %INC
+
+sub require_myconfig_or_config () {
+ if ( $INC{"CPAN/MyConfig.pm"} || _try_loading("CPAN::MyConfig", cpan_home())) {
+ return $INC{"CPAN/MyConfig.pm"};
}
+ elsif ( $INC{"CPAN/Config.pm"} || _try_loading("CPAN::Config") ) {
+ return $INC{"CPAN/Config.pm"};
}
- my $fh = FileHandle->new;
- if ($fh->open(">$configpmtest")) {
- $fh->print("1;\n");
- return $configpmtest;
- } else {
- # Should never happen
- Carp::confess("Cannot open >$configpmtest");
+ else {
+ return q{};
}
- } else { return }
}
-sub require_myconfig_or_config () {
- return if $INC{"CPAN/MyConfig.pm"};
+# Load a module, but ignore "can't locate..." errors
+# Optionally take a list of directories to add to @INC for the load
+sub _try_loading {
+ my ($module, @dirs) = @_;
+ (my $file = $module) =~ s{::}{/}g;
+ $file .= ".pm";
+
local @INC = @INC;
- my $home = home();
- unshift @INC, File::Spec->catdir($home,'.cpan');
- eval { require CPAN::MyConfig };
- my $err_myconfig = $@;
- if ($err_myconfig and $err_myconfig !~ m#locate CPAN/MyConfig\.pm#) {
- die "Error while requiring CPAN::MyConfig:\n$err_myconfig";
+ for my $dir ( @dirs ) {
+ if ( -f File::Spec->catfile($dir, $file) ) {
+ unshift @INC, $dir;
+ last;
}
- unless ($INC{"CPAN/MyConfig.pm"}) { # this guy has settled his needs already
- eval {require CPAN::Config;}; # not everybody has one
- my $err_config = $@;
- if ($err_config and $err_config !~ m#locate CPAN/Config\.pm#) {
- die "Error while requiring CPAN::Config:\n$err_config";
}
+
+ eval { require $file };
+ my $err_myconfig = $@;
+ if ($err_myconfig and $err_myconfig !~ m#locate \Q$file\E#) {
+ die "Error while requiring ${module}:\n$err_myconfig";
}
+ return $INC{$file};
}
-sub home () {
- my $home;
- # Suppress load messages until we load the config and know whether
- # load messages are desired. Otherwise, it's unexpected and odd
- # why one load message pops up even when verbosity is turned off.
- # This means File::HomeDir load messages are never seen, but I
- # think that's probably OK -- DAGOLDEN
-
- # 5.6.2 seemed to segfault localizing a value in a hashref
- # so do it manually instead
+# prioritized list of possible places for finding "CPAN/MyConfig.pm"
+sub cpan_home_dir_candidates {
+ my @dirs;
my $old_v = $CPAN::Config->{load_module_verbosity};
$CPAN::Config->{load_module_verbosity} = q[none];
- if ($CPAN::META->has_usable("File::HomeDir")) {
- if ($^O eq 'darwin') {
- $home = File::HomeDir->my_home; # my_data is ~/Library/Application Support on darwin,
+ if ($CPAN::META->has_usable('File::HomeDir')) {
+ if ($^O ne 'darwin') {
+ push @dirs, File::HomeDir->my_data;
+ # my_data is ~/Library/Application Support on darwin,
# which causes issues in the toolchain.
}
- else {
- $home = File::HomeDir->my_data || File::HomeDir->my_home;
- }
- }
- unless (defined $home) {
- $home = $ENV{HOME};
+ push @dirs, File::HomeDir->my_home;
}
+ # Windows might not have HOME, so check it first
+ push @dirs, $ENV{HOME} if $ENV{HOME};
+ # Windows might have these instead
+ push( @dirs, File::Spec->catpath($ENV{HOMEDRIVE}, $ENV{HOMEPATH}, '') )
+ if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
+ push @dirs, $ENV{USERPROFILE} if $ENV{USERPROFILE};
+
$CPAN::Config->{load_module_verbosity} = $old_v;
- $home;
+ @dirs = map { "$_/.cpan" } grep { defined } @dirs;
+ return wantarray ? @dirs : $dirs[0];
}
sub load {
my($self, %args) = @_;
- $CPAN::Be_Silent++ if $args{be_silent};
- my $doit;
- $doit = delete $args{doit} || 0;
+ $CPAN::Be_Silent+=0; # protect against 'used only once'
+ $CPAN::Be_Silent++ if $args{be_silent}; # do not use; planned to be removed in 2011
+ my $do_init = delete $args{do_init} || 0;
+ my $make_myconfig = delete $args{make_myconfig};
$loading = 0 unless defined $loading;
- use Carp;
- require_myconfig_or_config;
+ my $configpm = require_myconfig_or_config;
my @miss = $self->missing_config_data;
- CPAN->debug("doit[$doit]loading[$loading]miss[@miss]") if $CPAN::DEBUG;
- return unless $doit || @miss;
+ CPAN->debug("do_init[$do_init]loading[$loading]miss[@miss]") if $CPAN::DEBUG;
+ return unless $do_init || @miss;
+
+ # I'm not how we'd ever wind up in a recursive loop, but I'm leaving
+ # this here for safety's sake -- dagolden, 2011-01-19
return if $loading;
local $loading = ($loading||0) + 1;
- require CPAN::FirstTime;
- my($redo,$configpm,$fh);
- if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
- $configpm = $INC{"CPAN/Config.pm"};
- $redo++;
- } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
- $configpm = $INC{"CPAN/MyConfig.pm"};
- $redo++;
- } else {
- my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
- my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN");
- my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm");
- my $inc_key;
- if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
- $configpm = _configpmtest($configpmdir,$configpmtest);
- $inc_key = "CPAN/Config.pm";
- }
- unless ($configpm) {
- $configpmdir = File::Spec->catdir(home,".cpan","CPAN");
- File::Path::mkpath($configpmdir);
- $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm");
- $configpm = _configpmtest($configpmdir,$configpmtest);
- $inc_key = "CPAN/MyConfig.pm";
+ # Warn if we have a config file, but things were found missing
+ if ($configpm && @miss && !$do_init) {
+ if ($make_myconfig || ( ! -w $configpm && $configpm =~ m{CPAN/Config\.pm})) {
+ $configpm = make_new_config();
+ $CPAN::Frontend->myprint(<<END);
+The system CPAN configuration file has provided some default values,
+but you need to complete the configuration dialog for CPAN.pm.
+Configuration will be written to
+ <<$configpm>>
+END
}
- if ($configpm) {
- $INC{$inc_key} = $configpm;
- } else {
- my $myconfigpm = File::Spec->catfile(home,".cpan","CPAN","MyConfig.pm");
- $CPAN::Frontend->mydie(<<"END");
-WARNING: CPAN.pm is unable to write a configuration file. You need write
-access to your default perl library directories or you must be able to
-create and write to '$myconfigpm'.
+ else {
+ $CPAN::Frontend->myprint(<<END);
+Sorry, we have to rerun the configuration dialog for CPAN.pm due to
+some missing parameters. Configuration will be written to
+ <<$configpm>>
-Aborting configuration.
END
}
+ }
+ require CPAN::FirstTime;
+ return CPAN::FirstTime::init($configpm || make_new_config(), %args);
+}
+
+# Creates a new, empty config file at the preferred location
+# Any existing will be renamed with a ".bak" suffix if possible
+# If the file cannot be created, an exception is thrown
+sub make_new_config {
+ my $configpm = _new_config_name();
+ my $configpmdir = File::Basename::dirname( $configpm );
+ File::Path::mkpath($configpmdir) unless -d $configpmdir;
+
+ if ( -w $configpmdir ) {
+ #_#_# following code dumped core on me with 5.003_11, a.k.
+ if( -f $configpm ) {
+ my $configpm_bak = "$configpm.bak";
+ unlink $configpm_bak if -f $configpm_bak;
+ if( rename $configpm, $configpm_bak ) {
+ $CPAN::Frontend->mywarn(<<END);
+Old configuration file $configpm
+ moved to $configpm_bak
+END
}
- local($") = ", ";
- if ($redo && !$doit) {
- $CPAN::Frontend->myprint(<<END);
-Sorry, we have to rerun the configuration dialog for CPAN.pm due to
-some missing parameters... Will write to
- <<$configpm>>
+ }
+ my $fh = FileHandle->new;
+ if ($fh->open(">$configpm")) {
+ $fh->print("1;\n");
+ return $configpm;
+ }
+ }
+ _die_cant_write_config($configpm);
+}
+
+sub _die_cant_write_config {
+ my ($configpm) = @_;
+ $CPAN::Frontend->mydie(<<"END");
+WARNING: CPAN.pm is unable to write a configuration file. You
+must be able to create and write to '$configpm'.
+Aborting configuration.
END
- $args{args} = \@miss;
+
+}
+
+# From candidate directories, we would like (in descending preference order):
+# * the one that contains a MyConfig file
+# * one that exists (even without MyConfig)
+# * the first one on the list
+sub cpan_home {
+ my @dirs = cpan_home_dir_candidates();
+ for my $d (@dirs) {
+ return $d if -f "$d/CPAN/MyConfig.pm";
}
- my $initialized = CPAN::FirstTime::init($configpm, %args);
- return $initialized;
+ for my $d (@dirs) {
+ return $d if -d $d;
+ }
+ return $dirs[0];
}
+sub _new_config_name {
+ return File::Spec->catfile(cpan_home(), 'CPAN', 'MyConfig.pm');
+}
# returns mandatory but missing entries in the Config
sub missing_config_data {
@@ -739,3 +785,4 @@ modify it under the same terms as Perl itself.
# mode: cperl
# cperl-indent-level: 4
# End:
+# vim: ts=4 sts=4 sw=4: