← Index
NYTProf Performance Profile   « line view »
For starman worker -M FindBin --max-requests 50 --workers 2 --user=kohadev-koha --group kohadev-koha --pid /var/run/koha/kohadev/plack.pid --daemonize --access-log /var/log/koha/kohadev/plack.log --error-log /var/log/koha/kohadev/plack-error.log -E deployment --socket /var/run/koha/kohadev/plack.sock /etc/koha/sites/kohadev/plack.psgi
  Run on Fri Jan 8 14:31:06 2016
Reported on Fri Jan 8 14:33:27 2016

Filename/usr/share/perl5/DBIx/Class/_Util.pm
StatementsExecuted 850 statements in 556µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1119.65ms20.7msDBIx::Class::_Util::::BEGIN@64DBIx::Class::_Util::BEGIN@64
318112.29ms2.29msDBIx::Class::_Util::::is_exceptionDBIx::Class::_Util::is_exception
111974µs1.11msDBIx::Class::_Util::::BEGIN@56DBIx::Class::_Util::BEGIN@56
21532454µs454µsDBIx::Class::_Util::::perlstringDBIx::Class::_Util::perlstring
11170µs5.87msDBIx::Class::_ENV_::::BEGIN@15DBIx::Class::_ENV_::BEGIN@15
11131µs52µsDBIx::Class::_Util::::BEGIN@60DBIx::Class::_Util::BEGIN@60
44116µs16µsDBIx::Class::_Util::::qsubDBIx::Class::_Util::qsub
11116µs21µsDBIx::Class::_Util::::BEGIN@4DBIx::Class::_Util::BEGIN@4
11116µs38µsDBIx::Class::_Util::::BEGIN@9DBIx::Class::_Util::BEGIN@9
11115µs62µsDBIx::Class::_Util::::BEGIN@7DBIx::Class::_Util::BEGIN@7
11113µs81µsDBIx::Class::_Util::::BEGIN@79DBIx::Class::_Util::BEGIN@79
11113µs48µsDBIx::Class::_Util::::BEGIN@58DBIx::Class::_Util::BEGIN@58
11112µs31µsDBIx::Class::_ENV_::::BEGIN@13DBIx::Class::_ENV_::BEGIN@13
11112µs20µsDBIx::Class::_Util::::BEGIN@276DBIx::Class::_Util::BEGIN@276
11111µs40µsDBIx::Class::_Util::::BEGIN@59DBIx::Class::_Util::BEGIN@59
11111µs45µsDBIx::Class::_Util::::BEGIN@88DBIx::Class::_Util::BEGIN@88
1118µs15µsDBIx::Class::_Util::::BEGIN@5DBIx::Class::_Util::BEGIN@5
0000s0sDBIx::Class::_Util::::__ANON__[:95]DBIx::Class::_Util::__ANON__[:95]
0000s0sDBIx::Class::_Util::::__ANON__[:97]DBIx::Class::_Util::__ANON__[:97]
0000s0sDBIx::Class::_Util::::fail_on_internal_callDBIx::Class::_Util::fail_on_internal_call
0000s0sDBIx::Class::_Util::::fail_on_internal_wantarrayDBIx::Class::_Util::fail_on_internal_wantarray
0000s0sDBIx::Class::_Util::::hrefaddrDBIx::Class::_Util::hrefaddr
0000s0sDBIx::Class::_Util::::modver_gt_or_eqDBIx::Class::_Util::modver_gt_or_eq
0000s0sDBIx::Class::_Util::::refcountDBIx::Class::_Util::refcount
0000s0sDBIx::Class::_Util::::refdescDBIx::Class::_Util::refdesc
0000s0sDBIx::Class::_Util::::serializeDBIx::Class::_Util::serialize
0000s0sDBIx::Class::_Util::::sigwarn_silencerDBIx::Class::_Util::sigwarn_silencer
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package # hide from PAUSE
2 DBIx::Class::_Util;
3
4226µs
# spent 21µs (16+5) within DBIx::Class::_Util::BEGIN@4 which was called: # once (16µs+5µs) by DBIx::Class::BEGIN@18 at line 4
use warnings;
# spent 21µs making 1 call to DBIx::Class::_Util::BEGIN@4 # spent 5µs making 1 call to warnings::import
5221µs
# spent 15µs (8+7) within DBIx::Class::_Util::BEGIN@5 which was called: # once (8µs+7µs) by DBIx::Class::BEGIN@18 at line 5
use strict;
# spent 15µs making 1 call to DBIx::Class::_Util::BEGIN@5 # spent 6µs making 1 call to strict::import
6
72109µs
# spent 62µs (15+47) within DBIx::Class::_Util::BEGIN@7 which was called: # once (15µs+47µs) by DBIx::Class::BEGIN@18 at line 7
use constant SPURIOUS_VERSION_CHECK_WARNINGS => ($] < 5.010 ? 1 : 0);
# spent 62µs making 1 call to DBIx::Class::_Util::BEGIN@7 # spent 47µs making 1 call to constant::import
8
9
# spent 38µs (16+22) within DBIx::Class::_Util::BEGIN@9 which was called: # once (16µs+22µs) by DBIx::Class::BEGIN@18 at line 52
BEGIN {
10 package # hide from pause
11 DBIx::Class::_ENV_;
12
13250µs
# spent 31µs (12+19) within DBIx::Class::_ENV_::BEGIN@13 which was called: # once (12µs+19µs) by DBIx::Class::BEGIN@18 at line 13
use Config;
# spent 31µs making 1 call to DBIx::Class::_ENV_::BEGIN@13 # spent 19µs making 1 call to Config::import
14
15
# spent 5.87ms (70µs+5.80) within DBIx::Class::_ENV_::BEGIN@15 which was called: # once (70µs+5.80ms) by DBIx::Class::BEGIN@18 at line 42
use constant {
16
17 # but of course
18 BROKEN_FORK => ($^O eq 'MSWin32') ? 1 : 0,
19
20 BROKEN_GOTO => ($] < '5.008003') ? 1 : 0,
21
22 HAS_ITHREADS => $Config{useithreads} ? 1 : 0,
23
24 # ::Runmode would only be loaded by DBICTest, which in turn implies t/
25 DBICTEST => eval { DBICTest::RunMode->is_author } ? 1 : 0,
26
27 # During 5.13 dev cycle HELEMs started to leak on copy
28 # add an escape for these perls ON SMOKERS - a user will still get death
2935.80ms PEEPEENESS => ( eval { DBICTest::RunMode->is_smoker } && ($] >= 5.013005 and $] <= 5.013006) ),
# spent 3.09ms making 1 call to constant::import # spent 2.71ms making 2 calls to Config::FETCH, avg 1.35ms/call
30
31 SHUFFLE_UNORDERED_RESULTSETS => $ENV{DBIC_SHUFFLE_UNORDERED_RESULTSETS} ? 1 : 0,
32
33 ASSERT_NO_INTERNAL_WANTARRAY => $ENV{DBIC_ASSERT_NO_INTERNAL_WANTARRAY} ? 1 : 0,
34
35 ASSERT_NO_INTERNAL_INDIRECT_CALLS => $ENV{DBIC_ASSERT_NO_INTERNAL_INDIRECT_CALLS} ? 1 : 0,
36
37 STRESSTEST_UTF8_UPGRADE_GENERATED_COLLAPSER_SOURCE => $ENV{DBIC_STRESSTEST_UTF8_UPGRADE_GENERATED_COLLAPSER_SOURCE} ? 1 : 0,
38
39 IV_SIZE => $Config{ivsize},
40
41 OS_NAME => $^O,
4215.87ms };
# spent 5.87ms making 1 call to DBIx::Class::_ENV_::BEGIN@15
43
44 if ($] < 5.009_005) {
45 require MRO::Compat;
46 constant->import( OLD_MRO => 1 );
47 }
48 else {
49 require mro;
50122µs constant->import( OLD_MRO => 0 );
# spent 22µs making 1 call to constant::import
51 }
52138µs}
# spent 38µs making 1 call to DBIx::Class::_Util::BEGIN@9
53
54# FIXME - this is not supposed to be here
55# Carp::Skip to the rescue soon
5621.15ms
# spent 1.11ms (974µs+137µs) within DBIx::Class::_Util::BEGIN@56 which was called: # once (974µs+137µs) by DBIx::Class::BEGIN@18 at line 56
use DBIx::Class::Carp '^DBIx::Class|^DBICTest';
# spent 1.11ms making 1 call to DBIx::Class::_Util::BEGIN@56 # spent 42µs making 1 call to DBIx::Class::Carp::import
57
58284µs
# spent 48µs (13+36) within DBIx::Class::_Util::BEGIN@58 which was called: # once (13µs+36µs) by DBIx::Class::BEGIN@18 at line 58
use Carp 'croak';
# spent 48µs making 1 call to DBIx::Class::_Util::BEGIN@58 # spent 36µs making 1 call to Exporter::import
59268µs
# spent 40µs (11+28) within DBIx::Class::_Util::BEGIN@59 which was called: # once (11µs+28µs) by DBIx::Class::BEGIN@18 at line 59
use Scalar::Util qw(weaken blessed reftype);
# spent 40µs making 1 call to DBIx::Class::_Util::BEGIN@59 # spent 28µs making 1 call to Exporter::import
60273µs
# spent 52µs (31+21) within DBIx::Class::_Util::BEGIN@60 which was called: # once (31µs+21µs) by DBIx::Class::BEGIN@18 at line 60
use List::Util qw(first);
# spent 52µs making 1 call to DBIx::Class::_Util::BEGIN@60 # spent 21µs making 1 call to List::Util::import
61
62# DO NOT edit away without talking to riba first, he will just put it back
63# BEGIN pre-Moo2 import block
64
# spent 20.7ms (9.65+11.1) within DBIx::Class::_Util::BEGIN@64 which was called: # once (9.65ms+11.1ms) by DBIx::Class::BEGIN@18 at line 75
BEGIN {
65 my $initial_fatal_bits = (${^WARNING_BITS}||'') & $warnings::DeadBits{all};
66
67 local $ENV{PERL_STRICTURES_EXTRA} = 0;
68 # load all of these now, so that lazy-loading does not escape
69 # the current PERL_STRICTURES_EXTRA setting
70 require Sub::Quote;
71 require Sub::Defer;
72
73144µs Sub::Quote->import('quote_sub');
# spent 44µs making 1 call to Exporter::import
74 ${^WARNING_BITS} &= ( $initial_fatal_bits | ~ $warnings::DeadBits{all} );
75120.7ms}
# spent 20.7ms making 1 call to DBIx::Class::_Util::BEGIN@64
764186µs
# spent 16µs within DBIx::Class::_Util::qsub which was called 4 times, avg 4µs/call: # once (9µs+0s) by DBIx::Class::Storage::BEGIN@16 at line 78 of DBIx/Class/Storage/BlockRunner.pm # once (3µs+0s) by DBIx::Class::Storage::BEGIN@16 at line 57 of DBIx/Class/Storage/BlockRunner.pm # once (2µs+0s) by DBIx::Class::Storage::BEGIN@16 at line 66 of DBIx/Class/Storage/BlockRunner.pm # once (1µs+0s) by DBIx::Class::Storage::BEGIN@16 at line 92 of DBIx/Class/Storage/BlockRunner.pm
sub qsub ($) { goto &quote_sub } # no point depping on new Moo just for this
# spent 186µs making 4 calls to Sub::Quote::quote_sub, avg 46µs/call
77# END pre-Moo2 import block
78
79281µs
# spent 81µs (13+68) within DBIx::Class::_Util::BEGIN@79 which was called: # once (13µs+68µs) by DBIx::Class::BEGIN@18 at line 79
use base 'Exporter';
# spent 81µs making 1 call to DBIx::Class::_Util::BEGIN@79 # spent 68µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 68µs
80our @EXPORT_OK = qw(
81 sigwarn_silencer modver_gt_or_eq
82 fail_on_internal_wantarray fail_on_internal_call
83 refdesc refcount hrefaddr is_exception
84 quote_sub qsub perlstring serialize
85 UNRESOLVABLE_CONDITION
86);
87
88280µs
# spent 45µs (11+34) within DBIx::Class::_Util::BEGIN@88 which was called: # once (11µs+34µs) by DBIx::Class::BEGIN@18 at line 88
use constant UNRESOLVABLE_CONDITION => \ '1 = 0';
# spent 45µs making 1 call to DBIx::Class::_Util::BEGIN@88 # spent 34µs making 1 call to constant::import
89
90sub sigwarn_silencer ($) {
91 my $pattern = shift;
92
93 croak "Expecting a regexp" if ref $pattern ne 'Regexp';
94
95 my $orig_sig_warn = $SIG{__WARN__} || sub { CORE::warn(@_) };
96
97 return sub { &$orig_sig_warn unless $_[0] =~ $pattern };
98}
99
100
# spent 454µs within DBIx::Class::_Util::perlstring which was called 215 times, avg 2µs/call: # 144 times (295µs+0s) by DBIx::Class::Relationship::Accessor::add_relationship_accessor at line 101 of DBIx/Class/Relationship/Accessor.pm, avg 2µs/call # 53 times (132µs+0s) by DBIx::Class::Relationship::Accessor::add_relationship_accessor at line 26 of DBIx/Class/Relationship/Accessor.pm, avg 2µs/call # 18 times (28µs+0s) by Class::C3::Componentised::ensure_class_loaded at line 124 of DBIx/Class/Storage/DBI.pm, avg 2µs/call
sub perlstring ($) { q{"}. quotemeta( shift ). q{"} };
101
102sub hrefaddr ($) { sprintf '0x%x', &Scalar::Util::refaddr||0 }
103
104sub refdesc ($) {
105 croak "Expecting a reference" if ! length ref $_[0];
106
107 # be careful not to trigger stringification,
108 # reuse @_ as a scratch-pad
109 sprintf '%s%s(0x%x)',
110 ( defined( $_[1] = blessed $_[0]) ? "$_[1]=" : '' ),
111 reftype $_[0],
112 Scalar::Util::refaddr($_[0]),
113 ;
114}
115
116sub refcount ($) {
117 croak "Expecting a reference" if ! length ref $_[0];
118
119 require B;
120 # No tempvars - must operate on $_[0], otherwise the pad
121 # will count as an extra ref
122 B::svref_2object($_[0])->REFCNT;
123}
124
125sub serialize ($) {
126 require Storable;
127 local $Storable::canonical = 1;
128 Storable::nfreeze($_[0]);
129}
130
131
# spent 2.29ms within DBIx::Class::_Util::is_exception which was called 318 times, avg 7µs/call: # 318 times (2.29ms+0s) by DBIx::Class::Storage::BlockRunner::__ANON__[/usr/share/perl5/DBIx/Class/Storage/BlockRunner.pm:233] at line 179 of DBIx/Class/Storage/BlockRunner.pm, avg 7µs/call
sub is_exception ($) {
1328534µs my $e = $_[0];
133
134 # this is not strictly correct - an eval setting $@ to undef
135 # is *not* the same as an eval setting $@ to ''
136 # but for the sake of simplicity assume the following for
137 # the time being
1388518µs return 0 unless defined $e;
139
1408521µs my ($not_blank, $suberror);
141 {
14217052µs local $@;
1438572µs eval {
1448575µs $not_blank = ($e ne '') ? 1 : 0;
1458532µs 1;
146 } or $suberror = $@;
147 }
148
1498526µs if (defined $suberror) {
150 if (length (my $class = blessed($e) )) {
151 carp_unique( sprintf(
152 'External exception class %s implements partial (broken) overloading '
153 . 'preventing its instances from being used in simple ($x eq $y) '
154 . 'comparisons. Given Perl\'s "globally cooperative" exception '
155 . 'handling this type of brokenness is extremely dangerous on '
156 . 'exception objects, as it may (and often does) result in silent '
157 . '"exception substitution". DBIx::Class tries to work around this '
158 . 'as much as possible, but other parts of your software stack may '
159 . 'not be even aware of this. Please submit a bugreport against the '
160 . 'distribution containing %s and in the meantime apply a fix similar '
161 . 'to the one shown at %s, in order to ensure your exception handling '
162 . 'is saner application-wide. What follows is the actual error text '
163 . "as generated by Perl itself:\n\n%s\n ",
164 $class,
165 $class,
166 'http://v.gd/DBIC_overload_tempfix/',
167 $suberror,
168 ));
169
170 # workaround, keeps spice flowing
171 $not_blank = ("$e" ne '') ? 1 : 0;
172 }
173 else {
174 # not blessed yet failed the 'ne'... this makes 0 sense...
175 # just throw further
176 die $suberror
177 }
178 }
179
18085227µs return $not_blank;
181}
182
183sub modver_gt_or_eq ($$) {
184 my ($mod, $ver) = @_;
185
186 croak "Nonsensical module name supplied"
187 if ! defined $mod or ! length $mod;
188
189 croak "Nonsensical minimum version supplied"
190 if ! defined $ver or $ver =~ /[^0-9\.\_]/;
191
192 local $SIG{__WARN__} = sigwarn_silencer( qr/\Qisn't numeric in subroutine entry/ )
193 if SPURIOUS_VERSION_CHECK_WARNINGS;
194
195 croak "$mod does not seem to provide a version (perhaps it never loaded)"
196 unless $mod->VERSION;
197
198 local $@;
199 eval { $mod->VERSION($ver) } ? 1 : 0;
200}
201
202{
203 my $list_ctx_ok_stack_marker;
204
205 sub fail_on_internal_wantarray () {
206 return if $list_ctx_ok_stack_marker;
207
208 if (! defined wantarray) {
209 croak('fail_on_internal_wantarray() needs a tempvar to save the stack marker guard');
210 }
211
212 my $cf = 1;
213 while ( ( (caller($cf+1))[3] || '' ) =~ / :: (?:
214
215 # these are public API parts that alter behavior on wantarray
216 search | search_related | slice | search_literal
217
218 |
219
220 # these are explicitly prefixed, since we only recognize them as valid
221 # escapes when they come from the guts of CDBICompat
222 CDBICompat .*? :: (?: search_where | retrieve_from_sql | retrieve_all )
223
224 ) $/x ) {
225 $cf++;
226 }
227
228 my ($fr, $want, $argdesc);
229 {
230 package DB;
231
- -
239 if (
240 $want and $fr->[0] =~ /^(?:DBIx::Class|DBICx::)/
241 ) {
242 DBIx::Class::Exception->throw( sprintf (
243 "Improper use of %s instance in list context at %s line %d\n\n Stacktrace starts",
244 $argdesc, @{$fr}[1,2]
245 ), 'with_stacktrace');
246 }
247
248 my $mark = [];
249 weaken ( $list_ctx_ok_stack_marker = $mark );
250 $mark;
251 }
252}
253
254sub fail_on_internal_call {
255 my ($fr, $argdesc);
256 {
257 package DB;
258
- -
265 if (
266 $argdesc
267 and
268 $fr->[0] =~ /^(?:DBIx::Class|DBICx::)/
269 and
270 $fr->[1] !~ /\b(?:CDBICompat|ResultSetProxy)\b/ # no point touching there
271 ) {
272 DBIx::Class::Exception->throw( sprintf (
273 "Illegal internal call of indirect proxy-method %s() with argument %s: examine the last lines of the proxy method deparse below to determine what to call directly instead at %s on line %d\n\n%s\n\n Stacktrace starts",
274 $fr->[3], $argdesc, @{$fr}[1,2], ( $fr->[6] || do {
275 require B::Deparse;
276229µs
# spent 20µs (12+8) within DBIx::Class::_Util::BEGIN@276 which was called: # once (12µs+8µs) by DBIx::Class::BEGIN@18 at line 276
no strict 'refs';
# spent 20µs making 1 call to DBIx::Class::_Util::BEGIN@276 # spent 8µs making 1 call to strict::unimport
277 B::Deparse->new->coderef2text(\&{$fr->[3]})
278 }),
279 ), 'with_stacktrace');
280 }
281}
282
2831;
Report produced by the NYTProf 6.02 Perl profiler, developed by Tim Bunce and Adam Kaplan.