← 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:31:36 2016

Filename/usr/share/perl5/DBIx/Class/_Util.pm
StatementsExecuted 1148 statements in 4.14ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1111.57ms10.0msDBIx::Class::_Util::::BEGIN@64DBIx::Class::_Util::BEGIN@64
111832µs936µsDBIx::Class::_Util::::BEGIN@56DBIx::Class::_Util::BEGIN@56
8911570µs570µsDBIx::Class::_Util::::is_exceptionDBIx::Class::_Util::is_exception
21532471µs471µsDBIx::Class::_Util::::perlstringDBIx::Class::_Util::perlstring
11174µs2.73msDBIx::Class::_ENV_::::BEGIN@15DBIx::Class::_ENV_::BEGIN@15
11144µs65µsDBIx::Class::_Util::::BEGIN@60DBIx::Class::_Util::BEGIN@60
11116µs54µsDBIx::Class::_Util::::BEGIN@59DBIx::Class::_Util::BEGIN@59
11114µs33µsDBIx::Class::_ENV_::::BEGIN@13DBIx::Class::_ENV_::BEGIN@13
11114µs23µsDBIx::Class::_Util::::BEGIN@276DBIx::Class::_Util::BEGIN@276
11114µs83µsDBIx::Class::_Util::::BEGIN@79DBIx::Class::_Util::BEGIN@79
11114µs18µsDBIx::Class::_Util::::BEGIN@4DBIx::Class::_Util::BEGIN@4
11113µs31µsDBIx::Class::_Util::::BEGIN@9DBIx::Class::_Util::BEGIN@9
11112µs45µsDBIx::Class::_Util::::BEGIN@7DBIx::Class::_Util::BEGIN@7
11111µs45µsDBIx::Class::_Util::::BEGIN@88DBIx::Class::_Util::BEGIN@88
11110µs42µsDBIx::Class::_Util::::BEGIN@58DBIx::Class::_Util::BEGIN@58
4419µs9µsDBIx::Class::_Util::::qsubDBIx::Class::_Util::qsub
1118µ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µs222µs
# spent 18µs (14+4) within DBIx::Class::_Util::BEGIN@4 which was called: # once (14µs+4µs) by DBIx::Class::BEGIN@18 at line 4
use warnings;
# spent 18µs making 1 call to DBIx::Class::_Util::BEGIN@4 # spent 4µs making 1 call to warnings::import
5254µs220µs
# spent 14µs (8+6) within DBIx::Class::_Util::BEGIN@5 which was called: # once (8µ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µs279µs
# spent 45µs (12+34) within DBIx::Class::_Util::BEGIN@7 which was called: # once (12µs+34µs) by DBIx::Class::BEGIN@18 at line 7
use constant SPURIOUS_VERSION_CHECK_WARNINGS => ($] < 5.010 ? 1 : 0);
# spent 45µs making 1 call to DBIx::Class::_Util::BEGIN@7 # spent 34µs making 1 call to constant::import
8
9
# spent 31µs (13+18) within DBIx::Class::_Util::BEGIN@9 which was called: # once (13µs+18µs) by DBIx::Class::BEGIN@18 at line 52
BEGIN {
10 package # hide from pause
11 DBIx::Class::_ENV_;
12
132180µs252µs
# spent 33µs (14+19) within DBIx::Class::_ENV_::BEGIN@13 which was called: # once (14µs+19µs) by DBIx::Class::BEGIN@18 at line 13
use Config;
# spent 33µs making 1 call to DBIx::Class::_ENV_::BEGIN@13 # spent 19µs making 1 call to Config::import
14
15
# spent 2.73ms (74µs+2.65) within DBIx::Class::_ENV_::BEGIN@15 which was called: # once (74µs+2.65ms) 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/
25113µ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
292209µs32.65ms PEEPEENESS => ( eval { DBICTest::RunMode->is_smoker } && ($] >= 5.013005 and $] <= 5.013006) ),
# spent 2.57ms making 2 calls to Config::FETCH, avg 1.28ms/call # spent 82µ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,
421124µs12.73ms };
# spent 2.73ms making 1 call to DBIx::Class::_ENV_::BEGIN@15
43
4414µs if ($] < 5.009_005) {
45 require MRO::Compat;
46 constant->import( OLD_MRO => 1 );
47 }
48 else {
4911µs require mro;
50124µs118µs constant->import( OLD_MRO => 0 );
# spent 18µs making 1 call to constant::import
51 }
52139µs131µs}
# spent 31µ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
562140µs2973µs
# spent 936µs (832+104) within DBIx::Class::_Util::BEGIN@56 which was called: # once (832µs+104µs) by DBIx::Class::BEGIN@18 at line 56
use DBIx::Class::Carp '^DBIx::Class|^DBICTest';
# spent 936µs making 1 call to DBIx::Class::_Util::BEGIN@56 # spent 37µs making 1 call to DBIx::Class::Carp::import
57
58292µs273µs
# spent 42µs (10+31) within DBIx::Class::_Util::BEGIN@58 which was called: # once (10µs+31µs) by DBIx::Class::BEGIN@18 at line 58
use Carp 'croak';
# spent 42µs making 1 call to DBIx::Class::_Util::BEGIN@58 # spent 31µs making 1 call to Exporter::import
59284µs292µs
# spent 54µs (16+38) within DBIx::Class::_Util::BEGIN@59 which was called: # once (16µs+38µs) by DBIx::Class::BEGIN@18 at line 59
use Scalar::Util qw(weaken blessed reftype);
# spent 54µs making 1 call to DBIx::Class::_Util::BEGIN@59 # spent 38µs making 1 call to Exporter::import
602205µs286µs
# spent 65µs (44+21) within DBIx::Class::_Util::BEGIN@60 which was called: # once (44µs+21µs) by DBIx::Class::BEGIN@18 at line 60
use List::Util qw(first);
# spent 65µ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 10.0ms (1.57+8.45) within DBIx::Class::_Util::BEGIN@64 which was called: # once (1.57ms+8.45ms) by DBIx::Class::BEGIN@18 at line 75
BEGIN {
6514µ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
701111µs require Sub::Quote;
7111µs require Sub::Defer;
72
73188µs178µs Sub::Quote->import('quote_sub');
# spent 78µs making 1 call to Exporter::import
74116µs ${^WARNING_BITS} &= ( $initial_fatal_bits | ~ $warnings::DeadBits{all} );
75186µs110.0ms}
# spent 10.0ms making 1 call to DBIx::Class::_Util::BEGIN@64
76419µs4159µs
# spent 9µs within DBIx::Class::_Util::qsub which was called 4 times, avg 2µ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 78 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 # once (1µ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 159µs making 4 calls to Sub::Quote::quote_sub, avg 40µs/call
77# END pre-Moo2 import block
78
792133µs283µs
# spent 83µs (14+68) within DBIx::Class::_Util::BEGIN@79 which was called: # once (14µs+68µs) by DBIx::Class::BEGIN@18 at line 79
use base 'Exporter';
# spent 83µ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
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
8821.08ms279µ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
100215610µs
# spent 471µs within DBIx::Class::_Util::perlstring which was called 215 times, avg 2µs/call: # 144 times (307µ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 (140µ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 570µs within DBIx::Class::_Util::is_exception which was called 89 times, avg 6µs/call: # 89 times (570µs+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 6µs/call
sub is_exception ($) {
1328938µ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
1388930µs return 0 unless defined $e;
139
1408929µs my ($not_blank, $suberror);
141 {
14217849µs local $@;
1438970µs eval {
1448960µs $not_blank = ($e ne '') ? 1 : 0;
1458933µs 1;
146 } or $suberror = $@;
147 }
148
1498931µ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
18089235µ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{
2032900ns 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;
2762106µs232µs
# spent 23µs (14+9) within DBIx::Class::_Util::BEGIN@276 which was called: # once (14µs+9µs) by DBIx::Class::BEGIN@18 at line 276
no strict 'refs';
# spent 23µs making 1 call to DBIx::Class::_Util::BEGIN@276 # spent 9µs making 1 call to strict::unimport
277 B::Deparse->new->coderef2text(\&{$fr->[3]})
278 }),
279 ), 'with_stacktrace');
280 }
281}
282
28314µs1;
Report produced by the NYTProf 6.02 Perl profiler, developed by Tim Bunce and Adam Kaplan.