my
$server
= Test::RedisDB->new;
plan(
skip_all
=>
"Can't start redis-server"
)
unless
$server
;
my
$redis
=
$server
->redisdb_client;
diag(
"Testing against redis-server "
.
$redis
->info->{redis_version});
plan(
skip_all
=>
"test requires redis-server version 2.0.0 and above"
)
if
$redis
->version < 2;
$redis
->send_command(
'PING'
);
my
$res
=
$redis
->get_reply;
is
$res
,
'PONG'
,
"Got PONG"
;
$redis
->send_command(
'SET'
,
'test string'
,
'test value'
);
$res
=
$redis
->get_reply;
is
$res
,
'OK'
,
"Set test string"
;
$redis
->send_command(
'GET'
,
'test string'
);
$res
=
$redis
->get_reply;
is
$res
,
'test value'
,
"Got test string"
;
$redis
->send_command(
'GET'
,
'test non-existing string'
);
$res
=
$redis
->get_reply;
is
$res
,
undef
,
"Got undef for non-existing string"
;
$redis
->send_command(
'INCR'
,
'counter'
);
$res
=
$redis
->get_reply;
is
$res
, 1,
"counter value is 1"
;
$redis
->send_command(
'INCRBY'
,
'counter'
, 10 );
$res
=
$redis
->get_reply;
is
$res
, 11,
"counter value now is 11"
;
for
(
qw(this is a list to test LRANGE)
) {
$redis
->send_command(
'RPUSH'
,
'test list'
,
$_
);
}
for
( 1 .. 7 ) {
$res
=
$redis
->get_reply;
is
$res
,
$_
,
"List length is $_"
;
}
$redis
->send_command(
'LRANGE'
,
'test list'
, 1, 3 );
$res
=
$redis
->get_reply;
eq_or_diff
$res
, [
qw(is a list)
],
'LRANGE returned correct result'
;
is
$redis
->quit,
"OK"
,
"QUIT"
;
ok !
$redis
->reply_ready,
"No any replies"
;
$redis
->send_command(
'SET'
,
'key A'
,
'value A'
);
$redis
->send_command(
'RPUSH'
,
'list B'
,
'B1'
);
$redis
->send_command(
'RPUSH'
,
'list B'
,
'B2'
);
$redis
->send_command(
'LRANGE'
,
'list B'
, 0, 2);
$redis
->send_command(
'GET'
,
'key A'
);
sleep
1;
ok
$redis
->reply_ready,
"Got some replies"
;
is
$redis
->replies_to_fetch, 5,
"5 commands in flight"
;
eq_or_diff [
$redis
->get_all_replies ], [
'OK'
, 1, 2, [
qw(B1 B2)
],
'value A'
],
"Got all replies"
;
my
@replies
;
sub
cb {
shift
;
push
@replies
, [
@_
];
}
$redis
->send_command(
'SET'
,
'CB A'
,
'AAA'
, RedisDB::IGNORE_REPLY );
$redis
->send_command(
'GET'
,
'CB A'
, \
&cb
);
$redis
->set(
'CB B'
,
'BBB'
, RedisDB::IGNORE_REPLY );
$redis
->get(
'CB B'
, \
&cb
);
is
$redis
->ping,
"PONG"
,
"can execute while sent some commands with callbacks"
;
$redis
->send_command(
'RPUSH'
,
'CB LIST'
,
'CCC'
, RedisDB::IGNORE_REPLY );
$redis
->rpush(
'CB LIST'
,
'DDD'
, RedisDB::IGNORE_REPLY );
$redis
->send_command(
'RPUSH'
,
'CB LIST'
,
'EEE'
);
$redis
->send_command(
'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"
;
my
$incr
;
my
$icnt
;
$incr
=
sub
{
my
(
$redis
,
$res
) =
@_
;
$icnt
=
$res
;
$redis
->rpush(
'mainlist'
,
$res
, RedisDB::IGNORE_REPLY );
$redis
->incr(
'mainloop'
,
$incr
)
if
$res
< 5;
};
$redis
->incr(
'mainloop'
,
$incr
);
$redis
->send_command(
'PING'
);
$redis
->mainloop;
is
$icnt
, 5,
"last result of increment is 5"
;
is
$redis
->get_reply,
'PONG'
,
"got PONG after mainloop"
;
eq_or_diff
$redis
->lrange(
'mainlist'
, 0, -1 ), [ 1 .. 5 ],
"Correct mainlist value"
;
$redis
->set(
"DB_number"
, 0 );
is
$redis
->
select
(1),
'OK'
,
"selected DB 1"
;
is
$redis
->selected_database, 1,
"selected_database 1"
;
is
$redis
->get(
"DB_number"
),
undef
,
"DB_number is not defined"
;
$redis
->set(
"DB_number"
, 1 );
is
$redis
->get(
"DB_number"
), 1,
"DB number 1"
;
is
$redis
->selected_database, 1,
"selected_database 1"
;
$redis
->quit;
$redis
->{_socket}->
recv
(
my
$buf
, 100, 0 );
is
$redis
->get(
"DB_number"
), 1,
"after reconnecting DB number is still 1"
;
is
$redis
->
select
(0),
'OK'
,
"selected DB 0"
;
is
$redis
->selected_database, 0,
"selected_database 0"
;
is
$redis
->get(
"DB_number"
), 0,
"DB number 0"
;
subtest
"Error handling"
=>
sub
{
$redis
->set(
"scalar"
,
"scalar"
);
dies_ok {
$redis
->hget(
"scalar"
,
"scalar"
); }
"dies on error from redis if raise_error is on"
;
my
$redis2
= RedisDB->new(
host
=>
'localhost'
,
port
=>
$server
->{port},
raise_error
=>
undef
);
my
$res
=
$redis2
->hget(
"scalar"
,
"scalar"
);
isa_ok
$res
,
"RedisDB::Error"
,
"with raise_error off returns RedisDB::Error object"
;
};
done_testing;