| Filename | /usr/share/perl5/DBIx/Class/Carp.pm |
| Statements | Executed 147 statements in 1.56ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 17 | 17 | 17 | 465µs | 732µs | DBIx::Class::Carp::import |
| 17 | 1 | 1 | 238µs | 238µs | DBIx::Class::Carp::CORE:regcomp (opcode) |
| 17 | 1 | 1 | 28µs | 28µs | DBIx::Class::Carp::CORE:qr (opcode) |
| 1 | 1 | 1 | 15µs | 26µs | DBIx::Class::Carp::BEGIN@4 |
| 1 | 1 | 1 | 11µs | 19µs | DBIx::Class::Carp::BEGIN@86 |
| 1 | 1 | 1 | 11µs | 19µs | DBIx::Class::Carp::BEGIN@5 |
| 1 | 1 | 1 | 3µs | 3µs | DBIx::Class::Carp::BEGIN@9 |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::Carp::__ANON__[:104] |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::Carp::__ANON__[:121] |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::Carp::__ANON__[:75] |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::Carp::__ANON__[:93] |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::Carp::__find_caller |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::Carp::unimport |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package # hide from pause | ||||
| 2 | DBIx::Class::Carp; | ||||
| 3 | |||||
| 4 | 2 | 41µs | 2 | 37µs | # spent 26µs (15+11) within DBIx::Class::Carp::BEGIN@4 which was called:
# once (15µs+11µs) by DBIx::Class::_Util::BEGIN@56 at line 4 # spent 26µs making 1 call to DBIx::Class::Carp::BEGIN@4
# spent 11µs making 1 call to strict::import |
| 5 | 2 | 38µs | 2 | 28µs | # spent 19µs (11+8) within DBIx::Class::Carp::BEGIN@5 which was called:
# once (11µs+8µs) by DBIx::Class::_Util::BEGIN@56 at line 5 # spent 19µs making 1 call to DBIx::Class::Carp::BEGIN@5
# spent 8µs making 1 call to warnings::import |
| 6 | |||||
| 7 | # load Carp early to prevent tickling of the ::Internal stash being | ||||
| 8 | # interpreted as "Carp is already loaded" by some braindead loader | ||||
| 9 | 2 | 432µs | 1 | 3µs | # spent 3µs within DBIx::Class::Carp::BEGIN@9 which was called:
# once (3µs+0s) by DBIx::Class::_Util::BEGIN@56 at line 9 # spent 3µs making 1 call to DBIx::Class::Carp::BEGIN@9 |
| 10 | 1 | 2µs | $Carp::Internal{ (__PACKAGE__) }++; | ||
| 11 | |||||
| 12 | sub __find_caller { | ||||
| 13 | my ($skip_pattern, $class) = @_; | ||||
| 14 | |||||
| 15 | my $skip_class_data = $class->_skip_namespace_frames | ||||
| 16 | if ($class and $class->can('_skip_namespace_frames')); | ||||
| 17 | |||||
| 18 | $skip_pattern = qr/$skip_pattern|$skip_class_data/ | ||||
| 19 | if $skip_class_data; | ||||
| 20 | |||||
| 21 | my $fr_num = 1; # skip us and the calling carp* | ||||
| 22 | |||||
| 23 | my (@f, $origin); | ||||
| 24 | while (@f = caller($fr_num++)) { | ||||
| 25 | |||||
| 26 | next if | ||||
| 27 | ( $f[3] eq '(eval)' or $f[3] =~ /::__ANON__$/ ); | ||||
| 28 | |||||
| 29 | $origin ||= ( | ||||
| 30 | $f[3] =~ /^ (.+) :: ([^\:]+) $/x | ||||
| 31 | and | ||||
| 32 | ! $Carp::Internal{$1} | ||||
| 33 | and | ||||
| 34 | $1 !~ /^(?: DBIx::Class::Storage::BlockRunner | Context::Preserve | Try::Tiny | Class::Accessor::Grouped | Class::C3::Componentised | Module::Runtime )$/x | ||||
| 35 | |||||
| 36 | |||||
| 37 | and | ||||
| 38 | $2 !~ /^(?: throw_exception | carp | carp_unique | carp_once | dbh_do | txn_do | with_deferred_fk_checks)$/x | ||||
| 39 | ############################# | ||||
| 40 | ) ? $f[3] : undef; | ||||
| 41 | |||||
| 42 | if ( | ||||
| 43 | $f[0]->can('_skip_namespace_frames') | ||||
| 44 | and | ||||
| 45 | my $extra_skip = $f[0]->_skip_namespace_frames | ||||
| 46 | ) { | ||||
| 47 | $skip_pattern = qr/$skip_pattern|$extra_skip/; | ||||
| 48 | } | ||||
| 49 | |||||
| 50 | last if $f[0] !~ $skip_pattern; | ||||
| 51 | } | ||||
| 52 | |||||
| 53 | my $site = @f # if empty - nothing matched - full stack | ||||
| 54 | ? "at $f[1] line $f[2]" | ||||
| 55 | : Carp::longmess() | ||||
| 56 | ; | ||||
| 57 | $origin ||= '{UNKNOWN}'; | ||||
| 58 | |||||
| 59 | return ( | ||||
| 60 | $site, | ||||
| 61 | $origin =~ /::/ ? "$origin(): " : "$origin: ", # cargo-cult from Carp::Clan | ||||
| 62 | ); | ||||
| 63 | }; | ||||
| 64 | |||||
| 65 | my $warn = sub { | ||||
| 66 | my ($ln, @warn) = @_; | ||||
| 67 | @warn = "Warning: something's wrong" unless @warn; | ||||
| 68 | |||||
| 69 | # back-compat with Carp::Clan - a warning ending with \n does | ||||
| 70 | # not include caller info | ||||
| 71 | warn ( | ||||
| 72 | @warn, | ||||
| 73 | $warn[-1] =~ /\n$/ ? '' : " $ln\n" | ||||
| 74 | ); | ||||
| 75 | 1 | 3µs | }; | ||
| 76 | |||||
| 77 | # spent 732µs (465+267) within DBIx::Class::Carp::import which was called 17 times, avg 43µs/call:
# once (40µs+19µs) by DBIx::Class::Storage::BEGIN@15 at line 15 of DBIx/Class/Storage.pm
# once (29µs+28µs) by DBIx::Class::ResultSource::BEGIN@11 at line 11 of DBIx/Class/ResultSource.pm
# once (26µs+24µs) by DBIx::Class::Storage::TxnScopeGuard::BEGIN@9 at line 9 of DBIx/Class/Storage/TxnScopeGuard.pm
# once (37µs+13µs) by DBIx::Class::Storage::DBI::BEGIN@10 at line 10 of DBIx/Class/Storage/DBI.pm
# once (32µs+13µs) by DBIx::Class::Relationship::HasOne::BEGIN@6 at line 6 of DBIx/Class/Relationship/HasOne.pm
# once (26µs+19µs) by DBIx::Class::Relationship::Accessor::BEGIN@6 at line 6 of DBIx/Class/Relationship/Accessor.pm
# once (28µs+16µs) by DBIx::Class::Row::BEGIN@11 at line 11 of DBIx/Class/Row.pm
# once (28µs+16µs) by DBIx::Class::Schema::BEGIN@8 at line 8 of DBIx/Class/Schema.pm
# once (30µs+12µs) by DBIx::Class::Relationship::ManyToMany::BEGIN@7 at line 7 of DBIx/Class/Relationship/ManyToMany.pm
# once (30µs+12µs) by DBIx::Class::SQLMaker::BEGIN@42 at line 42 of DBIx/Class/SQLMaker.pm
# once (28µs+13µs) by DBIx::Class::ResultSet::BEGIN@6 at line 6 of DBIx/Class/ResultSet.pm
# once (28µs+14µs) by DBIx::Class::Componentised::BEGIN@10 at line 10 of DBIx/Class/Componentised.pm
# once (20µs+19µs) by DBIx::Class::Relationship::CascadeActions::BEGIN@6 at line 6 of DBIx/Class/Relationship/CascadeActions.pm
# once (22µs+15µs) by DBIx::Class::Storage::DBIHacks::BEGIN@20 at line 20 of DBIx/Class/Storage/DBIHacks.pm
# once (24µs+13µs) by DBIx::Class::_Util::BEGIN@56 at line 56 of DBIx/Class/_Util.pm
# once (18µs+11µs) by DBIx::Class::Storage::BlockRunner::BEGIN@8 at line 8 of DBIx/Class/Storage/BlockRunner.pm
# once (17µs+10µs) by DBIx::Class::ResultSetColumn::BEGIN@7 at line 7 of DBIx/Class/ResultSetColumn.pm | ||||
| 78 | 17 | 16µs | my (undef, $skip_pattern) = @_; | ||
| 79 | 17 | 15µs | my $into = caller; | ||
| 80 | |||||
| 81 | 17 | 375µs | 34 | 267µs | $skip_pattern = $skip_pattern # spent 238µs making 17 calls to DBIx::Class::Carp::CORE:regcomp, avg 14µs/call
# spent 28µs making 17 calls to DBIx::Class::Carp::CORE:qr, avg 2µs/call |
| 82 | ? qr/ ^ $into $ | $skip_pattern /x | ||||
| 83 | : qr/ ^ $into $ /x | ||||
| 84 | ; | ||||
| 85 | |||||
| 86 | 2 | 275µs | 2 | 26µs | # spent 19µs (11+7) within DBIx::Class::Carp::BEGIN@86 which was called:
# once (11µs+7µs) by DBIx::Class::_Util::BEGIN@56 at line 86 # spent 19µs making 1 call to DBIx::Class::Carp::BEGIN@86
# spent 7µs making 1 call to strict::unimport |
| 87 | |||||
| 88 | *{"${into}::carp"} = sub { | ||||
| 89 | $warn->( | ||||
| 90 | __find_caller($skip_pattern, $into), | ||||
| 91 | @_ | ||||
| 92 | ); | ||||
| 93 | 17 | 132µs | }; | ||
| 94 | |||||
| 95 | 17 | 20µs | my $fired = {}; | ||
| 96 | *{"${into}::carp_once"} = sub { | ||||
| 97 | return if $fired->{$_[0]}; | ||||
| 98 | $fired->{$_[0]} = 1; | ||||
| 99 | |||||
| 100 | $warn->( | ||||
| 101 | __find_caller($skip_pattern, $into), | ||||
| 102 | @_, | ||||
| 103 | ); | ||||
| 104 | 17 | 71µs | }; | ||
| 105 | |||||
| 106 | 17 | 4µs | my $seen; | ||
| 107 | *{"${into}::carp_unique"} = sub { | ||||
| 108 | my ($ln, $calling) = __find_caller($skip_pattern, $into); | ||||
| 109 | my $msg = join ('', $calling, @_); | ||||
| 110 | |||||
| 111 | # unique carping with a hidden caller makes no sense | ||||
| 112 | $msg =~ s/\n+$//; | ||||
| 113 | |||||
| 114 | return if $seen->{$ln}{$msg}; | ||||
| 115 | $seen->{$ln}{$msg} = 1; | ||||
| 116 | |||||
| 117 | $warn->( | ||||
| 118 | $ln, | ||||
| 119 | $msg, | ||||
| 120 | ); | ||||
| 121 | 17 | 135µs | }; | ||
| 122 | } | ||||
| 123 | |||||
| 124 | sub unimport { | ||||
| 125 | die (__PACKAGE__ . " does not implement unimport yet\n"); | ||||
| 126 | } | ||||
| 127 | |||||
| 128 | 1 | 3µs | 1; | ||
| 129 | |||||
| 130 | __END__ | ||||
# spent 28µs within DBIx::Class::Carp::CORE:qr which was called 17 times, avg 2µs/call:
# 17 times (28µs+0s) by DBIx::Class::Carp::import at line 81, avg 2µs/call | |||||
# spent 238µs within DBIx::Class::Carp::CORE:regcomp which was called 17 times, avg 14µs/call:
# 17 times (238µs+0s) by DBIx::Class::Carp::import at line 81, avg 14µs/call |