diff 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
line wrap: on
line diff
new file mode 100644
--- /dev/null
+++ b/lib/Cache/Memcached/GetParser.pm
@@ -0,0 +1,125 @@
+package Cache::Memcached::GetParser;
+use strict;
+use warnings;
+use integer;
+
+use Errno qw( EINPROGRESS EWOULDBLOCK EISCONN );
+
+use constant DEST    => 0;  # destination hashref we're writing into
+use constant NSLEN   => 1;  # length of namespace to ignore on keys
+use constant ON_ITEM => 2;
+use constant BUF     => 3;  # read buffer
+use constant STATE   => 4;  # 0 = waiting for a line, N = reading N bytes
+use constant OFFSET  => 5;  # offsets to read into buffers
+use constant FLAGS   => 6;
+use constant KEY     => 7;  # current key we're parsing (without the namespace prefix)
+
+sub new {
+    my ($class, $dest, $nslen, $on_item) = @_;
+    return bless [$dest, $nslen, $on_item, '', 0, 0], $class;
+}
+
+sub current_key {
+    return $_[0][KEY];
+}
+
+# returns 1 on success, -1 on failure, and 0 if still working.
+sub parse_from_sock {
+    my ($self, $sock) = @_;
+    my $res;
+
+    # where are we reading into?
+    if ($self->[STATE]) { # reading value into $ret
+        my $ret = $self->[DEST];
+        $res = sysread($sock, $ret->{$self->[KEY]},
+                       $self->[STATE] - $self->[OFFSET],
+                       $self->[OFFSET]);
+
+        return 0
+            if !defined($res) and $!==EWOULDBLOCK;
+
+        if ($res == 0) { # catches 0=conn closed or undef=error
+            $self->[ON_ITEM] = undef;
+            return -1;
+        }
+
+        $self->[OFFSET] += $res;
+        if ($self->[OFFSET] == $self->[STATE]) { # finished reading
+            $self->[ON_ITEM]->($self->[KEY], $self->[FLAGS]);
+            $self->[OFFSET] = 0;
+            $self->[STATE]  = 0;
+            # wait for another VALUE line or END...
+        }
+        return 0; # still working, haven't got to end yet
+    }
+
+    # we're reading a single line.
+    # first, read whatever's there, but be satisfied with 2048 bytes
+    $res = sysread($sock, $self->[BUF],
+                   128*1024, $self->[OFFSET]);
+    return 0
+        if !defined($res) and $!==EWOULDBLOCK;
+    if ($res == 0) {
+        $self->[ON_ITEM] = undef;
+        return -1;
+    }
+
+    $self->[OFFSET] += $res;
+
+    return $self->parse_buffer;
+}
+
+# returns 1 on success, -1 on failure, and 0 if still working.
+sub parse_buffer {
+    my ($self) = @_;
+    my $ret = $self->[DEST];
+
+  SEARCH:
+    while (1) { # may have to search many times
+
+        # do we have a complete END line?
+        if ($self->[BUF] =~ /^END\r\n/) {
+            $self->[ON_ITEM] = undef;
+            return 1;  # we're done successfully, return 1 to finish
+        }
+
+        # do we have a complete VALUE line?
+        if ($self->[BUF] =~ /^VALUE (\S+) (\d+) (\d+)\r\n/) {
+            ($self->[KEY], $self->[FLAGS], $self->[STATE]) =
+                (substr($1, $self->[NSLEN]), int($2), $3+2);
+            # Note: we use $+[0] and not pos($self->[BUF]) because pos()
+            # seems to have problems under perl's taint mode.  nobody
+            # on the list discovered why, but this seems a reasonable
+            # work-around:
+            my $p = $+[0];
+            my $len = length($self->[BUF]);
+            my $copy = $len-$p > $self->[STATE] ? $self->[STATE] : $len-$p;
+            $ret->{$self->[KEY]} = substr($self->[BUF], $p, $copy)
+                if $copy;
+            $self->[OFFSET] = $copy;
+            substr($self->[BUF], 0, $p+$copy, ''); # delete the stuff we used
+
+            if ($self->[OFFSET] == $self->[STATE]) { # have it all?
+                $self->[ON_ITEM]->($self->[KEY], $self->[FLAGS]);
+                $self->[OFFSET] = 0;
+                $self->[STATE]  = 0;
+                next SEARCH; # look again
+            }
+
+            last SEARCH; # buffer is empty now
+        }
+
+        # if we're here probably means we only have a partial VALUE
+        # or END line in the buffer. Could happen with multi-get,
+        # though probably very rarely. Exit the loop and let it read
+        # more.
+
+        # but first, make sure subsequent reads don't destroy our
+        # partial VALUE/END line.
+        $self->[OFFSET] = length($self->[BUF]);
+        last SEARCH;
+    }
+    return 0;
+}
+
+1;