← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:11:21 2013

Filename/usr/share/perl/5.10/fields.pm
StatementsExecuted 319 statements in 2.28ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
17221.69ms3.83msfields::::__ANON__[:128]fields::__ANON__[:128]
2521224µs224µsfields::::_accessible_keysfields::_accessible_keys (recurses: max depth 1, inclusive time 41µs)
222204µs222µsfields::::importfields::import
11131µs38µsfields::::BEGIN@4fields::BEGIN@4
261118µs18µsfields::::CORE:matchfields::CORE:match (opcode)
11118µs86µsfields::::BEGIN@12fields::BEGIN@12
11116µs44µsfields::::BEGIN@5fields::BEGIN@5
0000s0sfields::::__ANON__[:10]fields::__ANON__[:10]
0000s0sfields::::__ANON__[:117]fields::__ANON__[:117]
0000s0sfields::::_dumpfields::_dump
0000s0sfields::::inheritfields::inherit
0000s0sfields::::phashfields::phash
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package fields;
2
3136µsrequire 5.005;
4348µs245µs
# spent 38µs (31+7) within fields::BEGIN@4 which was called: # once (31µs+7µs) by Cache::Memcached::BEGIN@22 at line 4
use strict;
# spent 38µs making 1 call to fields::BEGIN@4 # spent 7µs making 1 call to strict::import
53103µs273µs
# spent 44µs (16+29) within fields::BEGIN@5 which was called: # once (16µs+29µs) by Cache::Memcached::BEGIN@22 at line 5
no strict 'refs';
# spent 44µs making 1 call to fields::BEGIN@5 # spent 29µs making 1 call to strict::unimport
6137µsunless( eval q{require warnings::register; warnings::register->import; 1} ) {
# spent 11µs executing statements in string eval
7 *warnings::warnif = sub {
8 require Carp;
9 Carp::carp(@_);
10 }
11}
1231.15ms2153µs
# spent 86µs (18+68) within fields::BEGIN@12 which was called: # once (18µs+68µs) by Cache::Memcached::BEGIN@22 at line 12
use vars qw(%attr $VERSION);
# spent 86µs making 1 call to fields::BEGIN@12 # spent 68µs making 1 call to vars::import
13
141600ns$VERSION = '2.14';
15
16# constant.pm is slow
17sub PUBLIC () { 2**0 }
18sub PRIVATE () { 2**1 }
19sub INHERITED () { 2**2 }
20sub PROTECTED () { 2**3 }
21
22# The %attr hash holds the attributes of the currently assigned fields
23# per class. The hash is indexed by class names and the hash value is
24# an array reference. The first element in the array is the lowest field
25# number not belonging to a base class. The remaining elements' indices
26# are the field numbers. The values are integer bit masks, or undef
27# in the case of base class private fields (which occupy a slot but are
28# otherwise irrelevant to the class).
29
30
# spent 222µs (204+18) within fields::import which was called 2 times, avg 111µs/call: # once (124µs+14µs) by Cache::Memcached::BEGIN@22 at line 22 of Cache/Memcached.pm # once (80µs+5µs) by Memoize::Memcached::BEGIN@26 at line 26 of Memoize/Memcached.pm
sub import {
31152223µs my $class = shift;
32 return unless @_;
33 my $package = caller(0);
34 # avoid possible typo warnings
35 %{"$package\::FIELDS"} = () unless %{"$package\::FIELDS"};
36 my $fields = \%{"$package\::FIELDS"};
37 my $fattr = ($attr{$package} ||= [1]);
38 my $next = @$fattr;
39
40 # Quiet pseudo-hash deprecation warning for uses of fields::new.
41 bless \%{"$package\::FIELDS"}, 'pseudohash';
42
43 if ($next > $fattr->[0]
44 and ($fields->{$_[0]} || 0) >= $fattr->[0])
45 {
46 # There are already fields not belonging to base classes.
47 # Looks like a possible module reload...
48 $next = $fattr->[0];
49 }
50 foreach my $f (@_) {
51 my $fno = $fields->{$f};
52
53 # Allow the module to be reloaded so long as field positions
54 # have not changed.
55 if ($fno and $fno != $next) {
56 require Carp;
57 if ($fno < $fattr->[0]) {
58 if ($] < 5.006001) {
59 warn("Hides field '$f' in base class") if $^W;
60 } else {
61 warnings::warnif("Hides field '$f' in base class") ;
62 }
63 } else {
64 Carp::croak("Field name '$f' already in use");
65 }
66 }
67 $fields->{$f} = $next;
682618µs $fattr->[$next] = ($f =~ /^_/) ? PRIVATE : PUBLIC;
# spent 18µs making 26 calls to fields::CORE:match, avg 704ns/call
69 $next += 1;
70 }
71 if (@$fattr > $next) {
72 # Well, we gave them the benefit of the doubt by guessing the
73 # module was reloaded, but they appear to be declaring fields
74 # in more than one place. We can't be sure (without some extra
75 # bookkeeping) that the rest of the fields will be declared or
76 # have the same positions, so punt.
77 require Carp;
78 Carp::croak ("Reloaded module must declare all fields at once");
79 }
80}
81
82sub inherit {
83 require base;
84 goto &base::inherit_fields;
85}
86
87sub _dump # sometimes useful for debugging
88{
89 for my $pkg (sort keys %attr) {
90 print "\n$pkg";
91 if (@{"$pkg\::ISA"}) {
92 print " (", join(", ", @{"$pkg\::ISA"}), ")";
93 }
94 print "\n";
95 my $fields = \%{"$pkg\::FIELDS"};
96 for my $f (sort {$fields->{$a} <=> $fields->{$b}} keys %$fields) {
97 my $no = $fields->{$f};
98 print " $no: $f";
99 my $fattr = $attr{$pkg}[$no];
100 if (defined $fattr) {
101 my @a;
102 push(@a, "public") if $fattr & PUBLIC;
103 push(@a, "private") if $fattr & PRIVATE;
104 push(@a, "inherited") if $fattr & INHERITED;
105 print "\t(", join(", ", @a), ")";
106 }
107 print "\n";
108 }
109 }
110}
111
11212µsif ($] < 5.009) {
113 *new = sub {
114 my $class = shift;
115 $class = ref $class if ref $class;
116 return bless [\%{$class . "::FIELDS"}], $class;
117 }
118} else {
119
# spent 3.83ms (1.69+2.14) within fields::__ANON__[/usr/share/perl/5.10/fields.pm:128] which was called 17 times, avg 225µs/call: # 9 times (1.57ms+1.54ms) by Cache::Memcached::new at line 67 of Cache/Memcached.pm, avg 346µs/call # 8 times (119µs+602µs) by Memoize::Memcached::_new at line 195 of Memoize/Memcached.pm, avg 90µs/call
*new = sub {
120102414µs my $class = shift;
121 $class = ref $class if ref $class;
122 require Hash::Util;
123 my $self = bless {}, $class;
124
125 # The lock_keys() prototype won't work since we require Hash::Util :(
126341.50ms &Hash::Util::lock_keys(\%$self, _accessible_keys($class));
# spent 1.28ms making 17 calls to Hash::Util::lock_keys, avg 75µs/call # spent 224µs making 17 calls to fields::_accessible_keys, avg 13µs/call
127 return $self;
128 }
12914µs}
130
131
# spent 224µs (224+0ns) within fields::_accessible_keys which was called 25 times, avg 9µs/call: # 17 times (184µs+41µs) by fields::__ANON__[/usr/share/perl/5.10/fields.pm:128] at line 126, avg 13µs/call # 8 times (41µs+-41µs) by fields::_accessible_keys at line 135, avg 0s/call
sub _accessible_keys {
13250251µs my ($class) = @_;
133 return (
134 keys %{$class.'::FIELDS'},
13580s map(_accessible_keys($_), @{$class.'::ISA'}),
# spent 41µs making 8 calls to fields::_accessible_keys, avg 5µs/call, recursion: max depth 1, sum of overlapping time 41µs
136 );
137}
138
139sub phash {
140 die "Pseudo-hashes have been removed from Perl" if $] >= 5.009;
141 my $h;
142 my $v;
143 if (@_) {
144 if (ref $_[0] eq 'ARRAY') {
145 my $a = shift;
146 @$h{@$a} = 1 .. @$a;
147 if (@_) {
148 $v = shift;
149 unless (! @_ and ref $v eq 'ARRAY') {
150 require Carp;
151 Carp::croak ("Expected at most two array refs\n");
152 }
153 }
154 }
155 else {
156 if (@_ % 2) {
157 require Carp;
158 Carp::croak ("Odd number of elements initializing pseudo-hash\n");
159 }
160 my $i = 0;
161 @$h{grep ++$i % 2, @_} = 1 .. @_ / 2;
162 $i = 0;
163 $v = [grep $i++ % 2, @_];
164 }
165 }
166 else {
167 $h = {};
168 $v = [];
169 }
170 [ $h, @$v ];
171
172}
173
17419µs1;
175
176__END__
 
# spent 18µs within fields::CORE:match which was called 26 times, avg 704ns/call: # 26 times (18µs+0s) by fields::import at line 68, avg 704ns/call
sub fields::CORE:match; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.