File Coverage

blib/lib/CPAN/HandleConfig.pm
Criterion Covered Total %
statement 65 283 22.9
branch 16 164 9.7
condition 7 101 6.9
subroutine 13 29 44.8
pod 1 16 6.2
total 102 593 17.2


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