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

Filename/usr/share/perl5/Cache/Memcached.pm
StatementsExecuted 6738 statements in 44.0ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
571113.2ms1.60sCache::Memcached::::_load_multiCache::Memcached::_load_multi
58215.40ms5.40msCache::Memcached::::CORE:sendCache::Memcached::CORE:send (opcode)
1114.37ms10.6msCache::Memcached::::BEGIN@21Cache::Memcached::BEGIN@21
127313.83ms3.83msCache::Memcached::::CORE:sselectCache::Memcached::CORE:sselect (opcode)
57213.32ms1.56sCache::Memcached::::__ANON__[:714]Cache::Memcached::__ANON__[:714]
57112.98ms1.60sCache::Memcached::::get_multiCache::Memcached::get_multi
1112.39ms28.8msCache::Memcached::::BEGIN@14Cache::Memcached::BEGIN@14
1112.11ms2.55msCache::Memcached::::BEGIN@19Cache::Memcached::BEGIN@19
57221.52ms1.61sCache::Memcached::::getCache::Memcached::get
1111.50ms1.90msCache::Memcached::::BEGIN@22Cache::Memcached::BEGIN@22
57111.45ms6.72msCache::Memcached::::__ANON__[:767]Cache::Memcached::__ANON__[:767]
1111.31ms2.62msCache::Memcached::::BEGIN@15Cache::Memcached::BEGIN@15
67111.14ms1.58sCache::Memcached::::__ANON__[:741]Cache::Memcached::__ANON__[:741]
1111.14ms3.95msCache::Memcached::::BEGIN@20Cache::Memcached::BEGIN@20
111863µs1.43msCache::Memcached::::BEGIN@17Cache::Memcached::BEGIN@17
5821679µs1.58msCache::Memcached::::sock_to_hostCache::Memcached::sock_to_host
922310µs3.70msCache::Memcached::::newCache::Memcached::new
111275µs395µsCache::Memcached::::_connect_sockCache::Memcached::_connect_sock
111247µs247µsCache::Memcached::::CORE:gpbynameCache::Memcached::CORE:gpbyname (opcode)
111164µs404µsCache::Memcached::::BEGIN@18Cache::Memcached::BEGIN@18
911153µs276µsCache::Memcached::::set_serversCache::Memcached::set_servers
111152µs317µsCache::Memcached::::_write_and_readCache::Memcached::_write_and_read
911123µs123µsCache::Memcached::::init_bucketsCache::Memcached::init_buckets
111113µs59.1msCache::Memcached::::BEGIN@42Cache::Memcached::BEGIN@42
22195µs95µsCache::Memcached::::CORE:connectCache::Memcached::CORE:connect (opcode)
11167µs1.43msCache::Memcached::::_setCache::Memcached::_set
11148µs48µsCache::Memcached::::CORE:socketCache::Memcached::CORE:socket (opcode)
11121µs25µsCache::Memcached::::BEGIN@10Cache::Memcached::BEGIN@10
11119µs125µsCache::Memcached::::BEGIN@33Cache::Memcached::BEGIN@33
11115µs19µsCache::Memcached::::BEGIN@652Cache::Memcached::BEGIN@652
11114µs1.05msCache::Memcached::::get_sockCache::Memcached::get_sock
11114µs18µsCache::Memcached::::BEGIN@487Cache::Memcached::BEGIN@487
11112µs36µsCache::Memcached::::BEGIN@256Cache::Memcached::BEGIN@256
11112µs107µsCache::Memcached::::BEGIN@39Cache::Memcached::BEGIN@39
11111µs1.44msCache::Memcached::::setCache::Memcached::set
11110µs10µsCache::Memcached::::CORE:sysreadCache::Memcached::CORE:sysread (opcode)
11110µs48µsCache::Memcached::::BEGIN@34Cache::Memcached::BEGIN@34
11110µs10µsCache::Memcached::::__ANON__[:374]Cache::Memcached::__ANON__[:374]
11110µs28µsCache::Memcached::::BEGIN@11Cache::Memcached::BEGIN@11
1119µs9µsCache::Memcached::::CORE:matchCache::Memcached::CORE:match (opcode)
1119µs22µsCache::Memcached::::BEGIN@280Cache::Memcached::BEGIN@280
1118µs40µsCache::Memcached::::BEGIN@37Cache::Memcached::BEGIN@37
1118µs25µsCache::Memcached::::BEGIN@13Cache::Memcached::BEGIN@13
2217µs7µsCache::Memcached::::CORE:selectCache::Memcached::CORE:select (opcode)
1116µs6µsCache::Memcached::::BEGIN@16Cache::Memcached::BEGIN@16
1112µs2µsCache::Memcached::::CORE:substCache::Memcached::CORE:subst (opcode)
0000s0sCache::Memcached::::__ANON__[:685]Cache::Memcached::__ANON__[:685]
0000s0sCache::Memcached::::__ANON__[:898]Cache::Memcached::__ANON__[:898]
0000s0sCache::Memcached::::_close_sockCache::Memcached::_close_sock
0000s0sCache::Memcached::::_dead_sockCache::Memcached::_dead_sock
0000s0sCache::Memcached::::_hashfuncCache::Memcached::_hashfunc
0000s0sCache::Memcached::::_incrdecrCache::Memcached::_incrdecr
0000s0sCache::Memcached::::addCache::Memcached::add
0000s0sCache::Memcached::::appendCache::Memcached::append
0000s0sCache::Memcached::::decrCache::Memcached::decr
0000s0sCache::Memcached::::deleteCache::Memcached::delete
0000s0sCache::Memcached::::disconnect_allCache::Memcached::disconnect_all
0000s0sCache::Memcached::::enable_compressCache::Memcached::enable_compress
0000s0sCache::Memcached::::flush_allCache::Memcached::flush_all
0000s0sCache::Memcached::::forget_dead_hostsCache::Memcached::forget_dead_hosts
0000s0sCache::Memcached::::incrCache::Memcached::incr
0000s0sCache::Memcached::::prependCache::Memcached::prepend
0000s0sCache::Memcached::::replaceCache::Memcached::replace
0000s0sCache::Memcached::::run_commandCache::Memcached::run_command
0000s0sCache::Memcached::::set_cb_connect_failCache::Memcached::set_cb_connect_fail
0000s0sCache::Memcached::::set_compress_thresholdCache::Memcached::set_compress_threshold
0000s0sCache::Memcached::::set_connect_timeoutCache::Memcached::set_connect_timeout
0000s0sCache::Memcached::::set_debugCache::Memcached::set_debug
0000s0sCache::Memcached::::set_norehashCache::Memcached::set_norehash
0000s0sCache::Memcached::::set_pref_ipCache::Memcached::set_pref_ip
0000s0sCache::Memcached::::set_readonlyCache::Memcached::set_readonly
0000s0sCache::Memcached::::set_stat_callbackCache::Memcached::set_stat_callback
0000s0sCache::Memcached::::statsCache::Memcached::stats
0000s0sCache::Memcached::::stats_resetCache::Memcached::stats_reset
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# $Id: Memcached.pm 844 2010-06-18 01:26:15Z dormando $
2#
3# Copyright (c) 2003, 2004 Brad Fitzpatrick <brad@danga.com>
4#
5# See COPYRIGHT section in pod text below for usage and distribution rights.
6#
7
8package Cache::Memcached;
9
10331µs230µs
# spent 25µs (21+5) within Cache::Memcached::BEGIN@10 which was called: # once (21µs+5µs) by C4::Context::BEGIN@23 at line 10
use strict;
# spent 25µs making 1 call to Cache::Memcached::BEGIN@10 # spent 4µs making 1 call to strict::import
11328µs247µs
# spent 28µs (10+19) within Cache::Memcached::BEGIN@11 which was called: # once (10µs+19µs) by C4::Context::BEGIN@23 at line 11
use warnings;
# spent 28µs making 1 call to Cache::Memcached::BEGIN@11 # spent 19µs making 1 call to warnings::import
12
13325µs243µs
# spent 25µs (8+17) within Cache::Memcached::BEGIN@13 which was called: # once (8µs+17µs) by C4::Context::BEGIN@23 at line 13
no strict 'refs';
# spent 25µs making 1 call to Cache::Memcached::BEGIN@13 # spent 17µs making 1 call to strict::unimport
143299µs128.8ms
# spent 28.8ms (2.39+26.4) within Cache::Memcached::BEGIN@14 which was called: # once (2.39ms+26.4ms) by C4::Context::BEGIN@23 at line 14
use Storable ();
# spent 28.8ms making 1 call to Cache::Memcached::BEGIN@14
153236µs23.16ms
# spent 2.62ms (1.31+1.30) within Cache::Memcached::BEGIN@15 which was called: # once (1.31ms+1.30ms) by C4::Context::BEGIN@23 at line 15
use Socket qw( MSG_NOSIGNAL PF_INET PF_UNIX IPPROTO_TCP SOCK_STREAM );
# spent 2.62ms making 1 call to Cache::Memcached::BEGIN@15 # spent 547µs making 1 call to Exporter::import
16332µs16µs
# spent 6µs within Cache::Memcached::BEGIN@16 which was called: # once (6µs+0s) by C4::Context::BEGIN@23 at line 16
use IO::Handle ();
# spent 6µs making 1 call to Cache::Memcached::BEGIN@16
173161µs11.43ms
# spent 1.43ms (863µs+563µs) within Cache::Memcached::BEGIN@17 which was called: # once (863µs+563µs) by C4::Context::BEGIN@23 at line 17
use Time::HiRes ();
# spent 1.43ms making 1 call to Cache::Memcached::BEGIN@17
183160µs2454µs
# spent 404µs (164+239) within Cache::Memcached::BEGIN@18 which was called: # once (164µs+239µs) by C4::Context::BEGIN@23 at line 18
use String::CRC32;
# spent 404µs making 1 call to Cache::Memcached::BEGIN@18 # spent 51µs making 1 call to Exporter::import
193194µs22.90ms
# spent 2.55ms (2.11+439µs) within Cache::Memcached::BEGIN@19 which was called: # once (2.11ms+439µs) by C4::Context::BEGIN@23 at line 19
use Errno qw( EINPROGRESS EWOULDBLOCK EISCONN );
# spent 2.55ms making 1 call to Cache::Memcached::BEGIN@19 # spent 350µs making 1 call to Exporter::import
203384µs13.95ms
# spent 3.95ms (1.14+2.81) within Cache::Memcached::BEGIN@20 which was called: # once (1.14ms+2.81ms) by C4::Context::BEGIN@23 at line 20
use Cache::Memcached::GetParser;
# spent 3.95ms making 1 call to Cache::Memcached::BEGIN@20
213277µs110.6ms
# spent 10.6ms (4.37+6.28) within Cache::Memcached::BEGIN@21 which was called: # once (4.37ms+6.28ms) by C4::Context::BEGIN@23 at line 21
use Encode ();
# spent 10.6ms making 1 call to Cache::Memcached::BEGIN@21
221137µs
# spent 1.90ms (1.50+406µs) within Cache::Memcached::BEGIN@22 which was called: # once (1.50ms+406µs) by C4::Context::BEGIN@23 at line 30
use fields qw{
# spent 137µs making 1 call to fields::import
23 debug no_rehash stats compress_threshold compress_enable stat_callback
24 readonly select_timeout namespace namespace_len servers active buckets
25 pref_ip
26 bucketcount _single_sock _stime
27 connect_timeout cb_connect_fail
28 parser_class
29 buck2sock
303189µs11.90ms};
# spent 1.90ms making 1 call to Cache::Memcached::BEGIN@22
31
32# flag definitions
33359µs2232µs
# spent 125µs (19+107) within Cache::Memcached::BEGIN@33 which was called: # once (19µs+107µs) by C4::Context::BEGIN@23 at line 33
use constant F_STORABLE => 1;
# spent 125µs making 1 call to Cache::Memcached::BEGIN@33 # spent 107µs making 1 call to constant::import
34336µs287µs
# spent 48µs (10+38) within Cache::Memcached::BEGIN@34 which was called: # once (10µs+38µs) by C4::Context::BEGIN@23 at line 34
use constant F_COMPRESS => 2;
# spent 48µs making 1 call to Cache::Memcached::BEGIN@34 # spent 38µs making 1 call to constant::import
35
36# size savings required before saving compressed value
37333µs272µs
# spent 40µs (8+32) within Cache::Memcached::BEGIN@37 which was called: # once (8µs+32µs) by C4::Context::BEGIN@23 at line 37
use constant COMPRESS_SAVINGS => 0.20; # percent
# spent 40µs making 1 call to Cache::Memcached::BEGIN@37 # spent 32µs making 1 call to constant::import
38
39360µs2202µs
# spent 107µs (12+95) within Cache::Memcached::BEGIN@39 which was called: # once (12µs+95µs) by C4::Context::BEGIN@23 at line 39
use vars qw($VERSION $HAVE_ZLIB $FLAG_NOSIGNAL $HAVE_SOCKET6);
# spent 107µs making 1 call to Cache::Memcached::BEGIN@39 # spent 95µs making 1 call to vars::import
401900ns$VERSION = "1.29";
41
42
# spent 59.1ms (113µs+59.0) within Cache::Memcached::BEGIN@42 which was called: # once (113µs+59.0ms) by C4::Context::BEGIN@23 at line 45
BEGIN {
43280µs $HAVE_ZLIB = eval "use Compress::Zlib (); 1;";
# spent 139µs executing statements in string eval
# includes 3.59ms spent executing 1 call to 1 sub defined therein.
44 $HAVE_SOCKET6 = eval "use Socket6 qw(AF_INET6 PF_INET6); 1;";
# spent 93µs executing statements in string eval
# includes 79µs spent executing 1 call to 1 sub defined therein.
4511.55ms159.1ms}
# spent 59.1ms making 1 call to Cache::Memcached::BEGIN@42
46
47154µsmy $HAVE_XS = eval "use Cache::Memcached::GetParserXS; 1;";
# spent 106µs executing statements in string eval
# includes 80µs spent executing 1 call to 1 sub defined therein.
4813µs$HAVE_XS = 0 if $ENV{NO_XS};
49
5012µsmy $parser_class = $HAVE_XS ? "Cache::Memcached::GetParserXS" : "Cache::Memcached::GetParser";
5111µsif ($ENV{XS_DEBUG}) {
52 print "using parser: $parser_class\n";
53}
54
551700ns$FLAG_NOSIGNAL = 0;
5623µseval { $FLAG_NOSIGNAL = MSG_NOSIGNAL; };
57
581600nsmy %host_dead; # host -> unixtime marked dead until
591400nsmy %cache_sock; # host -> socket
60
611500nsmy $PROTO_TCP;
62
6311µsour $SOCK_TIMEOUT = 2.6; # default timeout in seconds
64
65
# spent 3.70ms (310µs+3.39) within Cache::Memcached::new which was called 9 times, avg 411µs/call: # 8 times (271µs+1.18ms) by Memoize::Memcached::_init at line 218 of Memoize/Memcached.pm, avg 181µs/call # once (39µs+2.21ms) by C4::Context::BEGIN@23 at line 87 of /usr/share/koha/lib/C4/Context.pm
sub new {
66171315µs my Cache::Memcached $self = shift;
6793.11ms $self = fields::new( $self ) unless ref $self;
# spent 3.11ms making 9 calls to fields::__ANON__[fields.pm:128], avg 346µs/call
68
69 my $args = (@_ == 1) ? shift : { @_ }; # hashref-ify args
70
71 $self->{'buck2sock'}= [];
729276µs $self->set_servers($args->{'servers'});
# spent 276µs making 9 calls to Cache::Memcached::set_servers, avg 31µs/call
73 $self->{'debug'} = $args->{'debug'} || 0;
74 $self->{'no_rehash'} = $args->{'no_rehash'};
75 $self->{'stats'} = {};
76 $self->{'pref_ip'} = $args->{'pref_ip'} || {};
77 $self->{'compress_threshold'} = $args->{'compress_threshold'};
78 $self->{'compress_enable'} = 1;
79 $self->{'stat_callback'} = $args->{'stat_callback'} || undef;
80 $self->{'readonly'} = $args->{'readonly'};
81 $self->{'parser_class'} = $args->{'parser_class'} || $parser_class;
82
83 # TODO: undocumented
84 $self->{'connect_timeout'} = $args->{'connect_timeout'} || 0.25;
85 $self->{'select_timeout'} = $args->{'select_timeout'} || 1.0;
86 $self->{namespace} = $args->{namespace} || '';
87 $self->{namespace_len} = length $self->{namespace};
88
89 return $self;
90}
91
92sub set_pref_ip {
93 my Cache::Memcached $self = shift;
94 $self->{'pref_ip'} = shift;
95}
96
97
# spent 276µs (153+123) within Cache::Memcached::set_servers which was called 9 times, avg 31µs/call: # 9 times (153µs+123µs) by Cache::Memcached::new at line 72, avg 31µs/call
sub set_servers {
9899142µs my Cache::Memcached $self = shift;
99 my ($list) = @_;
100 $self->{'servers'} = $list || [];
101 $self->{'active'} = scalar @{$self->{'servers'}};
102 $self->{'buckets'} = undef;
103 $self->{'bucketcount'} = 0;
1049123µs $self->init_buckets;
# spent 123µs making 9 calls to Cache::Memcached::init_buckets, avg 14µs/call
105 $self->{'buck2sock'}= [];
106
107 $self->{'_single_sock'} = undef;
108 if (@{$self->{'servers'}} == 1) {
109 $self->{'_single_sock'} = $self->{'servers'}[0];
110 }
111
112 return $self;
113}
114
115sub set_cb_connect_fail {
116 my Cache::Memcached $self = shift;
117 $self->{'cb_connect_fail'} = shift;
118}
119
120sub set_connect_timeout {
121 my Cache::Memcached $self = shift;
122 $self->{'connect_timeout'} = shift;
123}
124
125sub set_debug {
126 my Cache::Memcached $self = shift;
127 my ($dbg) = @_;
128 $self->{'debug'} = $dbg || 0;
129}
130
131sub set_readonly {
132 my Cache::Memcached $self = shift;
133 my ($ro) = @_;
134 $self->{'readonly'} = $ro;
135}
136
137sub set_norehash {
138 my Cache::Memcached $self = shift;
139 my ($val) = @_;
140 $self->{'no_rehash'} = $val;
141}
142
143sub set_compress_threshold {
144 my Cache::Memcached $self = shift;
145 my ($thresh) = @_;
146 $self->{'compress_threshold'} = $thresh;
147}
148
149sub enable_compress {
150 my Cache::Memcached $self = shift;
151 my ($enable) = @_;
152 $self->{'compress_enable'} = $enable;
153}
154
155sub forget_dead_hosts {
156 my Cache::Memcached $self = shift;
157 %host_dead = ();
158 $self->{'buck2sock'} = [];
159}
160
161sub set_stat_callback {
162 my Cache::Memcached $self = shift;
163 my ($stat_callback) = @_;
164 $self->{'stat_callback'} = $stat_callback;
165}
166
1671600nsmy %sock_map; # stringified-$sock -> "$ip:$port"
168
169sub _dead_sock {
170 my ($self, $sock, $ret, $dead_for) = @_;
171 if (my $ipport = $sock_map{$sock}) {
172 my $now = time();
173 $host_dead{$ipport} = $now + $dead_for
174 if $dead_for;
175 delete $cache_sock{$ipport};
176 delete $sock_map{$sock};
177 }
178 $self->{'buck2sock'} = [] if $self;
179 return $ret; # 0 or undef, probably, depending on what caller wants
180}
181
182sub _close_sock {
183 my ($self, $sock) = @_;
184 if (my $ipport = $sock_map{$sock}) {
185 close $sock;
186 delete $cache_sock{$ipport};
187 delete $sock_map{$sock};
188 }
189 $self->{'buck2sock'} = [];
190}
191
192
# spent 395µs (275+121) within Cache::Memcached::_connect_sock which was called: # once (275µs+121µs) by Cache::Memcached::sock_to_host at line 292
sub _connect_sock { # sock, sin, timeout
1937341µs my ($sock, $sin, $timeout) = @_;
194 $timeout = 0.25 if not defined $timeout;
195
196 # make the socket non-blocking from now on,
197 # except if someone wants 0 timeout, meaning
198 # a blocking connect, but even then turn it
199 # non-blocking at the end of this function
200
201111µs if ($timeout) {
# spent 11µs making 1 call to IO::Handle::blocking
202 IO::Handle::blocking($sock, 0);
203 } else {
204 IO::Handle::blocking($sock, 1);
205 }
206
207192µs my $ret = connect($sock, $sin);
# spent 92µs making 1 call to Cache::Memcached::CORE:connect
208
209346µs if (!$ret && $timeout && $!==EINPROGRESS) {
210
211 my $win='';
212 vec($win, fileno($sock), 1) = 1;
213
214212µs114µs if (select(undef, $win, undef, $timeout) > 0) {
# spent 14µs making 1 call to Cache::Memcached::CORE:sselect
21513µs $ret = connect($sock, $sin);
# spent 3µs making 1 call to Cache::Memcached::CORE:connect
216 # EISCONN means connected & won't re-connect, so success
217 $ret = 1 if !$ret && $!==EISCONN;
218 }
219 }
220
221 unless ($timeout) { # socket was temporarily blocking, now revert
222 IO::Handle::blocking($sock, 0);
223 }
224
225 # from here on, we use non-blocking (async) IO for the duration
226 # of the socket's life
227
228 return $ret;
229}
230
231
# spent 1.58ms (679µs+898µs) within Cache::Memcached::sock_to_host which was called 58 times, avg 27µs/call: # 57 times (545µs+0s) by Cache::Memcached::get_multi at line 596, avg 10µs/call # once (134µs+898µs) by Cache::Memcached::get_sock at line 323
sub sock_to_host { # (host) #why is this public? I wouldn't have to worry about undef $self if it weren't.
2321881.05ms my Cache::Memcached $self = ref $_[0] ? shift : undef;
233 my $host = $_[0];
234 return $cache_sock{$host} if $cache_sock{$host};
235
236 my $now = time();
23719µs my ($ip, $port) = $host =~ /(.*):(\d+)$/;
# spent 9µs making 1 call to Cache::Memcached::CORE:match
238111µs if (defined($ip)) {
23912µs $ip =~ s/[\[\]]//g; # get rid of optional IPv6 brackets
# spent 2µs making 1 call to Cache::Memcached::CORE:subst
240 }
241
242 return undef if
243 $host_dead{$host} && $host_dead{$host} > $now;
244 my $sock;
245
246 my $connected = 0;
247 my $sin;
2481247µs my $proto = $PROTO_TCP ||= getprotobyname('tcp');
# spent 247µs making 1 call to Cache::Memcached::CORE:gpbyname
249
25023µs if ( index($host, '/') != 0 )
251 {
252 # if a preferred IP is known, try that first.
253 if ($self && $self->{pref_ip}{$ip}) {
254 my $prefip = $self->{pref_ip}{$ip};
255 if ($HAVE_SOCKET6 && index($prefip, ':') != -1) {
2563156µs259µs
# spent 36µs (12+23) within Cache::Memcached::BEGIN@256 which was called: # once (12µs+23µs) by C4::Context::BEGIN@23 at line 256
no strict 'subs'; # for PF_INET6 and AF_INET6, weirdly imported
# spent 36µs making 1 call to Cache::Memcached::BEGIN@256 # spent 23µs making 1 call to strict::unimport
257 socket($sock, PF_INET6, SOCK_STREAM, $proto);
258 $sock_map{$sock} = $host;
259 $sin = Socket6::pack_sockaddr_in6($port,
260 Socket6::inet_pton(AF_INET6, $prefip));
261 } else {
262 socket($sock, PF_INET, SOCK_STREAM, $proto);
263 $sock_map{$sock} = $host;
264 $sin = Socket::sockaddr_in($port, Socket::inet_aton($prefip));
265 }
266
267 if (_connect_sock($sock,$sin,$self->{connect_timeout})) {
268 $connected = 1;
269 } else {
270 if (my $cb = $self->{cb_connect_fail}) {
271 $cb->($prefip);
272 }
273 close $sock;
274 }
275 }
276
277 # normal path, or fallback path if preferred IP failed
27839µs unless ($connected) {
2793236µs if ($HAVE_SOCKET6 && index($ip, ':') != -1) {
28031.16ms235µs
# spent 22µs (9+13) within Cache::Memcached::BEGIN@280 which was called: # once (9µs+13µs) by C4::Context::BEGIN@23 at line 280
no strict 'subs'; # for PF_INET6 and AF_INET6, weirdly imported
# spent 22µs making 1 call to Cache::Memcached::BEGIN@280 # spent 13µs making 1 call to strict::unimport
281 socket($sock, PF_INET6, SOCK_STREAM, $proto);
282 $sock_map{$sock} = $host;
283 $sin = Socket6::pack_sockaddr_in6($port,
284 Socket6::inet_pton(AF_INET6, $ip));
285 } else {
286148µs socket($sock, PF_INET, SOCK_STREAM, $proto);
# spent 48µs making 1 call to Cache::Memcached::CORE:socket
287 $sock_map{$sock} = $host;
2882190µs $sin = Socket::sockaddr_in($port, Socket::inet_aton($ip));
# spent 155µs making 1 call to Socket::inet_aton # spent 35µs making 1 call to Socket::sockaddr_in
289 }
290
291 my $timeout = $self ? $self->{connect_timeout} : 0.25;
2921395µs unless (_connect_sock($sock, $sin, $timeout)) {
# spent 395µs making 1 call to Cache::Memcached::_connect_sock
293 my $cb = $self ? $self->{cb_connect_fail} : undef;
294 $cb->($ip) if $cb;
295 return _dead_sock($self, $sock, undef, 20 + int(rand(10)));
296 }
297 }
298 } else { # it's a unix domain/local socket
299 socket($sock, PF_UNIX, SOCK_STREAM, 0);
300 $sock_map{$sock} = $host;
301 $sin = Socket::sockaddr_un($host);
302 my $timeout = $self ? $self->{connect_timeout} : 0.25;
303 unless (_connect_sock($sock,$sin,$timeout)) {
304 my $cb = $self ? $self->{cb_connect_fail} : undef;
305 $cb->($host) if $cb;
306 return _dead_sock($self, $sock, undef, 20 + int(rand(10)));
307 }
308 }
309
310 # make the new socket not buffer writes.
31114µs my $old = select($sock);
# spent 4µs making 1 call to Cache::Memcached::CORE:select
312 $| = 1;
31312µs select($old);
# spent 2µs making 1 call to Cache::Memcached::CORE:select
314
315 $cache_sock{$host} = $sock;
316
317 return $sock;
318}
319
320
# spent 1.05ms (14µs+1.03) within Cache::Memcached::get_sock which was called: # once (14µs+1.03ms) by Cache::Memcached::_set at line 484
sub get_sock { # (key)
321315µs my Cache::Memcached $self = $_[0];
322 my $key = $_[1];
32311.03ms return $self->sock_to_host($self->{'_single_sock'}) if $self->{'_single_sock'};
# spent 1.03ms making 1 call to Cache::Memcached::sock_to_host
324 return undef unless $self->{'active'};
325 my $hv = ref $key ? int($key->[0]) : _hashfunc($key);
326
327 my $real_key = ref $key ? $key->[1] : $key;
328 my $tries = 0;
329 while ($tries++ < 20) {
330 my $host = $self->{'buckets'}->[$hv % $self->{'bucketcount'}];
331 my $sock = $self->sock_to_host($host);
332 return $sock if $sock;
333 return undef if $self->{'no_rehash'};
334 $hv += _hashfunc($tries . $real_key); # stupid, but works
335 }
336 return undef;
337}
338
339
# spent 123µs within Cache::Memcached::init_buckets which was called 9 times, avg 14µs/call: # 9 times (123µs+0s) by Cache::Memcached::set_servers at line 104, avg 14µs/call
sub init_buckets {
3404584µs my Cache::Memcached $self = shift;
341 return if $self->{'buckets'};
342 my $bu = $self->{'buckets'} = [];
343 foreach my $v (@{$self->{'servers'}}) {
3441853µs if (ref $v eq "ARRAY") {
345 for (1..$v->[1]) { push @$bu, $v->[0]; }
346 } else {
347 push @$bu, $v;
348 }
349 }
350 $self->{'bucketcount'} = scalar @{$self->{'buckets'}};
351}
352
353sub disconnect_all {
354 my Cache::Memcached $self = shift;
355 my $sock;
356 foreach $sock (values %cache_sock) {
357 close $sock;
358 }
359 %cache_sock = ();
360 $self->{'buck2sock'} = [];
361}
362
363# writes a line, then reads result. by default stops reading after a
364# single line, but caller can override the $check_complete subref,
365# which gets passed a scalarref of buffer read thus far.
366
# spent 317µs (152+165) within Cache::Memcached::_write_and_read which was called: # once (152µs+165µs) by Cache::Memcached::_set at line 523
sub _write_and_read {
3671331µs my Cache::Memcached $self = shift;
368 my ($sock, $line, $check_complete) = @_;
369 my $res;
370 my ($ret, $offset) = (undef, 0);
371
372
# spent 10µs within Cache::Memcached::__ANON__[/usr/share/perl5/Cache/Memcached.pm:374] which was called: # once (10µs+0s) by Cache::Memcached::_write_and_read at line 423
$check_complete ||= sub {
373120µs return (rindex($ret, "\r\n") + 2 == length($ret));
374 };
375
376 # state: 0 - writing, 1 - reading, 2 - done
377 my $state = 0;
378
379 # the bitsets for select
380 my ($rin, $rout, $win, $wout);
381 my $nfound;
382
383 my $copy_state = -1;
384 local $SIG{'PIPE'} = "IGNORE" unless $FLAG_NOSIGNAL;
385
386 # the select loop
387 while(1) {
3882267µs if ($copy_state!=$state) {
389 last if $state==2;
390 ($rin, $win) = ('', '');
391 vec($rin, fileno($sock), 1) = 1 if $state==1;
392 vec($win, fileno($sock), 1) = 1 if $state==0;
393 $copy_state = $state;
394 }
395212µs $nfound = select($rout=$rin, $wout=$win, undef,
# spent 12µs making 2 calls to Cache::Memcached::CORE:sselect, avg 6µs/call
396 $self->{'select_timeout'});
397 last unless $nfound;
398
3994157µs if (vec($wout, fileno($sock), 1)) {
4001132µs $res = send($sock, $line, $FLAG_NOSIGNAL);
# spent 132µs making 1 call to Cache::Memcached::CORE:send
401 next
402 if not defined $res and $!==EWOULDBLOCK;
403 unless ($res > 0) {
404 $self->_close_sock($sock);
405 return undef;
406 }
407 if ($res == length($line)) { # all sent
408 $state = 1;
409 } else { # we only succeeded in sending some of it
410 substr($line, 0, $res, ''); # delete the part we sent
411 }
412 }
413
414543µs if (vec($rout, fileno($sock), 1)) {
415110µs $res = sysread($sock, $ret, 255, $offset);
# spent 10µs making 1 call to Cache::Memcached::CORE:sysread
416 next
417 if !defined($res) and $!==EWOULDBLOCK;
418 if ($res == 0) { # catches 0=conn closed or undef=error
419 $self->_close_sock($sock);
420 return undef;
421 }
422 $offset += $res;
423110µs $state = 2 if $check_complete->(\$ret);
# spent 10µs making 1 call to Cache::Memcached::__ANON__[Cache/Memcached.pm:374]
424 }
425 }
426
427 unless ($state == 2) {
428 $self->_dead_sock($sock); # improperly finished
429 return undef;
430 }
431
432 return $ret;
433}
434
435sub delete {
436 my Cache::Memcached $self = shift;
437 my ($key, $time) = @_;
438 return 0 if ! $self->{'active'} || $self->{'readonly'};
439 my $stime = Time::HiRes::time() if $self->{'stat_callback'};
440 my $sock = $self->get_sock($key);
441 return 0 unless $sock;
442
443 $self->{'stats'}->{"delete"}++;
444 $key = ref $key ? $key->[1] : $key;
445 $time = $time ? " $time" : "";
446 my $cmd = "delete $self->{namespace}$key$time\r\n";
447 my $res = _write_and_read($self, $sock, $cmd);
448
449 if ($self->{'stat_callback'}) {
450 my $etime = Time::HiRes::time();
451 $self->{'stat_callback'}->($stime, $etime, $sock, 'delete');
452 }
453
454 return defined $res && $res eq "DELETED\r\n";
455}
45614µs*remove = \&delete;
457
458sub add {
459 _set("add", @_);
460}
461
462sub replace {
463 _set("replace", @_);
464}
465
466
# spent 1.44ms (11µs+1.43) within Cache::Memcached::set which was called: # once (11µs+1.43ms) by C4::Context::BEGIN@23 at line 95 of /usr/share/koha/lib/C4/Context.pm
sub set {
46719µs11.43ms _set("set", @_);
# spent 1.43ms making 1 call to Cache::Memcached::_set
468}
469
470sub append {
471 _set("append", @_);
472}
473
474sub prepend {
475 _set("prepend", @_);
476}
477
478
# spent 1.43ms (67µs+1.36) within Cache::Memcached::_set which was called: # once (67µs+1.36ms) by Cache::Memcached::set at line 467
sub _set {
4792264µs my $cmdname = shift;
480 my Cache::Memcached $self = shift;
481 my ($key, $val, $exptime) = @_;
482 return 0 if ! $self->{'active'} || $self->{'readonly'};
483 my $stime = Time::HiRes::time() if $self->{'stat_callback'};
48411.05ms my $sock = $self->get_sock($key);
# spent 1.05ms making 1 call to Cache::Memcached::get_sock
485 return 0 unless $sock;
486
48731.07ms223µs
# spent 18µs (14+5) within Cache::Memcached::BEGIN@487 which was called: # once (14µs+5µs) by C4::Context::BEGIN@23 at line 487
use bytes; # return bytes from length()
# spent 18µs making 1 call to Cache::Memcached::BEGIN@487 # spent 5µs making 1 call to bytes::import
488
489 my $app_or_prep = $cmdname eq 'append' || $cmdname eq 'prepend' ? 1 : 0;
490 $self->{'stats'}->{$cmdname}++;
491 my $flags = 0;
492 $key = ref $key ? $key->[1] : $key;
493
494 if (ref $val) {
495 die "append or prepend cannot take a reference" if $app_or_prep;
496 local $Carp::CarpLevel = 2;
497 $val = Storable::nfreeze($val);
498 $flags |= F_STORABLE;
499 }
500 warn "value for memkey:$key is not defined" unless defined $val;
501
502 my $len = length($val);
503
504 if ($self->{'compress_threshold'} && $HAVE_ZLIB && $self->{'compress_enable'} &&
505 $len >= $self->{'compress_threshold'} && !$app_or_prep) {
506
507 my $c_val = Compress::Zlib::memGzip($val);
508 my $c_len = length($c_val);
509
510 # do we want to keep it?
511 if ($c_len < $len*(1 - COMPRESS_SAVINGS)) {
512 $val = $c_val;
513 $len = $c_len;
514 $flags |= F_COMPRESS;
515 }
516 }
517
518 $exptime = int($exptime || 0);
519
520 local $SIG{'PIPE'} = "IGNORE" unless $FLAG_NOSIGNAL;
521 my $line = "$cmdname $self->{namespace}$key $flags $exptime $len\r\n$val\r\n";
522
5231317µs my $res = _write_and_read($self, $sock, $line);
# spent 317µs making 1 call to Cache::Memcached::_write_and_read
524
525 if ($self->{'debug'} && $line) {
526 chop $line; chop $line;
527 print STDERR "Cache::Memcache: $cmdname $self->{namespace}$key = $val ($line)\n";
528 }
529
530 if ($self->{'stat_callback'}) {
531 my $etime = Time::HiRes::time();
532 $self->{'stat_callback'}->($stime, $etime, $sock, $cmdname);
533 }
534
535 return defined $res && $res eq "STORED\r\n";
536}
537
538sub incr {
539 _incrdecr("incr", @_);
540}
541
542sub decr {
543 _incrdecr("decr", @_);
544}
545
546sub _incrdecr {
547 my $cmdname = shift;
548 my Cache::Memcached $self = shift;
549 my ($key, $value) = @_;
550 return undef if ! $self->{'active'} || $self->{'readonly'};
551 my $stime = Time::HiRes::time() if $self->{'stat_callback'};
552 my $sock = $self->get_sock($key);
553 return undef unless $sock;
554 $key = $key->[1] if ref $key;
555 $self->{'stats'}->{$cmdname}++;
556 $value = 1 unless defined $value;
557
558 my $line = "$cmdname $self->{namespace}$key $value\r\n";
559 my $res = _write_and_read($self, $sock, $line);
560
561 if ($self->{'stat_callback'}) {
562 my $etime = Time::HiRes::time();
563 $self->{'stat_callback'}->($stime, $etime, $sock, $cmdname);
564 }
565
566 return undef unless defined $res && $res =~ /^(\d+)/;
567 return $1;
568}
569
570
# spent 1.61s (1.52ms+1.60) within Cache::Memcached::get which was called 57 times, avg 28.2ms/call: # 54 times (1.47ms+1.60s) by Memoize::Memcached::FETCH at line 256 of Memoize/Memcached.pm, avg 29.7ms/call # 3 times (56µs+2.54ms) by C4::Context::new at line 380 of /usr/share/koha/lib/C4/Context.pm, avg 865µs/call
sub get {
5713421.89ms my Cache::Memcached $self = $_[0];
572 my $key = $_[1];
573
574 # TODO: make a fast path for this? or just keep using get_multi?
575571.60s my $r = $self->get_multi($key);
# spent 1.60s making 57 calls to Cache::Memcached::get_multi, avg 28.1ms/call
576 my $kval = ref $key ? $key->[1] : $key;
577
578 # key reconstituted from server won't have utf8 on, so turn it off on input
579 # scalar to allow hash lookup to succeed
58057389µs Encode::_utf8_off($kval) if Encode::is_utf8($kval);
# spent 389µs making 57 calls to Encode::is_utf8, avg 7µs/call
581
582 return $r->{$kval};
583}
584
585
# spent 1.60s (2.98ms+1.60) within Cache::Memcached::get_multi which was called 57 times, avg 28.1ms/call: # 57 times (2.98ms+1.60s) by Cache::Memcached::get at line 575, avg 28.1ms/call
sub get_multi {
5867982.04ms my Cache::Memcached $self = shift;
587 return {} unless $self->{'active'};
588 $self->{'_stime'} = Time::HiRes::time() if $self->{'stat_callback'};
589 $self->{'stats'}->{"get_multi"}++;
590
591 my %val; # what we'll be returning a reference to (realkey -> value)
592 my %sock_keys; # sockref_as_scalar -> [ realkeys ]
593 my $sock;
594
595171459µs if ($self->{'_single_sock'}) {
59657545µs $sock = $self->sock_to_host($self->{'_single_sock'});
# spent 545µs making 57 calls to Cache::Memcached::sock_to_host, avg 10µs/call
597 unless ($sock) {
598 return {};
599 }
600 foreach my $key (@_) {
601114372µs my $kval = ref $key ? $key->[1] : $key;
602 push @{$sock_keys{$sock}}, $kval;
603 }
604 } else {
605 my $bcount = $self->{'bucketcount'};
606 my $sock;
607 KEY:
608 foreach my $key (@_) {
609 my ($hv, $real_key) = ref $key ?
610 (int($key->[0]), $key->[1]) :
611 ((crc32($key) >> 16) & 0x7fff, $key);
612
613 my $tries;
614 while (1) {
615 my $bucket = $hv % $bcount;
616
617 # this segfaults perl 5.8.4 (and others?) if sock_to_host returns undef... wtf?
618 #$sock = $buck2sock[$bucket] ||= $self->sock_to_host($self->{buckets}[ $bucket ])
619 # and last;
620
621 # but this variant doesn't crash:
622 $sock = $self->{'buck2sock'}->[$bucket] || $self->sock_to_host($self->{buckets}[ $bucket ]);
623 if ($sock) {
624 $self->{'buck2sock'}->[$bucket] = $sock;
625 last;
626 }
627
628 next KEY if $tries++ >= 20;
629 $hv += _hashfunc($tries . $real_key);
630 }
631
632 push @{$sock_keys{$sock}}, $real_key;
633 }
634 }
635
636 $self->{'stats'}->{"get_keys"} += @_;
637 $self->{'stats'}->{"get_socks"} += keys %sock_keys;
638
639 local $SIG{'PIPE'} = "IGNORE" unless $FLAG_NOSIGNAL;
640
641571.60s _load_multi($self, \%sock_keys, \%val);
# spent 1.60s making 57 calls to Cache::Memcached::_load_multi, avg 28.1ms/call
642
643 if ($self->{'debug'}) {
644 while (my ($k, $v) = each %val) {
645 print STDERR "MemCache: got $k = $v\n";
646 }
647 }
648 return \%val;
649}
650
651
# spent 1.60s (13.2ms+1.59) within Cache::Memcached::_load_multi which was called 57 times, avg 28.1ms/call: # 57 times (13.2ms+1.59s) by Cache::Memcached::get_multi at line 641, avg 28.1ms/call
sub _load_multi {
65231.90ms222µs
# spent 19µs (15+4) within Cache::Memcached::BEGIN@652 which was called: # once (15µs+4µs) by C4::Context::BEGIN@23 at line 652
use bytes; # return bytes from length()
# spent 19µs making 1 call to Cache::Memcached::BEGIN@652 # spent 3µs making 1 call to bytes::import
65310836.39ms my Cache::Memcached $self;
654 my ($sock_keys, $ret);
655
656 ($self, $sock_keys, $ret) = @_;
657
658 # all keyed by $sockstr:
659 my %reading; # $sockstr -> $sock. bool, whether we're reading from this socket
660 my %writing; # $sockstr -> $sock. bool, whether we're writing to this socket
661 my %buf; # buffers, for writing
662
663 my %parser; # $sockstr -> Cache::Memcached::GetParser
664
665 my $active_changed = 1; # force rebuilding of select sets
666
667 my $dead = sub {
668 my $sock = shift;
669 print STDERR "killing socket $sock\n" if $self->{'debug'} >= 2;
670 delete $reading{$sock};
671 delete $writing{$sock};
672
673 if (my $p = $parser{$sock}) {
674 my $key = $p->current_key;
675 delete $ret->{$key} if $key;
676 }
677
678 if ($self->{'stat_callback'}) {
679 my $etime = Time::HiRes::time();
680 $self->{'stat_callback'}->($self->{'_stime'}, $etime, $sock, 'get_multi');
681 }
682
683 close $sock;
684 $self->_dead_sock($sock);
685 };
686
687 # $finalize->($key, $flags)
688 # $finalize->({ $key => $flags, $key => $flags });
689
# spent 1.56s (3.32ms+1.56) within Cache::Memcached::__ANON__[/usr/share/perl5/Cache/Memcached.pm:714] which was called 57 times, avg 27.4ms/call: # 52 times (2.94ms+1.41s) by Cache::Memcached::GetParser::parse_buffer at line 103 of Cache/Memcached/GetParser.pm, avg 27.1ms/call # 5 times (379µs+153ms) by Cache::Memcached::GetParser::parse_from_sock at line 48 of Cache/Memcached/GetParser.pm, avg 30.7ms/call
my $finalize = sub {
6901711.43ms my $map = $_[0];
691 $map = {@_} unless ref $map;
692
693228965µs while (my ($k, $flags) = each %$map) {
694
695 # remove trailing \r\n
696 chop $ret->{$k}; chop $ret->{$k};
697
698100563ms $ret->{$k} = Compress::Zlib::memGunzip($ret->{$k})
# spent 562ms making 50 calls to Compress::Zlib::memGunzip, avg 11.2ms/call # spent 615µs making 50 calls to Compress::Raw::Zlib::inflateStream::DESTROY, avg 12µs/call
699 if $HAVE_ZLIB && $flags & F_COMPRESS;
700114155µs if ($flags & F_STORABLE) {
701 # wrapped in eval in case a perl 5.6 Storable tries to
702 # unthaw data from a perl 5.8 Storable. (5.6 is stupid
703 # and dies if the version number changes at all. in 5.8
704 # they made it only die if it unencounters a new feature)
70557866µs eval {
70657996ms $ret->{$k} = Storable::thaw($ret->{$k});
# spent 996ms making 56 calls to Storable::thaw, avg 17.8ms/call # spent 384µs making 1 call to AutoLoader::AUTOLOAD
707 };
708 # so if there was a problem, just treat it as a cache miss.
709 if ($@) {
710 delete $ret->{$k};
711 }
712 }
713 }
714 };
715
716 foreach (keys %$sock_keys) {
7173421.56ms my $ipport = $sock_map{$_} or die "No map found matching for $_";
718 my $sock = $cache_sock{$ipport} or die "No sock found for $ipport";
719 print STDERR "processing socket $_\n" if $self->{'debug'} >= 2;
720 $writing{$_} = $sock;
721 if ($self->{namespace}) {
722 $buf{$_} = join(" ", 'get', (map { "$self->{namespace}$_" } @{$sock_keys->{$_}}), "\r\n");
723 } else {
724 $buf{$_} = join(" ", 'get', @{$sock_keys->{$_}}, "\r\n");
725 }
726
72757910µs $parser{$_} = $self->{parser_class}->new($ret, $self->{namespace_len}, $finalize);
# spent 910µs making 57 calls to Cache::Memcached::GetParser::new, avg 16µs/call
728 }
729
730
# spent 1.58s (1.14ms+1.57) within Cache::Memcached::__ANON__[/usr/share/perl5/Cache/Memcached.pm:741] which was called 67 times, avg 23.5ms/call: # 67 times (1.14ms+1.57s) by Cache::Memcached::_load_multi at line 803, avg 23.5ms/call
my $read = sub {
7313351.26ms my $sockstr = "$_[0]"; # $sock is $_[0];
732 my $p = $parser{$sockstr} or die;
733671.57s my $rv = $p->parse_from_sock($_[0]);
# spent 1.57s making 67 calls to Cache::Memcached::GetParser::parse_from_sock, avg 23.5ms/call
734 if ($rv > 0) {
735 # okay, finished with this socket
736 delete $reading{$sockstr};
737 } elsif ($rv < 0) {
738 $dead->($_[0]);
739 }
740 return $rv;
741 };
742
743 # returns 1 when it's done, for success or error. 0 if still working.
744
# spent 6.72ms (1.45+5.27) within Cache::Memcached::__ANON__[/usr/share/perl5/Cache/Memcached.pm:767] which was called 57 times, avg 118µs/call: # 57 times (1.45ms+5.27ms) by Cache::Memcached::_load_multi at line 798, avg 118µs/call
my $write = sub {
7453426.27ms my ($sock, $sockstr) = ($_[0], "$_[0]");
746 my $res;
747
748575.27ms $res = send($sock, $buf{$sockstr}, $FLAG_NOSIGNAL);
# spent 5.27ms making 57 calls to Cache::Memcached::CORE:send, avg 92µs/call
749
750 return 0
751 if not defined $res and $!==EWOULDBLOCK;
752 unless ($res > 0) {
753 $dead->($sock);
754 return 1;
755 }
756228512µs if ($res == length($buf{$sockstr})) { # all sent
757 $buf{$sockstr} = "";
758
759 # switch the socket from writing to reading
760 delete $writing{$sockstr};
761 $reading{$sockstr} = $sock;
762 return 1;
763 } else { # we only succeeded in sending some of it
764 substr($buf{$sockstr}, 0, $res, ''); # delete the part we sent
765 }
766 return 0;
767 };
768
769 # the bitsets for select
770 my ($rin, $rout, $win, $wout);
771 my $nfound;
772
773 # the big select loop
774 while(1) {
77513047.12ms if ($active_changed) {
776 last unless %reading or %writing; # no sockets left?
777 ($rin, $win) = ('', '');
778 foreach (values %reading) {
77957206µs vec($rin, fileno($_), 1) = 1;
780 }
781 foreach (values %writing) {
78257413µs vec($win, fileno($_), 1) = 1;
783 }
784 $active_changed = 0;
785 }
786 # TODO: more intelligent cumulative timeout?
787 # TODO: select is interruptible w/ ptrace attach, signal, etc. should note that.
7881243.80ms $nfound = select($rout=$rin, $wout=$win, undef,
# spent 3.80ms making 124 calls to Cache::Memcached::CORE:sselect, avg 31µs/call
789 $self->{'select_timeout'});
790 last unless $nfound;
791
792 # TODO: possible robustness improvement: we could select
793 # writing sockets for reading also, and raise hell if they're
794 # ready (input unread from last time, etc.)
795 # maybe do that on the first loop only?
796 foreach (values %writing) {
797114450µs if (vec($wout, fileno($_), 1)) {
798576.72ms $active_changed = 1 if $write->($_);
# spent 6.72ms making 57 calls to Cache::Memcached::__ANON__[Cache/Memcached.pm:767], avg 118µs/call
799 }
800 }
801 foreach (values %reading) {
802191760µs if (vec($rout, fileno($_), 1)) {
803671.58s $active_changed = 1 if $read->($_);
# spent 1.58s making 67 calls to Cache::Memcached::__ANON__[Cache/Memcached.pm:741], avg 23.5ms/call
804 }
805 }
806 }
807
808 # if there're active sockets left, they need to die
809 foreach (values %writing) {
810 $dead->($_);
811 }
812 foreach (values %reading) {
813 $dead->($_);
814 }
815
816 return;
817}
818
819sub _hashfunc {
820 return (crc32($_[0]) >> 16) & 0x7fff;
821}
822
823sub flush_all {
824 my Cache::Memcached $self = shift;
825
826 my $success = 1;
827
828 my @hosts = @{$self->{'buckets'}};
829 foreach my $host (@hosts) {
830 my $sock = $self->sock_to_host($host);
831 my @res = $self->run_command($sock, "flush_all\r\n");
832 $success = 0 unless (scalar @res == 1 && (($res[0] || "") eq "OK\r\n"));
833 }
834
835 return $success;
836}
837
838# returns array of lines, or () on failure.
839sub run_command {
840 my Cache::Memcached $self = shift;
841 my ($sock, $cmd) = @_;
842 return () unless $sock;
843 my $ret;
844 my $line = $cmd;
845 while (my $res = _write_and_read($self, $sock, $line)) {
846 undef $line;
847 $ret .= $res;
848 last if $ret =~ /(?:OK|END|ERROR)\r\n$/;
849 }
850 chop $ret; chop $ret;
851 return map { "$_\r\n" } split(/\r\n/, $ret);
852}
853
854sub stats {
855 my Cache::Memcached $self = shift;
856 my ($types) = @_;
857 return 0 unless $self->{'active'};
858 return 0 unless !ref($types) || ref($types) eq 'ARRAY';
859 if (!ref($types)) {
860 if (!$types) {
861 # I don't much care what the default is, it should just
862 # be something reasonable. Obviously "reset" should not
863 # be on the list :) but other types that might go in here
864 # include maps, cachedump, slabs, or items. Note that
865 # this does NOT include 'sizes' anymore, as that can freeze
866 # bug servers for a couple seconds.
867 $types = [ qw( misc malloc self ) ];
868 } else {
869 $types = [ $types ];
870 }
871 }
872
873 my $stats_hr = { };
874
875 # The "self" stat type is special, it only applies to this very
876 # object.
877 if (grep /^self$/, @$types) {
878 $stats_hr->{'self'} = \%{ $self->{'stats'} };
879 }
880
881 my %misc_keys = map { $_ => 1 }
882 qw/ bytes bytes_read bytes_written
883 cmd_get cmd_set connection_structures curr_items
884 get_hits get_misses
885 total_connections total_items
886 /;
887
888 # Now handle the other types, passing each type to each host server.
889 my @hosts = @{$self->{'buckets'}};
890 HOST: foreach my $host (@hosts) {
891 my $sock = $self->sock_to_host($host);
892 next HOST unless $sock;
893 TYPE: foreach my $typename (grep !/^self$/, @$types) {
894 my $type = $typename eq 'misc' ? "" : " $typename";
895 my $lines = _write_and_read($self, $sock, "stats$type\r\n", sub {
896 my $bref = shift;
897 return $$bref =~ /^(?:END|ERROR)\r?\n/m;
898 });
899 unless ($lines) {
900 $self->_dead_sock($sock);
901 next HOST;
902 }
903
904 $lines =~ s/\0//g; # 'stats sizes' starts with NULL?
905
906 # And, most lines end in \r\n but 'stats maps' (as of
907 # July 2003 at least) ends in \n. ??
908 my @lines = split(/\r?\n/, $lines);
909
910 # Some stats are key-value, some are not. malloc,
911 # sizes, and the empty string are key-value.
912 # ("self" was handled separately above.)
913 if ($typename =~ /^(malloc|sizes|misc)$/) {
914 # This stat is key-value.
915 foreach my $line (@lines) {
916 my ($key, $value) = $line =~ /^(?:STAT )?(\w+)\s(.*)/;
917 if ($key) {
918 $stats_hr->{'hosts'}{$host}{$typename}{$key} = $value;
919 }
920 $stats_hr->{'total'}{$key} += $value
921 if $typename eq 'misc' && $key && $misc_keys{$key};
922 $stats_hr->{'total'}{"malloc_$key"} += $value
923 if $typename eq 'malloc' && $key;
924 }
925 } else {
926 # This stat is not key-value so just pull it
927 # all out in one blob.
928 $lines =~ s/^END\r?\n//m;
929 $stats_hr->{'hosts'}{$host}{$typename} ||= "";
930 $stats_hr->{'hosts'}{$host}{$typename} .= "$lines";
931 }
932 }
933 }
934
935 return $stats_hr;
936}
937
938sub stats_reset {
939 my Cache::Memcached $self = shift;
940 my ($types) = @_;
941 return 0 unless $self->{'active'};
942
943 HOST: foreach my $host (@{$self->{'buckets'}}) {
944 my $sock = $self->sock_to_host($host);
945 next HOST unless $sock;
946 my $ok = _write_and_read($self, $sock, "stats reset");
947 unless (defined $ok && $ok eq "RESET\r\n") {
948 $self->_dead_sock($sock);
949 }
950 }
951 return 1;
952}
953
954116µs1;
955__END__
 
# spent 95µs within Cache::Memcached::CORE:connect which was called 2 times, avg 48µs/call: # once (92µs+0s) by Cache::Memcached::_connect_sock at line 207 # once (3µs+0s) by Cache::Memcached::_connect_sock at line 215
sub Cache::Memcached::CORE:connect; # opcode
# spent 247µs within Cache::Memcached::CORE:gpbyname which was called: # once (247µs+0s) by Cache::Memcached::sock_to_host at line 248
sub Cache::Memcached::CORE:gpbyname; # opcode
# spent 9µs within Cache::Memcached::CORE:match which was called: # once (9µs+0s) by Cache::Memcached::sock_to_host at line 237
sub Cache::Memcached::CORE:match; # opcode
# spent 7µs within Cache::Memcached::CORE:select which was called 2 times, avg 3µs/call: # once (4µs+0s) by Cache::Memcached::sock_to_host at line 311 # once (2µs+0s) by Cache::Memcached::sock_to_host at line 313
sub Cache::Memcached::CORE:select; # opcode
# spent 5.40ms within Cache::Memcached::CORE:send which was called 58 times, avg 93µs/call: # 57 times (5.27ms+0s) by Cache::Memcached::__ANON__[/usr/share/perl5/Cache/Memcached.pm:767] at line 748, avg 92µs/call # once (132µs+0s) by Cache::Memcached::_write_and_read at line 400
sub Cache::Memcached::CORE:send; # opcode
# spent 48µs within Cache::Memcached::CORE:socket which was called: # once (48µs+0s) by Cache::Memcached::sock_to_host at line 286
sub Cache::Memcached::CORE:socket; # opcode
# spent 3.83ms within Cache::Memcached::CORE:sselect which was called 127 times, avg 30µs/call: # 124 times (3.80ms+0s) by Cache::Memcached::_load_multi at line 788, avg 31µs/call # 2 times (12µs+0s) by Cache::Memcached::_write_and_read at line 395, avg 6µs/call # once (14µs+0s) by Cache::Memcached::_connect_sock at line 214
sub Cache::Memcached::CORE:sselect; # opcode
# spent 2µs within Cache::Memcached::CORE:subst which was called: # once (2µs+0s) by Cache::Memcached::sock_to_host at line 239
sub Cache::Memcached::CORE:subst; # opcode
# spent 10µs within Cache::Memcached::CORE:sysread which was called: # once (10µs+0s) by Cache::Memcached::_write_and_read at line 415
sub Cache::Memcached::CORE:sysread; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.