← 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/Index.pm
StatementsExecuted 497927 statements in 813ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1111.25s2.54sCPAN::Index::::read_metadata_cacheCPAN::Index::read_metadata_cache
111343µs343µsCPAN::Index::::CORE:ftereadCPAN::Index::CORE:fteread (opcode)
1121235µs2.54sCPAN::Index::::reloadCPAN::Index::reload
233137µs37µsCPAN::Index::::PROTOCOLCPAN::Index::PROTOCOL
71131µs31µsCPAN::Index::::CORE:matchCPAN::Index::CORE:match (opcode)
1119µs9µsCPAN::Index::::CORE:ftfileCPAN::Index::CORE:ftfile (opcode)
0000s0sCPAN::Index::::BEGINCPAN::Index::BEGIN
0000s0sCPAN::Index::::force_reloadCPAN::Index::force_reload
0000s0sCPAN::Index::::rd_authindexCPAN::Index::rd_authindex
0000s0sCPAN::Index::::rd_modlistCPAN::Index::rd_modlist
0000s0sCPAN::Index::::rd_modpacksCPAN::Index::rd_modpacks
0000s0sCPAN::Index::::reanimate_build_dirCPAN::Index::reanimate_build_dir
0000s0sCPAN::Index::::reload_xCPAN::Index::reload_x
0000s0sCPAN::Index::::useridCPAN::Index::userid
0000s0sCPAN::Index::::write_metadata_cacheCPAN::Index::write_metadata_cache
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package CPAN::Index;
2use strict;
3use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED $VERSION);
4$VERSION = "2.12";
5@CPAN::Index::ISA = qw(CPAN::Debug);
6$LAST_TIME ||= 0;
7$DATE_OF_03 ||= 0;
8# use constant PROTOCOL => "2.0"; # commented out to avoid warning on upgrade from 1.57
92373µs
# spent 37µs within CPAN::Index::PROTOCOL which was called 23 times, avg 2µs/call: # 11 times (24µs+0s) by CPAN::Index::reload at line 59, avg 2µs/call # 11 times (6µs+0s) by CPAN::Index::reload at line 109, avg 545ns/call # once (7µs+0s) by CPAN::Index::read_metadata_cache at line 582
sub PROTOCOL { 2.0 }
10
11#-> sub CPAN::Index::force_reload ;
12sub force_reload {
13 my($class) = @_;
14 $CPAN::Index::LAST_TIME = 0;
15 $class->reload(1);
16}
17
18my @indexbundle =
19 (
20 {
21 reader => "rd_authindex",
22 dir => "authors",
23 remotefile => '01mailrc.txt.gz',
24 shortlocalfile => '01mailrc.gz',
25 },
26 {
27 reader => "rd_modpacks",
28 dir => "modules",
29 remotefile => '02packages.details.txt.gz',
30 shortlocalfile => '02packag.gz',
31 },
32 {
33 reader => "rd_modlist",
34 dir => "modules",
35 remotefile => '03modlist.data.gz',
36 shortlocalfile => '03mlist.gz',
37 },
38 );
39
40#-> sub CPAN::Index::reload ;
41
# spent 2.54s (235µs+2.54) within CPAN::Index::reload which was called 11 times, avg 231ms/call: # 6 times (173µs+2.54s) by CPAN::exists at line 992 of CPAN.pm, avg 423ms/call # 5 times (62µs+19µs) by CPAN::instance at line 1259 of CPAN.pm, avg 16µs/call
sub reload {
42115µs my($self,$force) = @_;
431112µs my $time = time;
44
45 # XXX check if a newer one is available. (We currently read it
46 # from time to time)
471121µs for ($CPAN::Config->{index_expire}) {
481113µs $_ = 0.001 unless $_ && $_ > 0.001;
49 }
50 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
51 # debug here when CPAN doesn't seem to read the Metadata
52 require Carp;
53 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
54 }
55116µs unless ($CPAN::META->{PROTOCOL}) {
5617µs12.54s $self->read_metadata_cache;
# spent 2.54s making 1 call to CPAN::Index::read_metadata_cache
5712µs $CPAN::META->{PROTOCOL} ||= "1.0";
58 }
591137µs1124µs if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
# spent 24µs making 11 calls to CPAN::Index::PROTOCOL, avg 2µs/call
60 # warn "Setting last_time to 0";
61 $LAST_TIME = 0; # No warning necessary
62 }
631117µs if ($LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
64 and ! $force) {
65 # called too often
66 # CPAN->debug("LAST_TIME[$LAST_TIME]index_expire[$CPAN::Config->{index_expire}]time[$time]");
67 } elsif (0) {
68 # IFF we are developing, it helps to wipe out the memory
69 # between reloads, otherwise it is not what a user expects.
70 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
71 $CPAN::META = CPAN->new;
72 } else {
73 my($debug,$t2);
74 local $LAST_TIME = $time;
75 local $CPAN::META->{PROTOCOL} = PROTOCOL;
76
77 my $needshort = $^O eq "dos";
78
79 INX: for my $indexbundle (@indexbundle) {
80 my $reader = $indexbundle->{reader};
81 my $localfile = $needshort ? $indexbundle->{shortlocalfile} : $indexbundle->{remotefile};
82 my $localpath = File::Spec->catfile($indexbundle->{dir}, $localfile);
83 my $remote = join "/", $indexbundle->{dir}, $indexbundle->{remotefile};
84 my $localized = $self->reload_x($remote, $localpath, $force);
85 $self->$reader($localized); # may die but we let the shell catch it
86 if ($CPAN::DEBUG){
87 $t2 = time;
88 $debug = "timing reading 01[".($t2 - $time)."]";
89 $time = $t2;
90 }
91 return if $CPAN::Signal; # this is sometimes lengthy
92 }
93 $self->write_metadata_cache;
94 if ($CPAN::DEBUG){
95 $t2 = time;
96 $debug .= "03[".($t2 - $time)."]";
97 $time = $t2;
98 }
99 CPAN->debug($debug) if $CPAN::DEBUG;
100 }
101116µs if ($CPAN::Config->{build_dir_reuse}) {
102 $self->reanimate_build_dir;
103 }
1041120µs1158µs if (CPAN::_sqlite_running()) {
# spent 58µs making 11 calls to CPAN::_sqlite_running, avg 5µs/call
105 $CPAN::SQLite->reload(time => $time, force => $force)
106 if not $LAST_TIME;
107 }
108114µs $LAST_TIME = $time;
1091150µs116µs $CPAN::META->{PROTOCOL} = PROTOCOL;
# spent 6µs making 11 calls to CPAN::Index::PROTOCOL, avg 545ns/call
110}
111
112#-> sub CPAN::Index::reanimate_build_dir ;
113sub reanimate_build_dir {
114 my($self) = @_;
115 unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module}||"YAML")) {
116 return;
117 }
118 return if $HAVE_REANIMATED++;
119 my $d = $CPAN::Config->{build_dir};
120 my $dh = DirHandle->new;
121 opendir $dh, $d or return; # does not exist
122 my $dirent;
123 my $i = 0;
124 my $painted = 0;
125 my $restored = 0;
126 my $start = CPAN::FTP::_mytime();
127 my @candidates = map { $_->[0] }
128 sort { $b->[1] <=> $a->[1] }
129 map { [ $_, -M File::Spec->catfile($d,$_) ] }
130 grep {/(.+)\.yml$/ && -d File::Spec->catfile($d,$1)} readdir $dh;
131 if ( @candidates ) {
132 $CPAN::Frontend->myprint
133 (sprintf("Reading %d yaml file%s from %s/\n",
134 scalar @candidates,
135 @candidates==1 ? "" : "s",
136 $CPAN::Config->{build_dir}
137 ));
138 DISTRO: for $i (0..$#candidates) {
139 my $dirent = $candidates[$i];
140 my $y = eval {CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))};
141 if ($@) {
142 warn "Error while parsing file '$dirent'; error: '$@'";
143 next DISTRO;
144 }
145 my $c = $y->[0];
146 if ($c && $c->{perl} && $c->{distribution} && CPAN->_perl_fingerprint($c->{perl})) {
147 my $key = $c->{distribution}{ID};
148 for my $k (keys %{$c->{distribution}}) {
149 if ($c->{distribution}{$k}
150 && ref $c->{distribution}{$k}
151 && UNIVERSAL::isa($c->{distribution}{$k},"CPAN::Distrostatus")) {
152 $c->{distribution}{$k}{COMMANDID} = $i - @candidates;
153 }
154 }
155
156 #we tried to restore only if element already
157 #exists; but then we do not work with metadata
158 #turned off.
159 my $do
160 = $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key}
161 = $c->{distribution};
162 for my $skipper (qw(
163 badtestcnt
164 configure_requires_later
165 configure_requires_later_for
166 force_update
167 later
168 later_for
169 notest
170 should_report
171 sponsored_mods
172 prefs
173 negative_prefs_cache
174 )) {
175 delete $do->{$skipper};
176 }
177 if ($do->can("tested_ok_but_not_installed")) {
178 if ($do->tested_ok_but_not_installed) {
179 $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
180 } else {
181 next DISTRO;
182 }
183 }
184 $restored++;
185 }
186 $i++;
187 while (($painted/76) < ($i/@candidates)) {
188 $CPAN::Frontend->myprint(".");
189 $painted++;
190 }
191 }
192 }
193 else {
194 $CPAN::Frontend->myprint("Build_dir empty, nothing to restore\n");
195 }
196 my $took = CPAN::FTP::_mytime() - $start;
197 $CPAN::Frontend->myprint(sprintf(
198 "DONE\nRestored the state of %s (in %.4f secs)\n",
199 $restored || "none",
200 $took,
201 ));
202}
203
204
205#-> sub CPAN::Index::reload_x ;
206sub reload_x {
207 my($cl,$wanted,$localname,$force) = @_;
208 $force |= 2; # means we're dealing with an index here
209 CPAN::HandleConfig->load; # we should guarantee loading wherever
210 # we rely on Config XXX
211 $localname ||= $wanted;
212 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
213 $localname);
214 if (
215 -f $abs_wanted &&
216 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
217 !($force & 1)
218 ) {
219 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
220 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
221 qq{day$s. I\'ll use that.});
222 return $abs_wanted;
223 } else {
224 $force |= 1; # means we're quite serious about it.
225 }
226 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
227}
228
229#-> sub CPAN::Index::rd_authindex ;
230sub rd_authindex {
231 my($cl, $index_target) = @_;
232 return unless defined $index_target;
233 return if CPAN::_sqlite_running();
234 my @lines;
235 $CPAN::Frontend->myprint("Reading '$index_target'\n");
236 local(*FH);
237 tie *FH, 'CPAN::Tarzip', $index_target;
238 local($/) = "\n";
239 local($_);
240 push @lines, split /\012/ while <FH>;
241 my $i = 0;
242 my $painted = 0;
243 foreach (@lines) {
244 my($userid,$fullname,$email) =
245 m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
246 $fullname ||= $email;
247 if ($userid && $fullname && $email) {
248 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
249 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
250 } else {
251 CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
252 }
253 $i++;
254 while (($painted/76) < ($i/@lines)) {
255 $CPAN::Frontend->myprint(".");
256 $painted++;
257 }
258 return if $CPAN::Signal;
259 }
260 $CPAN::Frontend->myprint("DONE\n");
261}
262
263sub userid {
264 my($self,$dist) = @_;
265 $dist = $self->{'id'} unless defined $dist;
266 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
267 $ret;
268}
269
270#-> sub CPAN::Index::rd_modpacks ;
271sub rd_modpacks {
272 my($self, $index_target) = @_;
273 return unless defined $index_target;
274 return if CPAN::_sqlite_running();
275 $CPAN::Frontend->myprint("Reading '$index_target'\n");
276 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
277 local $_;
278 CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
279 my $slurp = "";
280 my $chunk;
281 while (my $bytes = $fh->READ(\$chunk,8192)) {
282 $slurp.=$chunk;
283 }
284 my @lines = split /\012/, $slurp;
285 CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
286 undef $fh;
287 # read header
288 my($line_count,$last_updated);
289 while (@lines) {
290 my $shift = shift(@lines);
291 last if $shift =~ /^\s*$/;
292 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
293 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
294 }
295 CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
296 my $errors = 0;
297 if (not defined $line_count) {
298
299 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
300Please check the validity of the index file by comparing it to more
301than one CPAN mirror. I'll continue but problems seem likely to
302happen.\a
303});
304 $errors++;
305 $CPAN::Frontend->mysleep(5);
306 } elsif ($line_count != scalar @lines) {
307
308 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
309contains a Line-Count header of %d but I see %d lines there. Please
310check the validity of the index file by comparing it to more than one
311CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
312$index_target, $line_count, scalar(@lines));
313
314 }
315 if (not defined $last_updated) {
316
317 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
318Please check the validity of the index file by comparing it to more
319than one CPAN mirror. I'll continue but problems seem likely to
320happen.\a
321});
322 $errors++;
323 $CPAN::Frontend->mysleep(5);
324 } else {
325
326 $CPAN::Frontend
327 ->myprint(sprintf qq{ Database was generated on %s\n},
328 $last_updated);
329 $DATE_OF_02 = $last_updated;
330
331 my $age = time;
332 if ($CPAN::META->has_inst('HTTP::Date')) {
333 require HTTP::Date;
334 $age -= HTTP::Date::str2time($last_updated);
335 } else {
336 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
337 require Time::Local;
338 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
339 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
340 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
341 }
342 $age /= 3600*24;
343 if ($age > 30) {
344
345 $CPAN::Frontend
346 ->mywarn(sprintf
347 qq{Warning: This index file is %d days old.
348 Please check the host you chose as your CPAN mirror for staleness.
349 I'll continue but problems seem likely to happen.\a\n},
350 $age);
351
352 } elsif ($age < -1) {
353
354 $CPAN::Frontend
355 ->mywarn(sprintf
356 qq{Warning: Your system date is %d days behind this index file!
357 System time: %s
358 Timestamp index file: %s
359 Please fix your system time, problems with the make command expected.\n},
360 -$age,
361 scalar gmtime,
362 $DATE_OF_02,
363 );
364
365 }
366 }
367
368
369 # A necessity since we have metadata_cache: delete what isn't
370 # there anymore
371 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
372 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
373 my(%exists);
374 my $i = 0;
375 my $painted = 0;
376 LINE: foreach (@lines) {
377 # before 1.56 we split into 3 and discarded the rest. From
378 # 1.57 we assign remaining text to $comment thus allowing to
379 # influence isa_perl
380 my($mod,$version,$dist,$comment) = split " ", $_, 4;
381 unless ($mod && defined $version && $dist) {
382 require Dumpvalue;
383 my $dv = Dumpvalue->new(tick => '"');
384 $CPAN::Frontend->mywarn(sprintf "Could not split line[%s]\n", $dv->stringify($_));
385 if ($errors++ >= 5){
386 $CPAN::Frontend->mydie("Giving up parsing your $index_target, too many errors");
387 }
388 next LINE;
389 }
390 my($bundle,$id,$userid);
391
392 if ($mod eq 'CPAN' &&
393 ! (
394 CPAN::Queue->exists('Bundle::CPAN') ||
395 CPAN::Queue->exists('CPAN')
396 )
397 ) {
398 local($^W)= 0;
399 if ($version > $CPAN::VERSION) {
400 $CPAN::Frontend->mywarn(qq{
401 New CPAN.pm version (v$version) available.
402 [Currently running version is v$CPAN::VERSION]
403 You might want to try
404 install CPAN
405 reload cpan
406 to both upgrade CPAN.pm and run the new version without leaving
407 the current session.
408
409}); #});
410 $CPAN::Frontend->mysleep(2);
411 $CPAN::Frontend->myprint(qq{\n});
412 }
413 last if $CPAN::Signal;
414 } elsif ($mod =~ /^Bundle::(.*)/) {
415 $bundle = $1;
416 }
417
418 if ($bundle) {
419 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
420 # Let's make it a module too, because bundles have so much
421 # in common with modules.
422
423 # Changed in 1.57_63: seems like memory bloat now without
424 # any value, so commented out
425
426 # $CPAN::META->instance('CPAN::Module',$mod);
427
428 } else {
429
430 # instantiate a module object
431 $id = $CPAN::META->instance('CPAN::Module',$mod);
432
433 }
434
435 # Although CPAN prohibits same name with different version the
436 # indexer may have changed the version for the same distro
437 # since the last time ("Force Reindexing" feature)
438 if ($id->cpan_file ne $dist
439 ||
440 $id->cpan_version ne $version
441 ) {
442 $userid = $id->userid || $self->userid($dist);
443 $id->set(
444 'CPAN_USERID' => $userid,
445 'CPAN_VERSION' => $version,
446 'CPAN_FILE' => $dist,
447 );
448 }
449
450 # instantiate a distribution object
451 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
452 # we do not need CONTAINSMODS unless we do something with
453 # this dist, so we better produce it on demand.
454
455 ## my $obj = $CPAN::META->instance(
456 ## 'CPAN::Distribution' => $dist
457 ## );
458 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
459 } else {
460 $CPAN::META->instance(
461 'CPAN::Distribution' => $dist
462 )->set(
463 'CPAN_USERID' => $userid,
464 'CPAN_COMMENT' => $comment,
465 );
466 }
467 if ($secondtime) {
468 for my $name ($mod,$dist) {
469 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
470 $exists{$name} = undef;
471 }
472 }
473 $i++;
474 while (($painted/76) < ($i/@lines)) {
475 $CPAN::Frontend->myprint(".");
476 $painted++;
477 }
478 return if $CPAN::Signal;
479 }
480 $CPAN::Frontend->myprint("DONE\n");
481 if ($secondtime) {
482 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
483 for my $o ($CPAN::META->all_objects($class)) {
484 next if exists $exists{$o->{ID}};
485 $CPAN::META->delete($class,$o->{ID});
486 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
487 # if $CPAN::DEBUG;
488 }
489 }
490 }
491}
492
493#-> sub CPAN::Index::rd_modlist ;
494sub rd_modlist {
495 my($cl,$index_target) = @_;
496 return unless defined $index_target;
497 return if CPAN::_sqlite_running();
498 $CPAN::Frontend->myprint("Reading '$index_target'\n");
499 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
500 local $_;
501 my $slurp = "";
502 my $chunk;
503 while (my $bytes = $fh->READ(\$chunk,8192)) {
504 $slurp.=$chunk;
505 }
506 my @eval2 = split /\012/, $slurp;
507
508 while (@eval2) {
509 my $shift = shift(@eval2);
510 if ($shift =~ /^Date:\s+(.*)/) {
511 if ($DATE_OF_03 eq $1) {
512 $CPAN::Frontend->myprint("Unchanged.\n");
513 return;
514 }
515 ($DATE_OF_03) = $1;
516 }
517 last if $shift =~ /^\s*$/;
518 }
519 push @eval2, q{CPAN::Modulelist->data;};
520 local($^W) = 0;
521 my($compmt) = Safe->new("CPAN::Safe1");
522 my($eval2) = join("\n", @eval2);
523 CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
524 my $ret = $compmt->reval($eval2);
525 Carp::confess($@) if $@;
526 return if $CPAN::Signal;
527 my $i = 0;
528 my $until = keys(%$ret);
529 my $painted = 0;
530 CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
531 for (sort keys %$ret) {
532 my $obj = $CPAN::META->instance("CPAN::Module",$_);
533 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
534 $obj->set(%{$ret->{$_}});
535 $i++;
536 while (($painted/76) < ($i/$until)) {
537 $CPAN::Frontend->myprint(".");
538 $painted++;
539 }
540 return if $CPAN::Signal;
541 }
542 $CPAN::Frontend->myprint("DONE\n");
543}
544
545#-> sub CPAN::Index::write_metadata_cache ;
546sub write_metadata_cache {
547 my($self) = @_;
548 return unless $CPAN::Config->{'cache_metadata'};
549 return if CPAN::_sqlite_running();
550 return unless $CPAN::META->has_usable("Storable");
551 my $cache;
552 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
553 CPAN::Distribution)) {
554 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
555 }
556 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
557 $cache->{last_time} = $LAST_TIME;
558 $cache->{DATE_OF_02} = $DATE_OF_02;
559 $cache->{PROTOCOL} = PROTOCOL;
560 $CPAN::Frontend->myprint("Writing $metadata_file\n");
561 eval { Storable::nstore($cache, $metadata_file) };
562 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
563}
564
565#-> sub CPAN::Index::read_metadata_cache ;
566
# spent 2.54s (1.25+1.29) within CPAN::Index::read_metadata_cache which was called: # once (1.25s+1.29s) by CPAN::Index::reload at line 56
sub read_metadata_cache {
56712µs my($self) = @_;
56811µs return unless $CPAN::Config->{'cache_metadata'};
56916µs117µs return if CPAN::_sqlite_running();
# spent 17µs making 1 call to CPAN::_sqlite_running
57017µs18.24ms return unless $CPAN::META->has_usable("Storable");
# spent 8.24ms making 1 call to CPAN::has_usable
571157µs459µs my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
# spent 43µs making 1 call to File::Spec::Unix::catfile # spent 12µs making 1 call to File::Spec::Unix::catdir # spent 4µs making 2 calls to File::Spec::Unix::canonpath, avg 2µs/call
5721371µs2352µs return unless -r $metadata_file and -f $metadata_file;
# spent 343µs making 1 call to CPAN::Index::CORE:fteread # spent 9µs making 1 call to CPAN::Index::CORE:ftfile
57318µs148µs $CPAN::Frontend->myprint("Reading '$metadata_file'\n");
# spent 48µs making 1 call to App::Cpan::__ANON__[App/Cpan.pm:673]
57410s my $cache;
57523µs1650ms eval { $cache = Storable::retrieve($metadata_file) };
# spent 650ms making 1 call to Storable::retrieve
57610s $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
57719µs13µs if (!$cache || !UNIVERSAL::isa($cache, 'HASH')) {
# spent 3µs making 1 call to UNIVERSAL::isa
578 $LAST_TIME = 0;
579 return;
580 }
58111µs if (exists $cache->{PROTOCOL}) {
58218µs17µs if (PROTOCOL > $cache->{PROTOCOL}) {
# spent 7µs making 1 call to CPAN::Index::PROTOCOL
583 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
584 "with protocol v%s, requiring v%s\n",
585 $cache->{PROTOCOL},
586 PROTOCOL)
587 );
588 return;
589 }
590 } else {
591 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
592 "with protocol v1.0\n");
593 return;
594 }
59510s my $clcnt = 0;
59610s my $idcnt = 0;
597114µs while(my($class,$v) = each %$cache) {
598754µs731µs next unless $class =~ /^CPAN::/;
# spent 31µs making 7 calls to CPAN::Index::CORE:match, avg 4µs/call
59946µs $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
6004244ms while (my($id,$ro) = each %$v) {
601248869529ms248869628ms $CPAN::META->{readwrite}{$class}{$id} ||=
# spent 507ms making 212543 calls to CPAN::InfoObj::new, avg 2µs/call # spent 122ms making 36326 calls to CPAN::Distribution::new, avg 3µs/call
602 $class->new(ID=>$id, RO=>$ro);
60324886937.7ms $idcnt++;
604 }
60542µs $clcnt++;
606 }
60710s unless ($clcnt) { # sanity check
608 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
609 return;
610 }
61111µs if ($idcnt < 1000) {
612 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
613 "in $metadata_file\n");
614 return;
615 }
616 $CPAN::META->{PROTOCOL} ||=
61711µs $cache->{PROTOCOL}; # reading does not up or downgrade, but it
618 # does initialize to some protocol
61913µs $LAST_TIME = $cache->{last_time};
62013µs $DATE_OF_02 = $cache->{DATE_OF_02};
621112µs172µs $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
# spent 72µs making 1 call to App::Cpan::__ANON__[App/Cpan.pm:673]
622 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
623112µs return;
624}
625
6261;
 
# spent 343µs within CPAN::Index::CORE:fteread which was called: # once (343µs+0s) by CPAN::Index::read_metadata_cache at line 572
sub CPAN::Index::CORE:fteread; # opcode
# spent 9µs within CPAN::Index::CORE:ftfile which was called: # once (9µs+0s) by CPAN::Index::read_metadata_cache at line 572
sub CPAN::Index::CORE:ftfile; # opcode
# spent 31µs within CPAN::Index::CORE:match which was called 7 times, avg 4µs/call: # 7 times (31µs+0s) by CPAN::Index::read_metadata_cache at line 598, avg 4µs/call
sub CPAN::Index::CORE:match; # 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.