← 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.pm
StatementsExecuted 241946 statements in 844ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111472ms119sCPAN::::shell CPAN::shell
611334ms334msCPAN::::CORE:sort CPAN::CORE:sort (opcode)
26014566.8ms196msCPAN::::has_inst CPAN::has_inst
247425.58ms6.16msCPAN::::cleanup CPAN::cleanup
118441.93ms19.7msCPAN::::_yaml_module CPAN::_yaml_module
28371693µs693µsCPAN::::CORE:subst CPAN::CORE:subst (opcode)
655566µs67.6msCPAN::::has_usable CPAN::has_usable
111292µs292µsCPAN::::CORE:unlink CPAN::CORE:unlink (opcode)
111182µs1.13msCPAN::::checklock CPAN::checklock
611157µs157µsCPAN::::CORE:stat CPAN::CORE:stat (opcode)
443130µs27.7msCPAN::::anycwd CPAN::anycwd
621126µs2.54sCPAN::::exists CPAN::exists
173194µs94µsCPAN::::CORE:match CPAN::CORE:match (opcode)
183289µs89µsCPAN::::_sqlite_running CPAN::_sqlite_running
22176µs97µsCPAN::::set_perl5lib CPAN::set_perl5lib
41173µs27.6msCPAN::::cwd CPAN::cwd
22272µs160µsCPAN::::_flock CPAN::_flock
22168µs68µsCPAN::::CORE:ftfile CPAN::CORE:ftfile (opcode)
11160µs60µsCPAN::::CORE:close CPAN::CORE:close (opcode)
11158µs123µsCPAN::::savehist CPAN::savehist
42157µs510µsCPAN::::soft_chdir_with_alternatives CPAN::soft_chdir_with_alternatives
11154µs54µsCPAN::::CORE:truncate CPAN::CORE:truncate (opcode)
11154µs240µsCPAN::::_yaml_loadfile CPAN::_yaml_loadfile
21152µs52µsCPAN::::CORE:flock CPAN::CORE:flock (opcode)
52246µs127µsCPAN::::instance CPAN::instance
11144µs387µsCPAN::::__ANON__[:1113] CPAN::__ANON__[:1113]
31141µs49µsCPAN::::_redirect CPAN::_redirect
11124µs24µsCPAN::::_exit_messages CPAN::_exit_messages
11122µs752µsCPAN::::END CPAN::END
11115µs15µsCPAN::::CORE:fttty CPAN::CORE:fttty (opcode)
33115µs15µsCPAN::::CORE:select CPAN::CORE:select (opcode)
31112µs12µsCPAN::::_unredirect CPAN::_unredirect
11111µs11µsCPAN::::CORE:ftsize CPAN::CORE:ftsize (opcode)
1116µs6µsCPAN::::CORE:seek CPAN::CORE:seek (opcode)
0000s0sCPAN::::AUTOLOAD CPAN::AUTOLOAD
0000s0sCPAN::::DESTROY CPAN::DESTROY
0000s0sCPAN::Eval::::BEGINCPAN::Eval::BEGIN
0000s0sCPAN::::__ANON__[:1036] CPAN::__ANON__[:1036]
0000s0sCPAN::::__ANON__[:1048] CPAN::__ANON__[:1048]
0000s0sCPAN::::__ANON__[:1054] CPAN::__ANON__[:1054]
0000s0sCPAN::::__ANON__[:1055] CPAN::__ANON__[:1055]
0000s0sCPAN::::__ANON__[:1056] CPAN::__ANON__[:1056]
0000s0sCPAN::::__ANON__[:1064] CPAN::__ANON__[:1064]
0000s0sCPAN::::__ANON__[:1076] CPAN::__ANON__[:1076]
0000s0sCPAN::::__ANON__[:1077] CPAN::__ANON__[:1077]
0000s0sCPAN::::__ANON__[:1078] CPAN::__ANON__[:1078]
0000s0sCPAN::::__ANON__[:1089] CPAN::__ANON__[:1089]
0000s0sCPAN::::__ANON__[:1099] CPAN::__ANON__[:1099]
0000s0sCPAN::::__ANON__[:1127] CPAN::__ANON__[:1127]
0000s0sCPAN::::__ANON__[:280] CPAN::__ANON__[:280]
0000s0sCPAN::::__ANON__[:878] CPAN::__ANON__[:878]
0000s0sCPAN::::__ANON__[:887] CPAN::__ANON__[:887]
0000s0sCPAN::::_init_sqlite CPAN::_init_sqlite
0000s0sCPAN::::_list_sorted_descending_is_tested CPAN::_list_sorted_descending_is_tested
0000s0sCPAN::::_perl_fingerprint CPAN::_perl_fingerprint
0000s0sCPAN::::_perl_is_same CPAN::_perl_is_same
0000s0sCPAN::::_uniq CPAN::_uniq
0000s0sCPAN::::_yaml_dumpfile CPAN::_yaml_dumpfile
0000s0sCPAN::::all_objects CPAN::all_objects
0000s0sCPAN::::backtickcwd CPAN::backtickcwd
0000s0sCPAN::::delete CPAN::delete
0000s0sCPAN::::fastcwd CPAN::fastcwd
0000s0sCPAN::::find_perl CPAN::find_perl
0000s0sCPAN::::frontend CPAN::frontend
0000s0sCPAN::::getcwd CPAN::getcwd
0000s0sCPAN::::getdcwd CPAN::getdcwd
0000s0sCPAN::::is_installed CPAN::is_installed
0000s0sCPAN::::is_tested CPAN::is_tested
0000s0sCPAN::::new CPAN::new
0000s0sCPAN::::readhist CPAN::readhist
0000s0sCPAN::::reset_tested CPAN::reset_tested
0000s0sCPAN::::suggest_myconfig CPAN::suggest_myconfig
0000s0sCPAN::::use_inst CPAN::use_inst
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2# vim: ts=4 sts=4 sw=4:
3use strict;
4package CPAN;
5$CPAN::VERSION = '2.18';
6$CPAN::VERSION =~ s/_//;
7
8# we need to run chdir all over and we would get at wrong libraries
9# there
10use File::Spec ();
11BEGIN {
12 if (File::Spec->can("rel2abs")) {
13 for my $inc (@INC) {
14 $inc = File::Spec->rel2abs($inc) unless ref $inc;
15 }
16 }
17 $SIG{WINCH} = 'IGNORE' if exists $SIG{WINCH};
18}
19use CPAN::Author;
20use CPAN::HandleConfig;
21use CPAN::Version;
22use CPAN::Bundle;
23use CPAN::CacheMgr;
24use CPAN::Complete;
25use CPAN::Debug;
26use CPAN::Distribution;
27use CPAN::Distrostatus;
28use CPAN::FTP;
29use CPAN::Index 1.93; # https://rt.cpan.org/Ticket/Display.html?id=43349
30use CPAN::InfoObj;
31use CPAN::Module;
32use CPAN::Prompt;
33use CPAN::URL;
34use CPAN::Queue;
35use CPAN::Tarzip;
36use CPAN::DeferredCode;
37use CPAN::Shell;
38use CPAN::LWP::UserAgent;
39use CPAN::Exception::RecursiveDependency;
40use CPAN::Exception::yaml_not_installed;
41use CPAN::Exception::yaml_process_error;
42
43use Carp ();
44use Config ();
45use Cwd qw(chdir);
46use DirHandle ();
47use Exporter ();
48use ExtUtils::MakeMaker qw(prompt); # for some unknown reason,
49 # 5.005_04 does not work without
50 # this
51use File::Basename ();
52use File::Copy ();
53use File::Find;
54use File::Path ();
55use FileHandle ();
56use Fcntl qw(:flock);
57use Safe ();
58use Sys::Hostname qw(hostname);
59use Text::ParseWords ();
60use Text::Wrap ();
61
62# protect against "called too early"
63sub find_perl ();
64sub anycwd ();
65sub _uniq;
66
67no lib ".";
68
69require Mac::BuildTools if $^O eq 'MacOS';
70if ($ENV{PERL5_CPAN_IS_RUNNING} && $$ != $ENV{PERL5_CPAN_IS_RUNNING}) {
71 $ENV{PERL5_CPAN_IS_RUNNING_IN_RECURSION} ||= $ENV{PERL5_CPAN_IS_RUNNING};
72 my @rec = _uniq split(/,/, $ENV{PERL5_CPAN_IS_RUNNING_IN_RECURSION}), $$;
73 $ENV{PERL5_CPAN_IS_RUNNING_IN_RECURSION} = join ",", @rec;
74 # warn "# Note: Recursive call of CPAN.pm detected\n";
75 my $w = sprintf "# Note: CPAN.pm is running in process %d now", pop @rec;
76 my %sleep = (
77 5 => 30,
78 6 => 60,
79 7 => 120,
80 );
81 my $sleep = @rec > 7 ? 300 : ($sleep{scalar @rec}||0);
82 my $verbose = @rec >= 4;
83 while (@rec) {
84 $w .= sprintf " which has been called by process %d", pop @rec;
85 }
86 if ($sleep) {
87 $w .= ".\n\n# Sleeping $sleep seconds to protect other processes\n";
88 }
89 if ($verbose) {
90 warn $w;
91 }
92 local $| = 1;
93 while ($sleep > 0) {
94 printf "\r#%5d", --$sleep;
95 sleep 1;
96 }
97 print "\n";
98}
99$ENV{PERL5_CPAN_IS_RUNNING}=$$;
100$ENV{PERL5_CPANPLUS_IS_RUNNING}=$$; # https://rt.cpan.org/Ticket/Display.html?id=23735
101
102218µs1730µs
# spent 752µs (22+730) within CPAN::END which was called: # once (22µs+730µs) by main::RUNTIME at line 0 of /Users/brian/bin/perls/cpan5.26.1
END { $CPAN::End++; &cleanup; }
# spent 730µs making 1 call to CPAN::cleanup
103
104$CPAN::Signal ||= 0;
105$CPAN::Frontend ||= "CPAN::Shell";
106unless (@CPAN::Defaultsites) {
107 @CPAN::Defaultsites = map {
108 CPAN::URL->new(TEXT => $_, FROM => "DEF")
109 }
110 "http://www.perl.org/CPAN/",
111 "ftp://ftp.perl.org/pub/CPAN/";
112}
113# $CPAN::iCwd (i for initial)
114$CPAN::iCwd ||= CPAN::anycwd();
115$CPAN::Perl ||= CPAN::find_perl();
116$CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
117$CPAN::Defaultrecent ||= "http://search.cpan.org/uploads.rdf";
118$CPAN::Defaultrecent ||= "http://cpan.uwinnipeg.ca/htdocs/cpan.xml";
119
120# our globals are getting a mess
121use vars qw(
122 $AUTOLOAD
123 $Be_Silent
124 $CONFIG_DIRTY
125 $Defaultdocs
126 $Echo_readline
127 $Frontend
128 $GOTOSHELL
129 $HAS_USABLE
130 $Have_warned
131 $MAX_RECURSION
132 $META
133 $RUN_DEGRADED
134 $Signal
135 $SQLite
136 $Suppress_readline
137 $VERSION
138 $autoload_recursion
139 $term
140 @Defaultsites
141 @EXPORT
142 );
143
144$MAX_RECURSION = 32;
145
146@CPAN::ISA = qw(CPAN::Debug Exporter);
147
148# note that these functions live in CPAN::Shell and get executed via
149# AUTOLOAD when called directly
150@EXPORT = qw(
151 autobundle
152 bundle
153 clean
154 cvs_import
155 expand
156 force
157 fforce
158 get
159 install
160 install_tested
161 is_tested
162 make
163 mkmyconfig
164 notest
165 perldoc
166 readme
167 recent
168 recompile
169 report
170 shell
171 smoke
172 test
173 upgrade
174 );
175
176sub soft_chdir_with_alternatives ($);
177
178{
179 $autoload_recursion ||= 0;
180
181 #-> sub CPAN::AUTOLOAD ;
182 sub AUTOLOAD { ## no critic
183 $autoload_recursion++;
184 my($l) = $AUTOLOAD;
185 $l =~ s/.*:://;
186 if ($CPAN::Signal) {
187 warn "Refusing to autoload '$l' while signal pending";
188 $autoload_recursion--;
189 return;
190 }
191 if ($autoload_recursion > 1) {
192 my $fullcommand = join " ", map { "'$_'" } $l, @_;
193 warn "Refusing to autoload $fullcommand in recursion\n";
194 $autoload_recursion--;
195 return;
196 }
197 my(%export);
198 @export{@EXPORT} = '';
199 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
200 if (exists $export{$l}) {
201 CPAN::Shell->$l(@_);
202 } else {
203 die(qq{Unknown CPAN command "$AUTOLOAD". }.
204 qq{Type ? for help.\n});
205 }
206 $autoload_recursion--;
207 }
208}
209
210{
211 my $x = *SAVEOUT; # avoid warning
212 open($x,">&STDOUT") or die "dup failed";
213 my $redir = 0;
214
# spent 49µs (41+8) within CPAN::_redirect which was called 3 times, avg 16µs/call: # 3 times (41µs+8µs) by CPAN::shell at line 375, avg 16µs/call
sub _redirect(@) {
215 #die if $redir;
21630s local $_;
21733µs push(@_,undef);
21835µs while(defined($_=shift)) {
219324µs68µs if (s/^\s*>//){
# spent 8µs making 6 calls to CPAN::CORE:subst, avg 1µs/call
220 my ($m) = s/^>// ? ">" : "";
221 s/\s+//;
222 $_=shift unless length;
223 die "no dest" unless defined;
224 open(STDOUT,">$m$_") or die "open:$_:$!\n";
225 $redir=1;
226 } elsif ( s/^\s*\|\s*// ) {
227 my $pipe="| $_";
228 while(defined($_[0])){
229 $pipe .= ' ' . shift;
230 }
231 open(STDOUT,$pipe) or die "open:$pipe:$!\n";
232 $redir=1;
233 } else {
23433µs push(@_,$_);
235 }
236 }
237315µs return @_;
238 }
239
# spent 12µs within CPAN::_unredirect which was called 3 times, avg 4µs/call: # 3 times (12µs+0s) by CPAN::shell at line 379, avg 4µs/call
sub _unredirect {
240320µs return unless $redir;
241 $redir = 0;
242 ## redirect: unredirect and propagate errors. explicit close to wait for pipe.
243 close(STDOUT);
244 open(STDOUT,">&SAVEOUT");
245 die "$@" if "$@";
246 ## redirect: done
247 }
248}
249
250sub _uniq {
251 my(@list) = @_;
252 my %seen;
253 return grep { !$seen{$_}++ } @list;
254}
255
256#-> sub CPAN::shell ;
257
# spent 119s (472ms+118) within CPAN::shell which was called: # once (472ms+118s) by App::Cpan::_process_options at line 414 of App/Cpan.pm
sub shell {
25814µs my($self) = @_;
259131µs115µs $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
# spent 15µs making 1 call to CPAN::CORE:fttty
260116µs11.42ms CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
# spent 1.42ms making 1 call to CPAN::HandleConfig::load
261
262115µs110µs my $oprompt = shift || CPAN::Prompt->new;
# spent 10µs making 1 call to CPAN::Prompt::new
26310s my $prompt = $oprompt;
26410s my $commandline = shift || "";
26513µs $CPAN::CurrentCommandId ||= 1;
266
26714µs local($^W) = 1;
26812µs unless ($Suppress_readline) {
2691650µs require Term::ReadLine;
27011µs if (! $term
271 or
272 $term->ReadLine eq "Term::ReadLine::Stub"
273 ) {
27418µs149.3ms $term = Term::ReadLine->new('CPAN Monitor');
# spent 49.3ms making 1 call to Term::ReadLine::Stub::new
275 }
27615µs14µs if ($term->ReadLine eq "Term::ReadLine::Gnu") {
# spent 4µs making 1 call to Term::ReadLine::Stub::ReadLine
277 my $attribs = $term->Attribs;
278 $attribs->{attempted_completion_function} = sub {
279 &CPAN::Complete::gnu_cpl;
280 }
281 } else {
28212µs $readline::rl_completion_function =
283 $readline::rl_completion_function = 'CPAN::Complete::cpl';
284 }
28515µs if (my $histfile = $CPAN::Config->{'histfile'}) {{
286233µs15µs unless ($term->can("AddHistory")) {
# spent 5µs making 1 call to UNIVERSAL::can
287134µs1143µs $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
# spent 143µs making 1 call to App::Cpan::__ANON__[App/Cpan.pm:681]
28812µs last;
289 }
290 $META->readhist($term,$histfile);
291 }}
29215µs for ($CPAN::Config->{term_ornaments}) { # alias
29311µs local $Term::ReadLine::termcap_nowarn = 1;
29416µs1115µs $term->ornaments($_) if defined;
# spent 115µs making 1 call to Term::ReadLine::TermCap::ornaments
295 }
296 # $term->OUT is autoflushed anyway
297130µs17µs my $odef = select STDERR;
# spent 7µs making 1 call to CPAN::CORE:select
29812µs $| = 1;
299111µs15µs select STDOUT;
# spent 5µs making 1 call to CPAN::CORE:select
30011µs $| = 1;
301111µs13µs select $odef;
# spent 3µs making 1 call to CPAN::CORE:select
302 }
303
304111µs11.13ms $META->checklock();
# spent 1.13ms making 1 call to CPAN::checklock
305158µs44.57ms my @cwd = grep { defined $_ and length $_ }
# spent 4.30ms making 1 call to CPAN::anycwd # spent 251µs making 1 call to File::Spec::Unix::tmpdir # spent 8µs making 1 call to UNIVERSAL::can # spent 5µs making 1 call to File::Spec::Unix::rootdir
306 CPAN::anycwd(),
307 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
308 File::Spec->rootdir();
30911µs my $try_detect_readline;
310127µs15µs $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
# spent 5µs making 1 call to Term::ReadLine::Stub::ReadLine
31112µs unless ($CPAN::Config->{inhibit_startup_message}) {
31215µs11µs my $rl_avail = $Suppress_readline ? "suppressed" :
# spent 1µs making 1 call to Term::ReadLine::Stub::ReadLine
313 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
314 "available (maybe install Bundle::CPAN or Bundle::CPANxxl?)";
315159µs195µs $CPAN::Frontend->myprint(
# spent 95µs making 1 call to App::Cpan::__ANON__[App/Cpan.pm:673]
316 sprintf qq{
317cpan shell -- CPAN exploration and modules installation (v%s)
318Enter 'h' for help.
319
320},
321 $CPAN::VERSION,
322 )
323 }
32412µs my($continuation) = "";
32510s my $last_term_ornaments;
32612µs SHELLCOMMAND: while () {
32744µs if ($Suppress_readline) {
328 if ($Echo_readline) {
329 $|=1;
330 }
331 print $prompt;
332 last SHELLCOMMAND unless defined ($_ = <> );
333 if ($Echo_readline) {
334 # backdoor: I could not find a way to record sessions
335 print $_;
336 }
337 chomp;
338 } else {
339 last SHELLCOMMAND unless
340449µs420.4s defined ($_ = $term->readline($prompt, $commandline));
# spent 20.4s making 4 calls to Term::ReadLine::Stub::readline, avg 5.10s/call
341 }
34243µs $_ = "$continuation$_" if $continuation;
343466µs441µs s/^\s+//;
# spent 41µs making 4 calls to CPAN::CORE:subst, avg 10µs/call
344477µs443µs next SHELLCOMMAND if /^$/;
# spent 43µs making 4 calls to CPAN::CORE:match, avg 11µs/call
345449µs419µs s/^\s*\?\s*/help /;
# spent 19µs making 4 calls to CPAN::CORE:subst, avg 5µs/call
346482µs1341µs if (/^(?:q(?:uit)?|bye|exit)\s*$/i) {
# spent 36µs making 10 calls to CPAN::CORE:match, avg 4µs/call # spent 5µs making 3 calls to CPAN::CORE:subst, avg 2µs/call
347116µs last SHELLCOMMAND;
348 } elsif (s/\\$//s) {
349 chomp;
350 $continuation = $_;
351 $prompt = " > ";
352 } elsif (/^\!/) {
353 s/^\!//;
354 my($eval) = $_;
355 package
356 CPAN::Eval; # hide from the indexer
357 use strict;
358 use vars qw($import_done);
359 CPAN->import(':DEFAULT') unless $import_done++;
360 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
361 eval($eval);
362 warn $@ if $@;
363 $continuation = "";
364 $prompt = $oprompt;
365 } elsif (/./) {
36634µs my(@line);
367636µs3522µs eval { @line = Text::ParseWords::shellwords($_) };
# spent 522µs making 3 calls to Text::ParseWords::shellwords, avg 174µs/call
36831µs warn($@), next SHELLCOMMAND if $@;
36932µs warn("Text::Parsewords could not parse the line [$_]"),
370 next SHELLCOMMAND unless @line;
37132µs $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
37234µs my $command = shift @line;
37334µs eval {
37437µs local (*STDOUT)=*STDOUT;
375315µs349µs @line = _redirect(@line);
# spent 49µs making 3 calls to CPAN::_redirect, avg 16µs/call
376338µs397.3s CPAN::Shell->$command(@line)
# spent 97.3s making 1 call to CPAN::Shell::__ANON__[CPAN/Shell.pm:2067] # spent 6.83ms making 2 calls to CPAN::Shell::o, avg 3.41ms/call
377 };
37836µs my $command_error = $@;
379314µs312µs _unredirect;
# spent 12µs making 3 calls to CPAN::_unredirect, avg 4µs/call
38030s my $reported_error;
38133µs if ($command_error) {
382 my $err = $command_error;
383 if (ref $err and $err->isa('CPAN::Exception::blocked_urllist')) {
384 $CPAN::Frontend->mywarn("Client not fully configured, please proceed with configuring.$err");
385 $reported_error = ref $err;
386 } else {
387 # I'd prefer never to arrive here and make all errors exception objects
388 if ($err =~ /\S/) {
389 require Carp;
390 require Dumpvalue;
391 my $dv = Dumpvalue->new(tick => '"');
392 Carp::cluck(sprintf "Catching error: %s", $dv->stringify($err));
393 }
394 }
395 }
396324µs315µs if ($command =~ /^(
# spent 15µs making 3 calls to CPAN::CORE:match, avg 5µs/call
397 # classic commands
398 make
399 |test
400 |install
401 |clean
402
403 # pragmas for classic commands
404 |ff?orce
405 |notest
406
407 # compounds
408 |report
409 |smoke
410 |upgrade
411 )$/x) {
412 # only commands that tell us something about failed distros
413 # eval necessary for people without an urllist
414 eval {CPAN::Shell->failed($CPAN::CurrentCommandId,1);};
415 if (my $err = $@) {
416 unless (ref $err and $reported_error eq ref $err) {
417 die $@;
418 }
419 }
420 }
421318µs3415µs soft_chdir_with_alternatives(\@cwd);
# spent 415µs making 3 calls to CPAN::soft_chdir_with_alternatives, avg 138µs/call
422322µs3160µs $CPAN::Frontend->myprint("\n");
# spent 160µs making 3 calls to App::Cpan::__ANON__[App/Cpan.pm:673], avg 53µs/call
42336µs $continuation = "";
42434µs $CPAN::CurrentCommandId++;
42538µs $prompt = $oprompt;
426 }
427 } continue {
42836µs $commandline = ""; # I do want to be able to pass a default to
429 # shell, but on the second command I see no
430 # use in that
43136µs $Signal=0;
432334µs322µs CPAN::Queue->nullify_queue;
# spent 22µs making 3 calls to CPAN::Queue::nullify_queue, avg 7µs/call
43335µs if ($try_detect_readline) {
434337µs6662µs if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
# spent 662µs making 6 calls to CPAN::has_inst, avg 110µs/call
435 ||
436 $CPAN::META->has_inst("Term::ReadLine::Perl")
437 ) {
438 delete $INC{"Term/ReadLine.pm"};
439 my $redef = 0;
440 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
441 require Term::ReadLine;
442 $CPAN::Frontend->myprint("\n$redef subroutines in ".
443 "Term::ReadLine redefined\n");
444 $GOTOSHELL = 1;
445 }
446 }
447349µs312µs if ($term and $term->can("ornaments")) {
# spent 12µs making 3 calls to UNIVERSAL::can, avg 4µs/call
44834µs for ($CPAN::Config->{term_ornaments}) { # alias
44932µs if (defined $_) {
45035µs if (not defined $last_term_ornaments
451 or $_ != $last_term_ornaments
452 ) {
45312µs local $Term::ReadLine::termcap_nowarn = 1;
45412µs164µs $term->ornaments($_);
# spent 64µs making 1 call to Term::ReadLine::TermCap::ornaments
45511µs $last_term_ornaments = $_;
456 }
457 } else {
458 undef $last_term_ornaments;
459 }
460 }
461 }
46237µs for my $class (qw(Module Distribution)) {
463 # again unsafe meta access?
4646529ms6334ms for my $dm (sort keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) {
# spent 334ms making 6 calls to CPAN::CORE:sort, avg 55.7ms/call
465235413272ms next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
466 CPAN->debug("BUG: $class '$dm' was in command state, resetting");
467 delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
468 }
469 }
47032µs if ($GOTOSHELL) {
471 $GOTOSHELL = 0; # not too often
472 $META->savehist if $CPAN::term && $CPAN::term->can("GetHistory");
473 @_ = ($oprompt,"");
474 goto &shell;
475 }
476 }
477173µs195µs soft_chdir_with_alternatives(\@cwd);
# spent 95µs making 1 call to CPAN::soft_chdir_with_alternatives
478}
479
480#-> CPAN::soft_chdir_with_alternatives ;
481
# spent 510µs (57+453) within CPAN::soft_chdir_with_alternatives which was called 4 times, avg 128µs/call: # 3 times (38µs+377µs) by CPAN::shell at line 421, avg 138µs/call # once (19µs+76µs) by CPAN::shell at line 477
sub soft_chdir_with_alternatives ($) {
48248µs my($cwd) = @_;
48343µs unless (@$cwd) {
484 my $root = File::Spec->rootdir();
485 $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to!
486Trying '$root' as temporary haven.
487});
488 push @$cwd, $root;
489 }
49041µs while () {
491477µs4453µs if (chdir $cwd->[0]) {
# spent 453µs making 4 calls to Cwd::chdir, avg 113µs/call
492 return;
493 } else {
494 if (@$cwd>1) {
495 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
496Trying to chdir to "$cwd->[1]" instead.
497});
498 shift @$cwd;
499 } else {
500 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
501 }
502 }
503 }
504}
505
506
# spent 160µs (72+88) within CPAN::_flock which was called 2 times, avg 80µs/call: # once (49µs+75µs) by CPAN::checklock at line 858 # once (23µs+13µs) by CPAN::FTP::_ftp_statistics at line 35 of CPAN/FTP.pm
sub _flock {
50722µs my($fh,$mode) = @_;
5082117µs488µs if ( $Config::Config{d_flock} || $Config::Config{d_fcntl_can_lock} ) {
# spent 52µs making 2 calls to CPAN::CORE:flock, avg 26µs/call # spent 36µs making 2 calls to Config::FETCH, avg 18µs/call
509 return flock $fh, $mode;
510 } elsif (!$Have_warned->{"d_flock"}++) {
511 $CPAN::Frontend->mywarn("Your OS does not seem to support locking; continuing and ignoring all locking issues\n");
512 $CPAN::Frontend->mysleep(5);
513 return 1;
514 } else {
515 return 1;
516 }
517}
518
519
# spent 19.7ms (1.93+17.8) within CPAN::_yaml_module which was called 118 times, avg 167µs/call: # 114 times (1.86ms+17.4ms) by CPAN::CacheMgr::_clean_cache at line 164 of CPAN/CacheMgr.pm, avg 169µs/call # 2 times (27µs+183µs) by CPAN::FTP::_add_to_statistics at line 98 of CPAN/FTP.pm, avg 105µs/call # once (28µs+150µs) by CPAN::Distribution::store_persistent_state at line 824 of CPAN/Distribution.pm # once (10µs+83µs) by CPAN::_yaml_loadfile at line 549
sub _yaml_module () {
520118326µs my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
521118130µs if (
522 $yaml_module ne "YAML"
523 &&
524 !$CPAN::META->has_inst($yaml_module)
525 ) {
526 # $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back to 'YAML'\n");
527 $yaml_module = "YAML";
528 }
529118662µs11817.8ms if ($yaml_module eq "YAML"
# spent 17.8ms making 118 calls to CPAN::has_inst, avg 151µs/call
530 &&
531 $CPAN::META->has_inst($yaml_module)
532 &&
533 $YAML::VERSION < 0.60
534 &&
535 !$Have_warned->{"YAML"}++
536 ) {
537 $CPAN::Frontend->mywarn("Warning: YAML version '$YAML::VERSION' is too low, please upgrade!\n".
538 "I'll continue but problems are *very* likely to happen.\n"
539 );
540 $CPAN::Frontend->mysleep(5);
541 }
542118530µs return $yaml_module;
543}
544
545# CPAN::_yaml_loadfile
546
# spent 240µs (54+186) within CPAN::_yaml_loadfile which was called: # once (54µs+186µs) by CPAN::FTP::_ftp_statistics at line 53 of CPAN/FTP.pm
sub _yaml_loadfile {
54711µs my($self,$local_file) = @_;
548120µs111µs return +[] unless -s $local_file;
# spent 11µs making 1 call to CPAN::CORE:ftsize
54913µs193µs my $yaml_module = _yaml_module;
# spent 93µs making 1 call to CPAN::_yaml_module
55013µs155µs if ($CPAN::META->has_inst($yaml_module)) {
# spent 55µs making 1 call to CPAN::has_inst
551 # temporarily enable yaml code deserialisation
552 no strict 'refs';
553 # 5.6.2 could not do the local() with the reference
554 # so we do it manually instead
555 my $old_loadcode = ${"$yaml_module\::LoadCode"};
556 ${ "$yaml_module\::LoadCode" } = $CPAN::Config->{yaml_load_code} || 0;
557
558 my ($code, @yaml);
559 if ($code = UNIVERSAL::can($yaml_module, "LoadFile")) {
560 eval { @yaml = $code->($local_file); };
561 if ($@) {
562 # this shall not be done by the frontend
563 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
564 }
565 } elsif ($code = UNIVERSAL::can($yaml_module, "Load")) {
566 local *FH;
567 open FH, $local_file or die "Could not open '$local_file': $!";
568 local $/;
569 my $ystream = <FH>;
570 eval { @yaml = $code->($ystream); };
571 if ($@) {
572 # this shall not be done by the frontend
573 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
574 }
575 }
576 ${"$yaml_module\::LoadCode"} = $old_loadcode;
577 return \@yaml;
578 } else {
579 # this shall not be done by the frontend
580131µs227µs die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "parse");
# spent 15µs making 1 call to CPAN::Exception::yaml_not_installed::new # spent 12µs making 1 call to CPAN::cleanup
581 }
582 return +[];
583}
584
585# CPAN::_yaml_dumpfile
586sub _yaml_dumpfile {
587 my($self,$local_file,@what) = @_;
588 my $yaml_module = _yaml_module;
589 if ($CPAN::META->has_inst($yaml_module)) {
590 my $code;
591 if (UNIVERSAL::isa($local_file, "FileHandle")) {
592 $code = UNIVERSAL::can($yaml_module, "Dump");
593 eval { print $local_file $code->(@what) };
594 } elsif ($code = UNIVERSAL::can($yaml_module, "DumpFile")) {
595 eval { $code->($local_file,@what); };
596 } elsif ($code = UNIVERSAL::can($yaml_module, "Dump")) {
597 local *FH;
598 open FH, ">$local_file" or die "Could not open '$local_file': $!";
599 print FH $code->(@what);
600 }
601 if ($@) {
602 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"dump",$@);
603 }
604 } else {
605 if (UNIVERSAL::isa($local_file, "FileHandle")) {
606 # I think this case does not justify a warning at all
607 } else {
608 die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "dump");
609 }
610 }
611}
612
613sub _init_sqlite () {
614 unless ($CPAN::META->has_inst("CPAN::SQLite")) {
615 $CPAN::Frontend->mywarn(qq{CPAN::SQLite not installed, trying to work without\n})
616 unless $Have_warned->{"CPAN::SQLite"}++;
617 return;
618 }
619 require CPAN::SQLite::META; # not needed since CVS version of 2006-12-17
620 $CPAN::SQLite ||= CPAN::SQLite::META->new($CPAN::META);
621}
622
623{
624 my $negative_cache = {};
625
# spent 89µs within CPAN::_sqlite_running which was called 18 times, avg 5µs/call: # 11 times (58µs+0s) by CPAN::Index::reload at line 104 of CPAN/Index.pm, avg 5µs/call # 6 times (14µs+0s) by CPAN::exists at line 997, avg 2µs/call # once (17µs+0s) by CPAN::Index::read_metadata_cache at line 569 of CPAN/Index.pm
sub _sqlite_running {
6261868µs if ($negative_cache->{time} && time < $negative_cache->{time} + 60) {
627 # need to cache the result, otherwise too slow
628 return $negative_cache->{fact};
629 } else {
630222µs $negative_cache = {}; # reset
631 }
63223µs my $ret = $CPAN::Config->{use_sqlite} && ($CPAN::SQLite || _init_sqlite());
63321µs return $ret if $ret; # fast anyway
63424µs $negative_cache->{time} = time;
635211µs return $negative_cache->{fact} = $ret;
636 }
637}
638
639$META ||= CPAN->new; # In case we re-eval ourselves we need the ||
640
641# from here on only subs.
642################################################################################
643
644sub _perl_fingerprint {
645 my($self,$other_fingerprint) = @_;
646 my $dll = eval {OS2::DLLname()};
647 my $mtime_dll = 0;
648 if (defined $dll) {
649 $mtime_dll = (-f $dll ? (stat(_))[9] : '-1');
650 }
651 my $mtime_perl = (-f CPAN::find_perl ? (stat(_))[9] : '-1');
652 my $this_fingerprint = {
653 '$^X' => CPAN::find_perl,
654 sitearchexp => $Config::Config{sitearchexp},
655 'mtime_$^X' => $mtime_perl,
656 'mtime_dll' => $mtime_dll,
657 };
658 if ($other_fingerprint) {
659 if (exists $other_fingerprint->{'stat($^X)'}) { # repair fp from rev. 1.88_57
660 $other_fingerprint->{'mtime_$^X'} = $other_fingerprint->{'stat($^X)'}[9];
661 }
662 # mandatory keys since 1.88_57
663 for my $key (qw($^X sitearchexp mtime_dll mtime_$^X)) {
664 return unless $other_fingerprint->{$key} eq $this_fingerprint->{$key};
665 }
666 return 1;
667 } else {
668 return $this_fingerprint;
669 }
670}
671
672sub suggest_myconfig () {
673 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
674 $CPAN::Frontend->myprint("You don't seem to have a user ".
675 "configuration (MyConfig.pm) yet.\n");
676 my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
677 "user configuration now? (Y/n)",
678 "yes");
679 if($new =~ m{^y}i) {
680 CPAN::Shell->mkmyconfig();
681 return &checklock;
682 } else {
683 $CPAN::Frontend->mydie("OK, giving up.");
684 }
685 }
686}
687
688#-> sub CPAN::all_objects ;
689sub all_objects {
690 my($mgr,$class) = @_;
691 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
692 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
693 CPAN::Index->reload;
694 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
695}
696
697# Called by shell, not in batch mode. In batch mode I see no risk in
698# having many processes updating something as installations are
699# continually checked at runtime. In shell mode I suspect it is
700# unintentional to open more than one shell at a time
701
702#-> sub CPAN::checklock ;
703
# spent 1.13ms (182µs+945µs) within CPAN::checklock which was called: # once (182µs+945µs) by CPAN::shell at line 304
sub checklock {
70412µs my($self) = @_;
705141µs440µs my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
# spent 28µs making 1 call to File::Spec::Unix::catfile # spent 8µs making 1 call to File::Spec::Unix::catdir # spent 4µs making 2 calls to File::Spec::Unix::canonpath, avg 2µs/call
706142µs133µs if (-f $lockfile && -M _ > 0) {
# spent 33µs making 1 call to CPAN::CORE:ftfile
707 my $fh = FileHandle->new($lockfile) or
708 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
709 my $otherpid = <$fh>;
710 my $otherhost = <$fh>;
711 $fh->close;
712 if (defined $otherpid && length $otherpid) {
713 chomp $otherpid;
714 }
715 if (defined $otherhost && length $otherhost) {
716 chomp $otherhost;
717 }
718 my $thishost = hostname();
719 my $ask_if_degraded_wanted = 0;
720 if (defined $otherhost && defined $thishost &&
721 $otherhost ne '' && $thishost ne '' &&
722 $otherhost ne $thishost) {
723 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
724 "reports other host $otherhost and other ".
725 "process $otherpid.\n".
726 "Cannot proceed.\n"));
727 } elsif ($RUN_DEGRADED) {
728 $CPAN::Frontend->mywarn("Running in downgraded mode (experimental)\n");
729 } elsif (defined $otherpid && $otherpid) {
730 return if $$ == $otherpid; # should never happen
731 $CPAN::Frontend->mywarn(
732 qq{
733There seems to be running another CPAN process (pid $otherpid). Contacting...
734});
735 if (kill 0, $otherpid or $!{EPERM}) {
736 $CPAN::Frontend->mywarn(qq{Other job is running.\n});
737 $ask_if_degraded_wanted = 1;
738 } elsif (-w $lockfile) {
739 my($ans) =
740 CPAN::Shell::colorable_makemaker_prompt
741 (qq{Other job not responding. Shall I overwrite }.
742 qq{the lockfile '$lockfile'? (Y/n)},"y");
743 $CPAN::Frontend->myexit("Ok, bye\n")
744 unless $ans =~ /^y/i;
745 } else {
746 Carp::croak(
747 qq{Lockfile '$lockfile' not writable by you. }.
748 qq{Cannot proceed.\n}.
749 qq{ On UNIX try:\n}.
750 qq{ rm '$lockfile'\n}.
751 qq{ and then rerun us.\n}
752 );
753 }
754 } elsif ($^O eq "MSWin32") {
755 $CPAN::Frontend->mywarn(
756 qq{
757There seems to be running another CPAN process according to '$lockfile'.
758});
759 $ask_if_degraded_wanted = 1;
760 } else {
761 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Found invalid lockfile ".
762 "'$lockfile', please remove. Cannot proceed.\n"));
763 }
764 if ($ask_if_degraded_wanted) {
765 my($ans) =
766 CPAN::Shell::colorable_makemaker_prompt
767 (qq{Shall I try to run in downgraded }.
768 qq{mode? (Y/n)},"y");
769 if ($ans =~ /^y/i) {
770 $CPAN::Frontend->mywarn("Running in downgraded mode (experimental).
771Please report if something unexpected happens\n");
772 $RUN_DEGRADED = 1;
773 for ($CPAN::Config) {
774 # XXX
775 # $_->{build_dir_reuse} = 0; # 2006-11-17 akoenig Why was that?
776 $_->{commandnumber_in_prompt} = 0; # visibility
777 $_->{histfile} = ""; # who should win otherwise?
778 $_->{cache_metadata} = 0; # better would be a lock?
779 $_->{use_sqlite} = 0; # better would be a write lock!
780 $_->{auto_commit} = 0; # we are violent, do not persist
781 $_->{test_report} = 0; # Oliver Paukstadt had sent wrong reports in degraded mode
782 }
783 } else {
784 my $msg = "You may want to kill the other job and delete the lockfile.";
785 if (defined $otherpid) {
786 $msg .= " Something like:
787 kill $otherpid
788 rm $lockfile
789";
790 }
791 $CPAN::Frontend->mydie("\n$msg");
792 }
793 }
794 }
79514µs my $dotcpan = $CPAN::Config->{cpan_home};
79629µs1111µs eval { File::Path::mkpath($dotcpan);};
# spent 111µs making 1 call to File::Path::mkpath
79711µs if ($@) {
798 # A special case at least for Jarkko.
799 my $firsterror = $@;
800 my $seconderror;
801 my $symlinkcpan;
802 if (-l $dotcpan) {
803 $symlinkcpan = readlink $dotcpan;
804 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
805 eval { File::Path::mkpath($symlinkcpan); };
806 if ($@) {
807 $seconderror = $@;
808 } else {
809 $CPAN::Frontend->mywarn(qq{
810Working directory $symlinkcpan created.
811});
812 }
813 }
814 unless (-d $dotcpan) {
815 my $mess = qq{
816Your configuration suggests "$dotcpan" as your
817CPAN.pm working directory. I could not create this directory due
818to this error: $firsterror\n};
819 $mess .= qq{
820As "$dotcpan" is a symlink to "$symlinkcpan",
821I tried to create that, but I failed with this error: $seconderror
822} if $seconderror;
823 $mess .= qq{
824Please make sure the directory exists and is writable.
825};
826 $CPAN::Frontend->mywarn($mess);
827 return suggest_myconfig;
828 }
829 } # $@ after eval mkpath $dotcpan
830 if (0) { # to test what happens when a race condition occurs
831 for (reverse 1..10) {
832 print $_, "\n";
833 sleep 1;
834 }
835 }
836 # locking
837116µs if (!$RUN_DEGRADED && !$self->{LOCKFH}) {
83812µs my $fh;
839117µs1359µs unless ($fh = FileHandle->new("+>>$lockfile")) {
# spent 359µs making 1 call to IO::File::new
840 $CPAN::Frontend->mywarn(qq{
841
842Your configuration suggests that CPAN.pm should use a working
843directory of
844 $CPAN::Config->{cpan_home}
845Unfortunately we could not create the lock file
846 $lockfile
847due to '$!'.
848
849Please make sure that the configuration variable
850 \$CPAN::Config->{cpan_home}
851points to a directory where you can write a .lock file. You can set
852this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
853\@INC path;
854});
855 return suggest_myconfig;
856 }
85711µs my $sleep = 1;
858112µs1124µs while (!CPAN::_flock($fh, LOCK_EX|LOCK_NB)) {
# spent 124µs making 1 call to CPAN::_flock
859 if ($sleep>10) {
860 $CPAN::Frontend->mydie("Giving up\n");
861 }
862 $CPAN::Frontend->mysleep($sleep++);
863 $CPAN::Frontend->mywarn("Could not lock lockfile with flock: $!; retrying\n");
864 }
865
866114µs16µs seek $fh, 0, 0;
# spent 6µs making 1 call to CPAN::CORE:seek
867162µs154µs truncate $fh, 0;
# spent 54µs making 1 call to CPAN::CORE:truncate
868119µs195µs $fh->autoflush(1);
# spent 95µs making 1 call to IO::Handle::autoflush
86917µs163µs $fh->print($$, "\n");
# spent 63µs making 1 call to IO::Handle::print
870110µs272µs $fh->print(hostname(), "\n");
# spent 50µs making 1 call to Sys::Hostname::hostname # spent 22µs making 1 call to IO::Handle::print
87115µs $self->{LOCK} = $lockfile;
87212µs $self->{LOCKFH} = $fh;
873 }
874 $SIG{TERM} = sub {
875 my $sig = shift;
876 &cleanup;
877 $CPAN::Frontend->mydie("Got SIG$sig, leaving");
878122µs };
879 $SIG{INT} = sub {
880 # no blocks!!!
881 my $sig = shift;
882 &cleanup if $Signal;
883 die "Got yet another signal" if $Signal > 1;
884 $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
885 $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
886 $Signal++;
887114µs };
888
889# From: Larry Wall <[email protected]>
890# Subject: Re: deprecating SIGDIE
891# To: [email protected]
892# Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
893#
894# The original intent of __DIE__ was only to allow you to substitute one
895# kind of death for another on an application-wide basis without respect
896# to whether you were in an eval or not. As a global backstop, it should
897# not be used any more lightly (or any more heavily :-) than class
898# UNIVERSAL. Any attempt to build a general exception model on it should
899# be politely squashed. Any bug that causes every eval {} to have to be
900# modified should be not so politely squashed.
901#
902# Those are my current opinions. It is also my opinion that polite
903# arguments degenerate to personal arguments far too frequently, and that
904# when they do, it's because both people wanted it to, or at least didn't
905# sufficiently want it not to.
906#
907# Larry
908
909 # global backstop to cleanup if we should really die
91018µs $SIG{__DIE__} = \&cleanup;
91116µs $self->debug("Signal handler set.") if $CPAN::DEBUG;
912}
913
914#-> sub CPAN::DESTROY ;
915sub DESTROY {
916 &cleanup; # need an eval?
917}
918
919#-> sub CPAN::anycwd ;
920
# spent 27.7ms (130µs+27.6) within CPAN::anycwd which was called 4 times, avg 6.92ms/call: # once (17µs+11.1ms) by CPAN::Distribution::get at line 384 of CPAN/Distribution.pm # once (33µs+7.05ms) by CPAN::Distribution::look at line 1293 of CPAN/Distribution.pm # once (19µs+5.20ms) by CPAN::CacheMgr::entries at line 66 of CPAN/CacheMgr.pm # once (61µs+4.24ms) by CPAN::shell at line 305
sub anycwd () {
92143µs my $getcwd;
922415µs $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
9234114µs427.6ms CPAN->$getcwd();
# spent 27.6ms making 4 calls to CPAN::cwd, avg 6.89ms/call
924}
925
926#-> sub CPAN::cwd ;
927497µs427.5ms
# spent 27.6ms (73µs+27.5) within CPAN::cwd which was called 4 times, avg 6.89ms/call: # 4 times (73µs+27.5ms) by CPAN::anycwd at line 923, avg 6.89ms/call
sub cwd {Cwd::cwd();}
# spent 27.5ms making 4 calls to Cwd::_backtick_pwd, avg 6.87ms/call
928
929#-> sub CPAN::getcwd ;
930sub getcwd {Cwd::getcwd();}
931
932#-> sub CPAN::fastcwd ;
933sub fastcwd {Cwd::fastcwd();}
934
935#-> sub CPAN::getdcwd ;
936sub getdcwd {Cwd::getdcwd();}
937
938#-> sub CPAN::backtickcwd ;
939sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
940
941# Adapted from Probe::Perl
942#-> sub CPAN::_perl_is_same
943sub _perl_is_same {
944 my ($perl) = @_;
945 return MM->maybe_command($perl)
946 && `$perl -MConfig=myconfig -e print -e myconfig` eq Config->myconfig;
947}
948
949# Adapted in part from Probe::Perl
950#-> sub CPAN::find_perl ;
951sub find_perl () {
952 if ( File::Spec->file_name_is_absolute($^X) ) {
953 return $^X;
954 }
955 else {
956 my $exe = $Config::Config{exe_ext};
957 my @candidates = (
958 File::Spec->catfile($CPAN::iCwd,$^X),
959 $Config::Config{'perlpath'},
960 );
961 for my $perl_name ($^X, 'perl', 'perl5', "perl$]") {
962 for my $path (File::Spec->path(), $Config::Config{'binexp'}) {
963 if ( defined($path) && length $path && -d $path ) {
964 my $perl = File::Spec->catfile($path,$perl_name);
965 push @candidates, $perl;
966 # try with extension if not provided already
967 if ($^O eq 'VMS') {
968 # VMS might have a file version at the end
969 push @candidates, $perl . $exe
970 unless $perl =~ m/$exe(;\d+)?$/i;
971 } elsif (defined $exe && length $exe) {
972 push @candidates, $perl . $exe
973 unless $perl =~ m/$exe$/i;
974 }
975 }
976 }
977 }
978 for my $perl ( @candidates ) {
979 if (MM->maybe_command($perl) && _perl_is_same($perl)) {
980 $^X = $perl;
981 return $perl;
982 }
983 }
984 }
985 return $^X; # default fall back
986}
987
988#-> sub CPAN::exists ;
989
# spent 2.54s (126µs+2.54) within CPAN::exists which was called 6 times, avg 423ms/call: # 4 times (71µs+157µs) by CPAN::Shell::expand_by_method at line 1408 of CPAN/Shell.pm, avg 57µs/call # 2 times (55µs+2.54s) by CPAN::Shell::expandany at line 1308 of CPAN/Shell.pm, avg 1.27s/call
sub exists {
99069µs my($mgr,$class,$id) = @_;
99167µs CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
992636µs62.54s CPAN::Index->reload;
# spent 2.54s making 6 calls to CPAN::Index::reload, avg 423ms/call
993 ### Carp::croak "exists called without class argument" unless $class;
99463µs $id ||= "";
995639µs422µs $id =~ s/:+/::/g if $class eq "CPAN::Module";
# spent 22µs making 4 calls to CPAN::CORE:subst, avg 6µs/call
99660s my $exists;
99768µs614µs if (CPAN::_sqlite_running) {
# spent 14µs making 6 calls to CPAN::_sqlite_running, avg 2µs/call
998 $exists = (exists $META->{readonly}{$class}{$id} or
999 $CPAN::SQLite->set($class, $id));
1000 } else {
1001610µs $exists = exists $META->{readonly}{$class}{$id};
1002 }
1003622µs $exists ||= exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1004}
1005
1006#-> sub CPAN::delete ;
1007sub delete {
1008 my($mgr,$class,$id) = @_;
1009 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
1010 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1011}
1012
1013#-> sub CPAN::has_usable
1014# has_inst is sometimes too optimistic, we should replace it with this
1015# has_usable whenever a case is given
1016
# spent 67.6ms (566µs+67.1) within CPAN::has_usable which was called 6 times, avg 11.3ms/call: # 2 times (31µs+768µs) by CPAN::FTP::localize at line 345 of CPAN/FTP.pm, avg 400µs/call # once (198µs+58.0ms) by CPAN::Tarzip::untar at line 255 of CPAN/Tarzip.pm # once (157µs+8.08ms) by CPAN::Index::read_metadata_cache at line 570 of CPAN/Index.pm # once (167µs+56µs) by CPAN::Distribution::run_preps_on_packagedir at line 562 of CPAN/Distribution.pm # once (13µs+141µs) by CPAN::HandleConfig::cpan_home_dir_candidates at line 525 of CPAN/HandleConfig.pm
sub has_usable {
1017610µs my($self,$mod,$message) = @_;
101869µs return 1 if $HAS_USABLE->{$mod};
1019630µs666.7ms my $has_inst = $self->has_inst($mod,$message);
# spent 66.7ms making 6 calls to CPAN::has_inst, avg 11.1ms/call
1020618µs return unless $has_inst;
102133µs my $usable;
1022 $usable = {
1023
1024 #
1025 # these subroutines die if they believe the installed version is unusable;
1026 #
1027 'CPAN::Meta' => [
1028 sub {
1029 require CPAN::Meta;
1030 unless (CPAN::Version->vge(CPAN::Meta->VERSION, 2.110350)) {
1031 for ("Will not use CPAN::Meta, need version 2.110350\n") {
1032 $CPAN::Frontend->mywarn($_);
1033 die $_;
1034 }
1035 }
1036 },
1037 ],
1038
1039 'CPAN::Meta::Requirements' => [
1040 sub {
1041 require CPAN::Meta::Requirements;
1042 unless (CPAN::Version->vge(CPAN::Meta::Requirements->VERSION, 2.120920)) {
1043 for ("Will not use CPAN::Meta::Requirements, need version 2.120920\n") {
1044 $CPAN::Frontend->mywarn($_);
1045 die $_;
1046 }
1047 }
1048 },
1049 ],
1050
1051 LWP => [ # we frequently had "Can't locate object
1052 # method "new" via package "LWP::UserAgent" at
1053 # (eval 69) line 2006
1054 sub {require LWP},
1055 sub {require LWP::UserAgent},
1056 sub {require HTTP::Request},
1057 sub {require URI::URL;
1058 unless (CPAN::Version->vge(URI::URL::->VERSION,0.08)) {
1059 for ("Will not use URI::URL, need 0.08\n") {
1060 $CPAN::Frontend->mywarn($_);
1061 die $_;
1062 }
1063 }
1064 },
1065 ],
1066 'Net::FTP' => [
1067 sub {
1068 my $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
1069 if ($var and $var =~ /^http:/i) {
1070 # rt #110833
1071 for ("Net::FTP cannot handle http proxy") {
1072 $CPAN::Frontend->mywarn($_);
1073 die $_;
1074 }
1075 }
1076 },
1077 sub {require Net::FTP},
1078 sub {require Net::Config},
1079 ],
1080 'HTTP::Tiny' => [
1081 sub {
1082 require HTTP::Tiny;
1083 unless (CPAN::Version->vge(HTTP::Tiny->VERSION, 0.005)) {
1084 for ("Will not use HTTP::Tiny, need version 0.005\n") {
1085 $CPAN::Frontend->mywarn($_);
1086 die $_;
1087 }
1088 }
1089 },
1090 ],
1091 'File::HomeDir' => [
1092 sub {require File::HomeDir;
1093 unless (CPAN::Version->vge(File::HomeDir::->VERSION, 0.52)) {
1094 for ("Will not use File::HomeDir, need 0.52\n") {
1095 $CPAN::Frontend->mywarn($_);
1096 die $_;
1097 }
1098 }
1099 },
1100 ],
1101 'Archive::Tar' => [
110212µs
# spent 387µs (44+343) within CPAN::__ANON__[/usr/local/perls/perl-5.26.1/lib/5.26.1/CPAN.pm:1113] which was called: # once (44µs+343µs) by CPAN::has_usable at line 1135
sub {require Archive::Tar;
110311µs my $demand = "1.50";
1104157µs2343µs unless (CPAN::Version->vge(Archive::Tar::->VERSION, $demand)) {
# spent 331µs making 1 call to CPAN::Version::vge # spent 12µs making 1 call to version::_VERSION
1105 my $atv = Archive::Tar->VERSION;
1106 for ("You have Archive::Tar $atv, but $demand or later is recommended. Please upgrade.\n") {
1107 $CPAN::Frontend->mywarn($_);
1108 # don't die, because we may need
1109 # Archive::Tar to upgrade
1110 }
1111
1112 }
1113 },
1114 ],
1115 'File::Temp' => [
1116 # XXX we should probably delete from
1117 # %INC too so we can load after we
1118 # installed a new enough version --
1119 # I'm not sure.
1120 sub {require File::Temp;
1121 unless (CPAN::Version->vge(File::Temp::->VERSION,0.16)) {
1122 for ("Will not use File::Temp, need 0.16\n") {
1123 $CPAN::Frontend->mywarn($_);
1124 die $_;
1125 }
1126 }
1127 },
11283297µs ]
1129 };
113035µs if ($usable->{$mod}) {
113114µs local @INC = @INC;
113211µs pop @INC if $INC[-1] eq '.';
113318µs for my $c (0..$#{$usable->{$mod}}) {
113411µs my $code = $usable->{$mod}[$c];
113526µs1387µs my $ret = eval { &$code() };
# spent 387µs making 1 call to CPAN::__ANON__[CPAN.pm:1113]
113610s $ret = "" unless defined $ret;
113712µs if ($@) {
1138 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
1139 return;
1140 }
1141 }
1142 }
11433152µs return $HAS_USABLE->{$mod} = 1;
1144}
1145
1146sub frontend {
1147 shift;
1148 $CPAN::Frontend = shift if @_;
1149 $CPAN::Frontend;
1150}
1151
1152sub use_inst {
1153 my ($self, $module) = @_;
1154
1155 unless ($self->has_inst($module)) {
1156 $self->frontend->mydie("$module not installed, cannot continue");
1157 }
1158}
1159
1160#-> sub CPAN::has_inst
1161
# spent 196ms (66.8+129) within CPAN::has_inst which was called 260 times, avg 753µs/call: # 118 times (14.1ms+3.63ms) by CPAN::_yaml_module at line 529, avg 151µs/call # 114 times (7.59ms+1.98ms) by CPAN::CacheMgr::_clean_cache at line 165 of CPAN/CacheMgr.pm, avg 84µs/call # 6 times (24.0ms+42.7ms) by CPAN::has_usable at line 1019, avg 11.1ms/call # 6 times (502µs+160µs) by CPAN::shell at line 434, avg 110µs/call # 4 times (6.32ms+2.96ms) by CPAN::FTP::_mytime at line 77 of CPAN/FTP.pm, avg 2.32ms/call # 2 times (5.39ms+61.1ms) by CPAN::Tarzip::gtest at line 119 of CPAN/Tarzip.pm, avg 33.3ms/call # 2 times (4.08ms+12.9ms) by CPAN::FTP::hostdleasy at line 562 of CPAN/FTP.pm, avg 8.49ms/call # 2 times (88µs+20µs) by CPAN::FTP::_add_to_statistics at line 100 of CPAN/FTP.pm, avg 54µs/call # once (4.52ms+3.38ms) by CPAN::Distribution::check_integrity at line 457 of CPAN/Distribution.pm # once (58µs+15µs) by CPAN::Distribution::store_persistent_state at line 825 of CPAN/Distribution.pm # once (46µs+9µs) by CPAN::_yaml_loadfile at line 550 # once (29µs+6µs) by CPAN::Tarzip::untar at line 255 of CPAN/Tarzip.pm # once (24µs+4µs) by CPAN::Tarzip::TIEHANDLE at line 174 of CPAN/Tarzip.pm # once (23µs+4µs) by CPAN::Distribution::eq_CHECKSUM at line 1589 of CPAN/Distribution.pm
sub has_inst {
1162260316µs my($self,$mod,$message) = @_;
1163260132µs Carp::croak("CPAN->has_inst() called without an argument")
1164 unless defined $mod;
1165 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
1166 keys %{$CPAN::Config->{dontload_hash}||{}},
11672602.98ms @{$CPAN::Config->{dontload_list}||[]};
1168260207µs if (defined $message && $message eq "no" # as far as I remember only used by Nox
1169 ||
1170 $dont{$mod}
1171 ) {
1172 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
1173 return 0;
1174 }
1175260964µs local @INC = @INC;
1176260200µs pop @INC if $INC[-1] eq '.';
1177260146µs my $file = $mod;
117826048µs my $obj;
11792601.67ms260577µs $file =~ s|::|/|g;
# spent 577µs making 260 calls to CPAN::CORE:subst, avg 2µs/call
1180260140µs $file .= ".pm";
1181260947µs if ($INC{$file}) {
1182 # checking %INC is wrong, because $INC{LWP} may be true
1183 # although $INC{"URI/URL.pm"} may have failed. But as
1184 # I really want to say "blah loaded OK", I have to somehow
1185 # cache results.
1186 ### warn "$file in %INC"; #debug
1187 return 1;
118825120.5ms2445.39ms } elsif (eval { require $file }) {
# spent 5.39ms making 244 calls to CPAN::cleanup, avg 22µs/call
1189 # eval is good: if we haven't yet read the database it's
1190 # perfect and if we have installed the module in the meantime,
1191 # it tries again. The second require is only a NOOP returning
1192 # 1 if we had success, otherwise it's retrying
1193
11946237µs6157µs my $mtime = (stat $INC{$file})[9];
# spent 157µs making 6 calls to CPAN::CORE:stat, avg 26µs/call
1195 # privileged files loaded by has_inst; Note: we use $mtime
1196 # as a proxy for a checksum.
1197623µs $CPAN::Shell::reload->{$file} = $mtime;
11986201µs my $v = eval "\$$mod\::VERSION";
# spent 12µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 6µs executing statements in string eval # spent 5µs executing statements in string eval # spent 4µs executing statements in string eval
1199628µs $v = $v ? " (v$v)" : "";
1200694µs6949µs CPAN::Shell->optprint("load_module","CPAN: $mod loaded ok$v\n");
# spent 949µs making 6 calls to CPAN::Shell::optprint, avg 158µs/call
120167µs if ($mod eq "CPAN::WAIT") {
1202 push @CPAN::Shell::ISA, 'CPAN::WAIT';
1203 }
1204678µs return 1;
1205 } elsif ($mod eq "Net::FTP") {
1206 $CPAN::Frontend->mywarn(qq{
1207 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
1208 if you just type
1209 install Bundle::libnet
1210
1211}) unless $Have_warned->{"Net::FTP"}++;
1212 $CPAN::Frontend->mysleep(3);
1213 } elsif ($mod eq "Digest::SHA") {
1214 if ($Have_warned->{"Digest::SHA"}++) {
1215 $CPAN::Frontend->mywarn(qq{CPAN: checksum security checks disabled }.
1216 qq{because Digest::SHA not installed.\n});
1217 } else {
1218 $CPAN::Frontend->mywarn(qq{
1219 CPAN: checksum security checks disabled because Digest::SHA not installed.
1220 Please consider installing the Digest::SHA module.
1221
1222});
1223 $CPAN::Frontend->mysleep(2);
1224 }
1225 } elsif ($mod eq "Module::Signature") {
1226 # NOT prefs_lookup, we are not a distro
1227 my $check_sigs = $CPAN::Config->{check_sigs};
1228 if (not $check_sigs) {
1229 # they do not want us:-(
1230 } elsif (not $Have_warned->{"Module::Signature"}++) {
1231 # No point in complaining unless the user can
1232 # reasonably install and use it.
1233 if (eval { require Crypt::OpenPGP; 1 } ||
1234 (
1235 defined $CPAN::Config->{'gpg'}
1236 &&
1237 $CPAN::Config->{'gpg'} =~ /\S/
1238 )
1239 ) {
1240 $CPAN::Frontend->mywarn(qq{
1241 CPAN: Module::Signature security checks disabled because Module::Signature
1242 not installed. Please consider installing the Module::Signature module.
1243 You may also need to be able to connect over the Internet to the public
1244 key servers like pool.sks-keyservers.net or pgp.mit.edu.
1245
1246});
1247 $CPAN::Frontend->mysleep(2);
1248 }
1249 }
1250 } else {
1251245176µs delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
1252 }
12532451.38ms return 0;
1254}
1255
1256#-> sub CPAN::instance ;
1257
# spent 127µs (46+81) within CPAN::instance which was called 5 times, avg 25µs/call: # 4 times (35µs+55µs) by CPAN::Shell::expand_by_method at line 1409 of CPAN/Shell.pm, avg 22µs/call # once (11µs+26µs) by CPAN::Module::rematein at line 448 of CPAN/Module.pm
sub instance {
125853µs my($mgr,$class,$id) = @_;
125958µs581µs CPAN::Index->reload;
# spent 81µs making 5 calls to CPAN::Index::reload, avg 16µs/call
126053µs $id ||= "";
1261 # unsafe meta access, ok?
1262527µs return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
1263 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
1264}
1265
1266#-> sub CPAN::new ;
1267sub new {
1268 bless {}, shift;
1269}
1270
1271#-> sub CPAN::_exit_messages ;
1272
# spent 24µs within CPAN::_exit_messages which was called: # once (24µs+0s) by CPAN::cleanup at line 1302
sub _exit_messages {
127311µs my ($self) = @_;
1274126µs $self->{exit_messages} ||= [];
1275}
1276
1277#-> sub CPAN::cleanup ;
1278
# spent 6.16ms (5.58+582µs) within CPAN::cleanup which was called 247 times, avg 25µs/call: # 244 times (5.39ms+0s) by CPAN::has_inst at line 1188, avg 22µs/call # once (148µs+582µs) by CPAN::END at line 102 # once (29µs+0s) by Archive::Tar::BEGIN@43 at line 50 of Archive/Tar.pm # once (12µs+0s) by CPAN::_yaml_loadfile at line 580
sub cleanup {
1279 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
12802471.04ms local $SIG{__DIE__} = '';
1281247266µs my($message) = @_;
128224799µs my $i = 0;
128324746µs my $ineval = 0;
128424756µs my($subroutine);
12852472.12ms while ((undef,undef,undef,$subroutine) = caller(++$i)) {
1286249296µs $ineval = 1, last if
1287 $subroutine eq '(eval)';
1288 }
12892472.07ms return if $ineval && !$CPAN::End;
129012µs return unless defined $META->{LOCK};
1291148µs135µs return unless -f $META->{LOCK};
# spent 35µs making 1 call to CPAN::CORE:ftfile
1292127µs1123µs $META->savehist;
# spent 123µs making 1 call to CPAN::savehist
129312µs $META->{cachemgr} ||= CPAN::CacheMgr->new('atexit');
1294189µs160µs close $META->{LOCKFH};
# spent 60µs making 1 call to CPAN::CORE:close
12951316µs1292µs unlink $META->{LOCK};
# spent 292µs making 1 call to CPAN::CORE:unlink
1296 # require Carp;
1297 # Carp::cluck("DEBUGGING");
129810s if ( $CPAN::CONFIG_DIRTY ) {
1299 $CPAN::Frontend->mywarn("Warning: Configuration not saved.\n");
1300 }
1301116µs148µs $CPAN::Frontend->myprint("Lockfile removed.\n");
# spent 48µs making 1 call to App::Cpan::__ANON__[App/Cpan.pm:673]
1302227µs124µs for my $msg ( @{ $META->_exit_messages } ) {
# spent 24µs making 1 call to CPAN::_exit_messages
1303 $CPAN::Frontend->myprint($msg);
1304 }
1305}
1306
1307#-> sub CPAN::readhist
1308sub readhist {
1309 my($self,$term,$histfile) = @_;
1310 my $histsize = $CPAN::Config->{'histsize'} || 100;
1311 $term->Attribs->{'MaxHistorySize'} = $histsize if (defined($term->Attribs->{'MaxHistorySize'}));
1312 my($fh) = FileHandle->new;
1313 open $fh, "<$histfile" or return;
1314 local $/ = "\n";
1315 while (<$fh>) {
1316 chomp;
1317 $term->AddHistory($_);
1318 }
1319 close $fh;
1320}
1321
1322#-> sub CPAN::savehist
1323
# spent 123µs (58+65) within CPAN::savehist which was called: # once (58µs+65µs) by CPAN::cleanup at line 1292
sub savehist {
132411µs my($self) = @_;
132517µs my($histfile,$histsize);
132611µs unless ($histfile = $CPAN::Config->{'histfile'}) {
1327 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1328 return;
1329 }
133011µs $histsize = $CPAN::Config->{'histsize'} || 100;
133118µs if ($CPAN::term) {
1332122µs114µs unless ($CPAN::term->can("GetHistory")) {
# spent 14µs making 1 call to UNIVERSAL::can
133315µs151µs $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
# spent 51µs making 1 call to App::Cpan::__ANON__[App/Cpan.pm:681]
1334110µs return;
1335 }
1336 } else {
1337 return;
1338 }
1339 my @h = $CPAN::term->GetHistory;
1340 splice @h, 0, @h-$histsize if @h>$histsize;
1341 my($fh) = FileHandle->new;
1342 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1343 local $\ = local $, = "\n";
1344 print $fh @h;
1345 close $fh;
1346}
1347
1348#-> sub CPAN::is_tested
1349sub is_tested {
1350 my($self,$what,$when) = @_;
1351 unless ($what) {
1352 Carp::cluck("DEBUG: empty what");
1353 return;
1354 }
1355 $self->{is_tested}{$what} = $when;
1356}
1357
1358#-> sub CPAN::reset_tested
1359# forget all distributions tested -- resets what gets included in PERL5LIB
1360sub reset_tested {
1361 my ($self) = @_;
1362 $self->{is_tested} = {};
1363}
1364
1365#-> sub CPAN::is_installed
1366# unsets the is_tested flag: as soon as the thing is installed, it is
1367# not needed in set_perl5lib anymore
1368sub is_installed {
1369 my($self,$what) = @_;
1370 delete $self->{is_tested}{$what};
1371}
1372
1373sub _list_sorted_descending_is_tested {
1374 my($self) = @_;
1375 my $foul = 0;
1376 my @sorted = sort
1377 { ($self->{is_tested}{$b}||0) <=> ($self->{is_tested}{$a}||0) }
1378 grep
1379 { if ($foul){ 0 } elsif (-e) { 1 } else { $foul = $_; 0 } }
1380 keys %{$self->{is_tested}};
1381 if ($foul) {
1382 $CPAN::Frontend->mywarn("Lost build_dir detected ($foul), giving up all cached test results of currently running session.\n");
1383 for my $dbd (sort keys %{$self->{is_tested}}) { # distro-build-dir
1384 SEARCH: for my $d (sort { $a->id cmp $b->id } $CPAN::META->all_objects("CPAN::Distribution")) {
1385 if ($d->{build_dir} && $d->{build_dir} eq $dbd) {
1386 $CPAN::Frontend->mywarn(sprintf "Flushing cache for %s\n", $d->pretty_id);
1387 $d->fforce("");
1388 last SEARCH;
1389 }
1390 }
1391 delete $self->{is_tested}{$dbd};
1392 }
1393 return ();
1394 } else {
1395 return @sorted;
1396 }
1397}
1398
1399#-> sub CPAN::set_perl5lib
1400# Notes on max environment variable length:
1401# - Win32 : XP or later, 8191; Win2000 or NT4, 2047
1402{
1403my $fh;
1404
# spent 97µs (76+21) within CPAN::set_perl5lib which was called 2 times, avg 48µs/call: # once (46µs+15µs) by CPAN::Distribution::look at line 1307 of CPAN/Distribution.pm # once (30µs+6µs) by CPAN::Distribution::get at line 381 of CPAN/Distribution.pm
sub set_perl5lib {
140525µs my($self,$for) = @_;
140621µs unless ($for) {
1407233µs (undef,undef,undef,$for) = caller(1);
1408234µs221µs $for =~ s/.*://;
# spent 21µs making 2 calls to CPAN::CORE:subst, avg 10µs/call
1409 }
141024µs $self->{is_tested} ||= {};
1411220µs return unless %{$self->{is_tested}};
1412 my $env = $ENV{PERL5LIB};
1413 $env = $ENV{PERLLIB} unless defined $env;
1414 my @env;
1415 push @env, split /\Q$Config::Config{path_sep}\E/, $env if defined $env and length $env;
1416 #my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1417 #$CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1418
1419 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} $self->_list_sorted_descending_is_tested;
1420 return if !@dirs;
1421
1422 if (@dirs < 12) {
1423 $CPAN::Frontend->optprint('perl5lib', "Prepending @dirs to PERL5LIB for '$for'\n");
1424 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1425 } elsif (@dirs < 24 ) {
1426 my @d = map {my $cp = $_;
1427 $cp =~ s/^\Q$CPAN::Config->{build_dir}\E/%BUILDDIR%/;
1428 $cp
1429 } @dirs;
1430 $CPAN::Frontend->optprint('perl5lib', "Prepending @d to PERL5LIB; ".
1431 "%BUILDDIR%=$CPAN::Config->{build_dir} ".
1432 "for '$for'\n"
1433 );
1434 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1435 } else {
1436 my $cnt = keys %{$self->{is_tested}};
1437 $CPAN::Frontend->optprint('perl5lib', "Prepending blib/arch and blib/lib of ".
1438 "$cnt build dirs to PERL5LIB; ".
1439 "for '$for'\n"
1440 );
1441 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1442 }
1443}}
1444
1445
14461;
1447
1448
1449__END__
 
# spent 60µs within CPAN::CORE:close which was called: # once (60µs+0s) by CPAN::cleanup at line 1294
sub CPAN::CORE:close; # opcode
# spent 52µs within CPAN::CORE:flock which was called 2 times, avg 26µs/call: # 2 times (52µs+0s) by CPAN::_flock at line 508, avg 26µs/call
sub CPAN::CORE:flock; # opcode
# spent 68µs within CPAN::CORE:ftfile which was called 2 times, avg 34µs/call: # once (35µs+0s) by CPAN::cleanup at line 1291 # once (33µs+0s) by CPAN::checklock at line 706
sub CPAN::CORE:ftfile; # opcode
# spent 11µs within CPAN::CORE:ftsize which was called: # once (11µs+0s) by CPAN::_yaml_loadfile at line 548
sub CPAN::CORE:ftsize; # opcode
# spent 15µs within CPAN::CORE:fttty which was called: # once (15µs+0s) by CPAN::shell at line 259
sub CPAN::CORE:fttty; # opcode
# spent 94µs within CPAN::CORE:match which was called 17 times, avg 6µs/call: # 10 times (36µs+0s) by CPAN::shell at line 346, avg 4µs/call # 4 times (43µs+0s) by CPAN::shell at line 344, avg 11µs/call # 3 times (15µs+0s) by CPAN::shell at line 396, avg 5µs/call
sub CPAN::CORE:match; # opcode
# spent 6µs within CPAN::CORE:seek which was called: # once (6µs+0s) by CPAN::checklock at line 866
sub CPAN::CORE:seek; # opcode
# spent 15µs within CPAN::CORE:select which was called 3 times, avg 5µs/call: # once (7µs+0s) by CPAN::shell at line 297 # once (5µs+0s) by CPAN::shell at line 299 # once (3µs+0s) by CPAN::shell at line 301
sub CPAN::CORE:select; # opcode
# spent 334ms within CPAN::CORE:sort which was called 6 times, avg 55.7ms/call: # 6 times (334ms+0s) by CPAN::shell at line 464, avg 55.7ms/call
sub CPAN::CORE:sort; # opcode
# spent 157µs within CPAN::CORE:stat which was called 6 times, avg 26µs/call: # 6 times (157µs+0s) by CPAN::has_inst at line 1194, avg 26µs/call
sub CPAN::CORE:stat; # opcode
# spent 693µs within CPAN::CORE:subst which was called 283 times, avg 2µs/call: # 260 times (577µs+0s) by CPAN::has_inst at line 1179, avg 2µs/call # 6 times (8µs+0s) by CPAN::_redirect at line 219, avg 1µs/call # 4 times (41µs+0s) by CPAN::shell at line 343, avg 10µs/call # 4 times (22µs+0s) by CPAN::exists at line 995, avg 6µs/call # 4 times (19µs+0s) by CPAN::shell at line 345, avg 5µs/call # 3 times (5µs+0s) by CPAN::shell at line 346, avg 2µs/call # 2 times (21µs+0s) by CPAN::set_perl5lib at line 1408, avg 10µs/call
sub CPAN::CORE:subst; # opcode
# spent 54µs within CPAN::CORE:truncate which was called: # once (54µs+0s) by CPAN::checklock at line 867
sub CPAN::CORE:truncate; # opcode
# spent 292µs within CPAN::CORE:unlink which was called: # once (292µs+0s) by CPAN::cleanup at line 1295
sub CPAN::CORE:unlink; # 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.