← 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/Module.pm
StatementsExecuted 39 statements in 308µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111162µs94.8sCPAN::Module::::remateinCPAN::Module::rematein
33151µs76µsCPAN::Module::::cpan_fileCPAN::Module::cpan_file
11146µs386µsCPAN::Module::::undelayCPAN::Module::undelay
11126µs94.8sCPAN::Module::::lookCPAN::Module::look
11118µs181µsCPAN::Module::::distributionCPAN::Module::distribution
1118µs8µsCPAN::Module::::CORE:matchCPAN::Module::CORE:match (opcode)
0000s0sCPAN::Module::::BEGINCPAN::Module::BEGIN
0000s0sCPAN::Module::::__ANON__[:14]CPAN::Module::__ANON__[:14]
0000s0sCPAN::Module::::__ANON__[:678]CPAN::Module::__ANON__[:678]
0000s0sCPAN::Module::::_file_in_pathCPAN::Module::_file_in_path
0000s0sCPAN::Module::::_in_priv_or_archCPAN::Module::_in_priv_or_arch
0000s0sCPAN::Module::::_is_representative_moduleCPAN::Module::_is_representative_module
0000s0sCPAN::Module::::as_glimpseCPAN::Module::as_glimpse
0000s0sCPAN::Module::::as_stringCPAN::Module::as_string
0000s0sCPAN::Module::::available_fileCPAN::Module::available_file
0000s0sCPAN::Module::::available_versionCPAN::Module::available_version
0000s0sCPAN::Module::::cleanCPAN::Module::clean
0000s0sCPAN::Module::::color_cmd_tmpsCPAN::Module::color_cmd_tmps
0000s0sCPAN::Module::::cpan_versionCPAN::Module::cpan_version
0000s0sCPAN::Module::::cvs_importCPAN::Module::cvs_import
0000s0sCPAN::Module::::deprecated_in_coreCPAN::Module::deprecated_in_core
0000s0sCPAN::Module::::descriptionCPAN::Module::description
0000s0sCPAN::Module::::dslip_statusCPAN::Module::dslip_status
0000s0sCPAN::Module::::fforceCPAN::Module::fforce
0000s0sCPAN::Module::::forceCPAN::Module::force
0000s0sCPAN::Module::::getCPAN::Module::get
0000s0sCPAN::Module::::inst_deprecatedCPAN::Module::inst_deprecated
0000s0sCPAN::Module::::inst_fileCPAN::Module::inst_file
0000s0sCPAN::Module::::inst_versionCPAN::Module::inst_version
0000s0sCPAN::Module::::installCPAN::Module::install
0000s0sCPAN::Module::::makeCPAN::Module::make
0000s0sCPAN::Module::::manpage_headlineCPAN::Module::manpage_headline
0000s0sCPAN::Module::::notestCPAN::Module::notest
0000s0sCPAN::Module::::parse_versionCPAN::Module::parse_version
0000s0sCPAN::Module::::perldocCPAN::Module::perldoc
0000s0sCPAN::Module::::readmeCPAN::Module::readme
0000s0sCPAN::Module::::reportsCPAN::Module::reports
0000s0sCPAN::Module::::testCPAN::Module::test
0000s0sCPAN::Module::::uptodateCPAN::Module::uptodate
0000s0sCPAN::Module::::useridCPAN::Module::userid
0000s0sCPAN::Module::::xs_fileCPAN::Module::xs_file
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:
3package CPAN::Module;
4use strict;
5@CPAN::Module::ISA = qw(CPAN::InfoObj);
6
7use vars qw(
8 $VERSION
9);
10$VERSION = "5.5003";
11
12BEGIN {
13 # alarm() is not implemented in perl 5.6.x and earlier under Windows
14 *ALARM_IMPLEMENTED = sub () { $] >= 5.007 || $^O !~ /MSWin/ };
15}
16
17# Accessors
18#-> sub CPAN::Module::userid
19sub userid {
20 my $self = shift;
21 my $ro = $self->ro;
22 return unless $ro;
23 return $ro->{userid} || $ro->{CPAN_USERID};
24}
25#-> sub CPAN::Module::description
26sub description {
27 my $self = shift;
28 my $ro = $self->ro or return "";
29 $ro->{description}
30}
31
32#-> sub CPAN::Module::distribution
33
# spent 181µs (18+163) within CPAN::Module::distribution which was called: # once (18µs+163µs) by CPAN::Shell::rematein at line 1821 of CPAN/Shell.pm
sub distribution {
3411µs my($self) = @_;
35114µs2163µs CPAN::Shell->expand("Distribution",$self->cpan_file);
# spent 134µs making 1 call to CPAN::Shell::expand # spent 29µs making 1 call to CPAN::Module::cpan_file
36}
37
38#-> sub CPAN::Module::_is_representative_module
39sub _is_representative_module {
40 my($self) = @_;
41 return $self->{_is_representative_module} if defined $self->{_is_representative_module};
42 my $pm = $self->cpan_file or return $self->{_is_representative_module} = 0;
43 $pm =~ s|.+/||;
44 $pm =~ s{\.(?:tar\.(bz2|gz|Z)|t(?:gz|bz)|zip)$}{}i; # see base_id
45 $pm =~ s|-\d+\.\d+.+$||;
46 $pm =~ s|-[\d\.]+$||;
47 $pm =~ s/-/::/g;
48 $self->{_is_representative_module} = $pm eq $self->{ID} ? 1 : 0;
49 # warn "DEBUG: $pm eq $self->{ID} => $self->{_is_representative_module}";
50 $self->{_is_representative_module};
51}
52
53#-> sub CPAN::Module::undelay
54
# spent 386µs (46+340) within CPAN::Module::undelay which was called: # once (46µs+340µs) by CPAN::Shell::rematein at line 1908 of CPAN/Shell.pm
sub undelay {
55110µs my $self = shift;
5617µs delete $self->{later};
57128µs3340µs if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
# spent 285µs making 1 call to CPAN::Shell::expand # spent 28µs making 1 call to CPAN::Module::cpan_file # spent 27µs making 1 call to CPAN::Distribution::undelay
58 $dist->undelay;
59 }
60}
61
62# mark as dirty/clean
63#-> sub CPAN::Module::color_cmd_tmps ;
64sub color_cmd_tmps {
65 my($self) = shift;
66 my($depth) = shift || 0;
67 my($color) = shift || 0;
68 my($ancestors) = shift || [];
69 # a module needs to recurse to its cpan_file
70
71 return if exists $self->{incommandcolor}
72 && $color==1
73 && $self->{incommandcolor}==$color;
74 return if $color==0 && !$self->{incommandcolor};
75 if ($color>=1) {
76 if ( $self->uptodate ) {
77 $self->{incommandcolor} = $color;
78 return;
79 } elsif (my $have_version = $self->available_version) {
80 # maybe what we have is good enough
81 if (@$ancestors) {
82 my $who_asked_for_me = $ancestors->[-1];
83 my $obj = CPAN::Shell->expandany($who_asked_for_me);
84 if (0) {
85 } elsif ($obj->isa("CPAN::Bundle")) {
86 # bundles cannot specify a minimum version
87 return;
88 } elsif ($obj->isa("CPAN::Distribution")) {
89 if (my $prereq_pm = $obj->prereq_pm) {
90 for my $k (keys %$prereq_pm) {
91 if (my $want_version = $prereq_pm->{$k}{$self->id}) {
92 if (CPAN::Version->vcmp($have_version,$want_version) >= 0) {
93 $self->{incommandcolor} = $color;
94 return;
95 }
96 }
97 }
98 }
99 }
100 }
101 }
102 } else {
103 $self->{incommandcolor} = $color; # set me before recursion,
104 # so we can break it
105 }
106 if ($depth>=$CPAN::MAX_RECURSION) {
107 my $e = CPAN::Exception::RecursiveDependency->new($ancestors);
108 if ($e->is_resolvable) {
109 return $self->{incommandcolor}=2;
110 } else {
111 die $e;
112 }
113 }
114 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
115
116 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
117 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
118 }
119 # unreached code?
120 # if ($color==0) {
121 # delete $self->{badtestcnt};
122 # }
123 $self->{incommandcolor} = $color;
124}
125
126#-> sub CPAN::Module::as_glimpse ;
127sub as_glimpse {
128 my($self) = @_;
129 my(@m);
130 my $class = ref($self);
131 $class =~ s/^CPAN:://;
132 my $color_on = "";
133 my $color_off = "";
134 if (
135 $CPAN::Shell::COLOR_REGISTERED
136 &&
137 $CPAN::META->has_inst("Term::ANSIColor")
138 &&
139 $self->description
140 ) {
141 $color_on = Term::ANSIColor::color("green");
142 $color_off = Term::ANSIColor::color("reset");
143 }
144 my $uptodateness = " ";
145 unless ($class eq "Bundle") {
146 my $u = $self->uptodate;
147 $uptodateness = $u ? "=" : "<" if defined $u;
148 };
149 my $id = do {
150 my $d = $self->distribution;
151 $d ? $d -> pretty_id : $self->cpan_userid;
152 };
153 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
154 $class,
155 $uptodateness,
156 $color_on,
157 $self->id,
158 $color_off,
159 $id,
160 );
161 join "", @m;
162}
163
164#-> sub CPAN::Module::dslip_status
165sub dslip_status {
166 my($self) = @_;
167 my($stat);
168 # development status
169 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
170 pre-alpha alpha beta released
171 mature standard,;
172 # support level
173 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
174 developer comp.lang.perl.*
175 none abandoned,;
176 # language
177 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
178 # interface
179 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
180 references+ties
181 object-oriented pragma
182 hybrid none,;
183 # public licence
184 @{$stat->{P}}{qw,p g l b a 2 o d r n,} = qw,Standard-Perl
185 GPL LGPL
186 BSD Artistic Artistic_2
187 open-source
188 distribution_allowed
189 restricted_distribution
190 no_licence,;
191 for my $x (qw(d s l i p)) {
192 $stat->{$x}{' '} = 'unknown';
193 $stat->{$x}{'?'} = 'unknown';
194 }
195 my $ro = $self->ro;
196 return +{} unless $ro && $ro->{statd};
197 return {
198 D => $ro->{statd},
199 S => $ro->{stats},
200 L => $ro->{statl},
201 I => $ro->{stati},
202 P => $ro->{statp},
203 DV => $stat->{D}{$ro->{statd}},
204 SV => $stat->{S}{$ro->{stats}},
205 LV => $stat->{L}{$ro->{statl}},
206 IV => $stat->{I}{$ro->{stati}},
207 PV => $stat->{P}{$ro->{statp}},
208 };
209}
210
211#-> sub CPAN::Module::as_string ;
212sub as_string {
213 my($self) = @_;
214 my(@m);
215 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
216 my $class = ref($self);
217 $class =~ s/^CPAN:://;
218 local($^W) = 0;
219 push @m, $class, " id = $self->{ID}\n";
220 my $sprintf = " %-12s %s\n";
221 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
222 if $self->description;
223 my $sprintf2 = " %-12s %s (%s)\n";
224 my($userid);
225 $userid = $self->userid;
226 if ( $userid ) {
227 my $author;
228 if ($author = CPAN::Shell->expand('Author',$userid)) {
229 my $email = "";
230 my $m; # old perls
231 if ($m = $author->email) {
232 $email = " <$m>";
233 }
234 push @m, sprintf(
235 $sprintf2,
236 'CPAN_USERID',
237 $userid,
238 $author->fullname . $email
239 );
240 }
241 }
242 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
243 if $self->cpan_version;
244 if (my $cpan_file = $self->cpan_file) {
245 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
246 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
247 my $upload_date = $dist->upload_date;
248 if ($upload_date) {
249 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
250 }
251 }
252 }
253 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
254 my $dslip = $self->dslip_status;
255 push @m, sprintf(
256 $sprintf3,
257 'DSLIP_STATUS',
258 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
259 ) if $dslip->{D};
260 my $local_file = $self->inst_file;
261 unless ($self->{MANPAGE}) {
262 my $manpage;
263 if ($local_file) {
264 $manpage = $self->manpage_headline($local_file);
265 } else {
266 # If we have already untarred it, we should look there
267 my $dist = $CPAN::META->instance('CPAN::Distribution',
268 $self->cpan_file);
269 # warn "dist[$dist]";
270 # mff=manifest file; mfh=manifest handle
271 my($mff,$mfh);
272 if (
273 $dist->{build_dir}
274 and
275 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
276 and
277 $mfh = FileHandle->new($mff)
278 ) {
279 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
280 my $lfre = $self->id; # local file RE
281 $lfre =~ s/::/./g;
282 $lfre .= "\\.pm\$";
283 my($lfl); # local file file
284 local $/ = "\n";
285 my(@mflines) = <$mfh>;
286 for (@mflines) {
287 s/^\s+//;
288 s/\s.*//s;
289 }
290 while (length($lfre)>5 and !$lfl) {
291 ($lfl) = grep /$lfre/, @mflines;
292 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
293 $lfre =~ s/.+?\.//;
294 }
295 $lfl =~ s/\s.*//; # remove comments
296 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
297 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
298 # warn "lfl_abs[$lfl_abs]";
299 if (-f $lfl_abs) {
300 $manpage = $self->manpage_headline($lfl_abs);
301 }
302 }
303 }
304 $self->{MANPAGE} = $manpage if $manpage;
305 }
306 my($item);
307 for $item (qw/MANPAGE/) {
308 push @m, sprintf($sprintf, $item, $self->{$item})
309 if exists $self->{$item};
310 }
311 for $item (qw/CONTAINS/) {
312 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
313 if exists $self->{$item} && @{$self->{$item}};
314 }
315 push @m, sprintf($sprintf, 'INST_FILE',
316 $local_file || "(not installed)");
317 push @m, sprintf($sprintf, 'INST_VERSION',
318 $self->inst_version) if $local_file;
319 if (%{$CPAN::META->{is_tested}||{}}) { # XXX needs to be methodified somehow
320 my $available_file = $self->available_file;
321 if ($available_file && $available_file ne $local_file) {
322 push @m, sprintf($sprintf, 'AVAILABLE_FILE', $available_file);
323 push @m, sprintf($sprintf, 'AVAILABLE_VERSION', $self->available_version);
324 }
325 }
326 join "", @m, "\n";
327}
328
329#-> sub CPAN::Module::manpage_headline
330sub manpage_headline {
331 my($self,$local_file) = @_;
332 my(@local_file) = $local_file;
333 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
334 push @local_file, $local_file;
335 my(@result,$locf);
336 for $locf (@local_file) {
337 next unless -f $locf;
338 my $fh = FileHandle->new($locf)
339 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
340 my $inpod = 0;
341 local $/ = "\n";
342 while (<$fh>) {
343 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
344 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
345 next unless $inpod;
346 next if /^=/;
347 next if /^\s+$/;
348 chomp;
349 push @result, $_;
350 }
351 close $fh;
352 last if @result;
353 }
354 for (@result) {
355 s/^\s+//;
356 s/\s+$//;
357 }
358 join " ", @result;
359}
360
361#-> sub CPAN::Module::cpan_file ;
362# Note: also inherited by CPAN::Bundle
363
# spent 76µs (51+25) within CPAN::Module::cpan_file which was called 3 times, avg 25µs/call: # once (22µs+7µs) by CPAN::Module::distribution at line 35 # once (15µs+13µs) by CPAN::Module::undelay at line 57 # once (14µs+5µs) by CPAN::Module::rematein at line 434
sub cpan_file {
36432µs my $self = shift;
365 # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
366321µs319µs unless ($self->ro) {
# spent 19µs making 3 calls to CPAN::InfoObj::ro, avg 6µs/call
367 CPAN::Index->reload;
368 }
36938µs36µs my $ro = $self->ro;
# spent 6µs making 3 calls to CPAN::InfoObj::ro, avg 2µs/call
370322µs if ($ro && defined $ro->{CPAN_FILE}) {
371 return $ro->{CPAN_FILE};
372 } else {
373 my $userid = $self->userid;
374 if ( $userid ) {
375 if ($CPAN::META->exists("CPAN::Author",$userid)) {
376 my $author = $CPAN::META->instance("CPAN::Author",
377 $userid);
378 my $fullname = $author->fullname;
379 my $email = $author->email;
380 unless (defined $fullname && defined $email) {
381 return sprintf("Contact Author %s",
382 $userid,
383 );
384 }
385 return "Contact Author $fullname <$email>";
386 } else {
387 return "Contact Author $userid (Email address not available)";
388 }
389 } else {
390 return "N/A";
391 }
392 }
393}
394
395#-> sub CPAN::Module::cpan_version ;
396sub cpan_version {
397 my $self = shift;
398
399 my $ro = $self->ro;
400 unless ($ro) {
401 # Can happen with modules that are not on CPAN
402 $ro = {};
403 }
404 $ro->{CPAN_VERSION} = 'undef'
405 unless defined $ro->{CPAN_VERSION};
406 $ro->{CPAN_VERSION};
407}
408
409#-> sub CPAN::Module::force ;
410sub force {
411 my($self) = @_;
412 $self->{force_update} = 1;
413}
414
415#-> sub CPAN::Module::fforce ;
416sub fforce {
417 my($self) = @_;
418 $self->{force_update} = 2;
419}
420
421#-> sub CPAN::Module::notest ;
422sub notest {
423 my($self) = @_;
424 # $CPAN::Frontend->mywarn("XDEBUG: set notest for Module");
425 $self->{notest}++;
426}
427
428#-> sub CPAN::Module::rematein ;
429
# spent 94.8s (162µs+94.8) within CPAN::Module::rematein which was called: # once (162µs+94.8s) by CPAN::Module::look at line 502
sub rematein {
43012µs my($self,$meth) = @_;
431110µs247µs $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
# spent 45µs making 1 call to App::Cpan::__ANON__[App/Cpan.pm:673] # spent 2µs making 1 call to CPAN::InfoObj::id
432 $meth,
433 $self->id));
43413µs119µs my $cpan_file = $self->cpan_file;
# spent 19µs making 1 call to CPAN::Module::cpan_file
435124µs18µs if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/) {
# spent 8µs making 1 call to CPAN::Module::CORE:match
436 $CPAN::Frontend->mywarn(sprintf qq{
437 The module %s isn\'t available on CPAN.
438
439 Either the module has not yet been uploaded to CPAN, or it is
440 temporary unavailable. Please contact the author to find out
441 more about the status. Try 'i %s'.
442},
443 $self->id,
444 $self->id,
445 );
446 return;
447 }
44813µs137µs my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
# spent 37µs making 1 call to CPAN::instance
449113µs214µs $pack->called_for($self->id);
# spent 12µs making 1 call to CPAN::Distribution::called_for # spent 2µs making 1 call to CPAN::InfoObj::id
45011µs if (exists $self->{force_update}) {
451 if ($self->{force_update} == 2) {
452 $pack->fforce($meth);
453 } else {
454 $pack->force($meth);
455 }
456 }
45711µs $pack->notest($meth) if exists $self->{notest} && $self->{notest};
458
45912µs $pack->{reqtype} ||= "";
46011µs CPAN->debug("dist-reqtype[$pack->{reqtype}]".
461 "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
46211µs if ($pack->{reqtype}) {
463 if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
464 $pack->{reqtype} = $self->{reqtype};
465 if (
466 exists $pack->{install}
467 &&
468 (
469 UNIVERSAL::can($pack->{install},"failed") ?
470 $pack->{install}->failed :
471 $pack->{install} =~ /^NO/
472 )
473 ) {
474 delete $pack->{install};
475 $CPAN::Frontend->mywarn
476 ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
477 }
478 }
479 } else {
48010s $pack->{reqtype} = $self->{reqtype};
481 }
482
48314µs my $success = eval {
48419µs194.8s $pack->$meth();
# spent 94.8s making 1 call to CPAN::Distribution::look
485 };
486115µs my $err = $@;
487140µs16µs $pack->unforce if $pack->can("unforce") && exists $self->{force_update};
# spent 6µs making 1 call to UNIVERSAL::can
48819µs13µs $pack->unnotest if $pack->can("unnotest") && exists $self->{notest};
# spent 3µs making 1 call to UNIVERSAL::can
48910s delete $self->{force_update};
49011µs delete $self->{notest};
49110s if ($err) {
492 die $err;
493 }
494131µs return $success;
495}
496
497#-> sub CPAN::Module::perldoc ;
498sub perldoc { shift->rematein('perldoc') }
499#-> sub CPAN::Module::readme ;
500sub readme { shift->rematein('readme') }
501#-> sub CPAN::Module::look ;
502125µs194.8s
# spent 94.8s (26µs+94.8) within CPAN::Module::look which was called: # once (26µs+94.8s) by CPAN::Shell::rematein at line 1900 of CPAN/Shell.pm
sub look { shift->rematein('look') }
# spent 94.8s making 1 call to CPAN::Module::rematein
503#-> sub CPAN::Module::cvs_import ;
504sub cvs_import { shift->rematein('cvs_import') }
505#-> sub CPAN::Module::get ;
506sub get { shift->rematein('get',@_) }
507#-> sub CPAN::Module::make ;
508sub make { shift->rematein('make') }
509#-> sub CPAN::Module::test ;
510sub test {
511 my $self = shift;
512 # $self->{badtestcnt} ||= 0;
513 $self->rematein('test',@_);
514}
515
516#-> sub CPAN::Module::deprecated_in_core ;
517sub deprecated_in_core {
518 my ($self) = @_;
519 return unless $CPAN::META->has_inst('Module::CoreList') && Module::CoreList->can('is_deprecated');
520 return Module::CoreList::is_deprecated($self->{ID});
521}
522
523#-> sub CPAN::Module::inst_deprecated;
524# Indicates whether the *installed* version of the module is a deprecated *and*
525# installed as part of the Perl core library path
526sub inst_deprecated {
527 my ($self) = @_;
528 my $inst_file = $self->inst_file or return;
529 return $self->deprecated_in_core && $self->_in_priv_or_arch($inst_file);
530}
531
532#-> sub CPAN::Module::uptodate ;
533sub uptodate {
534 my ($self) = @_;
535 local ($_);
536 my $inst = $self->inst_version or return 0;
537 my $cpan = $self->cpan_version;
538 return 0 if CPAN::Version->vgt($cpan,$inst) || $self->inst_deprecated;
539 CPAN->debug
540 (join
541 ("",
542 "returning uptodate. ",
543 "cpan[$cpan]inst[$inst]",
544 )) if $CPAN::DEBUG;
545 return 1;
546}
547
548# returns true if installed in privlib or archlib
549sub _in_priv_or_arch {
550 my($self,$inst_file) = @_;
551 foreach my $pair (
552 [qw(sitearchexp archlibexp)],
553 [qw(sitelibexp privlibexp)]
554 ) {
555 my ($site, $priv) = @Config::Config{@$pair};
556 if ($^O eq 'VMS') {
557 for my $d ($site, $priv) { $d = VMS::Filespec::unixify($d) };
558 }
559 s!/*$!!g foreach $site, $priv;
560 next if $site eq $priv;
561
562 if ($priv eq substr($inst_file,0,length($priv))) {
563 return 1;
564 }
565 }
566 return 0;
567}
568
569#-> sub CPAN::Module::install ;
570sub install {
571 my($self) = @_;
572 my($doit) = 0;
573 if ($self->uptodate
574 &&
575 not exists $self->{force_update}
576 ) {
577 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
578 $self->id,
579 $self->inst_version,
580 ));
581 } else {
582 $doit = 1;
583 }
584 my $ro = $self->ro;
585 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
586 $CPAN::Frontend->mywarn(qq{
587\n\n\n ***WARNING***
588 The module $self->{ID} has no active maintainer (CPAN support level flag 'abandoned').\n\n\n
589});
590 $CPAN::Frontend->mysleep(5);
591 }
592 return $doit ? $self->rematein('install') : 1;
593}
594#-> sub CPAN::Module::clean ;
595sub clean { shift->rematein('clean') }
596
597#-> sub CPAN::Module::inst_file ;
598sub inst_file {
599 my($self) = @_;
600 $self->_file_in_path([@INC]);
601}
602
603#-> sub CPAN::Module::available_file ;
604sub available_file {
605 my($self) = @_;
606 my $sep = $Config::Config{path_sep};
607 my $perllib = $ENV{PERL5LIB};
608 $perllib = $ENV{PERLLIB} unless defined $perllib;
609 my @perllib = split(/$sep/,$perllib) if defined $perllib;
610 my @cpan_perl5inc;
611 if ($CPAN::Perl5lib_tempfile) {
612 my $yaml = CPAN->_yaml_loadfile($CPAN::Perl5lib_tempfile);
613 @cpan_perl5inc = @{$yaml->[0]{inc} || []};
614 }
615 $self->_file_in_path([@cpan_perl5inc,@perllib,@INC]);
616}
617
618#-> sub CPAN::Module::file_in_path ;
619sub _file_in_path {
620 my($self,$path) = @_;
621 my($dir,@packpath);
622 @packpath = split /::/, $self->{ID};
623 $packpath[-1] .= ".pm";
624 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
625 unshift @packpath, "Term", "ReadLine"; # historical reasons
626 }
627 foreach $dir (@$path) {
628 my $pmfile = File::Spec->catfile($dir,@packpath);
629 if (-f $pmfile) {
630 return $pmfile;
631 }
632 }
633 return;
634}
635
636#-> sub CPAN::Module::xs_file ;
637sub xs_file {
638 my($self) = @_;
639 my($dir,@packpath);
640 @packpath = split /::/, $self->{ID};
641 push @packpath, $packpath[-1];
642 $packpath[-1] .= "." . $Config::Config{'dlext'};
643 foreach $dir (@INC) {
644 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
645 if (-f $xsfile) {
646 return $xsfile;
647 }
648 }
649 return;
650}
651
652#-> sub CPAN::Module::inst_version ;
653sub inst_version {
654 my($self) = @_;
655 my $parsefile = $self->inst_file or return;
656 my $have = $self->parse_version($parsefile);
657 $have;
658}
659
660#-> sub CPAN::Module::inst_version ;
661sub available_version {
662 my($self) = @_;
663 my $parsefile = $self->available_file or return;
664 my $have = $self->parse_version($parsefile);
665 $have;
666}
667
668#-> sub CPAN::Module::parse_version ;
669sub parse_version {
670 my($self,$parsefile) = @_;
671 if (ALARM_IMPLEMENTED) {
672 my $timeout = (exists($CPAN::Config{'version_timeout'}))
673 ? $CPAN::Config{'version_timeout'}
674 : 15;
675 alarm($timeout);
676 }
677 my $have = eval {
678 local $SIG{ALRM} = sub { die "alarm\n" };
679 MM->parse_version($parsefile);
680 };
681 if ($@) {
682 $CPAN::Frontend->mywarn("Error while parsing version number in file '$parsefile'\n");
683 }
684 alarm(0) if ALARM_IMPLEMENTED;
685 my $leastsanity = eval { defined $have && length $have; };
686 $have = "undef" unless $leastsanity;
687 $have =~ s/^ //; # since the %vd hack these two lines here are needed
688 $have =~ s/ $//; # trailing whitespace happens all the time
689
690 $have = CPAN::Version->readable($have);
691
692 $have =~ s/\s*//g; # stringify to float around floating point issues
693 $have; # no stringify needed, \s* above matches always
694}
695
696#-> sub CPAN::Module::reports
697sub reports {
698 my($self) = @_;
699 $self->distribution->reports;
700}
701
7021;
 
# spent 8µs within CPAN::Module::CORE:match which was called: # once (8µs+0s) by CPAN::Module::rematein at line 435
sub CPAN::Module::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.