Profile: /usr/local/share/perl/5.8.8/Cache/Memcached/GetParser.pm

File	/usr/local/share/perl/5.8.8/Cache/Memcached/GetParser.pm
Statements Executed	60
Total Time	0.000254 seconds

Subroutines — ordered by inclusive time then name
Calls	Inclusive Time	Subroutine
2	0.00089	Cache::Memcached::GetParser::	parse_from_sock
2	0.00079	Cache::Memcached::GetParser::	parse_buffer
2	0.00004	Cache::Memcached::GetParser::	new
0	0	Cache::Memcached::GetParser::	BEGIN
0	0	Cache::Memcached::GetParser::	current_key

Line	Stmts.	Exclusive Time	Avg.	Code
1				package Cache::Memcached::GetParser;
2				use strict;
3				use warnings;
4				use integer;
5
6				use Errno qw( EINPROGRESS EWOULDBLOCK EISCONN );
7
8				use constant DEST => 0; # destination hashref we're writing into
9				use constant NSLEN => 1; # length of namespace to ignore on keys
10				use constant ON_ITEM => 2;
11				use constant BUF => 3; # read buffer
12				use constant STATE => 4; # 0 = waiting for a line, N = reading N bytes
13				use constant OFFSET => 5; # offsets to read into buffers
14				use constant FLAGS => 6;
15				use constant KEY => 7; # current key we're parsing (without the namespace prefix)
16
17				# spent 0.00004s within Cache::Memcached::GetParser::new which was called 2 times, avg 0.00002s/call: # 2 times (0.00004s) by Cache::Memcached::_load_multi at line 681 of /usr/local/share/perl/5.8.8/Cache/Memcached.pm, avg 0.00002s/call sub new {
18	4	0.00003	7e-06	my ($class, $dest, $nslen, $on_item) = @_;
19				return bless [$dest, $nslen, $on_item, '', 0, 0], $class;
20				}
21
22				sub current_key {
23				return $_[0][KEY];
24				}
25
26				# returns 1 on success, -1 on failure, and 0 if still working.
27				# spent 0.00089s within Cache::Memcached::GetParser::parse_from_sock which was called 2 times, avg 0.00044s/call: # 2 times (0.00089s) by Cache::Memcached::_load_multi or Cache::Memcached::__ANON__[/usr/local/share/perl/5.8.8/Cache/Memcached.pm:695] at line 687 of /usr/local/share/perl/5.8.8/Cache/Memcached.pm, avg 0.00044s/call sub parse_from_sock {
28	16	0.00007	5e-06	my ($self, $sock) = @_;
29				my $res;
30
31				# where are we reading into?
32				if ($self->[STATE]) { # reading value into $ret
33				my $ret = $self->[DEST];
34				$res = sysread($sock, $ret->{$self->[KEY]},
35				$self->[STATE] - $self->[OFFSET],
36				$self->[OFFSET]);
37
38				return 0
39				if !defined($res) and $!==EWOULDBLOCK;
40
41				if ($res == 0) { # catches 0=conn closed or undef=error
42				$self->[ON_ITEM] = undef;
43				return -1;
44				}
45
46				$self->[OFFSET] += $res;
47				if ($self->[OFFSET] == $self->[STATE]) { # finished reading
48				$self->[ON_ITEM]->($self->[KEY], $self->[FLAGS]);
49				$self->[OFFSET] = 0;
50				$self->[STATE] = 0;
51				# wait for another VALUE line or END...
52				}
53				return 0; # still working, haven't got to end yet
54				}
55
56				# we're reading a single line.
57				# first, read whatever's there, but be satisfied with 2048 bytes
58				$res = sysread($sock, $self->[BUF],
59				128*1024, $self->[OFFSET]);
60				return 0
61				if !defined($res) and $!==EWOULDBLOCK;
62				if ($res == 0) {
63				$self->[ON_ITEM] = undef;
64				return -1;
65				}
66
67				$self->[OFFSET] += $res;
68
69				return $self->parse_buffer; # spent 0.00079s making 2 calls to Cache::Memcached::GetParser::parse_buffer, avg 0.00040s/call
70				}
71
72				# returns 1 on success, -1 on failure, and 0 if still working.
73				# spent 0.00079s within Cache::Memcached::GetParser::parse_buffer which was called 2 times, avg 0.00040s/call: # 2 times (0.00079s) by Cache::Memcached::GetParser::parse_from_sock at line 69 of /usr/local/share/perl/5.8.8/Cache/Memcached/GetParser.pm, avg 0.00040s/call sub parse_buffer {
74	40	0.00015	4e-06	my ($self) = @_;
75				my $ret = $self->[DEST];
76
77				SEARCH:
78				while (1) { # may have to search many times
79
80				# do we have a complete END line?
81				if ($self->[BUF] =~ /^END\r\n/) {
82				$self->[ON_ITEM] = undef;
83				return 1; # we're done successfully, return 1 to finish
84				}
85
86				# do we have a complete VALUE line?
87				if ($self->[BUF] =~ /^VALUE (\S+) (\d+) (\d+)\r\n/) {
88				($self->[KEY], $self->[FLAGS], $self->[STATE]) =
89				(substr($1, $self->[NSLEN]), int($2), $3+2);
90				# Note: we use $+[0] and not pos($self->[BUF]) because pos()
91				# seems to have problems under perl's taint mode. nobody
92				# on the list discovered why, but this seems a reasonable
93				# work-around:
94				my $p = $+[0];
95				my $len = length($self->[BUF]);
96				my $copy = $len-$p > $self->[STATE] ? $self->[STATE] : $len-$p;
97				$ret->{$self->[KEY]} = substr($self->[BUF], $p, $copy)
98				if $copy;
99				$self->[OFFSET] = $copy;
100				substr($self->[BUF], 0, $p+$copy, ''); # delete the stuff we used
101
102				if ($self->[OFFSET] == $self->[STATE]) { # have it all?
103				$self->[ON_ITEM]->($self->[KEY], $self->[FLAGS]); # spent 0.00061s making 2 calls to Cache::Memcached::__ANON__[/usr/local/share/perl/5.8.8/Cache/Memcached.pm:668], avg 0.00030s/call
104				$self->[OFFSET] = 0;
105				$self->[STATE] = 0;
106				next SEARCH; # look again
107				}
108
109				last SEARCH; # buffer is empty now
110				}
111
112				# if we're here probably means we only have a partial VALUE
113				# or END line in the buffer. Could happen with multi-get,
114				# though probably very rarely. Exit the loop and let it read
115				# more.
116
117				# but first, make sure subsequent reads don't destroy our
118				# partial VALUE/END line.
119				$self->[OFFSET] = length($self->[BUF]);
120				last SEARCH;
121				}
122				return 0;
123				}
124
125				1;