File Coverage

blib/lib/CPAN/HandleConfig.pm
Criterion Covered Total %
statement 65 283 22.9
branch 17 166 10.2
condition 7 101 6.9
subroutine 13 29 44.8
pod 1 16 6.2
total 103 595 17.3


line stmt bran cond sub pod time code
1             package CPAN::HandleConfig;
2 8     8   795 use strict;
  8         16  
  8         341  
3 8     8   43 use vars qw(%can %keys $loading $VERSION);
  8         72  
  8         631  
4 8     8   53 use File::Path ();
  8         16  
  8         134  
5 8     8   42 use File::Spec ();
  8         15  
  8         133  
6 8     8   48 use File::Basename ();
  8         14  
  8         153  
7 8     8   42 use Carp ();
  8         11  
  8         51447  
8              
9             =head1 NAME
10              
11             CPAN::HandleConfig - internal configuration handling for CPAN.pm
12              
13             =cut
14              
15             $VERSION = "5.5003"; # see also CPAN::Config::VERSION at end of file
16              
17             %can = (
18             commit => "Commit changes to disk",
19             defaults => "Reload defaults from disk",
20             help => "Short help about 'o conf' usage",
21             init => "Interactive setting of all options",
22             );
23              
24             # Q: where is the "How do I add a new config option" HOWTO?
25             # A1: svn diff -r 757:758 # where dagolden added test_report [git e997b71de88f1019a1472fc13cb97b1b7f96610f]
26             # A2: svn diff -r 985:986 # where andk added yaml_module [git 312b6d9b12b1bdec0b6e282d853482145475021f]
27             # A3: 1. add new config option to %keys below
28             # 2. add a Pod description in CPAN::FirstTime; it should include a
29             # prompt line; see others for examples
30             # 3. add a "matcher" section in CPAN::FirstTime::init that includes
31             # a prompt function; see others for examples
32             # 4. add config option to documentation section in CPAN.pm
33              
34             %keys = map { $_ => undef }
35             (
36             "applypatch",
37             "auto_commit",
38             "build_cache",
39             "build_dir",
40             "build_dir_reuse",
41             "build_requires_install_policy",
42             "bzip2",
43             "cache_metadata",
44             "check_sigs",
45             "colorize_debug",
46             "colorize_output",
47             "colorize_print",
48             "colorize_warn",
49             "commandnumber_in_prompt",
50             "commands_quote",
51             "connect_to_internet_ok",
52             "cpan_home",
53             "curl",
54             "dontload_hash", # deprecated after 1.83_68 (rev. 581)
55             "dontload_list",
56             "ftp",
57             "ftp_passive",
58             "ftp_proxy",
59             "ftpstats_size",
60             "ftpstats_period",
61             "getcwd",
62             "gpg",
63             "gzip",
64             "halt_on_failure",
65             "histfile",
66             "histsize",
67             "http_proxy",
68             "inactivity_timeout",
69             "index_expire",
70             "inhibit_startup_message",
71             "keep_source_where",
72             "load_module_verbosity",
73             "lynx",
74             "make",
75             "make_arg",
76             "make_install_arg",
77             "make_install_make_command",
78             "makepl_arg",
79             "mbuild_arg",
80             "mbuild_install_arg",
81             "mbuild_install_build_command",
82             "mbuildpl_arg",
83             "ncftp",
84             "ncftpget",
85             "no_proxy",
86             "pager",
87             "password",
88             "patch",
89             "patches_dir",
90             "perl5lib_verbosity",
91             "prefer_external_tar",
92             "prefer_installer",
93             "prefs_dir",
94             "prerequisites_policy",
95             "proxy_pass",
96             "proxy_user",
97             "randomize_urllist",
98             "recommends_policy",
99             "scan_cache",
100             "shell",
101             "show_unparsable_versions",
102             "show_upload_date",
103             "show_zero_versions",
104             "suggests_policy",
105             "tar",
106             "tar_verbosity",
107             "term_is_latin",
108             "term_ornaments",
109             "test_report",
110             "trust_test_report_history",
111             "unzip",
112             "urllist",
113             "use_prompt_default",
114             "use_sqlite",
115             "username",
116             "version_timeout",
117             "wait_list",
118             "wget",
119             "yaml_load_code",
120             "yaml_module",
121             );
122              
123             my %prefssupport = map { $_ => 1 }
124             (
125             "build_requires_install_policy",
126             "check_sigs",
127             "make",
128             "make_install_make_command",
129             "prefer_installer",
130             "test_report",
131             );
132              
133             # returns true on successful action
134             sub edit {
135 0     0 0 0 my($self,@args) = @_;
136 0 0       0 return unless @args;
137 0         0 CPAN->debug("self[$self]args[".join(" | ",@args)."]");
138 0         0 my($o,$str,$func,$args,$key_exists);
139 0         0 $o = shift @args;
140 0 0       0 if($can{$o}) {
141 0         0 my $success = $self->$o(args => \@args); # o conf init => sub init => sub load
142 0 0       0 unless ($success) {
143 0         0 die "Panic: could not configure CPAN.pm for args [@args]. Giving up.";
144             }
145             } else {
146 0 0       0 CPAN->debug("o[$o]") if $CPAN::DEBUG;
147 0 0       0 unless (exists $keys{$o}) {
148 0         0 $CPAN::Frontend->mywarn("Warning: unknown configuration variable '$o'\n");
149             }
150 0         0 my $changed;
151              
152              
153             # one day I used randomize_urllist for a boolean, so we must
154             # list them explicitly --ak
155 0 0       0 if (0) {
    0          
156 0         0 } elsif ($o =~ /^(wait_list|urllist|dontload_list)$/) {
157              
158             #
159             # ARRAYS
160             #
161              
162 0         0 $func = shift @args;
163 0   0     0 $func ||= "";
164 0 0       0 CPAN->debug("func[$func]args[@args]") if $CPAN::DEBUG;
165             # Let's avoid eval, it's easier to comprehend without.
166 0 0       0 if ($func eq "push") {
    0          
    0          
    0          
    0          
    0          
167 0         0 push @{$CPAN::Config->{$o}}, @args;
  0         0  
168 0         0 $changed = 1;
169             } elsif ($func eq "pop") {
170 0         0 pop @{$CPAN::Config->{$o}};
  0         0  
171 0         0 $changed = 1;
172             } elsif ($func eq "shift") {
173 0         0 shift @{$CPAN::Config->{$o}};
  0         0  
174 0         0 $changed = 1;
175             } elsif ($func eq "unshift") {
176 0         0 unshift @{$CPAN::Config->{$o}}, @args;
  0         0  
177 0         0 $changed = 1;
178             } elsif ($func eq "splice") {
179 0   0     0 my $offset = shift @args || 0;
180 0   0     0 my $length = shift @args || 0;
181 0         0 splice @{$CPAN::Config->{$o}}, $offset, $length, @args; # may warn
  0         0  
182 0         0 $changed = 1;
183             } elsif ($func) {
184 0         0 $CPAN::Config->{$o} = [$func, @args];
185 0         0 $changed = 1;
186             } else {
187 0         0 $self->prettyprint($o);
188             }
189 0 0       0 if ($changed) {
190 0 0       0 if ($o eq "urllist") {
    0          
191             # reset the cached values
192 0         0 undef $CPAN::FTP::Thesite;
193 0         0 undef $CPAN::FTP::Themethod;
194 0         0 $CPAN::Index::LAST_TIME = 0;
195             } elsif ($o eq "dontload_list") {
196             # empty it, it will be built up again
197 0         0 $CPAN::META->{dontload_hash} = {};
198             }
199             }
200             } elsif ($o =~ /_hash$/) {
201              
202             #
203             # HASHES
204             #
205              
206 0 0 0     0 if (@args==1 && $args[0] eq "") {
    0          
207 0         0 @args = ();
208             } elsif (@args % 2) {
209 0         0 push @args, "";
210             }
211 0         0 $CPAN::Config->{$o} = { @args };
212 0         0 $changed = 1;
213             } else {
214              
215             #
216             # SCALARS
217             #
218              
219 0 0       0 if (defined $args[0]) {
220 0         0 $CPAN::CONFIG_DIRTY = 1;
221 0         0 $CPAN::Config->{$o} = $args[0];
222 0         0 $changed = 1;
223             }
224 0 0 0     0 $self->prettyprint($o)
225             if exists $keys{$o} or defined $CPAN::Config->{$o};
226             }
227 0 0       0 if ($changed) {
228 0 0       0 if ($CPAN::Config->{auto_commit}) {
229 0         0 $self->commit;
230             } else {
231 0         0 $CPAN::CONFIG_DIRTY = 1;
232 0         0 $CPAN::Frontend->myprint("Please use 'o conf commit' to ".
233             "make the config permanent!\n\n");
234             }
235             }
236             }
237             }
238              
239             sub prettyprint {
240 0     0 0 0 my($self,$k) = @_;
241 0         0 my $v = $CPAN::Config->{$k};
242 0 0       0 if (ref $v) {
    0          
243 0         0 my(@report);
244 0 0       0 if (ref $v eq "ARRAY") {
245 0         0 @report = map {"\t$_ \[$v->[$_]]\n"} 0..$#$v;
  0         0  
246             } else {
247 0 0       0 @report = map
248             {
249 0         0 sprintf "\t%-18s => %s\n",
250             "[$_]",
251             defined $v->{$_} ? "[$v->{$_}]" : "undef"
252             } keys %$v;
253             }
254 0         0 $CPAN::Frontend->myprint(
255             join(
256             "",
257             sprintf(
258             " %-18s\n",
259             $k
260             ),
261             @report
262             )
263             );
264             } elsif (defined $v) {
265 0         0 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
266             } else {
267 0         0 $CPAN::Frontend->myprint(sprintf " %-18s undef\n", $k);
268             }
269             }
270              
271             # generally, this should be called without arguments so that the currently
272             # loaded config file is where changes are committed.
273             sub commit {
274 0     0 0 0 my($self,@args) = @_;
275 0 0       0 CPAN->debug("args[@args]") if $CPAN::DEBUG;
276 0 0       0 if ($CPAN::RUN_DEGRADED) {
277 0         0 $CPAN::Frontend->mydie(
278             "'o conf commit' disabled in ".
279             "degraded mode. Maybe try\n".
280             " !undef \$CPAN::RUN_DEGRADED\n"
281             );
282             }
283 0         0 my ($configpm, $must_reload);
284              
285             # XXX does anything do this? can it be simplified? -- dagolden, 2011-01-19
286 0 0       0 if (@args) {
287 0 0       0 if ($args[0] eq "args") {
288             # we have not signed that contract
289             } else {
290 0         0 $configpm = $args[0];
291             }
292             }
293              
294             # use provided name or the current config or create a new MyConfig
295 0   0     0 $configpm ||= require_myconfig_or_config() || make_new_config();
      0        
296              
297             # commit to MyConfig if we can't write to Config
298 0 0 0     0 if ( ! -w $configpm && $configpm =~ m{CPAN/Config\.pm} ) {
299 0         0 my $myconfig = _new_config_name();
300 0         0 $CPAN::Frontend->mywarn(
301             "Your $configpm file\n".
302             "is not writable. I will attempt to write your configuration to\n" .
303             "$myconfig instead.\n\n"
304             );
305 0         0 $configpm = make_new_config();
306 0         0 $must_reload++; # so it gets loaded as $INC{'CPAN/MyConfig.pm'}
307             }
308              
309             # XXX why not just "-w $configpm"? -- dagolden, 2011-01-19
310 0         0 my($mode);
311 0 0       0 if (-f $configpm) {
312 0         0 $mode = (stat $configpm)[2];
313 0 0 0     0 if ($mode && ! -w _) {
314 0         0 _die_cant_write_config($configpm);
315             }
316             }
317              
318 0         0 $self->_write_config_file($configpm);
319 0 0       0 require_myconfig_or_config() if $must_reload;
320              
321             #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
322             #chmod $mode, $configpm;
323             ###why was that so? $self->defaults;
324 0         0 $CPAN::Frontend->myprint("commit: wrote '$configpm'\n");
325 0         0 $CPAN::CONFIG_DIRTY = 0;
326 0         0 1;
327             }
328              
329             sub _write_config_file {
330 0     0   0 my ($self, $configpm) = @_;
331 0         0 my $msg;
332 0 0       0 $msg = <
333              
334             # This is CPAN.pm's systemwide configuration file. This file provides
335             # defaults for users, and the values can be changed in a per-user
336             # configuration file.
337              
338             EOF
339 0   0     0 $msg ||= "\n";
340 0         0 my($fh) = FileHandle->new;
341 0 0       0 rename $configpm, "$configpm~" if -f $configpm;
342 0 0       0 open $fh, ">$configpm" or
343             $CPAN::Frontend->mydie("Couldn't open >$configpm: $!");
344 0         0 $fh->print(qq[$msg\$CPAN::Config = \{\n]);
345 0         0 foreach (sort keys %$CPAN::Config) {
346 0 0       0 unless (exists $keys{$_}) {
347             # do not drop them: forward compatibility!
348 0         0 $CPAN::Frontend->mywarn("Unknown config variable '$_'\n");
349 0         0 next;
350             }
351             $fh->print(
352 0         0 " '$_' => ",
353             $self->neatvalue($CPAN::Config->{$_}),
354             ",\n"
355             );
356             }
357 0         0 $fh->print("};\n1;\n__END__\n");
358 0         0 close $fh;
359              
360 0         0 return;
361             }
362              
363              
364             # stolen from MakeMaker; not taking the original because it is buggy;
365             # bugreport will have to say: keys of hashes remain unquoted and can
366             # produce syntax errors
367             sub neatvalue {
368 7     7 0 4841 my($self, $v) = @_;
369 7 50       19 return "undef" unless defined $v;
370 7         14 my($t) = ref $v;
371 7 100       17 unless ($t) {
372 4         16 $v =~ s/\\/\\\\/g;
373 4         21 return "q[$v]";
374             }
375 3 100       10 if ($t eq 'ARRAY') {
376 1         10 my(@m, @neat);
377 1         6 push @m, "[";
378 1         10 foreach my $elem (@$v) {
379 1         6 push @neat, "q[$elem]";
380             }
381 1         5 push @m, join ", ", @neat;
382 1         2 push @m, "]";
383 1         6 return join "", @m;
384             }
385 2 50       9 return "$v" unless $t eq 'HASH';
386 2         4 my(@m, $key, $val);
387 2         13 while (($key,$val) = each %$v) {
388 2 50       8 last unless defined $key; # cautious programming in case (undef,undef) is true
389 2         21 push(@m,"q[$key]=>".$self->neatvalue($val)) ;
390             }
391 2         10 return "{ ".join(', ',@m)." }";
392             }
393              
394             sub defaults {
395 0     0 0 0 my($self) = @_;
396 0 0       0 if ($CPAN::RUN_DEGRADED) {
397 0         0 $CPAN::Frontend->mydie(
398             "'o conf defaults' disabled in ".
399             "degraded mode. Maybe try\n".
400             " !undef \$CPAN::RUN_DEGRADED\n"
401             );
402             }
403 0         0 my $done;
404 0         0 for my $config (qw(CPAN/MyConfig.pm CPAN/Config.pm)) {
405 0 0       0 if ($INC{$config}) {
406 0 0       0 CPAN->debug("INC{'$config'}[$INC{$config}]") if $CPAN::DEBUG;
407 0         0 CPAN::Shell->_reload_this($config,{reloforce => 1});
408 0         0 $CPAN::Frontend->myprint("'$INC{$config}' reread\n");
409 0         0 last;
410             }
411             }
412 0         0 $CPAN::CONFIG_DIRTY = 0;
413 0         0 1;
414             }
415              
416             =head2 C<< CLASS->safe_quote ITEM >>
417              
418             Quotes an item to become safe against spaces
419             in shell interpolation. An item is enclosed
420             in double quotes if:
421              
422             - the item contains spaces in the middle
423             - the item does not start with a quote
424              
425             This happens to avoid shell interpolation
426             problems when whitespace is present in
427             directory names.
428              
429             This method uses C to determine
430             the correct quote. If C is
431             a space, no quoting will take place.
432              
433              
434             if it starts and ends with the same quote character: leave it as it is
435              
436             if it contains no whitespace: leave it as it is
437              
438             if it contains whitespace, then
439              
440             if it contains quotes: better leave it as it is
441              
442             else: quote it with the correct quote type for the box we're on
443              
444             =cut
445              
446             {
447             # Instead of patching the guess, set commands_quote
448             # to the right value
449             my ($quotes,$use_quote)
450             = $^O eq 'MSWin32'
451             ? ('"', '"')
452             : (q{"'}, "'")
453             ;
454              
455             sub safe_quote {
456 2     2 1 5 my ($self, $command) = @_;
457             # Set up quote/default quote
458 2   33     14 my $quote = $CPAN::Config->{commands_quote} || $quotes;
459              
460 2 50 33     27 if ($quote ne ' '
      33        
      33        
461             and defined($command )
462             and $command =~ /\s/
463             and $command !~ /[$quote]/) {
464 0         0 return qq<$use_quote$command$use_quote>
465             }
466 2         6 return $command;
467             }
468             }
469              
470             sub init {
471 0     0 0 0 my($self,@args) = @_;
472 0         0 CPAN->debug("self[$self]args[".join(",",@args)."]");
473 0         0 $self->load(do_init => 1, @args);
474 0         0 1;
475             }
476              
477             # Loads CPAN::MyConfig or fall-back to CPAN::Config. Will not reload a file
478             # if already loaded. Returns the path to the file %INC or else the empty string
479             #
480             # Note -- if CPAN::Config were loaded and CPAN::MyConfig subsequently
481             # created, calling this again will leave *both* in %INC
482              
483             sub require_myconfig_or_config () {
484 7 50 33 7 0 92 if ( $INC{"CPAN/MyConfig.pm"} || _try_loading("CPAN::MyConfig", cpan_home())) {
    0 0        
485 7         35 return $INC{"CPAN/MyConfig.pm"};
486             }
487             elsif ( $INC{"CPAN/Config.pm"} || _try_loading("CPAN::Config") ) {
488 0         0 return $INC{"CPAN/Config.pm"};
489             }
490             else {
491 0         0 return q{};
492             }
493             }
494              
495             # Load a module, but ignore "can't locate..." errors
496             # Optionally take a list of directories to add to @INC for the load
497             sub _try_loading {
498 0     0   0 my ($module, @dirs) = @_;
499 0         0 (my $file = $module) =~ s{::}{/}g;
500 0         0 $file .= ".pm";
501              
502 0         0 local @INC = @INC;
503 0         0 for my $dir ( @dirs ) {
504 0 0       0 if ( -f File::Spec->catfile($dir, $file) ) {
505 0         0 unshift @INC, $dir;
506 0         0 last;
507             }
508             }
509              
510 0         0 eval { require $file };
  0         0  
511 0         0 my $err_myconfig = $@;
512 0 0 0     0 if ($err_myconfig and $err_myconfig !~ m#locate \Q$file\E#) {
513 0         0 die "Error while requiring ${module}:\n$err_myconfig";
514             }
515 0         0 return $INC{$file};
516             }
517              
518             # prioritized list of possible places for finding "CPAN/MyConfig.pm"
519             sub cpan_home_dir_candidates {
520 0     0 0 0 my @dirs;
521 0         0 my $old_v = $CPAN::Config->{load_module_verbosity};
522 0         0 $CPAN::Config->{load_module_verbosity} = q[none];
523 0 0       0 if ($CPAN::META->has_usable('File::HomeDir')) {
524 0 0       0 if ($^O ne 'darwin') {
525 0         0 push @dirs, File::HomeDir->my_data;
526             # my_data is ~/Library/Application Support on darwin,
527             # which causes issues in the toolchain.
528             }
529 0         0 push @dirs, File::HomeDir->my_home;
530             }
531             # Windows might not have HOME, so check it first
532 0 0       0 push @dirs, $ENV{HOME} if $ENV{HOME};
533             # Windows might have these instead
534 0 0 0     0 push( @dirs, File::Spec->catpath($ENV{HOMEDRIVE}, $ENV{HOMEPATH}, '') )
535             if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
536 0 0       0 push @dirs, $ENV{USERPROFILE} if $ENV{USERPROFILE};
537              
538 0         0 $CPAN::Config->{load_module_verbosity} = $old_v;
539 0 0       0 my $dotcpan = $^O eq 'VMS' ? '_cpan' : '.cpan';
540 0         0 @dirs = map { File::Spec->catdir($_, $dotcpan) } grep { defined } @dirs;
  0         0  
  0         0  
541 0 0       0 return wantarray ? @dirs : $dirs[0];
542             }
543              
544             sub load {
545 7     7 0 68 my($self, %args) = @_;
546 7         23 $CPAN::Be_Silent+=0; # protect against 'used only once'
547 7 50       38 $CPAN::Be_Silent++ if $args{be_silent}; # do not use; planned to be removed in 2011
548 7   50     65 my $do_init = delete $args{do_init} || 0;
549 7         17 my $make_myconfig = delete $args{make_myconfig};
550 7 100       57 $loading = 0 unless defined $loading;
551              
552 7         38 my $configpm = require_myconfig_or_config;
553 7         62 my @miss = $self->missing_config_data;
554 7 50       48 CPAN->debug("do_init[$do_init]loading[$loading]miss[@miss]") if $CPAN::DEBUG;
555 7 50 33     175 return unless $do_init || @miss;
556              
557             # I'm not how we'd ever wind up in a recursive loop, but I'm leaving
558             # this here for safety's sake -- dagolden, 2011-01-19
559 0 0       0 return if $loading;
560 0   0     0 local $loading = ($loading||0) + 1;
561              
562             # Warn if we have a config file, but things were found missing
563 0 0 0     0 if ($configpm && @miss && !$do_init) {
      0        
564 0 0 0     0 if ($make_myconfig || ( ! -w $configpm && $configpm =~ m{CPAN/Config\.pm})) {
      0        
565 0         0 $configpm = make_new_config();
566 0         0 $CPAN::Frontend->myprint(<
567             The system CPAN configuration file has provided some default values,
568             but you need to complete the configuration dialog for CPAN.pm.
569             Configuration will be written to
570             <<$configpm>>
571             END
572             }
573             else {
574 0         0 $CPAN::Frontend->myprint(<
575             Sorry, we have to rerun the configuration dialog for CPAN.pm due to
576             some missing parameters. Configuration will be written to
577             <<$configpm>>
578              
579             END
580             }
581             }
582              
583 0         0 require CPAN::FirstTime;
584 0   0     0 return CPAN::FirstTime::init($configpm || make_new_config(), %args);
585             }
586              
587             # Creates a new, empty config file at the preferred location
588             # Any existing will be renamed with a ".bak" suffix if possible
589             # If the file cannot be created, an exception is thrown
590             sub make_new_config {
591 0     0 0 0 my $configpm = _new_config_name();
592 0         0 my $configpmdir = File::Basename::dirname( $configpm );
593 0 0       0 File::Path::mkpath($configpmdir) unless -d $configpmdir;
594              
595 0 0       0 if ( -w $configpmdir ) {
596             #_#_# following code dumped core on me with 5.003_11, a.k.
597 0 0       0 if( -f $configpm ) {
598 0         0 my $configpm_bak = "$configpm.bak";
599 0 0       0 unlink $configpm_bak if -f $configpm_bak;
600 0 0       0 if( rename $configpm, $configpm_bak ) {
601 0         0 $CPAN::Frontend->mywarn(<
602             Old configuration file $configpm
603             moved to $configpm_bak
604             END
605             }
606             }
607 0         0 my $fh = FileHandle->new;
608 0 0       0 if ($fh->open(">$configpm")) {
609 0         0 $fh->print("1;\n");
610 0         0 return $configpm;
611             }
612             }
613 0         0 _die_cant_write_config($configpm);
614             }
615              
616             sub _die_cant_write_config {
617 0     0   0 my ($configpm) = @_;
618 0         0 $CPAN::Frontend->mydie(<<"END");
619             WARNING: CPAN.pm is unable to write a configuration file. You
620             must be able to create and write to '$configpm'.
621              
622             Aborting configuration.
623             END
624              
625             }
626              
627             # From candidate directories, we would like (in descending preference order):
628             # * the one that contains a MyConfig file
629             # * one that exists (even without MyConfig)
630             # * the first one on the list
631             sub cpan_home {
632 0     0 0 0 my @dirs = cpan_home_dir_candidates();
633 0         0 for my $d (@dirs) {
634 0 0       0 return $d if -f "$d/CPAN/MyConfig.pm";
635             }
636 0         0 for my $d (@dirs) {
637 0 0       0 return $d if -d $d;
638             }
639 0         0 return $dirs[0];
640             }
641              
642             sub _new_config_name {
643 0     0   0 return File::Spec->catfile(cpan_home(), 'CPAN', 'MyConfig.pm');
644             }
645              
646             # returns mandatory but missing entries in the Config
647             sub missing_config_data {
648 7     7 0 24 my(@miss);
649 7 50       58 for (
650             "auto_commit",
651             "build_cache",
652             "build_dir",
653             "cache_metadata",
654             "cpan_home",
655             "ftp_proxy",
656             #"gzip",
657             "http_proxy",
658             "index_expire",
659             #"inhibit_startup_message",
660             "keep_source_where",
661             #"make",
662             "make_arg",
663             "make_install_arg",
664             "makepl_arg",
665             "mbuild_arg",
666             "mbuild_install_arg",
667             ($^O eq "MSWin32" ? "" : "mbuild_install_build_command"),
668             "mbuildpl_arg",
669             "no_proxy",
670             #"pager",
671             "prerequisites_policy",
672             "scan_cache",
673             #"tar",
674             #"unzip",
675             "urllist",
676             ) {
677 140 50       323 next unless exists $keys{$_};
678 140 50       527 push @miss, $_ unless defined $CPAN::Config->{$_};
679             }
680 7         30 return @miss;
681             }
682              
683             sub help {
684 0     0 0   $CPAN::Frontend->myprint(q[
685             Known options:
686             commit commit session changes to disk
687             defaults reload default config values from disk
688             help this help
689             init enter a dialog to set all or a set of parameters
690              
691             Edit key values as in the following (the "o" is a literal letter o):
692             o conf build_cache 15
693             o conf build_dir "/foo/bar"
694             o conf urllist shift
695             o conf urllist unshift ftp://ftp.foo.bar/
696             o conf inhibit_startup_message 1
697              
698             ]);
699 0           1; #don't reprint CPAN::Config
700             }
701              
702             sub cpl {
703 0     0 0   my($word,$line,$pos) = @_;
704 0   0       $word ||= "";
705 0 0         CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
706 0           my(@words) = split " ", substr($line,0,$pos+1);
707 0 0 0       if (
    0 0        
    0 0        
      0        
      0        
      0        
708             defined($words[2])
709             and
710             $words[2] =~ /list$/
711             and
712             (
713             @words == 3
714             ||
715             @words == 4 && length($word)
716             )
717             ) {
718 0           return grep /^\Q$word\E/, qw(splice shift unshift pop push);
719             } elsif (defined($words[2])
720             and
721             $words[2] eq "init"
722             and
723             (
724             @words == 3
725             ||
726             @words >= 4 && length($word)
727             )) {
728 0           return sort grep /^\Q$word\E/, keys %keys;
729             } elsif (@words >= 4) {
730 0           return ();
731             }
732 0           my %seen;
733 0           my(@o_conf) = sort grep { !$seen{$_}++ }
  0            
734             keys %can,
735             keys %$CPAN::Config,
736             keys %keys;
737 0           return grep /^\Q$word\E/, @o_conf;
738             }
739              
740             sub prefs_lookup {
741 0     0 0   my($self,$distro,$what) = @_;
742              
743 0 0         if ($prefssupport{$what}) {
744 0 0 0       return $CPAN::Config->{$what} unless
      0        
      0        
745             $distro
746             and $distro->prefs
747             and $distro->prefs->{cpanconfig}
748             and defined $distro->prefs->{cpanconfig}{$what};
749 0           return $distro->prefs->{cpanconfig}{$what};
750             } else {
751 0           $CPAN::Frontend->mywarn("Warning: $what not yet officially ".
752             "supported for distroprefs, doing a normal lookup");
753 0           return $CPAN::Config->{$what};
754             }
755             }
756              
757              
758             {
759             package
760             CPAN::Config; ####::###### #hide from indexer
761             # note: J. Nick Koston wrote me that they are using
762             # CPAN::Config->commit although undocumented. I suggested
763             # CPAN::Shell->o("conf","commit") even when ugly it is at least
764             # documented
765              
766             # that's why I added the CPAN::Config class with autoload and
767             # deprecated warning
768              
769 8     8   225 use strict;
  8         25  
  8         408  
770 8     8   50 use vars qw($AUTOLOAD $VERSION);
  8         17  
  8         1510  
771             $VERSION = "5.5002";
772              
773             # formerly CPAN::HandleConfig was known as CPAN::Config
774             sub AUTOLOAD { ## no critic
775 0     0     my $class = shift; # e.g. in dh-make-perl: CPAN::Config
776 0           my($l) = $AUTOLOAD;
777 0           $CPAN::Frontend->mywarn("Dispatching deprecated method '$l' to CPAN::HandleConfig\n");
778 0           $l =~ s/.*:://;
779 0           CPAN::HandleConfig->$l(@_);
780             }
781             }
782              
783             1;
784              
785             __END__