[PATCH 6/6] Cache::Memcached: use 'noreply' option in void context.

Tomash Brechko tomash.brechko at gmail.com
Thu Nov 8 14:56:49 UTC 2007


For Cache::Memcached::add(), Cache::Memcached::set() and
Cache::Memcached::replace() set 'noreply' option if the method was
called in a void context.
---
 trunk/api/perl/lib/Cache/Memcached.pm |   14 ++++++++----
 trunk/api/perl/t/04_noreply.t         |   37 +++++++++++++++++++++++++++++++++
 2 files changed, 46 insertions(+), 5 deletions(-)
 create mode 100644 trunk/api/perl/t/04_noreply.t

diff --git a/trunk/api/perl/lib/Cache/Memcached.pm b/trunk/api/perl/lib/Cache/Memcached.pm
index cdfc983..14f7a51 100644
--- a/trunk/api/perl/lib/Cache/Memcached.pm
+++ b/trunk/api/perl/lib/Cache/Memcached.pm
@@ -335,7 +335,7 @@ sub disconnect_all {
 # which gets passed a scalarref of buffer read thus far.
 sub _write_and_read {
     my Cache::Memcached $self = shift;
-    my ($sock, $line, $check_complete) = @_;
+    my ($sock, $line, $check_complete, $noreply) = @_;
     my $res;
     my ($ret, $offset) = (undef, 0);
 
@@ -375,7 +375,7 @@ sub _write_and_read {
                 return undef;
             }
             if ($res == length($line)) { # all sent
-                $state = 1;
+                $state = $noreply ? 2 : 1;
             } else { # we only succeeded in sending some of it
                 substr($line, 0, $res, ''); # delete the part we sent
             }
@@ -446,6 +446,10 @@ sub _set {
     my $sock = $self->get_sock($key);
     return 0 unless $sock;
 
+    my @params;
+    my $noreply = not defined wantarray;
+    push @params, "noreply" if $noreply;
+
     use bytes; # return bytes from length()
 
     $self->{'stats'}->{$cmdname}++;
@@ -477,9 +481,9 @@ sub _set {
     $exptime = int($exptime || 0);
 
     local $SIG{'PIPE'} = "IGNORE" unless $FLAG_NOSIGNAL;
-    my $line = "$cmdname $self->{namespace}$key $flags $exptime $len\r\n$val\r\n";
+    my $line = "$cmdname $self->{namespace}$key $flags $exptime $len @params\r\n$val\r\n";
 
-    my $res = _write_and_read($self, $sock, $line);
+    my $res = _write_and_read($self, $sock, $line, undef, $noreply);
 
     if ($self->{'debug'} && $line) {
         chop $line; chop $line;
@@ -491,7 +495,7 @@ sub _set {
         $self->{'stat_callback'}->($stime, $etime, $sock, $cmdname);
     }
 
-    return $res eq "STORED\r\n";
+    return $res eq "STORED\r\n" unless $noreply;
 }
 
 sub incr {
diff --git a/trunk/api/perl/t/04_noreply.t b/trunk/api/perl/t/04_noreply.t
new file mode 100644
index 0000000..5220c60
--- /dev/null
+++ b/trunk/api/perl/t/04_noreply.t
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl -w
+
+use strict;
+use Test::More;
+use Cache::Memcached;
+use IO::Socket::INET;
+
+my $testaddr = "127.0.0.1:11211";
+my $msock = IO::Socket::INET->new(PeerAddr => $testaddr,
+                                  Timeout  => 3);
+if ($msock) {
+    plan tests => 4;
+} else {
+    plan skip_all => "No memcached instance running at $testaddr\n";
+    exit 0;
+}
+
+my $memd = Cache::Memcached->new({
+    servers   => [ $testaddr ],
+    namespace => "Cache::Memcached::t/$$/" . (time() % 100) . "/",
+});
+
+isa_ok($memd, 'Cache::Memcached');
+
+
+use constant count => 100;
+
+$memd->add("key", "add");
+is($memd->get("key"), "add");
+
+for (my $i = 0; $i < count; ++$i) {
+    $memd->set("key", $i);
+}
+is($memd->get("key"), count - 1);
+
+$memd->replace("key", count);
+is($memd->get("key"), count);
-- 
1.5.3.5.529.ge3d6d


More information about the memcached mailing list