This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to CPAN-1.88_62
[perl5.git] / lib / CPAN / HandleConfig.pm
CommitLineData
e82b9348
SP
1package CPAN::HandleConfig;
2use strict;
87892b73 3use vars qw(%can %keys $VERSION);
1a43333d 4
05bab18e 5$VERSION = sprintf "%.6f", substr(q$Rev: 1264 $,4)/1000000 + 5.4;
e82b9348
SP
6
7%can = (
4d1321a7
A
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",
e82b9348
SP
12);
13
1e8f9a0a
SP
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
6658a91b
SP
17%keys = map { $_ => undef }
18 (
19 "build_cache",
20 "build_dir",
05bab18e 21 "build_dir_reuse",
6658a91b
SP
22 "build_requires_install_policy",
23 "bzip2",
24 "cache_metadata",
25 "check_sigs",
26 "colorize_output",
27 "colorize_print",
28 "colorize_warn",
29 "commandnumber_in_prompt",
30 "commands_quote",
31 "cpan_home",
32 "curl",
33 "dontload_hash", # deprecated after 1.83_68 (rev. 581)
34 "dontload_list",
35 "ftp",
36 "ftp_passive",
37 "ftp_proxy",
38 "getcwd",
39 "gpg",
40 "gzip",
41 "histfile",
42 "histsize",
43 "http_proxy",
44 "inactivity_timeout",
45 "index_expire",
46 "inhibit_startup_message",
47 "keep_source_where",
48 "lynx",
49 "make",
50 "make_arg",
51 "make_install_arg",
52 "make_install_make_command",
53 "makepl_arg",
54 "mbuild_arg",
55 "mbuild_install_arg",
56 "mbuild_install_build_command",
57 "mbuildpl_arg",
58 "ncftp",
59 "ncftpget",
60 "no_proxy",
61 "pager",
62 "password",
63 "patch",
64 "prefer_installer",
65 "prerequisites_policy",
66 "prefs_dir",
67 "proxy_pass",
68 "proxy_user",
05bab18e 69 "randomize_urllist",
6658a91b
SP
70 "scan_cache",
71 "shell",
72 "show_upload_date",
73 "tar",
74 "term_is_latin",
75 "term_ornaments",
76 "test_report",
77 "unzip",
78 "urllist",
79 "username",
80 "wait_list",
81 "wget",
82 "yaml_module",
83 );
84
85my %prefssupport = map { $_ => 1 }
86 (
87 "build_requires_install_policy",
88 "make",
89 "make_install_make_command",
90 "prefer_installer",
91 "test_report",
92 );
93
44d21104
A
94if ($^O eq "MSWin32") {
95 for my $k (qw(
96 mbuild_install_build_command
97 make_install_make_command
98 )) {
99 delete $keys{$k};
100 if (exists $CPAN::Config->{$k}) {
87892b73
RGS
101 for ("deleting previously set config variable '$k' => '$CPAN::Config->{$k}'") {
102 $CPAN::Frontend ? $CPAN::Frontend->mywarn($_) : warn $_;
103 }
44d21104
A
104 delete $CPAN::Config->{$k};
105 }
106 }
107}
e82b9348
SP
108
109# returns true on successful action
110sub edit {
111 my($self,@args) = @_;
112 return unless @args;
113 CPAN->debug("self[$self]args[".join(" | ",@args)."]");
114 my($o,$str,$func,$args,$key_exists);
115 $o = shift @args;
9ddc4ed0 116 $DB::single = 1;
e82b9348 117 if($can{$o}) {
8962fc49 118 $self->$o(args => \@args); # o conf init => sub init => sub load
e82b9348
SP
119 return 1;
120 } else {
121 CPAN->debug("o[$o]") if $CPAN::DEBUG;
122 unless (exists $keys{$o}) {
123 $CPAN::Frontend->mywarn("Warning: unknown configuration variable '$o'\n");
124 }
05bab18e
SP
125 # one day I used randomize_urllist for a boolean, so we must
126 # list them explicitly --ak
127 if ($o =~ /^(wait_list|urllist|dontload_list)$/) {
e82b9348
SP
128 $func = shift @args;
129 $func ||= "";
05bab18e 130 CPAN->debug("func[$func]args[@args]") if $CPAN::DEBUG;
e82b9348
SP
131 my $changed;
132 # Let's avoid eval, it's easier to comprehend without.
133 if ($func eq "push") {
134 push @{$CPAN::Config->{$o}}, @args;
135 $changed = 1;
136 } elsif ($func eq "pop") {
137 pop @{$CPAN::Config->{$o}};
138 $changed = 1;
139 } elsif ($func eq "shift") {
140 shift @{$CPAN::Config->{$o}};
141 $changed = 1;
142 } elsif ($func eq "unshift") {
143 unshift @{$CPAN::Config->{$o}}, @args;
144 $changed = 1;
145 } elsif ($func eq "splice") {
05bab18e
SP
146 my $offset = shift @args || 0;
147 my $length = shift @args || 0;
148 splice @{$CPAN::Config->{$o}}, $offset, $length, @args; # may warn
e82b9348 149 $changed = 1;
05bab18e
SP
150 } elsif ($func) {
151 $CPAN::Config->{$o} = [$func, @args];
e82b9348
SP
152 $changed = 1;
153 } else {
154 $self->prettyprint($o);
155 }
4d1321a7 156 if ($changed) {
6658a91b 157 $CPAN::CONFIG_DIRTY = 1;
4d1321a7
A
158 if ($o eq "urllist") {
159 # reset the cached values
160 undef $CPAN::FTP::Thesite;
161 undef $CPAN::FTP::Themethod;
162 } elsif ($o eq "dontload_list") {
163 # empty it, it will be built up again
164 $CPAN::META->{dontload_hash} = {};
165 }
e82b9348
SP
166 }
167 return $changed;
ca79d794 168 } elsif ($o =~ /_hash$/) {
6658a91b
SP
169 if (@args==1 && $args[0] eq ""){
170 @args = ();
171 } elsif (@args % 2) {
172 push @args, "";
173 }
ca79d794 174 $CPAN::Config->{$o} = { @args };
6658a91b 175 $CPAN::CONFIG_DIRTY = 1;
ca79d794 176 } else {
6658a91b
SP
177 if (defined $args[0]){
178 $CPAN::CONFIG_DIRTY = 1;
179 $CPAN::Config->{$o} = $args[0];
180 }
7d97ad34
SP
181 $self->prettyprint($o)
182 if exists $keys{$o} or defined $CPAN::Config->{$o};
8962fc49 183 return 1;
e82b9348
SP
184 }
185 }
186}
187
188sub prettyprint {
189 my($self,$k) = @_;
190 my $v = $CPAN::Config->{$k};
191 if (ref $v) {
9ddc4ed0
A
192 my(@report);
193 if (ref $v eq "ARRAY") {
05bab18e 194 @report = map {"\t$_ \[$v->[$_]]\n"} 0..$#$v;
9ddc4ed0
A
195 } else {
196 @report = map { sprintf("\t%-18s => %s\n",
197 map { "[$_]" } $_,
198 defined $v->{$_} ? $v->{$_} : "UNDEFINED"
199 )} keys %$v;
200 }
e82b9348
SP
201 $CPAN::Frontend->myprint(
202 join(
203 "",
204 sprintf(
205 " %-18s\n",
206 $k
207 ),
9ddc4ed0 208 @report
e82b9348
SP
209 )
210 );
211 } elsif (defined $v) {
212 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
213 } else {
214 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, "UNDEFINED");
215 }
216}
217
218sub commit {
9ddc4ed0 219 my($self,@args) = @_;
6658a91b 220 CPAN->debug("args[@args]") if $CPAN::DEBUG;
05bab18e
SP
221 if ($CPAN::RUN_DEGRADED) {
222 $CPAN::Frontend->mydie(
223 "'o conf commit' disabled in ".
224 "degraded mode. Maybe try\n".
225 " !undef \$CPAN::RUN_DEGRADED\n"
226 );
227 }
9ddc4ed0
A
228 my $configpm;
229 if (@args) {
230 if ($args[0] eq "args") {
231 # we have not signed that contract
232 } else {
233 $configpm = $args[0];
234 }
235 }
e82b9348
SP
236 unless (defined $configpm){
237 $configpm ||= $INC{"CPAN/MyConfig.pm"};
238 $configpm ||= $INC{"CPAN/Config.pm"};
239 $configpm || Carp::confess(q{
240CPAN::Config::commit called without an argument.
241Please specify a filename where to save the configuration or try
242"o conf init" to have an interactive course through configing.
243});
244 }
245 my($mode);
246 if (-f $configpm) {
247 $mode = (stat $configpm)[2];
248 if ($mode && ! -w _) {
249 Carp::confess("$configpm is not writable");
250 }
251 }
252
253 my $msg;
254 $msg = <<EOF unless $configpm =~ /MyConfig/;
255
256# This is CPAN.pm's systemwide configuration file. This file provides
257# defaults for users, and the values can be changed in a per-user
258# configuration file. The user-config file is being looked for as
259# ~/.cpan/CPAN/MyConfig.pm.
260
261EOF
262 $msg ||= "\n";
263 my($fh) = FileHandle->new;
264 rename $configpm, "$configpm~" if -f $configpm;
265 open $fh, ">$configpm" or
266 $CPAN::Frontend->mydie("Couldn't open >$configpm: $!");
267 $fh->print(qq[$msg\$CPAN::Config = \{\n]);
268 foreach (sort keys %$CPAN::Config) {
44d21104
A
269 unless (exists $keys{$_}) {
270 $CPAN::Frontend->mywarn("Dropping unknown config variable '$_'\n");
271 delete $CPAN::Config->{$_};
272 next;
273 }
e82b9348
SP
274 $fh->print(
275 " '$_' => ",
ca79d794 276 $self->neatvalue($CPAN::Config->{$_}),
e82b9348
SP
277 ",\n"
278 );
279 }
280
281 $fh->print("};\n1;\n__END__\n");
282 close $fh;
283
284 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
285 #chmod $mode, $configpm;
286###why was that so? $self->defaults;
9ddc4ed0 287 $CPAN::Frontend->myprint("commit: wrote '$configpm'\n");
6658a91b 288 $CPAN::CONFIG_DIRTY = 0;
e82b9348
SP
289 1;
290}
291
ca79d794
SP
292# stolen from MakeMaker; not taking the original because it is buggy;
293# bugreport will have to say: keys of hashes remain unquoted and can
294# produce syntax errors
295sub neatvalue {
296 my($self, $v) = @_;
297 return "undef" unless defined $v;
298 my($t) = ref $v;
6658a91b
SP
299 unless ($t){
300 $v =~ s/\\/\\\\/g;
301 return "q[$v]";
302 }
ca79d794
SP
303 if ($t eq 'ARRAY') {
304 my(@m, @neat);
305 push @m, "[";
306 foreach my $elem (@$v) {
307 push @neat, "q[$elem]";
308 }
309 push @m, join ", ", @neat;
310 push @m, "]";
311 return join "", @m;
312 }
313 return "$v" unless $t eq 'HASH';
314 my(@m, $key, $val);
315 while (($key,$val) = each %$v){
316 last unless defined $key; # cautious programming in case (undef,undef) is true
317 push(@m,"q[$key]=>".$self->neatvalue($val)) ;
318 }
319 return "{ ".join(', ',@m)." }";
320}
321
e82b9348
SP
322sub defaults {
323 my($self) = @_;
05bab18e
SP
324 if ($CPAN::RUN_DEGRADED) {
325 $CPAN::Frontend->mydie(
326 "'o conf defaults' disabled in ".
327 "degraded mode. Maybe try\n".
328 " !undef \$CPAN::RUN_DEGRADED\n"
329 );
330 }
c9869e1c
SP
331 my $done;
332 for my $config (qw(CPAN/MyConfig.pm CPAN/Config.pm)) {
26844e27 333 if ($INC{$config}) {
6658a91b 334 CPAN->debug("INC{'$config'}[$INC{$config}]") if $CPAN::DEBUG;
6a935156 335 CPAN::Shell->reload_this($config,{force => 1});
26844e27
SP
336 $CPAN::Frontend->myprint("'$INC{$config}' reread\n");
337 last;
338 }
c9869e1c 339 }
6658a91b 340 $CPAN::CONFIG_DIRTY = 0;
e82b9348
SP
341 1;
342}
343
ed84aac9
A
344=head2 C<< CLASS->safe_quote ITEM >>
345
346Quotes an item to become safe against spaces
347in shell interpolation. An item is enclosed
348in double quotes if:
349
350 - the item contains spaces in the middle
351 - the item does not start with a quote
352
353This happens to avoid shell interpolation
354problems when whitespace is present in
355directory names.
356
357This method uses C<commands_quote> to determine
358the correct quote. If C<commands_quote> is
359a space, no quoting will take place.
360
361
362if it starts and ends with the same quote character: leave it as it is
363
364if it contains no whitespace: leave it as it is
365
366if it contains whitespace, then
367
368if it contains quotes: better leave it as it is
369
370else: quote it with the correct quote type for the box we're on
371
372=cut
373
374{
375 # Instead of patching the guess, set commands_quote
376 # to the right value
377 my ($quotes,$use_quote)
378 = $^O eq 'MSWin32'
379 ? ('"', '"')
380 : (q<"'>, "'")
381 ;
382
383 sub safe_quote {
384 my ($self, $command) = @_;
385 # Set up quote/default quote
386 my $quote = $CPAN::Config->{commands_quote} || $quotes;
387
388 if ($quote ne ' '
6658a91b 389 and defined($command )
ed84aac9
A
390 and $command =~ /\s/
391 and $command !~ /[$quote]/) {
392 return qq<$use_quote$command$use_quote>
393 }
394 return $command;
395 }
396}
397
e82b9348 398sub init {
9ddc4ed0 399 my($self,@args) = @_;
e82b9348
SP
400 undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
401 # have the least
402 # important
403 # variable
404 # undefined
9ddc4ed0 405 $self->load(@args);
e82b9348
SP
406 1;
407}
408
409# This is a piece of repeated code that is abstracted here for
410# maintainability. RMB
411#
412sub _configpmtest {
413 my($configpmdir, $configpmtest) = @_;
414 if (-w $configpmtest) {
415 return $configpmtest;
416 } elsif (-w $configpmdir) {
417 #_#_# following code dumped core on me with 5.003_11, a.k.
418 my $configpm_bak = "$configpmtest.bak";
419 unlink $configpm_bak if -f $configpm_bak;
420 if( -f $configpmtest ) {
421 if( rename $configpmtest, $configpm_bak ) {
422 $CPAN::Frontend->mywarn(<<END);
423Old configuration file $configpmtest
424 moved to $configpm_bak
425END
426 }
427 }
428 my $fh = FileHandle->new;
429 if ($fh->open(">$configpmtest")) {
430 $fh->print("1;\n");
431 return $configpmtest;
432 } else {
433 # Should never happen
434 Carp::confess("Cannot open >$configpmtest");
435 }
436 } else { return }
437}
438
87892b73
RGS
439sub require_myconfig_or_config () {
440 return if $INC{"CPAN/MyConfig.pm"};
441 local @INC = @INC;
442 my $home = home();
443 unshift @INC, File::Spec->catdir($home,'.cpan');
444 eval { require CPAN::MyConfig };
ed84aac9
A
445 my $err_myconfig = $@;
446 if ($err_myconfig and $err_myconfig !~ m#locate CPAN/MyConfig\.pm#) {
447 die "Error while requiring CPAN::MyConfig:\n$err_myconfig";
448 }
87892b73
RGS
449 unless ($INC{"CPAN/MyConfig.pm"}) { # this guy has settled his needs already
450 eval {require CPAN::Config;}; # not everybody has one
ed84aac9
A
451 my $err_config = $@;
452 if ($err_config and $err_config !~ m#locate CPAN/Config\.pm#) {
453 die "Error while requiring CPAN::Config:\n$err_config";
454 }
87892b73
RGS
455 }
456}
457
458sub home () {
459 my $home;
460 if ($CPAN::META->has_usable("File::HomeDir")) {
461 $home = File::HomeDir->my_data;
462 } else {
463 $home = $ENV{HOME};
464 }
465 $home;
466}
467
e82b9348
SP
468sub load {
469 my($self, %args) = @_;
470 $CPAN::Be_Silent++ if $args{be_silent};
471
472 my(@miss);
473 use Carp;
87892b73 474 require_myconfig_or_config;
e82b9348
SP
475 return unless @miss = $self->missing_config_data;
476
477 require CPAN::FirstTime;
478 my($configpm,$fh,$redo,$theycalled);
479 $redo ||= "";
480 $theycalled++ if @miss==1 && $miss[0] eq 'inhibit_startup_message';
481 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
482 $configpm = $INC{"CPAN/Config.pm"};
483 $redo++;
484 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
485 $configpm = $INC{"CPAN/MyConfig.pm"};
486 $redo++;
487 } else {
488 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
489 my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN");
490 my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm");
c9869e1c 491 my $inc_key;
e82b9348 492 if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
c9869e1c
SP
493 $configpm = _configpmtest($configpmdir,$configpmtest);
494 $inc_key = "CPAN/Config.pm";
e82b9348
SP
495 }
496 unless ($configpm) {
87892b73 497 $configpmdir = File::Spec->catdir(home,".cpan","CPAN");
e82b9348
SP
498 File::Path::mkpath($configpmdir);
499 $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm");
c9869e1c
SP
500 $configpm = _configpmtest($configpmdir,$configpmtest);
501 $inc_key = "CPAN/MyConfig.pm";
e82b9348 502 }
c9869e1c
SP
503 if ($configpm) {
504 $INC{$inc_key} = $configpm;
505 } else {
506 my $text = qq{WARNING: CPAN.pm is unable to } .
507 qq{create a configuration file.};
508 output($text, 'confess');
509 }
510
e82b9348
SP
511 }
512 local($") = ", ";
8962fc49
SP
513 if ($redo && ! $theycalled){
514 $CPAN::Frontend->myprint(<<END);
0cf35e6a
SP
515Sorry, we have to rerun the configuration dialog for CPAN.pm due to
516the following indispensable but missing parameters:
e82b9348
SP
517
518@miss
519END
26844e27 520 $args{args} = \@miss;
8962fc49 521 }
7fefbd44
RGS
522 if (0) {
523 # where do we need this?
524 $CPAN::Frontend->myprint(qq{
e82b9348
SP
525$configpm initialized.
526});
7fefbd44 527 }
e82b9348
SP
528 CPAN::FirstTime::init($configpm, %args);
529}
530
531sub missing_config_data {
532 my(@miss);
533 for (
0cf35e6a
SP
534 "build_cache",
535 "build_dir",
536 "cache_metadata",
537 "cpan_home",
538 "ftp_proxy",
ed84aac9 539 #"gzip",
0cf35e6a
SP
540 "http_proxy",
541 "index_expire",
542 "inhibit_startup_message",
543 "keep_source_where",
ed84aac9 544 #"make",
0cf35e6a
SP
545 "make_arg",
546 "make_install_arg",
547 "makepl_arg",
548 "mbuild_arg",
549 "mbuild_install_arg",
550 "mbuild_install_build_command",
551 "mbuildpl_arg",
552 "no_proxy",
ed84aac9 553 #"pager",
e82b9348 554 "prerequisites_policy",
0cf35e6a 555 "scan_cache",
ed84aac9
A
556 #"tar",
557 #"unzip",
0cf35e6a 558 "urllist",
e82b9348 559 ) {
44d21104 560 next unless exists $keys{$_};
e82b9348
SP
561 push @miss, $_ unless defined $CPAN::Config->{$_};
562 }
563 return @miss;
564}
565
e82b9348
SP
566sub help {
567 $CPAN::Frontend->myprint(q[
568Known options:
e82b9348 569 commit commit session changes to disk
4d1321a7
A
570 defaults reload default config values from disk
571 help this help
26844e27 572 init enter a dialog to set all or a set of parameters
e82b9348 573
4d1321a7 574Edit key values as in the following (the "o" is a literal letter o):
e82b9348 575 o conf build_cache 15
e82b9348 576 o conf build_dir "/foo/bar"
e82b9348 577 o conf urllist shift
e82b9348 578 o conf urllist unshift ftp://ftp.foo.bar/
4d1321a7 579 o conf inhibit_startup_message 1
e82b9348
SP
580
581]);
582 undef; #don't reprint CPAN::Config
583}
584
585sub cpl {
586 my($word,$line,$pos) = @_;
587 $word ||= "";
588 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
589 my(@words) = split " ", substr($line,0,$pos+1);
590 if (
591 defined($words[2])
592 and
8962fc49
SP
593 $words[2] =~ /list$/
594 and
e82b9348 595 (
8962fc49 596 @words == 3
e82b9348 597 ||
8962fc49 598 @words == 4 && length($word)
e82b9348
SP
599 )
600 ) {
601 return grep /^\Q$word\E/, qw(splice shift unshift pop push);
8962fc49
SP
602 } elsif (defined($words[2])
603 and
604 $words[2] eq "init"
605 and
606 (
607 @words == 3
608 ||
26844e27 609 @words >= 4 && length($word)
8962fc49
SP
610 )) {
611 return sort grep /^\Q$word\E/, keys %keys;
e82b9348
SP
612 } elsif (@words >= 4) {
613 return ();
614 }
615 my %seen;
616 my(@o_conf) = sort grep { !$seen{$_}++ }
617 keys %can,
618 keys %$CPAN::Config,
619 keys %keys;
620 return grep /^\Q$word\E/, @o_conf;
621}
622
6658a91b
SP
623sub prefs_lookup {
624 my($self,$distro,$what) = @_;
625 if ($prefssupport{$what}) {
626 return $distro->prefs->{cpanconfig}{$what} || $CPAN::Config->{$what};
627 } else {
628 warn "Warning: $what no yet officially supported for distroprefs, doing a normal lookup";
629 return $CPAN::Config->{$what};
630 }
631}
9ddc4ed0 632
9ddc4ed0 633
6658a91b
SP
634{
635 package
636 CPAN::Config; ####::###### #hide from indexer
637 # note: J. Nick Koston wrote me that they are using
638 # CPAN::Config->commit although undocumented. I suggested
639 # CPAN::Shell->o("conf","commit") even when ugly it is at least
640 # documented
641
642 # that's why I added the CPAN::Config class with autoload and
643 # deprecated warning
644
645 use strict;
646 use vars qw($AUTOLOAD $VERSION);
05bab18e 647 $VERSION = sprintf "%.2f", substr(q$Rev: 1264 $,4)/100;
6658a91b
SP
648
649 # formerly CPAN::HandleConfig was known as CPAN::Config
650 sub AUTOLOAD {
651 my($l) = $AUTOLOAD;
652 $CPAN::Frontend->mywarn("Dispatching deprecated method '$l' to CPAN::HandleConfig\n");
653 $l =~ s/.*:://;
654 CPAN::HandleConfig->$l(@_);
655 }
9ddc4ed0
A
656}
657
e82b9348 6581;
0cf35e6a
SP
659
660__END__
26844e27
SP
661
662=head1 LICENSE
663
664This program is free software; you can redistribute it and/or
665modify it under the same terms as Perl itself.
666
667=cut
668
0cf35e6a
SP
669# Local Variables:
670# mode: cperl
ca79d794 671# cperl-indent-level: 4
0cf35e6a 672# End: