← Index
NYTProf Performance Profile   « line view »
For /Users/brian/bin/perls/cpan5.26.1
  Run on Sat Dec 30 01:41:10 2017
Reported on Sat Dec 30 01:44:14 2017

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