← Index
NYTProf Performance Profile   « line view »
For ./view
  Run on Fri Jul 31 19:05:14 2015
Reported on Fri Jul 31 19:08:08 2015

Filename/usr/share/perl5/vendor_perl/Carp.pm
StatementsExecuted 3470 statements in 9.87ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
84311.77ms3.97msCarp::::caller_infoCarp::caller_info
104111.47ms1.82msCarp::::format_argCarp::format_arg
511553µs4.45msCarp::::ret_backtraceCarp::ret_backtrace
11151259µs259µsCarp::::_cgcCarp::_cgc
7911175µs184µsCarp::::get_subnameCarp::get_subname
10421173µs173µsCarp::::str_len_trimCarp::str_len_trim
51181µs111µsCarp::::long_error_locCarp::long_error_loc
53349µs4.70msCarp::::confessCarp::confess
11146µs105µsCarp::::short_error_locCarp::short_error_loc
51143µs4.65msCarp::::longmessCarp::longmess
51133µs4.59msCarp::::longmess_heavyCarp::longmess_heavy
11133µs60µsCarp::::BEGIN@398Carp::BEGIN@398
11132µs32µsCarp::::BEGIN@3Carp::BEGIN@3
11123µs35µsCarp::::BEGIN@5Carp::BEGIN@5
42121µs49µsCarp::::trustsCarp::trusts
11121µs45µsCarp::::BEGIN@8Carp::BEGIN@8
11118µs229µsCarp::::shortmessCarp::shortmess
11118µs39µsCarp::::BEGIN@399Carp::BEGIN@399
11117µs34µsCarp::::BEGIN@406Carp::BEGIN@406
41117µs28µsCarp::::get_statusCarp::get_status
11117µs40µsCarp::::BEGIN@67Carp::BEGIN@67
11116µs47µsCarp::::BEGIN@4Carp::BEGIN@4
11116µs91µsCarp::::ret_summaryCarp::ret_summary
11116µs16µsCarp::::BEGIN@7Carp::BEGIN@7
11115µs1.28msCarp::::croakCarp::croak
11115µs35µsCarp::::BEGIN@18Carp::BEGIN@18
11115µs35µsCarp::::BEGIN@413Carp::BEGIN@413
11114µs14µsCarp::::BEGIN@105Carp::BEGIN@105
11113µs13µsCarp::::BEGIN@17Carp::BEGIN@17
11111µs207µsCarp::::shortmess_heavyCarp::shortmess_heavy
21111µs11µsCarp::::trusts_directlyCarp::trusts_directly
0000s0sCarp::::__ANON__[:13]Carp::__ANON__[:13]
0000s0sCarp::::__ANON__[:23]Carp::__ANON__[:23]
0000s0sCarp::::carpCarp::carp
0000s0sCarp::::cluckCarp::cluck
0000s0sCarp::::export_failCarp::export_fail
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Carp;
2
33100µs132µs
# spent 32µs within Carp::BEGIN@3 which was called: # once (32µs+0s) by CGI::Carp::BEGIN@334 at line 3
{ use 5.006; }
# spent 32µs making 1 call to Carp::BEGIN@3
4252µs278µs
# spent 47µs (16+31) within Carp::BEGIN@4 which was called: # once (16µs+31µs) by CGI::Carp::BEGIN@334 at line 4
use strict;
# spent 47µs making 1 call to Carp::BEGIN@4 # spent 31µs making 1 call to strict::import
5262µs247µs
# spent 35µs (23+12) within Carp::BEGIN@5 which was called: # once (23µs+12µs) by CGI::Carp::BEGIN@334 at line 5
use warnings;
# spent 35µs making 1 call to Carp::BEGIN@5 # spent 12µs making 1 call to warnings::import
6
7
# spent 16µs within Carp::BEGIN@7 which was called: # once (16µs+0s) by CGI::Carp::BEGIN@334 at line 15
BEGIN {
82172µs270µs
# spent 45µs (21+25) within Carp::BEGIN@8 which was called: # once (21µs+25µs) by CGI::Carp::BEGIN@334 at line 8
no strict "refs";
# spent 45µs making 1 call to Carp::BEGIN@8 # spent 25µs making 1 call to strict::unimport
9116µs if(exists($::{"utf8::"}) && exists(*{$::{"utf8::"}}{HASH}->{"is_utf8"}) &&
10 defined(*{*{$::{"utf8::"}}{HASH}->{"is_utf8"}}{CODE})) {
11 *is_utf8 = \&{"utf8::is_utf8"};
12 } else {
13 *is_utf8 = sub { 0 };
14 }
15156µs116µs}
# spent 16µs making 1 call to Carp::BEGIN@7
16
17
# spent 13µs within Carp::BEGIN@17 which was called: # once (13µs+0s) by CGI::Carp::BEGIN@334 at line 25
BEGIN {
182169µs256µs
# spent 35µs (15+21) within Carp::BEGIN@18 which was called: # once (15µs+21µs) by CGI::Carp::BEGIN@334 at line 18
no strict "refs";
# spent 35µs making 1 call to Carp::BEGIN@18 # spent 21µs making 1 call to strict::unimport
19117µs if(exists($::{"utf8::"}) && exists(*{$::{"utf8::"}}{HASH}->{"downgrade"}) &&
20 defined(*{*{$::{"utf8::"}}{HASH}->{"downgrade"}}{CODE})) {
21 *downgrade = \&{"utf8::downgrade"};
22 } else {
23 *downgrade = sub {};
24 }
251360µs113µs}
# spent 13µs making 1 call to Carp::BEGIN@17
26
2711µsour $VERSION = '1.26';
28
291300nsour $MaxEvalLen = 0;
301200nsour $Verbose = 0;
311200nsour $CarpLevel = 0;
321300nsour $MaxArgLen = 64; # How much of each argument to print. 0 = all.
331200nsour $MaxArgNums = 8; # How many arguments to print. 0 = all.
34
351800nsrequire Exporter;
36113µsour @ISA = ('Exporter');
3712µsour @EXPORT = qw(confess croak carp);
3811µsour @EXPORT_OK = qw(cluck verbose longmess shortmess);
3911µsour @EXPORT_FAIL = qw(verbose); # hook to enable verbose mode
40
41# The members of %Internal are packages that are internal to perl.
42# Carp will not report errors from within these packages if it
43# can. The members of %CarpInternal are internal to Perl's warning
44# system. Carp will not report errors from within these packages
45# either, and will not report calls *to* these packages for carp and
46# croak. They replace $CarpLevel, which is deprecated. The
47# $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
48# text and function arguments should be formatted when printed.
49
501300nsour %CarpInternal;
511100nsour %Internal;
52
53# disable these by default, so they can live w/o require Carp
5413µs$CarpInternal{Carp}++;
551700ns$CarpInternal{warnings}++;
561800ns$Internal{Exporter}++;
571400ns$Internal{'Exporter::Heavy'}++;
58
59# if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
60# then the following method will be called by the Exporter which knows
61# to do this thanks to @EXPORT_FAIL, above. $_[1] will contain the word
62# 'verbose'.
63
64sub export_fail { shift; $Verbose = shift if $_[0] eq 'verbose'; @_ }
65
66
# spent 259µs within Carp::_cgc which was called 111 times, avg 2µs/call: # 84 times (198µs+0s) by Carp::caller_info at line 117, avg 2µs/call # 16 times (30µs+0s) by Carp::long_error_loc at line 245, avg 2µs/call # 5 times (17µs+0s) by Carp::longmess at line 79, avg 3µs/call # 5 times (10µs+0s) by Carp::short_error_loc at line 332, avg 2µs/call # once (4µs+0s) by Carp::shortmess at line 93
sub _cgc {
672621µs264µs
# spent 40µs (17+24) within Carp::BEGIN@67 which was called: # once (17µs+24µs) by CGI::Carp::BEGIN@334 at line 67
no strict 'refs';
# spent 40µs making 1 call to Carp::BEGIN@67 # spent 24µs making 1 call to strict::unimport
68111194µs return \&{"CORE::GLOBAL::caller"} if defined &{"CORE::GLOBAL::caller"};
69111188µs return;
70}
71
72
# spent 4.65ms (43µs+4.61) within Carp::longmess which was called 5 times, avg 931µs/call: # 5 times (43µs+4.61ms) by Carp::confess at line 101, avg 931µs/call
sub longmess {
73 # Icky backwards compatibility wrapper. :-(
74 #
75 # The story is that the original implementation hard-coded the
76 # number of call levels to go back, so calls to longmess were off
77 # by one. Other code began calling longmess and expecting this
78 # behaviour, so the replacement has to emulate that behaviour.
7955µs517µs my $cgc = _cgc();
# spent 17µs making 5 calls to Carp::_cgc, avg 3µs/call
8059µs my $call_pack = $cgc ? $cgc->() : caller();
81521µs54.59ms if ( $Internal{$call_pack} or $CarpInternal{$call_pack} ) {
# spent 4.59ms making 5 calls to Carp::longmess_heavy, avg 919µs/call
82 return longmess_heavy(@_);
83 }
84 else {
85 local $CarpLevel = $CarpLevel + 1;
86 return longmess_heavy(@_);
87 }
88}
89
901200nsour @CARP_NOT;
91
92
# spent 229µs (18+211) within Carp::shortmess which was called: # once (18µs+211µs) by Carp::croak at line 100
sub shortmess {
9311µs14µs my $cgc = _cgc();
# spent 4µs making 1 call to Carp::_cgc
94
95 # Icky backwards compatibility wrapper. :-(
9616µs local @CARP_NOT = $cgc ? $cgc->() : caller();
9715µs1207µs shortmess_heavy(@_);
# spent 207µs making 1 call to Carp::shortmess_heavy
98}
99
10018µs21.27ms
# spent 1.28ms (15µs+1.27) within Carp::croak which was called: # once (15µs+1.27ms) by CGI::_compile at line 882 of CGI.pm
sub croak { die shortmess @_ }
# spent 1.04ms making 1 call to Carp::confess # spent 229µs making 1 call to Carp::shortmess
1015136µs54.65ms
# spent 4.70ms (49µs+4.65) within Carp::confess which was called 5 times, avg 941µs/call: # 2 times (26µs+1.94ms) by Foswiki::Plugin::BEGIN@2.9 or Foswiki::Plugins::ConvertAttachmentPlugin::BEGIN@26 at line 26 of /var/www/foswiki11/lib/Foswiki/Plugins/ConvertAttachmentPlugin.pm, avg 985µs/call # 2 times (16µs+1.68ms) by Foswiki::Plugin::BEGIN@2.9 or Foswiki::Plugin::load at line 2 of (eval 78)[/var/www/foswiki11/lib/Foswiki/Plugin.pm:121], avg 848µs/call # once (6µs+1.03ms) by Carp::croak at line 100
sub confess { die longmess @_ }
# spent 4.65ms making 5 calls to Carp::longmess, avg 931µs/call
102sub carp { warn shortmess @_ }
103sub cluck { warn longmess @_ }
104
105
# spent 14µs within Carp::BEGIN@105 which was called: # once (14µs+0s) by CGI::Carp::BEGIN@334 at line 112
BEGIN {
106115µs if("$]" >= 5.015002 || ("$]" >= 5.014002 && "$]" < 5.015) ||
107 ("$]" >= 5.012005 && "$]" < 5.013)) {
108 *CALLER_OVERRIDE_CHECK_OK = sub () { 1 };
109 } else {
110 *CALLER_OVERRIDE_CHECK_OK = sub () { 0 };
111 }
11212.85ms114µs}
# spent 14µs making 1 call to Carp::BEGIN@105
113
114
# spent 3.97ms (1.77+2.20) within Carp::caller_info which was called 84 times, avg 47µs/call: # 78 times (1.59ms+1.89ms) by Carp::ret_backtrace at line 302, avg 45µs/call # 5 times (150µs+266µs) by Carp::ret_backtrace at line 288, avg 83µs/call # once (35µs+40µs) by Carp::ret_summary at line 320
sub caller_info {
1158440µs my $i = shift(@_) + 1;
116849µs my %call_info;
1178462µs84198µs my $cgc = _cgc();
# spent 198µs making 84 calls to Carp::_cgc, avg 2µs/call
118 {
119 # Some things override caller() but forget to implement the
120 # @DB::args part of it, which we need. We check for this by
121 # pre-populating @DB::args with a sentinel which no-one else
122 # has the address of, so that we can detect whether @DB::args
123 # has been properly populated. However, on earlier versions
124 # of perl this check tickles a bug in CORE::caller() which
125 # leaks memory. So we only check on fixed perls.
126168123µs @DB::args = \$i if CALLER_OVERRIDE_CHECK_OK;
127 package DB;
128
12984492µs
- -
1338433µs unless ( defined $call_info{pack} ) {
134 return ();
135 }
136
1377996µs79184µs my $sub_name = Carp::get_subname( \%call_info );
# spent 184µs making 79 calls to Carp::get_subname, avg 2µs/call
1387926µs if ( $call_info{has_args} ) {
139587µs my @args;
1405842µs if (CALLER_OVERRIDE_CHECK_OK && @DB::args == 1
141 && ref $DB::args[0] eq ref \$i
142 && $DB::args[0] == \$i ) {
143 @DB::args = (); # Don't let anyone see the address of $i
144 local $@;
145 my $where = eval {
146 my $func = $cgc or return '';
147 my $gv =
148 *{
149 ( $::{"B::"} || return '') # B stash
150 ->{svref_2object} || return '' # entry in stash
151 }{CODE} # coderef in entry
152 ->($func)->GV;
153 my $package = $gv->STASH->NAME;
154 my $subname = $gv->NAME;
155 return unless defined $package && defined $subname;
156
157 # returning CORE::GLOBAL::caller isn't useful for tracing the cause:
158 return if $package eq 'CORE::GLOBAL' && $subname eq 'caller';
159 " in &${package}::$subname";
160 } || '';
161 @args
162 = "** Incomplete caller override detected$where; \@DB::args were not set **";
163 }
164 else {
165162208µs1041.82ms @args = map { Carp::format_arg($_) } @DB::args;
# spent 1.82ms making 104 calls to Carp::format_arg, avg 17µs/call
166 }
1675822µs if ( $MaxArgNums and @args > $MaxArgNums )
168 { # More than we want to show?
169 $#args = $MaxArgNums;
170 push @args, '...';
171 }
172
173 # Push the args onto the subroutine
1745864µs $sub_name .= '(' . join( ', ', @args ) . ')';
175 }
1767944µs $call_info{sub_name} = $sub_name;
17779348µs return wantarray() ? %call_info : \%call_info;
178}
179
180# Transform an argument to a function into a string.
181
# spent 1.82ms (1.47+345µs) within Carp::format_arg which was called 104 times, avg 17µs/call: # 104 times (1.47ms+345µs) by Carp::caller_info at line 165, avg 17µs/call
sub format_arg {
18210444µs my $arg = shift;
18310481µs5570µs if ( ref($arg) ) {
# spent 70µs making 55 calls to overload::AddrRef, avg 1µs/call
184 $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
185 }
18610428µs if ( defined($arg) ) {
18799131µs $arg =~ s/'/\\'/g;
1889996µs99164µs $arg = str_len_trim( $arg, $MaxArgLen );
# spent 164µs making 99 calls to Carp::str_len_trim, avg 2µs/call
189
190 # Quote it?
191 # Downgrade, and use [0-9] rather than \d, to avoid loading
192 # Unicode tables, which would be liable to fail if we're
193 # processing a syntax error.
19499199µs9956µs downgrade($arg, 1);
# spent 56µs making 99 calls to utf8::downgrade, avg 569ns/call
19599185µs $arg = "'$arg'" unless $arg =~ /^-?[0-9.]+\z/;
196 }
197 else {
19852µs $arg = 'undef';
199 }
200
201 # The following handling of "control chars" is direct from
202 # the original code - it is broken on Unicode though.
203 # Suggestions?
204 is_utf8($arg)
205104568µs10455µs or $arg =~ s/([[:cntrl:]]|[[:^ascii:]])/sprintf("\\x{%x}",ord($1))/eg;
# spent 55µs making 104 calls to utf8::is_utf8, avg 529ns/call
206104190µs return $arg;
207}
208
209# Takes an inheritance cache and a package and returns
210# an anon hash of known inheritances and anon array of
211# inheritances which consequences have not been figured
212# for.
213
# spent 28µs (17+11) within Carp::get_status which was called 4 times, avg 7µs/call: # 4 times (17µs+11µs) by Carp::trusts at line 380, avg 7µs/call
sub get_status {
2144700ns my $cache = shift;
2154700ns my $pkg = shift;
21646µs211µs $cache->{$pkg} ||= [ { $pkg => $pkg }, [ trusts_directly($pkg) ] ];
# spent 11µs making 2 calls to Carp::trusts_directly, avg 6µs/call
217411µs return @{ $cache->{$pkg} };
218}
219
220# Takes the info from caller() and figures out the name of
221# the sub/require/eval
222
# spent 184µs (175+9) within Carp::get_subname which was called 79 times, avg 2µs/call: # 79 times (175µs+9µs) by Carp::caller_info at line 137, avg 2µs/call
sub get_subname {
2237917µs my $info = shift;
2247924µs if ( defined( $info->{evaltext} ) ) {
22583µs my $eval = $info->{evaltext};
226810µs if ( $info->{is_require} ) {
227 return "require $eval";
228 }
229 else {
23054µs $eval =~ s/([\\\'])/\\$1/g;
231516µs59µs return "eval '" . str_len_trim( $eval, $MaxEvalLen ) . "'";
# spent 9µs making 5 calls to Carp::str_len_trim, avg 2µs/call
232 }
233 }
234
23571164µs return ( $info->{sub} eq '(eval)' ) ? 'eval {...}' : $info->{sub};
236}
237
238# Figures out what call (from the point of view of the caller)
239# the long error backtrace should start at.
240
# spent 111µs (81+30) within Carp::long_error_loc which was called 5 times, avg 22µs/call: # 5 times (81µs+30µs) by Carp::longmess_heavy at line 270, avg 22µs/call
sub long_error_loc {
24151µs my $i;
24252µs my $lvl = $CarpLevel;
243 {
244214µs ++$i;
2451613µs1630µs my $cgc = _cgc();
# spent 30µs making 16 calls to Carp::_cgc, avg 2µs/call
2461622µs my $pkg = $cgc ? $cgc->($i) : caller($i);
247162µs unless ( defined($pkg) ) {
248
249 # This *shouldn't* happen.
250 if (%Internal) {
251 local %Internal;
252 $i = long_error_loc();
253 last;
254 }
255 else {
256
257 # OK, now I am irritated.
258 return 2;
259 }
260 }
261169µs redo if $CarpInternal{$pkg};
26252µs redo unless 0 > --$lvl;
26353µs redo if $Internal{$pkg};
264 }
265512µs return $i - 1;
266}
267
268
# spent 4.59ms (33µs+4.56) within Carp::longmess_heavy which was called 5 times, avg 919µs/call: # 5 times (33µs+4.56ms) by Carp::longmess at line 81, avg 919µs/call
sub longmess_heavy {
26951µs return @_ if ref( $_[0] ); # don't break references as exceptions
27058µs5111µs my $i = long_error_loc();
# spent 111µs making 5 calls to Carp::long_error_loc, avg 22µs/call
271517µs54.45ms return ret_backtrace( $i, @_ );
# spent 4.45ms making 5 calls to Carp::ret_backtrace, avg 890µs/call
272}
273
274# Returns a full stack backtrace starting from where it is
275# told.
276
# spent 4.45ms (553µs+3.90) within Carp::ret_backtrace which was called 5 times, avg 890µs/call: # 5 times (553µs+3.90ms) by Carp::longmess_heavy at line 271, avg 890µs/call
sub ret_backtrace {
27759µs my ( $i, @error ) = @_;
2785900ns my $mess;
279512µs my $err = join '', @error;
2805600ns $i++;
281
28251µs my $tid_msg = '';
28352µs if ( defined &threads::tid ) {
284 my $tid = threads->tid;
285 $tid_msg = " thread $tid" if $tid;
286 }
287
288519µs5416µs my %i = caller_info($i);
# spent 416µs making 5 calls to Carp::caller_info, avg 83µs/call
289520µs $mess = "$err at $i{file} line $i{line}$tid_msg";
29053µs if( defined $. ) {
291 local $@ = '';
292 local $SIG{__DIE__};
293 eval {
294 CORE::die;
295 };
296 if($@ =~ /^Died at .*(, <.*?> line \d+).$/ ) {
297 $mess .= $1;
298 }
299 }
30051µs $mess .= "\.\n";
301
3025371µs783.48ms while ( my %i = caller_info( ++$i ) ) {
# spent 3.48ms making 78 calls to Carp::caller_info, avg 45µs/call
303 $mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
304 }
305
306541µs return $mess;
307}
308
309
# spent 91µs (16+75) within Carp::ret_summary which was called: # once (16µs+75µs) by Carp::shortmess_heavy at line 352
sub ret_summary {
31011µs my ( $i, @error ) = @_;
31112µs my $err = join '', @error;
3121200ns $i++;
313
3141500ns my $tid_msg = '';
3151400ns if ( defined &threads::tid ) {
316 my $tid = threads->tid;
317 $tid_msg = " thread $tid" if $tid;
318 }
319
32015µs175µs my %i = caller_info($i);
# spent 75µs making 1 call to Carp::caller_info
32116µs return "$err at $i{file} line $i{line}$tid_msg\.\n";
322}
323
324
# spent 105µs (46+60) within Carp::short_error_loc which was called: # once (46µs+60µs) by Carp::shortmess_heavy at line 351
sub short_error_loc {
325 # You have to create your (hash)ref out here, rather than defaulting it
326 # inside trusts *on a lexical*, as you want it to persist across calls.
327 # (You can default it on $_[2], but that gets messy)
32811µs my $cache = {};
3291300ns my $i = 1;
3301300ns my $lvl = $CarpLevel;
331 {
33264µs510µs my $cgc = _cgc();
# spent 10µs making 5 calls to Carp::_cgc, avg 2µs/call
33356µs my $called = $cgc ? $cgc->($i) : caller($i);
3345900ns $i++;
33557µs my $caller = $cgc ? $cgc->($i) : caller($i);
336
3375500ns return 0 unless defined($caller); # What happened?
33851µs redo if $Internal{$caller};
33951µs redo if $CarpInternal{$caller};
34041µs redo if $CarpInternal{$called};
34135µs336µs redo if trusts( $called, $caller, $cache );
# spent 36µs making 3 calls to Carp::trusts, avg 12µs/call
3421900ns113µs redo if trusts( $caller, $called, $cache );
# spent 13µs making 1 call to Carp::trusts
3431900ns redo unless 0 > --$lvl;
344 }
34516µs return $i - 1;
346}
347
348
# spent 207µs (11+196) within Carp::shortmess_heavy which was called: # once (11µs+196µs) by Carp::shortmess at line 97
sub shortmess_heavy {
3491400ns return longmess_heavy(@_) if $Verbose;
3501400ns return @_ if ref( $_[0] ); # don't break references as exceptions
35112µs1105µs my $i = short_error_loc();
# spent 105µs making 1 call to Carp::short_error_loc
35219µs191µs if ($i) {
# spent 91µs making 1 call to Carp::ret_summary
353 ret_summary( $i, @_ );
354 }
355 else {
356 longmess_heavy(@_);
357 }
358}
359
360# If a string is too long, trims it with ...
361
# spent 173µs within Carp::str_len_trim which was called 104 times, avg 2µs/call: # 99 times (164µs+0s) by Carp::format_arg at line 188, avg 2µs/call # 5 times (9µs+0s) by Carp::get_subname at line 231, avg 2µs/call
sub str_len_trim {
36210424µs my $str = shift;
36310420µs my $max = shift || 0;
36410437µs if ( 2 < $max and $max < length($str) ) {
365 substr( $str, $max - 3 ) = '...';
366 }
367104187µs return $str;
368}
369
370# Takes two packages and an optional cache. Says whether the
371# first inherits from the second.
372#
373# Recursive versions of this have to work to avoid certain
374# possible endless loops, and when following long chains of
375# inheritance are less efficient.
376
# spent 49µs (21+28) within Carp::trusts which was called 4 times, avg 12µs/call: # 3 times (18µs+19µs) by Carp::short_error_loc at line 341, avg 12µs/call # once (4µs+9µs) by Carp::short_error_loc at line 342
sub trusts {
37741µs my $child = shift;
3784600ns my $parent = shift;
3794700ns my $cache = shift;
38045µs428µs my ( $known, $partial ) = get_status( $cache, $child );
# spent 28µs making 4 calls to Carp::get_status, avg 7µs/call
381
382 # Figure out consequences until we have an answer
38342µs while ( @$partial and not exists $known->{$parent} ) {
384 my $anc = shift @$partial;
385 next if exists $known->{$anc};
386 $known->{$anc}++;
387 my ( $anc_knows, $anc_partial ) = get_status( $cache, $anc );
388 my @found = keys %$anc_knows;
389 @$known{@found} = ();
390 push @$partial, @$anc_partial;
391 }
392412µs return exists $known->{$parent};
393}
394
395# Takes a package and gives a list of those trusted directly
396
# spent 11µs within Carp::trusts_directly which was called 2 times, avg 6µs/call: # 2 times (11µs+0s) by Carp::get_status at line 216, avg 6µs/call
sub trusts_directly {
3972700ns my $class = shift;
398273µs286µs
# spent 60µs (33+27) within Carp::BEGIN@398 which was called: # once (33µs+27µs) by CGI::Carp::BEGIN@334 at line 398
no strict 'refs';
# spent 60µs making 1 call to Carp::BEGIN@398 # spent 27µs making 1 call to strict::unimport
3992128µs261µs
# spent 39µs (18+21) within Carp::BEGIN@399 which was called: # once (18µs+21µs) by CGI::Carp::BEGIN@334 at line 399
no warnings 'once';
# spent 39µs making 1 call to Carp::BEGIN@399 # spent 21µs making 1 call to warnings::unimport
400 return @{"$class\::CARP_NOT"}
401 ? @{"$class\::CARP_NOT"}
402214µs : @{"$class\::ISA"};
403}
404
40512µsif(!defined($warnings::VERSION) ||
406378µs251µs
# spent 34µs (17+17) within Carp::BEGIN@406 which was called: # once (17µs+17µs) by CGI::Carp::BEGIN@334 at line 406
do { no warnings "numeric"; $warnings::VERSION < 1.03 }) {
# spent 34µs making 1 call to Carp::BEGIN@406 # spent 17µs making 1 call to warnings::unimport
407 # Very old versions of warnings.pm import from Carp. This can go
408 # wrong due to the circular dependency. If Carp is invoked before
409 # warnings, then Carp starts by loading warnings, then warnings
410 # tries to import from Carp, and gets nothing because Carp is in
411 # the process of loading and hasn't defined its import method yet.
412 # So we work around that by manually exporting to warnings here.
4132136µs255µs
# spent 35µs (15+20) within Carp::BEGIN@413 which was called: # once (15µs+20µs) by CGI::Carp::BEGIN@334 at line 413
no strict "refs";
# spent 35µs making 1 call to Carp::BEGIN@413 # spent 20µs making 1 call to strict::unimport
414 *{"warnings::$_"} = \&$_ foreach @EXPORT;
415}
416
417122µs1;
418
419__END__