1 package CPAN::HandleConfig;
3 use vars qw(%can %keys $loading $VERSION);
8 commit => "Commit changes to disk",
9 defaults => "Reload defaults from disk",
10 help => "Short help about 'o conf' usage",
11 init => "Interactive setting of all options",
14 # Q: where is the "How do I add a new config option" HOWTO?
15 # A1: svn diff -r 757:758 # where dagolden added test_report
16 # A2: svn diff -r 985:986 # where andk added yaml_module
17 # A3: 1. add new config option to %keys below
18 # 2. add a Pod description in CPAN::FirstTime; it should include a
19 # prompt line; see others for examples
20 # 3. add a "matcher" section in CPAN::FirstTime::init that includes
21 # a prompt function; see others for examples
22 # 4. add config option to documentation section in CPAN.pm
24 %keys = map { $_ => undef }
31 "build_requires_install_policy",
39 "commandnumber_in_prompt",
41 "connect_to_internet_ok",
44 "dontload_hash", # deprecated after 1.83_68 (rev. 581)
60 "inhibit_startup_message",
62 "load_module_verbosity",
67 "make_install_make_command",
71 "mbuild_install_build_command",
83 "prerequisites_policy",
89 "show_unparsable_versions",
97 "trust_test_report_history",
108 my %prefssupport = map { $_ => 1 }
110 "build_requires_install_policy",
113 "make_install_make_command",
118 # returns true on successful action
120 my($self,@args) = @_;
122 CPAN->debug("self[$self]args[".join(" | ",@args)."]");
123 my($o,$str,$func,$args,$key_exists);
126 $self->$o(args => \@args); # o conf init => sub init => sub load
129 CPAN->debug("o[$o]") if $CPAN::DEBUG;
130 unless (exists $keys{$o}) {
131 $CPAN::Frontend->mywarn("Warning: unknown configuration variable '$o'\n");
136 # one day I used randomize_urllist for a boolean, so we must
137 # list them explicitly --ak
139 } elsif ($o =~ /^(wait_list|urllist|dontload_list)$/) {
147 CPAN->debug("func[$func]args[@args]") if $CPAN::DEBUG;
148 # Let's avoid eval, it's easier to comprehend without.
149 if ($func eq "push") {
150 push @{$CPAN::Config->{$o}}, @args;
152 } elsif ($func eq "pop") {
153 pop @{$CPAN::Config->{$o}};
155 } elsif ($func eq "shift") {
156 shift @{$CPAN::Config->{$o}};
158 } elsif ($func eq "unshift") {
159 unshift @{$CPAN::Config->{$o}}, @args;
161 } elsif ($func eq "splice") {
162 my $offset = shift @args || 0;
163 my $length = shift @args || 0;
164 splice @{$CPAN::Config->{$o}}, $offset, $length, @args; # may warn
167 $CPAN::Config->{$o} = [$func, @args];
170 $self->prettyprint($o);
173 if ($o eq "urllist") {
174 # reset the cached values
175 undef $CPAN::FTP::Thesite;
176 undef $CPAN::FTP::Themethod;
177 $CPAN::Index::LAST_TIME = 0;
178 } elsif ($o eq "dontload_list") {
179 # empty it, it will be built up again
180 $CPAN::META->{dontload_hash} = {};
183 } elsif ($o =~ /_hash$/) {
189 if (@args==1 && $args[0] eq "") {
191 } elsif (@args % 2) {
194 $CPAN::Config->{$o} = { @args };
202 if (defined $args[0]) {
203 $CPAN::CONFIG_DIRTY = 1;
204 $CPAN::Config->{$o} = $args[0];
207 $self->prettyprint($o)
208 if exists $keys{$o} or defined $CPAN::Config->{$o};
211 if ($CPAN::Config->{auto_commit}) {
214 $CPAN::CONFIG_DIRTY = 1;
215 $CPAN::Frontend->myprint("Please use 'o conf commit' to ".
216 "make the config permanent!\n\n");
224 my $v = $CPAN::Config->{$k};
227 if (ref $v eq "ARRAY") {
228 @report = map {"\t$_ \[$v->[$_]]\n"} 0..$#$v;
232 sprintf "\t%-18s => %s\n",
234 defined $v->{$_} ? "[$v->{$_}]" : "undef"
237 $CPAN::Frontend->myprint(
247 } elsif (defined $v) {
248 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
250 $CPAN::Frontend->myprint(sprintf " %-18s undef\n", $k);
255 my($self,@args) = @_;
256 CPAN->debug("args[@args]") if $CPAN::DEBUG;
257 if ($CPAN::RUN_DEGRADED) {
258 $CPAN::Frontend->mydie(
259 "'o conf commit' disabled in ".
260 "degraded mode. Maybe try\n".
261 " !undef \$CPAN::RUN_DEGRADED\n"
266 if ($args[0] eq "args") {
267 # we have not signed that contract
269 $configpm = $args[0];
272 unless (defined $configpm) {
273 $configpm ||= $INC{"CPAN/MyConfig.pm"};
274 $configpm ||= $INC{"CPAN/Config.pm"};
275 $configpm || Carp::confess(q{
276 CPAN::Config::commit called without an argument.
277 Please specify a filename where to save the configuration or try
278 "o conf init" to have an interactive course through configing.
283 $mode = (stat $configpm)[2];
284 if ($mode && ! -w _) {
285 Carp::confess("$configpm is not writable");
291 $msg = <<EOF unless $configpm =~ /MyConfig/;
293 # This is CPAN.pm's systemwide configuration file. This file provides
294 # defaults for users, and the values can be changed in a per-user
295 # configuration file. The user-config file is being looked for as
296 # $home/.cpan/CPAN/MyConfig.pm.
300 my($fh) = FileHandle->new;
301 rename $configpm, "$configpm~" if -f $configpm;
302 open $fh, ">$configpm" or
303 $CPAN::Frontend->mydie("Couldn't open >$configpm: $!");
304 $fh->print(qq[$msg\$CPAN::Config = \{\n]);
305 foreach (sort keys %$CPAN::Config) {
306 unless (exists $keys{$_}) {
307 # do not drop them: forward compatibility!
308 $CPAN::Frontend->mywarn("Unknown config variable '$_'\n");
313 $self->neatvalue($CPAN::Config->{$_}),
318 $fh->print("};\n1;\n__END__\n");
321 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
322 #chmod $mode, $configpm;
323 ###why was that so? $self->defaults;
324 $CPAN::Frontend->myprint("commit: wrote '$configpm'\n");
325 $CPAN::CONFIG_DIRTY = 0;
329 # stolen from MakeMaker; not taking the original because it is buggy;
330 # bugreport will have to say: keys of hashes remain unquoted and can
331 # produce syntax errors
334 return "undef" unless defined $v;
343 foreach my $elem (@$v) {
344 push @neat, "q[$elem]";
346 push @m, join ", ", @neat;
350 return "$v" unless $t eq 'HASH';
352 while (($key,$val) = each %$v) {
353 last unless defined $key; # cautious programming in case (undef,undef) is true
354 push(@m,"q[$key]=>".$self->neatvalue($val)) ;
356 return "{ ".join(', ',@m)." }";
361 if ($CPAN::RUN_DEGRADED) {
362 $CPAN::Frontend->mydie(
363 "'o conf defaults' disabled in ".
364 "degraded mode. Maybe try\n".
365 " !undef \$CPAN::RUN_DEGRADED\n"
369 for my $config (qw(CPAN/MyConfig.pm CPAN/Config.pm)) {
371 CPAN->debug("INC{'$config'}[$INC{$config}]") if $CPAN::DEBUG;
372 CPAN::Shell->_reload_this($config,{reloforce => 1});
373 $CPAN::Frontend->myprint("'$INC{$config}' reread\n");
377 $CPAN::CONFIG_DIRTY = 0;
381 =head2 C<< CLASS->safe_quote ITEM >>
383 Quotes an item to become safe against spaces
384 in shell interpolation. An item is enclosed
387 - the item contains spaces in the middle
388 - the item does not start with a quote
390 This happens to avoid shell interpolation
391 problems when whitespace is present in
394 This method uses C<commands_quote> to determine
395 the correct quote. If C<commands_quote> is
396 a space, no quoting will take place.
399 if it starts and ends with the same quote character: leave it as it is
401 if it contains no whitespace: leave it as it is
403 if it contains whitespace, then
405 if it contains quotes: better leave it as it is
407 else: quote it with the correct quote type for the box we're on
412 # Instead of patching the guess, set commands_quote
414 my ($quotes,$use_quote)
421 my ($self, $command) = @_;
422 # Set up quote/default quote
423 my $quote = $CPAN::Config->{commands_quote} || $quotes;
426 and defined($command )
428 and $command !~ /[$quote]/) {
429 return qq<$use_quote$command$use_quote>
436 my($self,@args) = @_;
437 CPAN->debug("self[$self]args[".join(",",@args)."]");
438 $self->load(doit => 1, @args);
442 # This is a piece of repeated code that is abstracted here for
443 # maintainability. RMB
446 my($configpmdir, $configpmtest) = @_;
447 if (-w $configpmtest) {
448 return $configpmtest;
449 } elsif (-w $configpmdir) {
450 #_#_# following code dumped core on me with 5.003_11, a.k.
451 my $configpm_bak = "$configpmtest.bak";
452 unlink $configpm_bak if -f $configpm_bak;
453 if( -f $configpmtest ) {
454 if( rename $configpmtest, $configpm_bak ) {
455 $CPAN::Frontend->mywarn(<<END);
456 Old configuration file $configpmtest
457 moved to $configpm_bak
461 my $fh = FileHandle->new;
462 if ($fh->open(">$configpmtest")) {
464 return $configpmtest;
466 # Should never happen
467 Carp::confess("Cannot open >$configpmtest");
472 sub require_myconfig_or_config () {
473 return if $INC{"CPAN/MyConfig.pm"};
476 unshift @INC, File::Spec->catdir($home,'.cpan');
477 eval { require CPAN::MyConfig };
478 my $err_myconfig = $@;
479 if ($err_myconfig and $err_myconfig !~ m#locate CPAN/MyConfig\.pm#) {
480 die "Error while requiring CPAN::MyConfig:\n$err_myconfig";
482 unless ($INC{"CPAN/MyConfig.pm"}) { # this guy has settled his needs already
483 eval {require CPAN::Config;}; # not everybody has one
485 if ($err_config and $err_config !~ m#locate CPAN/Config\.pm#) {
486 die "Error while requiring CPAN::Config:\n$err_config";
493 # Suppress load messages until we load the config and know whether
494 # load messages are desired. Otherwise, it's unexpected and odd
495 # why one load message pops up even when verbosity is turned off.
496 # This means File::HomeDir load messages are never seen, but I
497 # think that's probably OK -- DAGOLDEN
499 # 5.6.2 seemed to segfault localizing a value in a hashref
500 # so do it manually instead
501 my $old_v = $CPAN::Config->{load_module_verbosity};
502 $CPAN::Config->{load_module_verbosity} = q[none];
503 if ($CPAN::META->has_usable("File::HomeDir")) {
504 $home = File::HomeDir->can('my_dot_config')
505 ? File::HomeDir->my_dot_config
506 : File::HomeDir->my_data;
507 unless (defined $home) {
508 $home = File::HomeDir->my_home
511 unless (defined $home) {
514 $CPAN::Config->{load_module_verbosity} = $old_v;
519 my($self, %args) = @_;
520 $CPAN::Be_Silent++ if $args{be_silent};
522 $doit = delete $args{doit};
525 require_myconfig_or_config;
526 my @miss = $self->missing_config_data;
527 CPAN->debug("doit[$doit]loading[$loading]miss[@miss]") if $CPAN::DEBUG;
528 return unless $doit || @miss;
532 require CPAN::FirstTime;
533 my($configpm,$fh,$redo);
535 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
536 $configpm = $INC{"CPAN/Config.pm"};
538 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
539 $configpm = $INC{"CPAN/MyConfig.pm"};
542 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
543 my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN");
544 my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm");
546 if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
547 $configpm = _configpmtest($configpmdir,$configpmtest);
548 $inc_key = "CPAN/Config.pm";
551 $configpmdir = File::Spec->catdir(home,".cpan","CPAN");
552 File::Path::mkpath($configpmdir);
553 $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm");
554 $configpm = _configpmtest($configpmdir,$configpmtest);
555 $inc_key = "CPAN/MyConfig.pm";
558 $INC{$inc_key} = $configpm;
560 my $text = qq{WARNING: CPAN.pm is unable to } .
561 qq{create a configuration file.};
562 output($text, 'confess');
567 if ($redo && !$doit) {
568 $CPAN::Frontend->myprint(<<END);
569 Sorry, we have to rerun the configuration dialog for CPAN.pm due to
570 some missing parameters...
573 $args{args} = \@miss;
575 CPAN::FirstTime::init($configpm, %args);
581 # returns mandatory but missing entries in the Config
582 sub missing_config_data {
594 #"inhibit_startup_message",
601 "mbuild_install_arg",
602 ($^O eq "MSWin32" ? "" : "mbuild_install_build_command"),
606 "prerequisites_policy",
612 next unless exists $keys{$_};
613 push @miss, $_ unless defined $CPAN::Config->{$_};
619 $CPAN::Frontend->myprint(q[
621 commit commit session changes to disk
622 defaults reload default config values from disk
624 init enter a dialog to set all or a set of parameters
626 Edit key values as in the following (the "o" is a literal letter o):
627 o conf build_cache 15
628 o conf build_dir "/foo/bar"
630 o conf urllist unshift ftp://ftp.foo.bar/
631 o conf inhibit_startup_message 1
634 undef; #don't reprint CPAN::Config
638 my($word,$line,$pos) = @_;
640 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
641 my(@words) = split " ", substr($line,0,$pos+1);
650 @words == 4 && length($word)
653 return grep /^\Q$word\E/, qw(splice shift unshift pop push);
654 } elsif (defined($words[2])
661 @words >= 4 && length($word)
663 return sort grep /^\Q$word\E/, keys %keys;
664 } elsif (@words >= 4) {
668 my(@o_conf) = sort grep { !$seen{$_}++ }
672 return grep /^\Q$word\E/, @o_conf;
676 my($self,$distro,$what) = @_;
678 if ($prefssupport{$what}) {
679 return $CPAN::Config->{$what} unless
682 and $distro->prefs->{cpanconfig}
683 and defined $distro->prefs->{cpanconfig}{$what};
684 return $distro->prefs->{cpanconfig}{$what};
686 $CPAN::Frontend->mywarn("Warning: $what not yet officially ".
687 "supported for distroprefs, doing a normal lookup");
688 return $CPAN::Config->{$what};
695 CPAN::Config; ####::###### #hide from indexer
696 # note: J. Nick Koston wrote me that they are using
697 # CPAN::Config->commit although undocumented. I suggested
698 # CPAN::Shell->o("conf","commit") even when ugly it is at least
701 # that's why I added the CPAN::Config class with autoload and
705 use vars qw($AUTOLOAD $VERSION);
708 # formerly CPAN::HandleConfig was known as CPAN::Config
709 sub AUTOLOAD { ## no critic
710 my $class = shift; # e.g. in dh-make-perl: CPAN::Config
712 $CPAN::Frontend->mywarn("Dispatching deprecated method '$l' to CPAN::HandleConfig\n");
714 CPAN::HandleConfig->$l(@_);
724 This program is free software; you can redistribute it and/or
725 modify it under the same terms as Perl itself.
731 # cperl-indent-level: 4