[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