From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

use Test::Most 0.22;
use RedisDB;
# This test is derived from basic_redis to preserve
# tests for deprecated send_command_cb method
my $server = Test::RedisDB->new;
plan( skip_all => "Can't start redis-server" ) unless $server;
my $redis = $server->redisdb_client;
# Test callbacks
my @replies;
sub cb {
shift;
push @replies, [ @_ ];
}
$redis->send_command_cb('SET', 'CB A', 'AAA');
$redis->send_command_cb('GET', 'CB A', \&cb);
$redis->send_command_cb('SET', 'CB B', 'BBB');
$redis->send_command_cb('GET', 'CB B', \&cb);
is $redis->ping, "PONG", "can execute while sent some commands with callbacks";
$redis->send_command_cb('RPUSH', 'CB LIST', 'CCC');
$redis->send_command_cb('RPUSH', 'CB LIST', 'DDD');
$redis->send_command('RPUSH', 'CB LIST', 'EEE');
$redis->send_command_cb('LRANGE', 'CB LIST', 0, 3, sub { my $redis = shift; cb($redis, 'LIST', @_) } );
is $redis->replies_to_fetch, 1, "One reply to fetch";
is $redis->get_reply, 3, "Added 3 elements to the list";
$redis->send_command('PING');
is $redis->get_reply, 'PONG', "Pinged server";
eq_or_diff \@replies,
[ [qw(AAA)], [qw(BBB)], [ 'LIST', [qw(CCC DDD EEE)] ], ],
"Callback was called with correct arguments";
is $redis->replies_to_fetch, 0, "No replies to fetch";
done_testing;