← 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:41 2013

Filename/usr/share/perl5/Memoize/Memcached.pm
StatementsExecuted 899 statements in 5.01ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1112.12ms2.40msMemoize::Memcached::::BEGIN@8Memoize::Memcached::BEGIN@8
54221.18ms1.60sMemoize::Memcached::::FETCHMemoize::Memcached::FETCH
411670µs3.20msMemoize::Memcached::::_memcached_setupMemoize::Memcached::_memcached_setup
5411397µs397µsMemoize::Memcached::::_get_keyMemoize::Memcached::_get_key
2711350µs815msMemoize::Memcached::::EXISTSMemoize::Memcached::EXISTS
811215µs1.66msMemoize::Memcached::::_initMemoize::Memcached::_init
111150µs200µsMemoize::Memcached::::BEGIN@6Memoize::Memcached::BEGIN@6
442136µs3.35msMemoize::Memcached::::memoize_memcachedMemoize::Memcached::memoize_memcached
222109µs520µsMemoize::Memcached::::importMemoize::Memcached::import
81184µs2.47msMemoize::Memcached::::_newMemoize::Memcached::_new
82162µs2.53msMemoize::Memcached::::TIEHASHMemoize::Memcached::TIEHASH
11119µs23µsMemoize::Memcached::::BEGIN@3Memoize::Memcached::BEGIN@3
11117µs81µsMemoize::Memcached::::BEGIN@17Memoize::Memcached::BEGIN@17
11115µs17µsMemoize::Memcached::::BEGIN@9Memoize::Memcached::BEGIN@9
11115µs47µsMemoize::Memcached::::BEGIN@13Memoize::Memcached::BEGIN@13
11113µs32µsMemoize::Memcached::::BEGIN@4Memoize::Memcached::BEGIN@4
11113µs98µsMemoize::Memcached::::BEGIN@26Memoize::Memcached::BEGIN@26
11113µs48µsMemoize::Memcached::::BEGIN@7Memoize::Memcached::BEGIN@7
0000s0sMemoize::Memcached::::CLEARMemoize::Memcached::CLEAR
0000s0sMemoize::Memcached::::DELETEMemoize::Memcached::DELETE
0000s0sMemoize::Memcached::::FIRSTKEYMemoize::Memcached::FIRSTKEY
0000s0sMemoize::Memcached::::NEXTKEYMemoize::Memcached::NEXTKEY
0000s0sMemoize::Memcached::::SCALARMemoize::Memcached::SCALAR
0000s0sMemoize::Memcached::::STOREMemoize::Memcached::STORE
0000s0sMemoize::Memcached::::UNTIEMemoize::Memcached::UNTIE
0000s0sMemoize::Memcached::::_key_lookup_errorMemoize::Memcached::_key_lookup_error
0000s0sMemoize::Memcached::::flush_cacheMemoize::Memcached::flush_cache
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Memoize::Memcached;
2
3328µs227µs
# spent 23µs (19+4) within Memoize::Memcached::BEGIN@3 which was called: # once (19µs+4µs) by C4::Templates::BEGIN@35 at line 3
use strict;
# spent 23µs making 1 call to Memoize::Memcached::BEGIN@3 # spent 4µs making 1 call to strict::import
4333µs251µs
# spent 32µs (13+19) within Memoize::Memcached::BEGIN@4 which was called: # once (13µs+19µs) by C4::Templates::BEGIN@35 at line 4
use warnings;
# spent 32µs making 1 call to Memoize::Memcached::BEGIN@4 # spent 19µs making 1 call to warnings::import
5
63162µs2203µs
# spent 200µs (150+50) within Memoize::Memcached::BEGIN@6 which was called: # once (150µs+50µs) by C4::Templates::BEGIN@35 at line 6
use UNIVERSAL qw( isa );
# spent 200µs making 1 call to Memoize::Memcached::BEGIN@6 # spent 4µs making 1 call to UNIVERSAL::import
7332µs282µs
# spent 48µs (13+35) within Memoize::Memcached::BEGIN@7 which was called: # once (13µs+35µs) by C4::Templates::BEGIN@35 at line 7
use Carp qw( carp croak );
# spent 48µs making 1 call to Memoize::Memcached::BEGIN@7 # spent 35µs making 1 call to Exporter::import
83152µs22.44ms
# spent 2.40ms (2.12+276µs) within Memoize::Memcached::BEGIN@8 which was called: # once (2.12ms+276µs) by C4::Templates::BEGIN@35 at line 8
use Memoize qw( unmemoize );
# spent 2.40ms making 1 call to Memoize::Memcached::BEGIN@8 # spent 47µs making 1 call to Exporter::import
9342µs219µs
# spent 17µs (15+2) within Memoize::Memcached::BEGIN@9 which was called: # once (15µs+2µs) by C4::Templates::BEGIN@35 at line 9
use Cache::Memcached;
# spent 17µs making 1 call to Memoize::Memcached::BEGIN@9 # spent 2µs making 1 call to UNIVERSAL::import
10
111700nsour $VERSION = '0.03';
12
13343µs279µs
# spent 47µs (15+32) within Memoize::Memcached::BEGIN@13 which was called: # once (15µs+32µs) by C4::Templates::BEGIN@35 at line 13
use Data::Dumper;
# spent 47µs making 1 call to Memoize::Memcached::BEGIN@13 # spent 32µs making 1 call to Exporter::import
141300ns$Data::Dumper::Sortkeys = 1;
15
16
17378µs2146µs
# spent 81µs (17+65) within Memoize::Memcached::BEGIN@17 which was called: # once (17µs+65µs) by C4::Templates::BEGIN@35 at line 17
use base 'Exporter';
# spent 81µs making 1 call to Memoize::Memcached::BEGIN@17 # spent 64µs making 1 call to base::import
18
1911µsour @EXPORT = qw( memoize_memcached );
201700nsour @EXPORT_OK = qw( unmemoize flush_cache );
2113µsour %EXPORT_TAGS = (
22 all => [ @EXPORT, @EXPORT_OK ],
23);
24
25
26185µs
# spent 98µs (13+85) within Memoize::Memcached::BEGIN@26 which was called: # once (13µs+85µs) by C4::Templates::BEGIN@35 at line 32
use fields qw(
# spent 85µs making 1 call to fields::import
27 key_prefix
28 expire_time
29 memcached_obj
30 key_error
31 scalar_error
3231.24ms198µs);
# spent 98µs making 1 call to Memoize::Memcached::BEGIN@26
33
- -
361300nsmy %memo_data;
371100nsmy %memcached_config;
38
39
40
# spent 3.35ms (136µs+3.21) within Memoize::Memcached::memoize_memcached which was called 4 times, avg 837µs/call: # once (61µs+1.26ms) by C4::Reserves::BEGIN@27 at line 148 of /usr/share/koha/lib/C4/Biblio.pm # once (34µs+810µs) by C4::Templates::BEGIN@35 at line 33 of /usr/share/koha/lib/C4/Languages.pm # once (22µs+625µs) by C4::Templates::BEGIN@35 at line 34 of /usr/share/koha/lib/C4/Languages.pm # once (20µs+513µs) by C4::Templates::BEGIN@35 at line 35 of /usr/share/koha/lib/C4/Languages.pm
sub memoize_memcached {
41 # Be sure to leave @_ intact in case we need to redirect to
42 # 'Memoize::memoize'.
4340172µs my ($function, %args) = @_;
44
45 if (exists $args{LIST_CACHE} or exists $args{ARRAY_CACHE}) {
46 carp "Call to 'memoize_memcached' with a cache option passed to 'memoize'";
47 goto &Memoize::memoize;
48 }
49
50 my $memcached_args = delete $args{memcached} || {};
5149µs croak "Invalid memcached argument (expected a hash)"
# spent 9µs making 4 calls to UNIVERSAL::isa, avg 2µs/call
52 unless isa($memcached_args, 'HASH');
53
54 _memcached_setup(
5543.20ms %{$memcached_args},
# spent 3.20ms making 4 calls to Memoize::Memcached::_memcached_setup, avg 800µs/call
56 memoized_function => $function,
57 );
58 $args{LIST_CACHE} = [ HASH => $memo_data{$function}{list_cache} ];
59 $args{SCALAR_CACHE} = [ HASH => $memo_data{$function}{scalar_cache} ];
60
61 # If we are passed a normalizer, we need to keep a version of it
62 # around for flush_cache to use. This breaks encapsulation. And it
63 # is just plain ugly.
64 $memo_data{$function}{normalizer} = Memoize::_make_cref($args{NORMALIZER}, scalar caller)
65 if defined $args{NORMALIZER};
66
67 # Rebuild @_ since there is a good probability we have removed some
68 # arguments meant for us and added the cache arguments.
69 @_ = ($function, %args);
704924µs goto &Memoize::memoize;
# spent 924µs making 4 calls to Memoize::memoize, avg 231µs/call
71}
72
73
74# Unfortunately, we need to do some magic to make flush_cache sorta
75# work. I don't think this is enough magic yet.
76
77sub flush_cache {
78 # If we have exactly 1 argument then we are probably expected to
79 # clear the cache for a single function. Pass this along to
80 # Memoize, even though it cannot be handled correctly at this time
81 # (whatever we do will be wrong, anyway).
82
83 goto &Memoize::flush_cache if @_ == 1;
84
85
86 # If we have more than 1 argument, we are probably expected to clear
87 # a single call signature for a function. This we can almost do
88 # properly.
89
90 # Even though we can do this "properly", it is still very bad. This
91 # breaks encapsulation pretty disgustingly. With any luck Memoize
92 # will eventually be patched to do this for us...
93
94 if (@_ > 1) {
95 my ($function, @args) = @_;
96 my $cur_memo = $memo_data{$function};
97 my $normalizer = $memo_data{$function}{normalizer};
98 my $array_argstr;
99 my $scalar_argstr;
100 if (defined $normalizer) {
101 ($array_argstr) = $normalizer->(@_);
102 $scalar_argstr = $normalizer->(@_);
103 }
104 else { # Default normalizer
105 local $^W = 0;
106 $array_argstr = $scalar_argstr = join chr(28), @args;
107 }
108 for my $cache (qw( list_cache scalar_cache )) {
109 for my $argstr ($scalar_argstr, $array_argstr) {
110 delete $cur_memo->{$cache}{$argstr};
111 }
112 }
113 return 1;
114 }
115
116
117 # Currently all memoized functions share memcached config, so just
118 # find the first valid object and flush cache.
119
120 for my $function (keys %memo_data) {
121 next unless $memo_data{$function}{list_obj};
122 $memo_data{$function}{list_obj}{memcached_obj}->flush_all;
123 last;
124 }
125
126 return 1;
127}
128
129
130
# spent 520µs (109+412) within Memoize::Memcached::import which was called 2 times, avg 260µs/call: # once (86µs+273µs) by C4::Reserves::BEGIN@27 at line 146 of /usr/share/koha/lib/C4/Biblio.pm # once (23µs+139µs) by C4::Templates::BEGIN@35 at line 31 of /usr/share/koha/lib/C4/Languages.pm
sub import {
131650µs my ($class) = @_;
132
133 # Search through the arg list for the 'memcached' arg, process it,
134 # and remove it (and its associated value) from the arg list in
135 # anticipation of passing off to Exporter.
136 for my $idx ($[ + 1 .. $#_) {
137450µs my $arg = $_[$idx] || q();
138 next unless $arg eq 'memcached';
139 (undef, my $memcached_config) = splice @_, $idx, 2;
140 croak "Invalid memcached config (expected a hash ref)"
141 unless isa($memcached_config, 'HASH');
142 %memcached_config = %{$memcached_config};
143 }
144
145299µs return $class->export_to_level(1, @_);
# spent 99µs making 2 calls to Exporter::export_to_level, avg 49µs/call
146}
147
148
149
# spent 3.20ms (670µs+2.53) within Memoize::Memcached::_memcached_setup which was called 4 times, avg 800µs/call: # 4 times (670µs+2.53ms) by Memoize::Memcached::memoize_memcached at line 55, avg 800µs/call
sub _memcached_setup {
15060382µs my %args = %memcached_config;
151 while (@_) {
152240255µs my $key = shift;
153 my $value = shift;
154 $args{$key} = $value;
155 }
156
157 my $function = delete $args{memoized_function};
158 my $list_key_prefix = delete $args{list_key_prefix};
159 my $scalar_key_prefix = delete $args{scalar_key_prefix};
160
161 $args{key_prefix} = 'memoize-' unless defined $args{key_prefix};
162
163 croak "Missing function name for memcached setup"
164 unless defined $function;
165 my $tie_data = $memo_data{$function} = {
166 list_obj => undef,
167 list_cache => {},
168 scalar_obj => undef,
169 scalar_cache => {},
170 };
171
172 my %cur_args = %args;
173 $cur_args{key_prefix}
174 .= (defined $function ? "$function-" : '-')
175 . (defined $list_key_prefix ? $list_key_prefix : 'list-')
176 ;
177117µs41.37ms $tie_data->{list_obj} = tie %{$tie_data->{list_cache}}, __PACKAGE__, %cur_args
# spent 1.37ms making 4 calls to Memoize::Memcached::TIEHASH, avg 342µs/call
178 or die "Error creating list cache";
179
180 %cur_args = %args;
181 $cur_args{key_prefix}
182 .= (defined $function ? "$function-" : '-')
183 . (defined $scalar_key_prefix ? $scalar_key_prefix : 'scalar-')
184 ;
185113µs41.16ms $tie_data->{scalar_obj} = tie %{$tie_data->{scalar_cache}}, __PACKAGE__, %cur_args
# spent 1.16ms making 4 calls to Memoize::Memcached::TIEHASH, avg 290µs/call
186 or die "Error creating scalar cache";
187
188 return 1;
189}
190
191
192
# spent 2.47ms (84µs+2.38) within Memoize::Memcached::_new which was called 8 times, avg 309µs/call: # 8 times (84µs+2.38ms) by Memoize::Memcached::TIEHASH at line 238, avg 309µs/call
sub _new {
1934079µs my $class = shift;
194 croak "Called new in object context" if ref $class;
1958720µs my $self = fields::new($class);
# spent 720µs making 8 calls to fields::__ANON__[fields.pm:128], avg 90µs/call
19681.66ms $self->_init(@_);
# spent 1.66ms making 8 calls to Memoize::Memcached::_init, avg 208µs/call
197 return $self;
198}
199
200
201
# spent 1.66ms (215µs+1.45) within Memoize::Memcached::_init which was called 8 times, avg 208µs/call: # 8 times (215µs+1.45ms) by Memoize::Memcached::_new at line 196, avg 208µs/call
sub _init {
20280208µs my $self = shift;
203 my %args = @_;
204 %{$self} = ();
205
206 $self->{key_prefix} = delete $args{key_prefix};
207 $self->{key_prefix} = q() unless defined $self->{key_prefix};
208 $self->{expire_time} = exists $args{expire_time} ? delete $args{expire_time} : undef;
209
210 # Default these to false so that we can use Data::Dumper on tied
211 # hashes by default. Yes, it will show them as empty, but I doubt
212 # someone running Dumper on this tied hash would really want to dump
213 # the contents of the memcached cache (and they can't anyway).
214
215 $self->{$_} = exists $args{$_} ? delete $args{$_} : !1
216 for qw( key_error scalar_error );
217
21881.45ms $self->{memcached_obj} = Cache::Memcached->new(\%args);
# spent 1.45ms making 8 calls to Cache::Memcached::new, avg 181µs/call
219
220 return $self;
221}
222
223
224
# spent 397µs within Memoize::Memcached::_get_key which was called 54 times, avg 7µs/call: # 54 times (397µs+0s) by Memoize::Memcached::FETCH at line 255, avg 7µs/call
sub _get_key {
225162529µs my $self = shift;
226 my $key = shift;
227 return $self->{key_prefix} . $key;
228}
229
230
231sub _key_lookup_error {
232 croak "Key lookup functionality is not implemented by memcached";
233}
234
235
236
# spent 2.53ms (62µs+2.47) within Memoize::Memcached::TIEHASH which was called 8 times, avg 316µs/call: # 4 times (35µs+1.33ms) by Memoize::Memcached::_memcached_setup at line 177, avg 342µs/call # 4 times (27µs+1.13ms) by Memoize::Memcached::_memcached_setup at line 185, avg 290µs/call
sub TIEHASH {
2371658µs my $class = shift;
23882.47ms return $class->_new(@_);
# spent 2.47ms making 8 calls to Memoize::Memcached::_new, avg 309µs/call
239}
240
241
242sub STORE {
243 my $self = shift;
244 my $key = $self->_get_key(shift);
245 my $value = shift;
246 my @args = ($key, $value);
247 push @args, $self->{expire_time} if defined $self->{expire_time};
248 $self->{memcached_obj}->set(@args);
249 return $self;
250}
251
252
253
# spent 1.60s (1.18ms+1.60) within Memoize::Memcached::FETCH which was called 54 times, avg 29.7ms/call: # 27 times (672µs+814ms) by Memoize::Memcached::EXISTS at line 262, avg 30.2ms/call # 27 times (505µs+790ms) by Memoize::_memoizer at line 244 of Memoize.pm, avg 29.3ms/call
sub FETCH {
2541621.10ms my $self = shift;
25554397µs my $key = $self->_get_key(shift);
# spent 397µs making 54 calls to Memoize::Memcached::_get_key, avg 7µs/call
256541.60s return $self->{memcached_obj}->get($key);
# spent 1.60s making 54 calls to Cache::Memcached::get, avg 29.7ms/call
257}
258
259
260
# spent 815ms (350µs+814) within Memoize::Memcached::EXISTS which was called 27 times, avg 30.2ms/call: # 27 times (350µs+814ms) by Memoize::_memoizer at line 244 of Memoize.pm, avg 30.2ms/call
sub EXISTS {
26154265µs my $self = shift;
26227814ms return defined $self->FETCH(@_);
# spent 814ms making 27 calls to Memoize::Memcached::FETCH, avg 30.2ms/call
263}
264
265
266sub DELETE {
267 my $self = shift;
268 my $key = $self->_get_key(shift);
269 $self->{memcached_obj}->delete($key);
270 return $self;
271}
272
273
274sub CLEAR {
275 my $self = shift;
276 # This is not safe because all object share memcached setup.
277 $self->{memcached_obj}->flush_all;
278 return $self;
279}
280
281
282sub FIRSTKEY {
283 my $self = shift;
284 return unless $self->{key_error};
285 $self->_key_lookup_error;
286}
287
288
289sub NEXTKEY {
290 my $self = shift;
291 return unless $self->{key_error};
292 $self->_key_lookup_error;
293}
294
295
296sub SCALAR {
297 my $self = shift;
298 return unless $self->{scalar_error};
299 # I think this error still makes sense, since to determine if the
300 # cache has content one would need to first determine if the cache
301 # contains keys.
302 $self->_key_lookup_error;
303}
304
305
306sub UNTIE {
307 my $self = shift;
308 $self->{memcached_obj}->disconnect_all;
309 return $self;
310}
311
- -
31416µs1;
315
316__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.