1 package CPAN::HandleConfig;
3 use vars qw(%can %keys $VERSION);
5 $VERSION = sprintf "%.6f", substr(q$Rev: 1315 $,4)/1000000 + 5.4;
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 %keys = map { $_ => undef }
22 "build_requires_install_policy",
29 "commandnumber_in_prompt",
33 "dontload_hash", # deprecated after 1.83_68 (rev. 581)
46 "inhibit_startup_message",
52 "make_install_make_command",
56 "mbuild_install_build_command",
65 "prerequisites_policy",
85 my %prefssupport = map { $_ => 1 }
87 "build_requires_install_policy",
90 "make_install_make_command",
95 if ($^O eq "MSWin32") {
97 mbuild_install_build_command
98 make_install_make_command
101 if (exists $CPAN::Config->{$k}) {
102 for ("deleting previously set config variable '$k' => '$CPAN::Config->{$k}'") {
103 $CPAN::Frontend ? $CPAN::Frontend->mywarn($_) : warn $_;
105 delete $CPAN::Config->{$k};
110 # returns true on successful action
112 my($self,@args) = @_;
114 CPAN->debug("self[$self]args[".join(" | ",@args)."]");
115 my($o,$str,$func,$args,$key_exists);
119 $self->$o(args => \@args); # o conf init => sub init => sub load
122 CPAN->debug("o[$o]") if $CPAN::DEBUG;
123 unless (exists $keys{$o}) {
124 $CPAN::Frontend->mywarn("Warning: unknown configuration variable '$o'\n");
126 # one day I used randomize_urllist for a boolean, so we must
127 # list them explicitly --ak
128 if ($o =~ /^(wait_list|urllist|dontload_list)$/) {
131 CPAN->debug("func[$func]args[@args]") if $CPAN::DEBUG;
133 # Let's avoid eval, it's easier to comprehend without.
134 if ($func eq "push") {
135 push @{$CPAN::Config->{$o}}, @args;
137 } elsif ($func eq "pop") {
138 pop @{$CPAN::Config->{$o}};
140 } elsif ($func eq "shift") {
141 shift @{$CPAN::Config->{$o}};
143 } elsif ($func eq "unshift") {
144 unshift @{$CPAN::Config->{$o}}, @args;
146 } elsif ($func eq "splice") {
147 my $offset = shift @args || 0;
148 my $length = shift @args || 0;
149 splice @{$CPAN::Config->{$o}}, $offset, $length, @args; # may warn
152 $CPAN::Config->{$o} = [$func, @args];
155 $self->prettyprint($o);
158 $CPAN::CONFIG_DIRTY = 1;
159 if ($o eq "urllist") {
160 # reset the cached values
161 undef $CPAN::FTP::Thesite;
162 undef $CPAN::FTP::Themethod;
163 } elsif ($o eq "dontload_list") {
164 # empty it, it will be built up again
165 $CPAN::META->{dontload_hash} = {};
169 } elsif ($o =~ /_hash$/) {
170 if (@args==1 && $args[0] eq ""){
172 } elsif (@args % 2) {
175 $CPAN::Config->{$o} = { @args };
176 $CPAN::CONFIG_DIRTY = 1;
178 if (defined $args[0]){
179 $CPAN::CONFIG_DIRTY = 1;
180 $CPAN::Config->{$o} = $args[0];
182 $self->prettyprint($o)
183 if exists $keys{$o} or defined $CPAN::Config->{$o};
191 my $v = $CPAN::Config->{$k};
194 if (ref $v eq "ARRAY") {
195 @report = map {"\t$_ \[$v->[$_]]\n"} 0..$#$v;
197 @report = map { sprintf("\t%-18s => %s\n",
199 defined $v->{$_} ? $v->{$_} : "UNDEFINED"
202 $CPAN::Frontend->myprint(
212 } elsif (defined $v) {
213 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
215 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, "UNDEFINED");
220 my($self,@args) = @_;
221 CPAN->debug("args[@args]") if $CPAN::DEBUG;
222 if ($CPAN::RUN_DEGRADED) {
223 $CPAN::Frontend->mydie(
224 "'o conf commit' disabled in ".
225 "degraded mode. Maybe try\n".
226 " !undef \$CPAN::RUN_DEGRADED\n"
231 if ($args[0] eq "args") {
232 # we have not signed that contract
234 $configpm = $args[0];
237 unless (defined $configpm){
238 $configpm ||= $INC{"CPAN/MyConfig.pm"};
239 $configpm ||= $INC{"CPAN/Config.pm"};
240 $configpm || Carp::confess(q{
241 CPAN::Config::commit called without an argument.
242 Please specify a filename where to save the configuration or try
243 "o conf init" to have an interactive course through configing.
248 $mode = (stat $configpm)[2];
249 if ($mode && ! -w _) {
250 Carp::confess("$configpm is not writable");
255 $msg = <<EOF unless $configpm =~ /MyConfig/;
257 # This is CPAN.pm's systemwide configuration file. This file provides
258 # defaults for users, and the values can be changed in a per-user
259 # configuration file. The user-config file is being looked for as
260 # ~/.cpan/CPAN/MyConfig.pm.
264 my($fh) = FileHandle->new;
265 rename $configpm, "$configpm~" if -f $configpm;
266 open $fh, ">$configpm" or
267 $CPAN::Frontend->mydie("Couldn't open >$configpm: $!");
268 $fh->print(qq[$msg\$CPAN::Config = \{\n]);
269 foreach (sort keys %$CPAN::Config) {
270 unless (exists $keys{$_}) {
271 $CPAN::Frontend->mywarn("Dropping unknown config variable '$_'\n");
272 delete $CPAN::Config->{$_};
277 $self->neatvalue($CPAN::Config->{$_}),
282 $fh->print("};\n1;\n__END__\n");
285 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
286 #chmod $mode, $configpm;
287 ###why was that so? $self->defaults;
288 $CPAN::Frontend->myprint("commit: wrote '$configpm'\n");
289 $CPAN::CONFIG_DIRTY = 0;
293 # stolen from MakeMaker; not taking the original because it is buggy;
294 # bugreport will have to say: keys of hashes remain unquoted and can
295 # produce syntax errors
298 return "undef" unless defined $v;
307 foreach my $elem (@$v) {
308 push @neat, "q[$elem]";
310 push @m, join ", ", @neat;
314 return "$v" unless $t eq 'HASH';
316 while (($key,$val) = each %$v){
317 last unless defined $key; # cautious programming in case (undef,undef) is true
318 push(@m,"q[$key]=>".$self->neatvalue($val)) ;
320 return "{ ".join(', ',@m)." }";
325 if ($CPAN::RUN_DEGRADED) {
326 $CPAN::Frontend->mydie(
327 "'o conf defaults' disabled in ".
328 "degraded mode. Maybe try\n".
329 " !undef \$CPAN::RUN_DEGRADED\n"
333 for my $config (qw(CPAN/MyConfig.pm CPAN/Config.pm)) {
335 CPAN->debug("INC{'$config'}[$INC{$config}]") if $CPAN::DEBUG;
336 CPAN::Shell->reload_this($config,{force => 1});
337 $CPAN::Frontend->myprint("'$INC{$config}' reread\n");
341 $CPAN::CONFIG_DIRTY = 0;
345 =head2 C<< CLASS->safe_quote ITEM >>
347 Quotes an item to become safe against spaces
348 in shell interpolation. An item is enclosed
351 - the item contains spaces in the middle
352 - the item does not start with a quote
354 This happens to avoid shell interpolation
355 problems when whitespace is present in
358 This method uses C<commands_quote> to determine
359 the correct quote. If C<commands_quote> is
360 a space, no quoting will take place.
363 if it starts and ends with the same quote character: leave it as it is
365 if it contains no whitespace: leave it as it is
367 if it contains whitespace, then
369 if it contains quotes: better leave it as it is
371 else: quote it with the correct quote type for the box we're on
376 # Instead of patching the guess, set commands_quote
378 my ($quotes,$use_quote)
385 my ($self, $command) = @_;
386 # Set up quote/default quote
387 my $quote = $CPAN::Config->{commands_quote} || $quotes;
390 and defined($command )
392 and $command !~ /[$quote]/) {
393 return qq<$use_quote$command$use_quote>
400 my($self,@args) = @_;
401 undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
410 # This is a piece of repeated code that is abstracted here for
411 # maintainability. RMB
414 my($configpmdir, $configpmtest) = @_;
415 if (-w $configpmtest) {
416 return $configpmtest;
417 } elsif (-w $configpmdir) {
418 #_#_# following code dumped core on me with 5.003_11, a.k.
419 my $configpm_bak = "$configpmtest.bak";
420 unlink $configpm_bak if -f $configpm_bak;
421 if( -f $configpmtest ) {
422 if( rename $configpmtest, $configpm_bak ) {
423 $CPAN::Frontend->mywarn(<<END);
424 Old configuration file $configpmtest
425 moved to $configpm_bak
429 my $fh = FileHandle->new;
430 if ($fh->open(">$configpmtest")) {
432 return $configpmtest;
434 # Should never happen
435 Carp::confess("Cannot open >$configpmtest");
440 sub require_myconfig_or_config () {
441 return if $INC{"CPAN/MyConfig.pm"};
444 unshift @INC, File::Spec->catdir($home,'.cpan');
445 eval { require CPAN::MyConfig };
446 my $err_myconfig = $@;
447 if ($err_myconfig and $err_myconfig !~ m#locate CPAN/MyConfig\.pm#) {
448 die "Error while requiring CPAN::MyConfig:\n$err_myconfig";
450 unless ($INC{"CPAN/MyConfig.pm"}) { # this guy has settled his needs already
451 eval {require CPAN::Config;}; # not everybody has one
453 if ($err_config and $err_config !~ m#locate CPAN/Config\.pm#) {
454 die "Error while requiring CPAN::Config:\n$err_config";
461 if ($CPAN::META->has_usable("File::HomeDir")) {
462 $home = File::HomeDir->my_data;
470 my($self, %args) = @_;
471 $CPAN::Be_Silent++ if $args{be_silent};
475 require_myconfig_or_config;
476 return unless @miss = $self->missing_config_data;
478 require CPAN::FirstTime;
479 my($configpm,$fh,$redo,$theycalled);
481 $theycalled++ if @miss==1 && $miss[0] eq 'inhibit_startup_message';
482 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
483 $configpm = $INC{"CPAN/Config.pm"};
485 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
486 $configpm = $INC{"CPAN/MyConfig.pm"};
489 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
490 my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN");
491 my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm");
493 if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
494 $configpm = _configpmtest($configpmdir,$configpmtest);
495 $inc_key = "CPAN/Config.pm";
498 $configpmdir = File::Spec->catdir(home,".cpan","CPAN");
499 File::Path::mkpath($configpmdir);
500 $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm");
501 $configpm = _configpmtest($configpmdir,$configpmtest);
502 $inc_key = "CPAN/MyConfig.pm";
505 $INC{$inc_key} = $configpm;
507 my $text = qq{WARNING: CPAN.pm is unable to } .
508 qq{create a configuration file.};
509 output($text, 'confess');
514 if ($redo && ! $theycalled){
515 $CPAN::Frontend->myprint(<<END);
516 Sorry, we have to rerun the configuration dialog for CPAN.pm due to
517 the following indispensable but missing parameters:
521 $args{args} = \@miss;
524 # where do we need this?
525 $CPAN::Frontend->myprint(qq{
526 $configpm initialized.
529 CPAN::FirstTime::init($configpm, %args);
532 sub missing_config_data {
543 "inhibit_startup_message",
550 "mbuild_install_arg",
551 "mbuild_install_build_command",
555 "prerequisites_policy",
561 next unless exists $keys{$_};
562 push @miss, $_ unless defined $CPAN::Config->{$_};
568 $CPAN::Frontend->myprint(q[
570 commit commit session changes to disk
571 defaults reload default config values from disk
573 init enter a dialog to set all or a set of parameters
575 Edit key values as in the following (the "o" is a literal letter o):
576 o conf build_cache 15
577 o conf build_dir "/foo/bar"
579 o conf urllist unshift ftp://ftp.foo.bar/
580 o conf inhibit_startup_message 1
583 undef; #don't reprint CPAN::Config
587 my($word,$line,$pos) = @_;
589 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
590 my(@words) = split " ", substr($line,0,$pos+1);
599 @words == 4 && length($word)
602 return grep /^\Q$word\E/, qw(splice shift unshift pop push);
603 } elsif (defined($words[2])
610 @words >= 4 && length($word)
612 return sort grep /^\Q$word\E/, keys %keys;
613 } elsif (@words >= 4) {
617 my(@o_conf) = sort grep { !$seen{$_}++ }
621 return grep /^\Q$word\E/, @o_conf;
625 my($self,$distro,$what) = @_;
627 if ($prefssupport{$what}) {
628 return $CPAN::Config->{$what} unless
631 and $distro->prefs->{cpanconfig}
632 and defined $distro->prefs->{cpanconfig}{$what};
633 return $distro->prefs->{cpanconfig}{$what};
635 $CPAN::Frontend->mywarn("Warning: $what not yet officially ".
636 "supported for distroprefs, doing a normal lookup");
637 return $CPAN::Config->{$what};
644 CPAN::Config; ####::###### #hide from indexer
645 # note: J. Nick Koston wrote me that they are using
646 # CPAN::Config->commit although undocumented. I suggested
647 # CPAN::Shell->o("conf","commit") even when ugly it is at least
650 # that's why I added the CPAN::Config class with autoload and
654 use vars qw($AUTOLOAD $VERSION);
655 $VERSION = sprintf "%.2f", substr(q$Rev: 1315 $,4)/100;
657 # formerly CPAN::HandleConfig was known as CPAN::Config
660 $CPAN::Frontend->mywarn("Dispatching deprecated method '$l' to CPAN::HandleConfig\n");
662 CPAN::HandleConfig->$l(@_);
672 This program is free software; you can redistribute it and/or
673 modify it under the same terms as Perl itself.
679 # cperl-indent-level: 4