← 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:01:18 2016
Reported on Fri Jan 8 13:01:34 2016

Filename/usr/share/perl5/DBIx/Class/_Util.pm
StatementsExecuted 298 statements in 4.67ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1112.91ms17.5msDBIx::Class::_Util::::BEGIN@64DBIx::Class::_Util::BEGIN@64
111950µs1.07msDBIx::Class::_Util::::BEGIN@56DBIx::Class::_Util::BEGIN@56
21532422µs422µsDBIx::Class::_Util::::perlstringDBIx::Class::_Util::perlstring
11159µs2.76msDBIx::Class::_ENV_::::BEGIN@15DBIx::Class::_ENV_::BEGIN@15
11146µs75µsDBIx::Class::_Util::::BEGIN@60DBIx::Class::_Util::BEGIN@60
11129µs50µsDBIx::Class::_Util::::BEGIN@276DBIx::Class::_Util::BEGIN@276
41125µs25µsDBIx::Class::_Util::::is_exceptionDBIx::Class::_Util::is_exception
11122µs138µsDBIx::Class::_Util::::BEGIN@79DBIx::Class::_Util::BEGIN@79
11118µs73µsDBIx::Class::_Util::::BEGIN@88DBIx::Class::_Util::BEGIN@88
11118µs38µsDBIx::Class::_Util::::BEGIN@9DBIx::Class::_Util::BEGIN@9
11116µs55µsDBIx::Class::_Util::::BEGIN@7DBIx::Class::_Util::BEGIN@7
11114µs50µsDBIx::Class::_Util::::BEGIN@58DBIx::Class::_Util::BEGIN@58
11113µs33µsDBIx::Class::_ENV_::::BEGIN@13DBIx::Class::_ENV_::BEGIN@13
11113µs18µsDBIx::Class::_Util::::BEGIN@4DBIx::Class::_Util::BEGIN@4
11111µs38µsDBIx::Class::_Util::::BEGIN@59DBIx::Class::_Util::BEGIN@59
44110µs10µsDBIx::Class::_Util::::qsubDBIx::Class::_Util::qsub
1117µs13µ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
4235µs222µs
# spent 18µs (13+4) within DBIx::Class::_Util::BEGIN@4 which was called: # once (13µ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
5268µs219µs
# spent 13µ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 13µs making 1 call to DBIx::Class::_Util::BEGIN@5 # spent 6µs making 1 call to strict::import
6
72103µs294µs
# spent 55µs (16+39) within DBIx::Class::_Util::BEGIN@7 which was called: # once (16µs+39µs) by DBIx::Class::BEGIN@18 at line 7
use constant SPURIOUS_VERSION_CHECK_WARNINGS => ($] < 5.010 ? 1 : 0);
# spent 55µs making 1 call to DBIx::Class::_Util::BEGIN@7 # spent 39µs making 1 call to constant::import
8
9
# spent 38µs (18+21) within DBIx::Class::_Util::BEGIN@9 which was called: # once (18µs+21µs) by DBIx::Class::BEGIN@18 at line 52
BEGIN {
10 package # hide from pause
11 DBIx::Class::_ENV_;
12
132172µs253µs
# spent 33µs (13+20) within DBIx::Class::_ENV_::BEGIN@13 which was called: # once (13µs+20µs) by DBIx::Class::BEGIN@18 at line 13
use Config;
# spent 33µs making 1 call to DBIx::Class::_ENV_::BEGIN@13 # spent 20µs making 1 call to Config::import
14
15
# spent 2.76ms (59µs+2.71) within DBIx::Class::_ENV_::BEGIN@15 which was called: # once (59µs+2.71ms) 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
292126µs32.71ms PEEPEENESS => ( eval { DBICTest::RunMode->is_smoker } && ($] >= 5.013005 and $] <= 5.013006) ),
# spent 2.62ms making 2 calls to Config::FETCH, avg 1.31ms/call # spent 84µ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µs12.76ms };
# spent 2.76ms making 1 call to DBIx::Class::_ENV_::BEGIN@15
43
4415µs if ($] < 5.009_005) {
45 require MRO::Compat;
46 constant->import( OLD_MRO => 1 );
47 }
48 else {
4911µs require mro;
50130µs121µs constant->import( OLD_MRO => 0 );
# spent 21µs making 1 call to constant::import
51 }
52141µs138µ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
562176µs21.11ms
# spent 1.07ms (950µs+119µs) within DBIx::Class::_Util::BEGIN@56 which was called: # once (950µs+119µs) by DBIx::Class::BEGIN@18 at line 56
use DBIx::Class::Carp '^DBIx::Class|^DBICTest';
# spent 1.07ms making 1 call to DBIx::Class::_Util::BEGIN@56 # spent 44µs making 1 call to DBIx::Class::Carp::import
57
58274µs285µs
# spent 50µs (14+35) within DBIx::Class::_Util::BEGIN@58 which was called: # once (14µs+35µs) by DBIx::Class::BEGIN@18 at line 58
use Carp 'croak';
# spent 50µs making 1 call to DBIx::Class::_Util::BEGIN@58 # spent 35µs making 1 call to Exporter::import
59259µs266µs
# spent 38µ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 38µs making 1 call to DBIx::Class::_Util::BEGIN@59 # spent 28µs making 1 call to Exporter::import
602232µs2103µs
# spent 75µs (46+29) within DBIx::Class::_Util::BEGIN@60 which was called: # once (46µs+29µs) by DBIx::Class::BEGIN@18 at line 60
use List::Util qw(first);
# spent 75µs making 1 call to DBIx::Class::_Util::BEGIN@60 # spent 29µ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 17.5ms (2.91+14.6) within DBIx::Class::_Util::BEGIN@64 which was called: # once (2.91ms+14.6ms) by DBIx::Class::BEGIN@18 at line 75
BEGIN {
6519µs my $initial_fatal_bits = (${^WARNING_BITS}||'') & $warnings::DeadBits{all};
66
6719µ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
701200µs require Sub::Quote;
7112µs require Sub::Defer;
72
73195µs174µs Sub::Quote->import('quote_sub');
# spent 74µs making 1 call to Exporter::import
74129µs ${^WARNING_BITS} &= ( $initial_fatal_bits | ~ $warnings::DeadBits{all} );
751148µs117.5ms}
# spent 17.5ms making 1 call to DBIx::Class::_Util::BEGIN@64
76417µs4157µs
# spent 10µs within DBIx::Class::_Util::qsub which was called 4 times, avg 2µs/call: # once (3µ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 157µs making 4 calls to Sub::Quote::quote_sub, avg 39µs/call
77# END pre-Moo2 import block
78
792229µs2138µs
# spent 138µs (22+115) within DBIx::Class::_Util::BEGIN@79 which was called: # once (22µs+115µs) by DBIx::Class::BEGIN@18 at line 79
use base 'Exporter';
# spent 138µs making 1 call to DBIx::Class::_Util::BEGIN@79 # spent 115µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 115µs
8016µ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.79ms2128µs
# spent 73µs (18+55) within DBIx::Class::_Util::BEGIN@88 which was called: # once (18µs+55µs) by DBIx::Class::BEGIN@18 at line 88
use constant UNRESOLVABLE_CONDITION => \ '1 = 0';
# spent 73µs making 1 call to DBIx::Class::_Util::BEGIN@88 # spent 55µ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 422µs within DBIx::Class::_Util::perlstring which was called 215 times, avg 2µs/call: # 144 times (281µ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 (118µ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 (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 25µs within DBIx::Class::_Util::is_exception which was called 4 times, avg 6µs/call: # 4 times (25µ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 ($) {
13242µ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
1384800ns return 0 unless defined $e;
139
14041µs my ($not_blank, $suberror);
141 {
14283µs local $@;
14343µs eval {
14442µs $not_blank = ($e ne '') ? 1 : 0;
14541µs 1;
146 } or $suberror = $@;
147 }
148
14941µ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
180413µ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{
20321µs 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;
2762187µs271µs
# spent 50µs (29+21) within DBIx::Class::_Util::BEGIN@276 which was called: # once (29µs+21µs) by DBIx::Class::BEGIN@18 at line 276
no strict 'refs';
# spent 50µs making 1 call to DBIx::Class::_Util::BEGIN@276 # spent 21µs making 1 call to strict::unimport
277 B::Deparse->new->coderef2text(\&{$fr->[3]})
278 }),
279 ), 'with_stacktrace');
280 }
281}
282
28316µs1;
Report produced by the NYTProf 6.02 Perl profiler, developed by Tim Bunce and Adam Kaplan.