use strict;
my $key = 'CMAETest.' . int(rand(1000));
my @keys = map { "commands-$_" } (1..10);
my @callbacks = (
sub {
my ($memd, $cv) = @_;
$memd->delete($key, sub { ok(1, 'Delete'); $cv->end });
},
sub { my ($memd, $cv) = @_; $memd->flush_all(sub { is($_[0], 1, 'Flush all records'); $cv->end }); },
sub { my ($memd, $cv) = @_; my $cb = AE::cv {is($_[0]->recv, 1, 'Flush all records'); $cv->end }; $memd->flush_all($cb); },
sub { my ($memd, $cv) = @_; $memd->get($key, sub { ok(!$_[0], "Get on non-existent value"); $cv->end }) },
sub { my ($memd, $cv) = @_; my $cb = AE::cv {ok(!$_[0]->recv, "Get on non-existent value"); $cv->end }; $memd->get($key, $cb) },
sub { my ($memd, $cv) = @_; $memd->add($key, 'v1', sub { ok($_[0], 'Add'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->get($key, sub { is( $_[0], 'v1', 'Fetch'); $cv->end } ); },
sub { my ($memd, $cv) = @_; $memd->set($key, 'v2', sub { ok($_[0], 'Set'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->get($key, sub { is( $_[0], 'v2', 'Fetch'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->replace($key, 'v3', sub { ok($_[0], 'Replace'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->get($key, sub { is( $_[0], 'v3', 'Fetch'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->replace($key, 0, sub { ok( $_[0], 'replace with numeric'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->get($key, sub { is($_[0], 0, 'Replace turned out to be 0'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->incr($key, sub { ok($_[0], 'Incr'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->get($key, sub { is($_[0], 1, 'Fetch'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->incr($key, 5, sub { ok($_[0], 'Incr 5'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->incr('no-such-key', 5, sub { ok(!$_[0], 'Incr no_such_key'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->get($key, sub { is($_[0], 6, 'Fetch'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->decr($key, sub { ok($_[0], 'Decr'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->get($key, sub { is($_[0], 5, 'Fetch'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->decr($key, sub { is($_[0], 4, 'Decr'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->get($key, sub { is($_[0], 4, 'Fetch'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->decr($key, 100, sub { is($_[0], 0, 'Decr below zero'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->decr($key, 100, sub { is($_[0], 0, 'Decr below zero returns true value'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->get($key, sub { is($_[0], 0, 'Fetch'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->get_multi([], sub { ok($_[0], 'get_multi() with empty list'); $cv->end }); },
sub {
my ($memd, $cv) = @_;
my $xcv = AE::cv { $cv->end };
foreach my $key (@keys) {
$xcv->begin;
$memd->set( $key, $key, sub { ok($_[0], "set $key"); $xcv->end });
}
},
sub {
my ($memd, $cv) = @_;
$memd->get_multi(\@keys, sub {
my $h = shift;
foreach my $key (@keys) {
is($h->{$key}, $key, "Key $key match");
}
$cv->end;
});
},
sub {
my ($memd, $cv) = @_;
$memd->set( $key, "abc", sub { $cv->end } );
},
sub {
my ($memd, $cv) = @_;
$memd->append( $key, 'def', sub { ok ($_[0], "append $key"); $cv->end } );
},
sub {
my ($memd, $cv) = @_;
$memd->get( $key, sub { is ($_[0], 'abcdef', "append result ok for $key"); $cv->end } );
},
sub {
my ($memd, $cv) = @_;
$memd->prepend( $key, '123', sub { ok ($_[0], "prepend $key"); $cv->end } );
},
sub {
my ($memd, $cv) = @_;
$memd->get( $key, sub { is ($_[0], '123abcdef', "prepend result ok for $key"); $cv->end } );
},
sub { my ($memd, $cv) = @_; $memd->flush_all(sub { is($_[0], 1, 'Flush all records'); $cv->end }); },
sub { my ($memd, $cv) = @_; $memd->get($key, sub { ok(!$_[0], "Get on existing value fails after flush_all"); $cv->end }) },
);
sub run {
my ($pkg, $protocol, $selector) = @_;
lives_ok {
my $cv = AE::cv;
my $memd = test_client(protocol_class => $protocol, selector_class => $selector);
isa_ok $memd->selector, "Cache::Memcached::AnyEvent::Selector::$selector";
isa_ok $memd->protocol, "Cache::Memcached::AnyEvent::Protocol::$protocol";
$cv->begin;
$memd->version( sub {
while ( my($host_port, $version) = each %{$_[0]} ) {
note("[$protocol/$selector] using memcached $version on $host_port");
}
$cv->end;
} );
$cv->recv;
$cv = AE::cv;
foreach my $code (@callbacks) {
$cv->begin;
eval {
$code->($memd, $cv);
};
if ($@) {
ok(0, "an error occurred: $@");
$cv->end;
}
}
$cv->recv;
} "Command tests ran fine";
done_testing;
}
1;