|
0
|
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 sub new {
|
|
|
18 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 sub parse_from_sock {
|
|
|
28 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;
|
|
|
70 }
|
|
|
71
|
|
|
72 # returns 1 on success, -1 on failure, and 0 if still working.
|
|
|
73 sub parse_buffer {
|
|
|
74 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]);
|
|
|
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;
|
