diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPAN/HandleConfig.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/CPAN/HandleConfig.pm | 307 |
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: |