Mercurial > hg > Cache-Memcached
comparison lib/Cache/Memcached/GetParser.pm @ 0:17fc6afc155e CACHE_MEMCACHED_1_24
Cache::Memcached 1.24
author | Maxim Dounin <mdounin@mdounin.ru> |
---|---|
date | Sun, 30 Sep 2007 16:23:31 +0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:17fc6afc155e |
---|---|
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; |