[PATCH 3/3] Cache::Memcached: add support of noreply for delete, incr, decr.

[Tomash Brechko]

Note that run_command() generic interface is broken.  You can't use
it with noreply (and actually with many blocking commands either).

There's no 'verbosity' Perl binding, and 'flush_all' is implemented via
run_command(), so I haven't add the support of noreply for them.
---
 trunk/api/perl/lib/Cache/Memcached.pm |   23 +++++++++++++++++------
 trunk/api/perl/t/04_noreply.t         |   17 +++++++++++++++--
 2 files changed, 32 insertions(+), 8 deletions(-)

diff --git a/trunk/api/perl/lib/Cache/Memcached.pm b/trunk/api/perl/lib/Cache/Memcached.pm
index 14f7a51..757575b 100644
--- a/trunk/api/perl/lib/Cache/Memcached.pm
+++ b/trunk/api/perl/lib/Cache/Memcached.pm
@@ -410,18 +410,22 @@ sub delete {
     my $sock = $self->get_sock($key);
     return 0 unless $sock;
 
+    my @params;
+    my $noreply = not defined wantarray;
+    push @params, "noreply" if $noreply;
+
     $self->{'stats'}->{"delete"}++;
     $key = ref $key ? $key->[1] : $key;
     $time = $time ? " $time" : "";
-    my $cmd = "delete $self->{namespace}$key$time\r\n";
-    my $res = _write_and_read($self, $sock, $cmd);
+    my $cmd = "delete $self->{namespace}$key$time @params\r\n";
+    my $res = _write_and_read($self, $sock, $cmd, undef, $noreply);
 
     if ($self->{'stat_callback'}) {
         my $etime = Time::HiRes::time();
         $self->{'stat_callback'}->($stime, $etime, $sock, 'delete');
     }
 
-    return $res eq "DELETED\r\n";
+    return $res eq "DELETED\r\n" unless $noreply;
 }
 *remove = \&delete;
 
@@ -518,15 +522,19 @@ sub _incrdecr {
     $self->{'stats'}->{$cmdname}++;
     $value = 1 unless defined $value;
 
-    my $line = "$cmdname $self->{namespace}$key $value\r\n";
-    my $res = _write_and_read($self, $sock, $line);
+    my @params;
+    my $noreply = not defined wantarray;
+    push @params, "noreply" if $noreply;
+
+    my $line = "$cmdname $self->{namespace}$key $value @params\r\n";
+    my $res = _write_and_read($self, $sock, $line, undef, $noreply);
 
     if ($self->{'stat_callback'}) {
         my $etime = Time::HiRes::time();
         $self->{'stat_callback'}->($stime, $etime, $sock, $cmdname);
     }
 
-    return undef unless $res =~ /^(\d+)/;
+    return undef if $noreply or $res !~ /^(\d+)/;
     return $1;
 }
 
@@ -794,6 +802,7 @@ sub flush_all {
 }
 
 # returns array of lines, or () on failure.
+# FIXME: current implementation is broken.
 sub run_command {
     my Cache::Memcached $self = shift;
     my ($sock, $cmd) = @_;
@@ -801,8 +810,10 @@ sub run_command {
     my $ret;
     my $line = $cmd;
     while (my $res = _write_and_read($self, $sock, $line)) {
+        # FIXME: _write_and_read() won't handle undefined $line.
         undef $line;
         $ret .= $res;
+        # FIXME: end condition is not correct.
         last if $ret =~ /(?:OK|END|ERROR)\r\n$/;
     }
     chop $ret; chop $ret;
diff --git a/trunk/api/perl/t/04_noreply.t b/trunk/api/perl/t/04_noreply.t
index 5220c60..26ff120 100644
--- a/trunk/api/perl/t/04_noreply.t
+++ b/trunk/api/perl/t/04_noreply.t
@@ -9,7 +9,7 @@ my $testaddr = "127.0.0.1:11211";
 my $msock = IO::Socket::INET->new(PeerAddr => $testaddr,
                                   Timeout  => 3);
 if ($msock) {
-    plan tests => 4;
+    plan tests => 7;
 } else {
     plan skip_all => "No memcached instance running at $testaddr\n";
     exit 0;
@@ -23,7 +23,7 @@ my $memd = Cache::Memcached->new({
 isa_ok($memd, 'Cache::Memcached');
 
 
-use constant count => 100;
+use constant count => 30;
 
 $memd->add("key", "add");
 is($memd->get("key"), "add");
@@ -35,3 +35,16 @@ is($memd->get("key"), count - 1);
 
 $memd->replace("key", count);
 is($memd->get("key"), count);
+
+for (my $i = 0; $i < count; ++$i) {
+    $memd->incr("key", 2);
+}
+is($memd->get("key"), count + 2 * count);
+
+for (my $i = 0; $i < count; ++$i) {
+    $memd->decr("key", 1);
+}
+is($memd->get("key"), count + 1 * count);
+
+$memd->delete("key");
+is($memd->get("key"), undef);
-- 
1.5.3.5.529.ge3d6d