diff options
Diffstat (limited to 'cpan')
| -rw-r--r-- | cpan/CPAN/Changes | 12 | ||||
| -rw-r--r-- | cpan/CPAN/lib/CPAN.pm | 89 | ||||
| -rw-r--r-- | cpan/CPAN/lib/CPAN/FTP/netrc.pm | 5 | ||||
| -rw-r--r-- | cpan/CPAN/lib/CPAN/FirstTime.pm | 108 | ||||
| -rw-r--r-- | cpan/CPAN/lib/CPAN/HandleConfig.pm | 293 | ||||
| -rw-r--r-- | cpan/CPAN/lib/CPAN/Shell.pm | 43 |
6 files changed, 242 insertions, 308 deletions
diff --git a/cpan/CPAN/Changes b/cpan/CPAN/Changes index e8bce6773d..c51f1c8721 100644 --- a/cpan/CPAN/Changes +++ b/cpan/CPAN/Changes @@ -1,3 +1,15 @@ +2011-01-20 David Golden <dagolden@cpan.org> + + * release 1.94_64 + + * remove 'use_file_homedir' config option and fix #62986 using + a more robust method. Original config directories will be found + even if File::HomeDir is installed + + * streamline configuration intro text + + * add missing documentation for 'atexit' and local::lib bootstrap + 2011-01-16 Andreas J. Koenig <andk@cpan.org> * release 1.94_63 diff --git a/cpan/CPAN/lib/CPAN.pm b/cpan/CPAN/lib/CPAN.pm index 9e7385e403..7809af31bb 100644 --- a/cpan/CPAN/lib/CPAN.pm +++ b/cpan/CPAN/lib/CPAN.pm @@ -2,7 +2,7 @@ # vim: ts=4 sts=4 sw=4: use strict; package CPAN; -$CPAN::VERSION = '1.94_63'; +$CPAN::VERSION = '1.94_64'; $CPAN::VERSION =~ s/_//; # we need to run chdir all over and we would get at wrong libraries @@ -515,27 +515,6 @@ sub _flock { } } -sub _use_file_homedir () { - my $use_file_homedir = $CPAN::Config->{use_file_homedir}; - unless (defined $use_file_homedir) { - if ($^O =~ /^(MSWin32|darwin)$/) { - $use_file_homedir = 1; - } else { - $use_file_homedir = 0; - } - } - if ($use_file_homedir - and not $CPAN::META->has_usable("File::HomeDir")) { - my $v = $File::HomeDir::VERSION; - if (CPAN::Version->vgt($v,0)) { - $CPAN::Frontend->mydie("Version of File::HomeDir ($v) is insufficient. Please upgrade or try 'o conf init use_file_homedir'"); - } else { - $CPAN::Frontend->mydie("File::HomeDir not installed. Please install it or try 'o conf init use_file_homedir'"); - } - } - return $use_file_homedir; -} - sub _yaml_module () { my $yaml_module = $CPAN::Config->{yaml_module} || "YAML"; if ( @@ -1061,8 +1040,8 @@ sub has_usable { ], 'File::HomeDir' => [ sub {require File::HomeDir; - unless (CPAN::Version->vge(File::HomeDir::->VERSION, 0.65)) { - for ("Will not use File::HomeDir, need 0.65\n") { + unless (CPAN::Version->vge(File::HomeDir::->VERSION, 0.52)) { + for ("Will not use File::HomeDir, need 0.52\n") { $CPAN::Frontend->mywarn($_); die $_; } @@ -2071,8 +2050,6 @@ currently defined: CPAN::Reporter history) unzip location of external program unzip urllist arrayref to nearby CPAN sites (or equivalent locations) - use_file_homedir use File::HomeDir to determine home directory and storage - locations use_sqlite use CPAN::SQLite for metadata storage (fast and lean) username your username if you CPAN server wants one version_timeout stops version parsing after this many seconds. @@ -3555,55 +3532,10 @@ so that STDOUT is captured in a file for later inspection. I am not root, how can I install a module in a personal directory? -First of all, you will want to use your own configuration, not the one -that your root user installed. If you do not have permission to write -in the cpan directory that root has configured, you will be asked if -you want to create your own config. Answering "yes" will bring you into -CPAN's configuration stage, using the system config for all defaults except -things that have to do with CPAN's work directory, saving your choices to -your MyConfig.pm file. - -You can also manually initiate this process with the following command: - - % perl -MCPAN -e 'mkmyconfig' - -or by running - - mkmyconfig - -from the CPAN shell. - -You will most probably also want to configure something like this: - - o conf makepl_arg "LIB=~/myperl/lib \ - INSTALLMAN1DIR=~/myperl/man/man1 \ - INSTALLMAN3DIR=~/myperl/man/man3 \ - INSTALLSCRIPT=~/myperl/bin \ - INSTALLBIN=~/myperl/bin" - -and then the equivalent command for Module::Build, which is - - o conf mbuildpl_arg "--lib=~/myperl/lib \ - --installman1dir=~/myperl/man/man1 \ - --installman3dir=~/myperl/man/man3 \ - --installscript=~/myperl/bin \ - --installbin=~/myperl/bin" - -You can make this setting permanent like all C<o conf> settings with -C<o conf commit> or by setting C<auto_commit> beforehand. - -You will have to add ~/myperl/man to the MANPATH environment variable -and also tell your perl programs to look into ~/myperl/lib, e.g. by -including - - use lib "$ENV{HOME}/myperl/lib"; - -or setting the PERL5LIB environment variable. - -While we're speaking about $ENV{HOME}, it might be worth mentioning, -that for Windows and Darwin (and when use_file_homedir is turned on) -we use the File::HomeDir module that provides an equivalent to the -concept of the home directory on Unix. +As of CPAN 1.9463, if you do not have permission to write the default perl +library directories, CPAN's configuration process will ask you whether +you want to bootstrap <local::lib>, which makes keeping a personal +perl library directory easy. Another thing you should bear in mind is that the UNINST parameter can be dangerous when you are installing into a private area because you @@ -3775,9 +3707,10 @@ Speaking of the build directory. Do I have to clean it up myself? You have the choice to set the config variable C<scan_cache> to C<never>. Then you must clean it up yourself. The other possible -value, C<atstart> only cleans up the build directory when you start -the CPAN shell. If you never start up the CPAN shell, you probably -also have to clean up the build directory yourself. +values, C<atstart> and C<atexit> clean up the build directory when you +start or exit the CPAN shell, respectively. If you never start up the +CPAN shell, you probably also have to clean up the build directory +yourself. =back diff --git a/cpan/CPAN/lib/CPAN/FTP/netrc.pm b/cpan/CPAN/lib/CPAN/FTP/netrc.pm index c05405e7ef..0778e8adbc 100644 --- a/cpan/CPAN/lib/CPAN/FTP/netrc.pm +++ b/cpan/CPAN/lib/CPAN/FTP/netrc.pm @@ -1,13 +1,12 @@ package CPAN::FTP::netrc; use strict; -$CPAN::FTP::netrc::VERSION = $CPAN::FTP::netrc::VERSION = "1.00"; +$CPAN::FTP::netrc::VERSION = $CPAN::FTP::netrc::VERSION = "1.01"; # package CPAN::FTP::netrc; sub new { my($class) = @_; - my $home = CPAN::HandleConfig::home(); - my $file = File::Spec->catfile($home,".netrc"); + my $file = File::Spec->catfile($ENV{HOME},".netrc"); my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) diff --git a/cpan/CPAN/lib/CPAN/FirstTime.pm b/cpan/CPAN/lib/CPAN/FirstTime.pm index 4339b739af..bc1ccc1b46 100644 --- a/cpan/CPAN/lib/CPAN/FirstTime.pm +++ b/cpan/CPAN/lib/CPAN/FirstTime.pm @@ -10,7 +10,7 @@ use File::Path (); use File::Spec (); use CPAN::Mirrors (); use vars qw($VERSION $auto_config); -$VERSION = "5.5301"; +$VERSION = "5.5302"; =head1 NAME @@ -538,17 +538,6 @@ regardless of the history using "force". Do you want to rely on the test report history (yes/no)? -=item use_file_homedir - -Windows and Darwin have no tradition of providing a home directory for -their users, so it has been requested to support the use of -File::HomeDir. But after so many years of using File::HomeDir, this -module started to bother people because it didn't fulfil their -expectations. By setting this variable you can choose whether you want -to let File::HomeDir decide about your storage locations. - -Use File::HomeDir to determine home directory and storage locations? - =item use_sqlite CPAN::SQLite is a layer between the index files that are downloaded @@ -602,21 +591,12 @@ use vars qw( %prompts ); my @prompts = ( -manual_config => qq[ -CPAN is the world-wide archive of perl resources. It consists of about -300 sites that all replicate the same contents around the globe. Many -countries have at least one CPAN site already. The resources found on -CPAN are easily accessible with the CPAN.pm module. If you want to use -CPAN.pm, lots of things have to be configured. Fortunately, most of -them can be determined automatically. If you prefer the automatic -configuration, answer 'yes' below. - -If you prefer to enter a dialog instead, you can answer 'no' to this -question and I'll let you configure in small steps one thing after the -other. (Note: you can revisit this dialog anytime later by typing 'o -conf init' at the cpan prompt.) +auto_config => qq{ +CPAN.pm requires configuration, but most of it can be done automatically. +If you answer 'no' below, you will enter an interactive dialog for each +configuration option instead. -], +Would you like to configure as much as possible automatically?}, auto_pick => qq{ Would you like me to automatically choose some CPAN mirror @@ -797,29 +777,17 @@ sub init { #= Files, directories # - unless ($matcher) { - $CPAN::Frontend->myprint($prompts{manual_config}); - } - - my $manual_conf; - local *_real_prompt; if ( $args{autoconfig} ) { - $manual_conf = "no"; + $auto_config = 1; } elsif ($matcher) { - $manual_conf = "yes"; - } else { - my $_conf = prompt("Would you like me to configure as much as possible ". - "automatically?", "yes"); - $manual_conf = ($_conf and $_conf =~ /^y/i) ? "no" : "yes"; - } - CPAN->debug("manual_conf[$manual_conf]") if $CPAN::DEBUG; - $auto_config = 0; - { - if ($manual_conf =~ /^y/i) { $auto_config = 0; } else { - $auto_config = 1; + my $_conf = prompt($prompts{auto_config}, "yes"); + $auto_config = ($_conf and $_conf =~ /^y/i) ? 1 : 0; + } + CPAN->debug("auto_config[$auto_config]") if $CPAN::DEBUG; + if ( $auto_config ) { local $^W = 0; # prototype should match that of &MakeMaker::prompt my $current_second = time; @@ -828,7 +796,6 @@ sub init { # silent prompting -- just quietly use default *_real_prompt = sub { return $_[1] }; } - } # # bootstrap local::lib or sudo @@ -910,13 +877,12 @@ sub init { if (!$matcher or 'test_report' =~ /$matcher/) { my_yn_prompt(test_report => 0, $matcher); if ( + $matcher && $CPAN::Config->{test_report} && $CPAN::META->has_inst("CPAN::Reporter") && CPAN::Reporter->can('configure') ) { - local *_real_prompt; - *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt; - my $_conf = prompt("Would you like me configure CPAN::Reporter now?", $auto_config ? "no" : "yes"); + my $_conf = prompt("Would you like me configure CPAN::Reporter now?", "yes"); if ($_conf =~ /^y/i) { $CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n"); CPAN::Reporter::configure(); @@ -1224,7 +1190,6 @@ sub init { or 'show_unparsable_versions' =~ /$matcher/ or 'show_zero_versions' =~ /$matcher/ ) { - $CPAN::Frontend->myprint($prompts{show_unparsable_or_zero_versions_intro}); my_yn_prompt(show_unparsable_versions => 0, $matcher); my_yn_prompt(show_zero_versions => 0, $matcher); } @@ -1276,11 +1241,6 @@ sub init { $auto_config = 0; # reset } - if (!$matcher || "use_file_homedir" =~ $matcher) { - my $use_file_homedir = CPAN::_use_file_homedir(); - my_yn_prompt("use_file_homedir" => $use_file_homedir, $matcher); - } - # bootstrap local::lib now if requested if ( $CPAN::Config->{install_help} eq 'local::lib' ) { if ( ! @{ $CPAN::Config->{urllist} } ) { @@ -1289,10 +1249,10 @@ sub init { ); } else { - $CPAN::Frontend->myprint("\nAttempting to boostrap local::lib...\n"); + $CPAN::Frontend->myprint("\nAttempting to bootstrap local::lib...\n"); $CPAN::Frontend->myprint("\nWriting $configpm for bootstrap...\n"); delete $CPAN::Config->{install_help}; # temporary only - CPAN::HandleConfig->commit($configpm); + CPAN::HandleConfig->commit; my $dist; if ( $dist = CPAN::Shell->expand('Module', 'local::lib')->distribution ) { # this is a hack to force bootstrapping @@ -1324,8 +1284,15 @@ sub init { $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ". "make the config permanent!\n"); } else { - CPAN::HandleConfig->commit($configpm); + CPAN::HandleConfig->commit; } + + if (! $matcher) { + $CPAN::Frontend->myprint( + "\nYou can re-run configuration any time with 'o conf init' in the CPAN shell\n" + ); + } + } sub _local_lib_config { @@ -1407,7 +1374,7 @@ sub _local_lib_path { my $local_lib_home; sub _local_lib_home { $local_lib_home ||= File::Spec->rel2abs( do { - if (CPAN::_use_file_homedir()) { + if ($CPAN::META->has_usable("File::HomeDir") && File::HomeDir->VERSION >= 0.65) { File::HomeDir->my_home; } elsif (defined $ENV{HOME}) { $ENV{HOME}; @@ -1434,8 +1401,8 @@ sub _do_pick_mirrors { else { _print_urllist('Current') if @old_list; my $msg = scalar @old_list - ? "Would you like to edit the urllist or pick new mirrors from a list?" - : "Would you like to pick from the CPAN mirror list?" ; + ? "\nWould you like to edit the urllist or pick new mirrors from a list?" + : "\nWould you like to pick from the CPAN mirror list?" ; my $_conf = prompt($msg, "yes"); if ( $_conf =~ /^y/i ) { conf_sites(); @@ -1567,17 +1534,14 @@ HERE sub init_cpan_home { my($matcher) = @_; if (!$matcher or 'cpan_home' =~ /$matcher/) { - my $cpan_home = $CPAN::Config->{cpan_home} - || File::Spec->catdir(CPAN::HandleConfig::home(), ".cpan"); - + my $cpan_home = + $CPAN::Config->{cpan_home} || CPAN::HandleConfig::cpan_home(); if (-d $cpan_home) { - $CPAN::Frontend->myprint(qq{ - -I see you already have a directory - $cpan_home -Shall we use it as the general CPAN build and cache directory? - -}) unless $auto_config; + $CPAN::Frontend->myprint( + "\nI see you already have a directory\n" . + "\n$cpan_home\n" . + "Shall we use it as the general CPAN build and cache directory?\n\n" + ) unless $auto_config; } else { # no cpan-home, must prompt and get one $CPAN::Frontend->myprint($prompts{cpan_home_where}) unless $auto_config; @@ -1984,7 +1948,6 @@ sub bring_your_own { my($ans,@urls); my $eacnt = 0; # empty answers $CPAN::Frontend->myprint(<<'HERE'); - Now you can enter your own CPAN URLs by hand. A local CPAN mirror can be listed using a 'file:' URL like 'file:///path/to/cpan/' @@ -2038,7 +2001,6 @@ sub _print_urllist { for ( @{$CPAN::Config->{urllist} || []} ) { $CPAN::Frontend->myprint(" $_\n") }; - $CPAN::Frontend->myprint("\n"); } sub _can_write_to_libdirs { @@ -2073,7 +2035,7 @@ sub prompt ($;$) { my $ans = _real_prompt(@_); _strip_spaces($ans); - $CPAN::Frontend->myprint("\n"); + $CPAN::Frontend->myprint("\n") unless $auto_config; return $ans; } diff --git a/cpan/CPAN/lib/CPAN/HandleConfig.pm b/cpan/CPAN/lib/CPAN/HandleConfig.pm index cca1186077..5007934a57 100644 --- a/cpan/CPAN/lib/CPAN/HandleConfig.pm +++ b/cpan/CPAN/lib/CPAN/HandleConfig.pm @@ -1,8 +1,11 @@ package CPAN::HandleConfig; use strict; use vars qw(%can %keys $loading $VERSION); +use File::Path (); +use File::Basename (); +use Carp (); -$VERSION = "5.5001"; # see also CPAN::Config::VERSION at end of file +$VERSION = "5.5002"; # see also CPAN::Config::VERSION at end of file %can = ( commit => "Commit changes to disk", @@ -98,7 +101,6 @@ $VERSION = "5.5001"; # see also CPAN::Config::VERSION at end of file "trust_test_report_history", "unzip", "urllist", - "use_file_homedir", "use_sqlite", "username", "version_timeout", @@ -256,6 +258,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; @@ -266,7 +270,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 @@ -274,31 +280,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"; @@ -319,18 +344,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 @@ -440,155 +460,171 @@ 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::_use_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; } + push @dirs, $ENV{HOME}; $CPAN::Config->{load_module_verbosity} = $old_v; - $home; + @dirs = map { "$_/.cpan" } @dirs; + return wantarray ? @dirs : $dirs[0]; } sub load { my($self, %args) = @_; $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 $doit; - $doit = delete $args{doit} || 0; + 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 { @@ -742,3 +778,4 @@ modify it under the same terms as Perl itself. # mode: cperl # cperl-indent-level: 4 # End: +# vim: ts=4 sts=4 sw=4: diff --git a/cpan/CPAN/lib/CPAN/Shell.pm b/cpan/CPAN/lib/CPAN/Shell.pm index 285ffc5d49..9effb0d2e7 100644 --- a/cpan/CPAN/lib/CPAN/Shell.pm +++ b/cpan/CPAN/lib/CPAN/Shell.pm @@ -47,7 +47,7 @@ use vars qw( "CPAN/Tarzip.pm", "CPAN/Version.pm", ); -$VERSION = "5.5001"; +$VERSION = "5.5002"; # record the initial timestamp for reload. $reload = { map {$INC{$_} ? ($_,(stat $INC{$_})[9]) : ()} @relo }; @CPAN::Shell::ISA = qw(CPAN::Debug); @@ -375,16 +375,8 @@ sub o { $cfilter ||= ""; my $qrfilter = eval 'qr/$cfilter/'; my($k,$v); - $CPAN::Frontend->myprint("\$CPAN::Config options from "); - my @from; - if (exists $INC{'CPAN/Config.pm'}) { - push @from, $INC{'CPAN/Config.pm'}; - } - if (exists $INC{'CPAN/MyConfig.pm'}) { - push @from, $INC{'CPAN/MyConfig.pm'}; - } - $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from); - $CPAN::Frontend->myprint(":\n"); + my $configpm = CPAN::HandleConfig->require_myconfig_or_config; + $CPAN::Frontend->myprint("\$CPAN::Config options from $configpm\:\n"); for $k (sort keys %CPAN::HandleConfig::can) { next unless $k =~ /$qrfilter/; $v = $CPAN::HandleConfig::can{$k}; @@ -655,22 +647,21 @@ sub _reload_this { #-> sub CPAN::Shell::mkmyconfig ; sub mkmyconfig { - my($self, $cpanpm, %args) = @_; + my($self) = @_; + if ( my $configpm = $INC{'CPAN/MyConfig.pm'} ) { + $CPAN::Frontend->myprint( + "CPAN::MyConfig already exists as $configpm.\n" . + "Running configuration again...\n" + ); require CPAN::FirstTime; - my $home = CPAN::HandleConfig::home(); - $cpanpm = $INC{'CPAN/MyConfig.pm'} || - File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm"); - File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm; - CPAN::HandleConfig::require_myconfig_or_config(); - $CPAN::Config ||= {}; - $CPAN::Config = { - %$CPAN::Config, - build_dir => undef, - cpan_home => undef, - keep_source_where => undef, - histfile => undef, - }; - CPAN::FirstTime::init($cpanpm, %args); + CPAN::FirstTime::init($configpm); + } + else { + # force some missing values to be filled in with defaults + delete $CPAN::Config->{$_} + for qw/build_dir cpan_home keep_source_where histfile/; + CPAN::HandleConfig->load( make_myconfig => 1 ); + } } #-> sub CPAN::Shell::_binary_extensions ; |