0
@@ -7,84 +7,73 @@ use FindBin qw($Bin);
0
my $server = new_memcached();
0
ok($server, "started the server");
0
-# Based almost 100% off testClient.py which is Copyright (c) 2007 Dustin Sallings <dustin@spy.net>
0
+# Based almost 100% off testClient.py which is:
0
+# Copyright (c) 2007 Dustin Sallings <dustin@spy.net>
0
-use constant CMD_GET => 0;
0
-use constant CMD_SET => 1;
0
-use constant CMD_ADD => 2;
0
-use constant CMD_REPLACE => 3;
0
-use constant CMD_DELETE => 4;
0
-use constant CMD_INCR => 5;
0
-use constant CMD_DECR => 6;
0
-use constant CMD_QUIT => 7;
0
-use constant CMD_FLUSH => 8;
0
-use constant CMD_GETQ => 9;
0
-use constant CMD_NOOP => 10;
0
-use constant CMD_VERSION => 11;
0
-# CAS, Flags, expiration
0
-use constant SET_PKT_FMT => "NNNN";
0
-# Flags, expiration, id
0
-use constant CAS_PKT_FMT => "NNNN";
0
-# How long until the deletion takes effect.
0
-use constant DEL_PKT_FMT => "N";
0
-# amount, initial value, expiration
0
+use constant CMD_GET => 0x00;
0
+use constant CMD_SET => 0x01;
0
+use constant CMD_ADD => 0x02;
0
+use constant CMD_REPLACE => 0x03;
0
+use constant CMD_DELETE => 0x04;
0
+use constant CMD_INCR => 0x05;
0
+use constant CMD_DECR => 0x06;
0
+use constant CMD_QUIT => 0x07;
0
+use constant CMD_FLUSH => 0x08;
0
+use constant CMD_GETQ => 0x09;
0
+use constant CMD_NOOP => 0x0A;
0
+use constant CMD_VERSION => 0x0B;
0
+use constant CMD_GETK => 0x0C;
0
+use constant CMD_GETKQ => 0x0D;
0
+use constant CMD_APPEND => 0x0E;
0
+use constant CMD_PREPEND => 0x0F;
0
+# REQ and RES formats are divided even though they currently share
0
+# the same format, since they _could_ differ in the future.
0
+use constant REQ_PKT_FMT => "CCnCCnNNNN";
0
+use constant RES_PKT_FMT => "CCnCCnNNNN";
0
use constant INCRDECR_PKT_FMT => "NNNNN";
0
-use constant REQ_MAGIC_BYTE => 0x80;
0
-use constant RES_MAGIC_BYTE => 0x81;
0
-use constant PKT_FMT => "CCnCxxxNN";
0
-use constant MIN_RECV_PACKET => length(pack(PKT_FMT));
0
+use constant MIN_RECV_BYTES => length(pack(RES_PKT_FMT));
0
+use constant REQ_MAGIC => 0x80;
0
+use constant RES_MAGIC => 0x81;
0
my $mc = MC::Client->new;
0
- my ($key, $orig_flags, $orig_value) = @_;
0
- my ($flags, $value) = $mc->get($key);
0
- is($flags, $orig_flags, "Flags is set properly");
0
- is($value, $orig_value, "Value is set properly");
0
+ my ($key, $orig_flags, $orig_val) = @_;
0
+ my ($flags, $val, $cas) = $mc->get($key);
0
+ is($flags, $orig_flags, "Flags is set properly");
0
- my ($key, $exp, $orig_flags, $orig_value) = @_;
0
- $mc->set($key, $exp, $orig_flags, $orig_value);
0
- $check->($key, $orig_flags, $orig_value);
0
+ my ($key, $exp, $orig_flags, $orig_value) = @_;
0
+ $mc->set($key, $orig_value, $orig_flags, $exp);
0
+ $check->($key, $orig_flags, $orig_value);
0
- my $rv =()= eval { $mc->get($key) };
0
- is($rv, 0, "Didn't get a result from get");
0
- ok($@->not_found, "We got a not found error when we expected one");
0
+ my $rv =()= eval { $mc->get($key) };
0
+ is($rv, 0, "Didn't get a result from get");
0
+ ok($@->not_found, "We got a not found error when we expected one");
0
- my ($key, $when) = @_;
0
- $mc->delete($key, $when);
0
+ my ($key, $when) = @_;
0
+ $mc->delete($key, $when);
0
+ok(defined $v && length($v), "Proper version: $v");
0
- ok(defined $v && length($v), "Proper version: $v");
0
@@ -102,58 +91,43 @@ $empty->('x');
0
- diag "Reservation delete";
0
- $set->('y', 5, 19, "someothervalue");
0
- my $rv =()= eval { $mc->add('y', 5, 19, "yetanothervalue") };
0
- is($rv, 0, "Add didn't return anything");
0
- ok($@->exists, "We got an exists error like we expected");
0
- $mc->add('y', 5, 19, "wibblevalue");
0
+ $mc->add('i', 'ex', 5, 10);
0
+ $check->('i', 5, "ex");
0
+ my $rv =()= eval { $mc->add('i', "ex2", 10, 5) };
0
+ is($rv, 0, "Add didn't return anything");
0
+ ok($@->exists, "Expected exists error received");
0
+ $check->('i', 5, "ex");
0
- $mc->add('i', 5, 19, "ex");
0
- $check->('i', 19, "ex");
0
- my $rv =()= eval { $mc->add('i', 5, 19, "ex2") };
0
- is($rv, 0, "Add didn't return anything");
0
- ok($@->exists, "Expected exists error received");
0
- $check->('i', 19, "ex");
0
+ my $rv =()= eval { $mc->replace('j', "ex", 19, 5) };
0
+ is($rv, 0, "Replace didn't return anything");
0
+ ok($@->not_found, "Expected not_found error received");
0
+ $mc->add('j', "ex2", 14, 5);
0
+ $check->('j', 14, "ex2");
0
+ $mc->replace('j', "ex3", 24, 5);
0
+ $check->('j', 24, "ex3");
0
- my $rv =()= eval { $mc->replace('j', 5, 19, "ex") };
0
- is($rv, 0, "Replace didn't return anything");
0
- ok($@->not_found, "Expected not_found error received");
0
- $mc->add('j', 5, 14, "ex2");
0
- $check->('j', 14, "ex2");
0
- $mc->replace('j', 5, 24, "ex3");
0
- $check->('j', 24, "ex3");
0
- $mc->add('xx', 5, 1, "ex");
0
- $mc->add('wye', 5, 2, "why");
0
- my $rv = $mc->getMulti(qw(xx wye zed));
0
+ $mc->add('xx', "ex", 1, 5);
0
+ $mc->add('wye', "why", 2, 5);
0
+ my $rv = $mc->get_multi(qw(xx wye zed));
0
# CAS is returned with all gets.
0
- is_deeply($rv->{xx}, [1, 'ex', 0], "X is correct");
0
- is_deeply($rv->{wye}, [2, 'why', 0], "Y is correct");
0
- is(keys(%$rv), 2, "Got only two answers like we expect");
0
+ is_deeply($rv->{xx}, [1, 'ex', 0], "X is correct");
0
+ is_deeply($rv->{wye}, [2, 'why', 0], "Y is correct");
0
+ is(keys(%$rv), 2, "Got only two answers like we expect");
0
@@ -170,264 +144,247 @@ is($mc->decr("x"), 4, "Decrease by one");
0
is($mc->decr("x", 211), 0, "Floor is zero");
0
- my $rv =()= eval { $mc->set("x", 5, 19, "bad value", 0x7FFFFFFFFF) };
0
- is($rv, 0, "Empty return on expected failure");
0
- ok($@->not_found, "Error was 'not found' as expected");
0
+ my $rv =()= eval { $mc->set("x", "bad value", 19, 5, 0x7FFFFFFFFF) };
0
+ is($rv, 0, "Empty return on expected failure");
0
+ ok($@->not_found, "Error was 'not found' as expected");
0
-
$mc->add("x", 5, 19, "original value");
0
+
$mc->add("x", "original value", 5, 19);
0
- my ($flags, $val, $i) = $mc->get("x");
0
- is($val, "original value", "->gets returned proper value");
0
+ my ($flags, $val, $i) = $mc->get("x");
0
+ is($val, "original value", "->gets returned proper value");
0
- my $rv =()= eval { $mc->set("x", 5, 19, "broken value", $i+1) };
0
- is($rv, 0, "Empty return on expected failure (1)");
0
- ok($@->exists, "Expected error state of 'exists' (1)");
0
- $mc->set("x", 5, 19, "new value", $i);
0
+ my $rv =()= eval { $mc->set("x", "broken value", 19, 5, $i+1) };
0
+ is($rv, 0, "Empty return on expected failure (1)");
0
+ ok($@->exists, "Expected error state of 'exists' (1)");
0
- my ($newflags, $newval, $newi) = $mc->get("x");
0
- is($newval, "new value", "CAS properly overwrote value");
0
+ $mc->set("x", "new value", 19, 5, $i);
0
- my $rv =()= eval { $mc->set("x", 5, 19, "replay value", $i) };
0
- is($rv, 0, "Empty return on expected failure (2)");
0
- ok($@->exists, "Expected error state of 'exists' (2)");
0
+ my ($newflags, $newval, $newi) = $mc->get("x");
0
+ is($newval, "new value", "CAS properly overwrote value");
0
- (undef, my $newval2) = $mc->get("x");
0
- is($newval2, "new value", "CAS replay didn't overwrite value");
0
+ my $rv =()= eval { $mc->set("x", "replay value", 19, 5, $i) };
0
+ is($rv, 0, "Empty return on expected failure (2)");
0
+ ok($@->exists, "Expected error state of 'exists' (2)");
0
my $sock = $server->sock;
0
+ $self = fields::new($self);
0
+ $self->{socket} = $sock;
0
- $self = fields::new($self);
0
- $self->{socket} = $sock;
0
+ die "Not enough args to send_command" unless @_ >= 4;
0
+ my ($cmd, $key, $val, $opaque, $extra_header, $cas) = @_;
0
+ $extra_header = '' unless defined $extra_header;
0
+ my $keylen = length($key);
0
+ my $vallen = length($val);
0
+ my $extralen = length($extra_header);
0
+ my $datatype = 0; # field for future use
0
+ my $reserved = 0; # field for future use
0
+ my $totallen = $keylen + $vallen + $extralen;
0
+ $ident_hi = int($cas / 2 ** 32);
0
+ $ident_lo = int($cas % 2 ** 32);
0
+ my $msg = pack(::REQ_PKT_FMT, ::REQ_MAGIC, $cmd, $keylen, $extralen,
0
+ $datatype, $reserved, $totallen, $opaque, $ident_hi,
0
- return $self->{socket}->close(@_);
0
+ return $self->{socket}->send($msg . $extra_header . $key . $val);
0
- die "Not enough args to _sendCmd" unless @_ >= 4;
0
- my ($cmd, $key, $val, $opaque, $extraHeader) = @_;
0
+sub _handle_single_response {
0
- $extraHeader = '' unless defined $extraHeader;
0
+ $self->{socket}->recv(my $response, ::MIN_RECV_BYTES);
0
+ Test::More::is(length($response), ::MIN_RECV_BYTES, "Expected read length");
0
- my $keylen = length($key);
0
- my $vallen = length($val);
0
- my $extralen = length($extraHeader);
0
+ my ($magic, $cmd, $keylen, $extralen, $datatype, $status, $remaining,
0
+ $opaque, $ident_hi, $ident_lo) = unpack(::RES_PKT_FMT, $response);
0
+ Test::More::is($magic, ::RES_MAGIC, "Got proper response magic");
0
- my $msg = pack(::PKT_FMT, ::REQ_MAGIC_BYTE, $cmd, $keylen, $extralen,
0
- $keylen + $vallen + $extralen, $opaque);
0
- return $self->{socket}->send($msg . $extraHeader . $key . $val);
0
+ return ($opaque, '') if($remaining == 0);
0
-sub _handleSingleResponse {
0
+ $self->{socket}->recv(my $rv, $remaining);
0
- $self->{socket}->recv(my $response, ::MIN_RECV_PACKET);
0
+ if (defined $myopaque) {
0
+ Test::More::is($opaque, $myopaque, "Expected opaque");
0
+ Test::More::pass("Implicit pass since myopaque is undefined");
0
-
Test::More::is(length($response), ::MIN_RECV_PACKET, "Expected read length");
0
+
my $cas = ($ident_hi * 2 ** 32) + $ident_lo;
0
- my ($magic, $cmd, $errcode, $extralen, $remaining,
0
- $opaque) = unpack(::PKT_FMT, $response);
0
+ die MC::Error->new($status, $rv);
0
- Test::More::is($magic, ::RES_MAGIC_BYTE, "Got proper magic");
0
+ return ($opaque, $rv, $cas);
0
+ my ($cmd, $key, $val, $extra_header, $cas) = @_;
0
- $self->{socket}->recv(my $rv, $remaining);
0
+ $extra_header = '' unless defined $extra_header;
0
+ my $opaque = int(rand(2**32));
0
+ $self->send_command($cmd, $key, $val, $opaque, $extra_header, $cas);
0
+ (undef, my $rv, my $rcas) = $self->_handle_single_response($opaque);
0
- if (defined $myopaque) {
0
- Test::More::is($opaque, $myopaque, "Expected opaque");
0
- Test::More::pass("Implicit pass since myopaque is undefined");
0
+ my ($cmd, $key, $amt, $init, $exp) = @_;
0
- die MC::Error->new($errcode, $rv);
0
+ my $amt_hi = int($amt / 2 ** 32);
0
+ my $amt_lo = int($amt % 2 ** 32);
0
- return ($opaque, $rv);
0
+ my $init_hi = int($init / 2 ** 32);
0
+ my $init_lo = int($init % 2 ** 32);
0
- my ($cmd, $key, $val, $extraHeader) = @_;
0
+ my $extra_header = pack(::INCRDECR_PKT_FMT, $amt_hi, $amt_lo, $init_hi,
0
-
$extraHeader = '' unless defined $extraHeader;
0
+
my ($data, undef) = $self->_do_command($cmd, $key, '', $extra_header);
0
- my $opaque = int(rand(2**32));
0
+ my $header = substr $data, 0, 8, '';
0
+ my ($resp_hi, $resp_lo) = unpack "NN", $header;
0
+ my $resp = ($resp_hi * 2 ** 32) + $resp_lo;
0
- $self->_sendCmd($cmd, $key, $val, $opaque, $extraHeader);
0
- (undef, my $rv) = $self->_handleSingleResponse($opaque);
0
- my $rv = shift; # currently contains 4 bytes of 'flag' followed by value
0
- my $header = substr $rv, 0, 12, '';
0
- my ($ident_hi, $ident_lo, $flags) = unpack "NNN", $header;
0
- my $ident = ($ident_hi * 2 ** 32) + $ident_lo;
0
+ my ($rv, $cas) = $self->_do_command(::CMD_GET, $key, '', '');
0
- return $flags, $rv, $ident;
0
+ my $header = substr $rv, 0, 4, '';
0
+ my $flags = unpack("N", $header);
0
- my $parts = $self->_doCmd(::CMD_GET, $key, '');
0
- return $self->__parseGet($parts);
0
+ return ($flags, $rv, $cas);
0
- my ($cmd, $key, $exp, $flags, $val, $ident) = @_;
0
- $ident_hi = int($ident / 2 ** 32);
0
- $ident_lo = int($ident % 2 ** 32);
0
+ for (my $i = 0; $i < @keys; $i++) {
0
+ $self->send_command(::CMD_GETQ, $keys[$i], '', $i, '', 0);
0
- return $self->_doCmd($cmd, $key, $val, pack(::SET_PKT_FMT, $ident_hi, $ident_lo, $flags, $exp));
0
- my ($key, $exp, $flags, $val, $ident) = @_;
0
- return $self->_mutate(::CMD_SET, $key, $exp, $flags, $val, $ident);
0
+ my $terminal = @keys + 10;
0
+ $self->send_command(::CMD_NOOP, '', '', $terminal);
0
- my ($cmd, $key, $amt, $init, $exp) = @_;
0
+ my ($opaque, $data) = $self->_handle_single_response;
0
+ last if $opaque == $terminal;
0
- my $amt_hi = int($amt / 2 ** 32);
0
- my $amt_lo = int($amt % 2 ** 32);
0
+ my $header = substr $data, 0, 4, '';
0
+ my $flags = unpack("N", $header);
0
- my $init_hi = int($init / 2 ** 32);
0
- my $init_lo = int($init % 2 ** 32);
0
+ $return{$keys[$opaque]} = [$flags, $data];
0
- my $data = $self->_doCmd($cmd, $key, '', pack(::INCRDECR_PKT_FMT, $amt_hi, $amt_lo, $init_hi, $init_lo, $exp));
0
- my $header = substr $data, 0, 12, '';
0
- my ($resp_hi, $resp_lo) = unpack "NN", $header;
0
- my $resp = ($resp_hi * 2 ** 32) + $resp_lo;
0
+ return %return if wantarray;
0
- my ($key, $amt, $init, $exp) = @_;
0
- $amt = 1 unless defined $amt;
0
- $init = 0 unless defined $init;
0
- $exp = 0 unless defined $exp;
0
- return $self->__incrdecr(::CMD_INCR, $key, $amt, $init, $exp);
0
+ return $self->_do_command(::CMD_VERSION, '', '');
0
- my ($key, $amt, $init, $exp) = @_;
0
- $amt = 1 unless defined $amt;
0
- $init = 0 unless defined $init;
0
- $exp = 0 unless defined $exp;
0
- return $self->__incrdecr(::CMD_DECR, $key, $amt, $init, $exp);
0
+ return $self->_do_command(::CMD_FLUSH, '', '');
0
- my ($key, $exp, $flags, $val) = @_;
0
- return $self->_mutate(::CMD_ADD, $key, $exp, $flags, $val);
0
- my ($key, $exp, $flags, $val) = @_;
0
- return $self->_mutate(::CMD_REPLACE, $key, $exp, $flags, $val);
0
+ my ($key, $val, $flags, $expire) = @_;
0
+ my $extra_header = pack "NN", $flags, $expire;
0
+ return $self->_do_command(::CMD_ADD, $key, $val, $extra_header, $cas);
0
- for (my $i = 0; $i < @keys; $i++) {
0
- $self->_sendCmd(::CMD_GETQ, $keys[$i], '', $i);
0
- my $terminal = @keys + 10;
0
- $self->_sendCmd(::CMD_NOOP, '', '', $terminal);
0
- my ($opaque, $data) = $self->_handleSingleResponse;
0
- last if $opaque == $terminal;
0
- $return{$keys[$opaque]} = [$self->__parseGet($data)];
0
- return %return if wantarray;
0
+ my ($key, $val, $flags, $expire, $cas) = @_;
0
+ my $extra_header = pack "NN", $flags, $expire;
0
+ return $self->_do_command(::CMD_SET, $key, $val, $extra_header, $cas);
0
- return $self->_doCmd(::CMD_NOOP, '', '');
0
+ my ($key, $val, $flags, $expire) = @_;
0
+ my $extra_header = pack "NN", $flags, $expire;
0
+ return $self->_do_command(::CMD_REPLACE, $key, $val, $extra_header, $cas);
0
- my ($key, $when) = @_;
0
- $when = 0 unless defined $when;
0
+ return $self->_do_command(::CMD_DELETE, $key, '');
0
- return $self->_doCmd(::CMD_DELETE, $key, '', pack(::DEL_PKT_FMT, $when));
0
+ my ($key, $amt, $init, $exp) = @_;
0
+ $amt = 1 unless defined $amt;
0
+ $init = 0 unless defined $init;
0
+ $exp = 0 unless defined $exp;
0
+ return $self->_incrdecr(::CMD_INCR, $key, $amt, $init, $exp);
0
- return $self->_doCmd(::CMD_VERSION, '', '');
0
+ my ($key, $amt, $init, $exp) = @_;
0
+ $amt = 1 unless defined $amt;
0
+ $init = 0 unless defined $init;
0
+ $exp = 0 unless defined $exp;
0
+ return $self->_incrdecr(::CMD_DECR, $key, $amt, $init, $exp);
0
- return $self->_doCmd(::CMD_FLUSH, '', '');
0
+ return $self->_do_command(::CMD_NOOP, '', '');
0
@@ -438,31 +395,27 @@ use constant ERR_NOT_FOUND => 0x1;
0
use constant ERR_EXISTS => 0x2;
0
use overload '""' => sub {
0
- return "Memcache Error ($self->[0]): $self->[1]";
0
+ return "Memcache Error ($self->[0]): $self->[1]";
0
- my $self = bless $error, (ref $class || $class);
0
+ my $self = bless $error, (ref $class || $class);
0
- return $self->[0] == ERR_NOT_FOUND;
0
+ return $self->[0] == ERR_NOT_FOUND;
0
- return $self->[0] == ERR_EXISTS;
0
+ return $self->[0] == ERR_EXISTS;
Comments
No one has commented yet.