← 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 13:50:58 2016
Reported on Fri Jan 8 13:51:26 2016

Filename/usr/share/perl5/DBIx/Class/_Util.pm
StatementsExecuted 30268 statements in 29.1ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
30011120.5ms20.5msDBIx::Class::_Util::::is_exceptionDBIx::Class::_Util::is_exception
1111.50ms9.62msDBIx::Class::_Util::::BEGIN@64DBIx::Class::_Util::BEGIN@64
1111.13ms1.27msDBIx::Class::_Util::::BEGIN@56DBIx::Class::_Util::BEGIN@56
21532460µs460µsDBIx::Class::_Util::::perlstringDBIx::Class::_Util::perlstring
11166µs3.10msDBIx::Class::_ENV_::::BEGIN@15DBIx::Class::_ENV_::BEGIN@15
11133µs59µsDBIx::Class::_Util::::BEGIN@9DBIx::Class::_Util::BEGIN@9
11130µs50µsDBIx::Class::_Util::::BEGIN@60DBIx::Class::_Util::BEGIN@60
11115µs35µsDBIx::Class::_ENV_::::BEGIN@13DBIx::Class::_ENV_::BEGIN@13
11112µs16µsDBIx::Class::_Util::::BEGIN@4DBIx::Class::_Util::BEGIN@4
11112µs43µsDBIx::Class::_Util::::BEGIN@58DBIx::Class::_Util::BEGIN@58
11112µs75µsDBIx::Class::_Util::::BEGIN@79DBIx::Class::_Util::BEGIN@79
11111µs44µsDBIx::Class::_Util::::BEGIN@7DBIx::Class::_Util::BEGIN@7
11111µs42µsDBIx::Class::_Util::::BEGIN@88DBIx::Class::_Util::BEGIN@88
44111µs11µsDBIx::Class::_Util::::qsubDBIx::Class::_Util::qsub
11111µs18µsDBIx::Class::_Util::::BEGIN@276DBIx::Class::_Util::BEGIN@276
1119µs35µsDBIx::Class::_Util::::BEGIN@59DBIx::Class::_Util::BEGIN@59
1117µs14µ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
4233µs220µs
# spent 16µs (12+4) within DBIx::Class::_Util::BEGIN@4 which was called: # once (12µs+4µs) by DBIx::Class::BEGIN@18 at line 4
use warnings;
# spent 16µs making 1 call to DBIx::Class::_Util::BEGIN@4 # spent 4µs making 1 call to warnings::import
5247µs220µs
# spent 14µs (7+6) within DBIx::Class::_Util::BEGIN@5 which was called: # once (7µs+6µs) by DBIx::Class::BEGIN@18 at line 5
use strict;
# spent 14µs making 1 call to DBIx::Class::_Util::BEGIN@5 # spent 6µs making 1 call to strict::import
6
7290µs277µs
# spent 44µs (11+33) within DBIx::Class::_Util::BEGIN@7 which was called: # once (11µs+33µs) by DBIx::Class::BEGIN@18 at line 7
use constant SPURIOUS_VERSION_CHECK_WARNINGS => ($] < 5.010 ? 1 : 0);
# spent 44µs making 1 call to DBIx::Class::_Util::BEGIN@7 # spent 33µs making 1 call to constant::import
8
9
# spent 59µs (33+25) within DBIx::Class::_Util::BEGIN@9 which was called: # once (33µs+25µs) by DBIx::Class::BEGIN@18 at line 52
BEGIN {
10 package # hide from pause
11 DBIx::Class::_ENV_;
12
132249µs255µs
# spent 35µs (15+20) within DBIx::Class::_ENV_::BEGIN@13 which was called: # once (15µs+20µs) by DBIx::Class::BEGIN@18 at line 13
use Config;
# spent 35µs making 1 call to DBIx::Class::_ENV_::BEGIN@13 # spent 20µs making 1 call to Config::import
14
15
# spent 3.10ms (66µs+3.03) within DBIx::Class::_ENV_::BEGIN@15 which was called: # once (66µs+3.03ms) 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/
25110µs 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
292122µs33.03ms PEEPEENESS => ( eval { DBICTest::RunMode->is_smoker } && ($] >= 5.013005 and $] <= 5.013006) ),
# spent 2.90ms making 2 calls to Config::FETCH, avg 1.45ms/call # spent 136µs making 1 call to constant::import
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,
421173µs13.10ms };
# spent 3.10ms making 1 call to DBIx::Class::_ENV_::BEGIN@15
43
4418µs if ($] < 5.009_005) {
45 require MRO::Compat;
46 constant->import( OLD_MRO => 1 );
47 }
48 else {
4911µs require mro;
50150µs125µs constant->import( OLD_MRO => 0 );
# spent 25µs making 1 call to constant::import
51 }
52167µs159µs}
# spent 59µ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
562203µs21.30ms
# spent 1.27ms (1.13+136µs) within DBIx::Class::_Util::BEGIN@56 which was called: # once (1.13ms+136µs) by DBIx::Class::BEGIN@18 at line 56
use DBIx::Class::Carp '^DBIx::Class|^DBICTest';
# spent 1.27ms making 1 call to DBIx::Class::_Util::BEGIN@56 # spent 39µs making 1 call to DBIx::Class::Carp::import
57
58265µs274µs
# spent 43µs (12+31) within DBIx::Class::_Util::BEGIN@58 which was called: # once (12µs+31µs) by DBIx::Class::BEGIN@18 at line 58
use Carp 'croak';
# spent 43µs making 1 call to DBIx::Class::_Util::BEGIN@58 # spent 31µs making 1 call to Exporter::import
59256µs261µs
# spent 35µs (9+26) within DBIx::Class::_Util::BEGIN@59 which was called: # once (9µs+26µs) by DBIx::Class::BEGIN@18 at line 59
use Scalar::Util qw(weaken blessed reftype);
# spent 35µs making 1 call to DBIx::Class::_Util::BEGIN@59 # spent 26µs making 1 call to Exporter::import
602136µs271µs
# spent 50µs (30+20) within DBIx::Class::_Util::BEGIN@60 which was called: # once (30µs+20µs) by DBIx::Class::BEGIN@18 at line 60
use List::Util qw(first);
# spent 50µs making 1 call to DBIx::Class::_Util::BEGIN@60 # spent 20µ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 9.62ms (1.50+8.12) within DBIx::Class::_Util::BEGIN@64 which was called: # once (1.50ms+8.12ms) by DBIx::Class::BEGIN@18 at line 75
BEGIN {
6515µs my $initial_fatal_bits = (${^WARNING_BITS}||'') & $warnings::DeadBits{all};
66
6715µs 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
701109µs require Sub::Quote;
7111µs require Sub::Defer;
72
73146µs138µs Sub::Quote->import('quote_sub');
# spent 38µs making 1 call to Exporter::import
74116µs ${^WARNING_BITS} &= ( $initial_fatal_bits | ~ $warnings::DeadBits{all} );
75192µs19.62ms}
# spent 9.62ms making 1 call to DBIx::Class::_Util::BEGIN@64
76418µs4162µs
# spent 11µs within DBIx::Class::_Util::qsub which was called 4 times, avg 3µs/call: # once (4µs+0s) by DBIx::Class::Storage::BEGIN@16 at line 57 of DBIx/Class/Storage/BlockRunner.pm # once (3µs+0s) by DBIx::Class::Storage::BEGIN@16 at line 92 of DBIx/Class/Storage/BlockRunner.pm # once (2µs+0s) by DBIx::Class::Storage::BEGIN@16 at line 78 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
sub qsub ($) { goto &quote_sub } # no point depping on new Moo just for this
# spent 162µs making 4 calls to Sub::Quote::quote_sub, avg 41µs/call
77# END pre-Moo2 import block
78
792120µs275µs
# spent 75µs (12+63) within DBIx::Class::_Util::BEGIN@79 which was called: # once (12µs+63µs) by DBIx::Class::BEGIN@18 at line 79
use base 'Exporter';
# spent 75µs making 1 call to DBIx::Class::_Util::BEGIN@79 # spent 63µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 63µs
8012µsour @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
882992µs273µs
# spent 42µs (11+31) within DBIx::Class::_Util::BEGIN@88 which was called: # once (11µs+31µs) by DBIx::Class::BEGIN@18 at line 88
use constant UNRESOLVABLE_CONDITION => \ '1 = 0';
# spent 42µs making 1 call to DBIx::Class::_Util::BEGIN@88 # spent 31µ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
100215632µs
# spent 460µs within DBIx::Class::_Util::perlstring which was called 215 times, avg 2µs/call: # 144 times (301µ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 (135µs+0s) by DBIx::Class::Relationship::Accessor::add_relationship_accessor at line 26 of DBIx/Class/Relationship/Accessor.pm, avg 3µs/call # 18 times (24µs+0s) by Class::C3::Componentised::ensure_class_loaded at line 124 of DBIx/Class/Storage/DBI.pm, avg 1µ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 20.5ms within DBIx::Class::_Util::is_exception which was called 3001 times, avg 7µs/call: # 3001 times (20.5ms+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 ($) {
13230011.24ms 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
1383001822µs return 0 unless defined $e;
139
1403001602µs my ($not_blank, $suberror);
141 {
14260022.04ms local $@;
14330012.86ms eval {
14430012.15ms $not_blank = ($e ne '') ? 1 : 0;
14530011.35ms 1;
146 } or $suberror = $@;
147 }
148
14930011.06ms 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
180300113.6ms 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{
2032600ns 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;
276293µs225µs
# spent 18µs (11+7) within DBIx::Class::_Util::BEGIN@276 which was called: # once (11µs+7µs) by DBIx::Class::BEGIN@18 at line 276
no strict 'refs';
# spent 18µs making 1 call to DBIx::Class::_Util::BEGIN@276 # spent 7µs making 1 call to strict::unimport
277 B::Deparse->new->coderef2text(\&{$fr->[3]})
278 }),
279 ), 'with_stacktrace');
280 }
281}
282
28313µs1;
Report produced by the NYTProf 6.02 Perl profiler, developed by Tim Bunce and Adam Kaplan.