Mercurial > hg > Cache-Memcached

comparison lib/Cache/Memcached/GetParser.pm @ 0:17fc6afc155e CACHE_MEMCACHED_1_24

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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;