#!perl


BEGIN {
    unless ( $ENV{RELEASE_TESTING} ) {
        require Test::More;
        Test::More::plan( skip_all => 'these tests are for release candidate testing' );
    }
}

use warnings;
use strict;
use Test::More;
use Test::Exception;
use ReRe::Client;

my $srv = '127.0.0.1:3000';

ok(my $o = ReRe::Client->new( url => $srv ), 'connected to our test redis-server');
ok($o->ping, 'ping');

## Commands operating on string values

ok($o->set(foo => 'bar'), 'set foo => bar');

ok(!$o->setnx(foo => 'bar'), 'setnx foo => bar fails');

cmp_ok($o->get('foo'), 'eq', 'bar', 'get foo = bar');

ok($o->set('foo', ''), 'set foo => ""');

cmp_ok($o->get('foo'), 'eq', '', 'get foo = ""');

ok($o->set('foo', 'baz'), 'set foo => baz');

cmp_ok($o->get('foo'), 'eq', 'baz', 'get foo = baz');

#my $euro = "\x{20ac}";
#ok($o->set('utf8', $euro), 'set utf8');
#cmp_ok($o->get('utf8'), 'eq', $euro, 'get utf8');

ok($o->set('test-undef', 42), 'set test-undef');
ok($o->exists('test-undef'), 'exists undef');

# Big sized keys # TODO: Need to work with POST.
for my $size (10_000) {
  my $v = 'a' x $size;
  ok($o->set('big_key', $v), "set with value size $size ok");
  is($o->get('big_key'), $v, "... and get was ok to");
}

$o->del('non-existant');
ok(!$o->exists('non-existant'),      'exists non-existant');
ok(!defined $o->get('non-existant'), 'get non-existant');

my $key_next = 3;
ok($o->set('key-next', 0),         'key-next = 0');
ok($o->set('key-left', $key_next), 'key-left');

is_deeply($o->mget('foo', 'key-next', 'key-left'), ['baz', 0, 3], 'mget');

my @keys;
foreach my $id (0 .. $key_next) {
  my $key = 'key-' . $id;
  push @keys, $key;
  ok($o->set($key, "$id"), "set $key");
  ok($o->exists($key), "exists $key");
  is($o->get($key), "$id", "get $key");
  cmp_ok($o->incr('key-next'), '==', $id + 1,             'incr');
  cmp_ok($o->decr('key-left'), '==', $key_next - $id - 1, 'decr');
}
is($o->get('key-next'), $key_next + 1, 'key-next');

ok($o->set('test-incrby', 0), 'test-incrby');
ok($o->set('test-decrby', 0), 'test-decry');
foreach (1 .. 3) {
  is($o->incrby('test-incrby', 3), $_ * 3, 'incrby 3');
  is($o->decrby('test-decrby', 7), -($_ * 7), 'decrby 7');
}

ok($o->del($_), "del $_") foreach map {"key-$_"} ('next', 'left');
ok(!$o->del('non-existing'), 'del non-existing');

cmp_ok($o->type('foo'), 'eq', 'string', 'type');

#is($o->keys('key-*'), $key_next + 1, 'key-*');
#is_deeply([$o->keys('key-*')], [@keys], 'keys');

ok(my $key = $o->randomkey, 'randomkey');

ok($o->rename('test-incrby', 'test-renamed'), 'rename');
ok($o->exists('test-renamed'), 'exists test-renamed');

#eval { $o->rename('test-decrby', 'test-renamed', 1) };
#ok($@, 'rename to existing key');

ok(my $nr_keys = $o->dbsize, 'dbsize');

## Commands operating on lists

my $list = 'test-list';

$o->del($list);

ok($o->rpush($list, "r$_"), 'rpush') foreach (1 .. 3);

ok($o->lpush($list, "l$_"), 'lpush') foreach (1 .. 2);

cmp_ok($o->type($list), 'eq', 'list', 'type');
cmp_ok($o->llen($list), '==', 5,      'llen');

is_deeply($o->lrange($list, 0, 1), ['l2', 'l1'], 'lrange');

ok($o->ltrim($list, 1, 2), 'ltrim');
cmp_ok($o->llen($list), '==', 2, 'llen after ltrim');

cmp_ok($o->lindex($list, 0), 'eq', 'l1', 'lindex');
cmp_ok($o->lindex($list, 1), 'eq', 'r1', 'lindex');

ok($o->lset($list, 0, 'foo'), 'lset');
cmp_ok($o->lindex($list, 0), 'eq', 'foo', 'verified');

ok($o->lrem($list, 1, 'foo'), 'lrem');
cmp_ok($o->llen($list), '==', 1, 'llen after lrem');

cmp_ok($o->lpop($list), 'eq', 'r1', 'lpop');

ok(!$o->rpop($list), 'rpop');



## Commands operating on sets

my $set = 'test-set';
$o->del($set);

ok($o->sadd($set, 'foo'), 'sadd');
ok(!$o->sadd($set, 'foo'), 'sadd');
cmp_ok($o->scard($set), '==', 1, 'scard');
ok($o->sismember($set, 'foo'), 'sismember');

cmp_ok($o->type($set), 'eq', 'set', 'type is set');

ok($o->srem($set, 'foo'), 'srem');
ok(!$o->srem($set, 'foo'), 'srem again');
cmp_ok($o->scard($set), '==', 0, 'scard');

$o->sadd('test-set1', $_) foreach ('foo', 'bar', 'baz');
$o->sadd('test-set2', $_) foreach ('foo', 'baz', 'xxx');

my $inter = ['foo', 'baz'];

is_deeply($o->sinter('test-set1', 'test-set2'), $inter, 'siter');

ok($o->sinterstore('test-set-inter', 'test-set1', 'test-set2'),
  'sinterstore');

cmp_ok(
  $o->scard('test-set-inter'),
  '==',
  $#$inter + 1,
  'cardinality of intersection'
);

## Commands operating on zsets (sorted sets)
# TODO: ZUNIONSTORE, ZINTERSTORE, SORT, tests w/multiple values having the same score

my $zset = 'test-zset';
$o->del($zset);

ok($o->zadd($zset, 0, 'foo'));
ok(!$o->zadd($zset, 1, 'foo')); # 0 returned because foo is already in the set

is($o->zscore($zset, 'foo'), 1);

ok($o->zincrby($zset, 1, 'foo'));
is($o->zscore($zset, 'foo'), 2);

ok($o->zincrby($zset, 1, 'bar'));
is($o->zscore($zset, 'bar'), 1)
  ;    # bar was new, so its score got set to the increment

is($o->zrank($zset, 'bar'), 0);
is($o->zrank($zset, 'foo'), 1);

is($o->zrevrank($zset, 'bar'), 1);
is($o->zrevrank($zset, 'foo'), 0);

#ok($o->zadd($zset, '2.1', 'baz'));    # we now have bar foo baz

is_deeply($o->zrange($zset, 0, 1), [qw/bar foo/]);
#is_deeply($o->zrevrange($zset, 0, 1), [qw/baz foo/]);


#my $withscores = {$o->zrevrange($zset, 0, 1, 'WITHSCORES')};

# this uglyness gets around floating point weirdness in the return (I.E. 2.1000000000000001);
#my $rounded_withscores = {
#  map { $_ => 0 + sprintf("%0.5f", $withscores->{$_}) }
#    keys %$withscores
#};

#is_deeply($rounded_withscores, {baz => 2.1, foo => 2});

#is_deeply([$o->zrangebyscore($zset, 2, 3)], [qw/foo baz/]);

#is($o->zcount($zset, 2, 3), 2);

#is($o->zcard($zset), 3);

#ok($o->del($zset));    # cleanup

#my $score = 0.1;
#my @zkeys = (qw/foo bar baz qux quux quuux quuuux quuuuux/);

#ok($o->zadd($zset, $score++, $_)) for @zkeys;
#is_deeply([$o->zrangebyscore($zset, 0, 8)], \@zkeys);

#is($o->zremrangebyrank($zset, 5, 8), 3);    # remove quux and up
#is_deeply([$o->zrangebyscore($zset, 0, 8)], [@zkeys[0 .. 4]]);

#is($o->zremrangebyscore($zset, 0, 2), 2);    # remove foo and bar
#is_deeply([$o->zrangebyscore($zset, 0, 8)], [@zkeys[2 .. 4]]);

# only left with 3
#is($o->zcard($zset), 3);

#ok($o->del($zset));                          # cleanup


## Commands operating on hashes

my $hash = 'test-hash';
$o->del($hash);

ok($o->hset($hash, 'foo', 'bar'));
is($o->hget($hash, 'foo'), 'bar');
ok($o->hexists($hash, 'foo'));
ok($o->hdel($hash, 'foo'));
ok(!$o->hexists($hash, 'foo'));

ok($o->hincrby($hash, 'incrtest', 1));
is($o->hget($hash, 'incrtest'), 1);

is($o->hincrby($hash, 'incrtest', -1), 0);
is($o->hget($hash, 'incrtest'), 0);

ok($o->hdel($hash, 'incrtest'));    #cleanup

ok($o->hsetnx($hash, 'setnxtest', 'baz'));
ok(!$o->hsetnx($hash, 'setnxtest',  'baz'));    # already exists, 0 returned

ok($o->hdel($hash, 'setnxtest'));              #cleanup

#ok($o->hmset($hash, foo => 1, bar => 2, baz => 3, qux => 4));
#
#is_deeply($o->hmget($hash, qw/foo bar baz/), [1, 2, 3]);
#
#is($o->hlen($hash), 4);
#
#is_deeply($o->hkeys($hash), [qw/foo bar baz qux/]);
#is_deeply([$o->hvals($hash)], [qw/1 2 3 4/]);
#is_deeply({$o->hgetall($hash)}, {foo => 1, bar => 2, baz => 3, qux => 4});

#ok($o->del($hash));                            # remove entire hash


## Multiple databases handling commands

#ok($o->select(1), 'select');
#ok($o->select(0), 'select');

#ok($o->move('foo', 1), 'move');
#ok(!$o->exists('foo'), 'gone');

#ok($o->select(1),     'select');
#ok($o->exists('foo'), 'exists');

ok($o->flushdb, 'flushdb');
cmp_ok($o->dbsize, '==', 0, 'empty');

## Sorting

ok($o->lpush('test-sort', $_), "put $_") foreach (1 .. 4);
cmp_ok($o->llen('test-sort'), '==', 4, 'llen');

is_deeply($o->sort('test-sort'), [1, 2, 3, 4], 'sort');
is_deeply($o->sort('test-sort', 'DESC'), [4, 3, 2, 1], 'sort DESC');


## "Persistence control commands"

ok($o->save,     'save');
ok($o->bgsave,   'bgsave');
ok($o->lastsave, 'lastsave');

#ok( $o->shutdown, 'shutdown' );


## Remote server control commands

ok(my $info = $o->info, 'info');
isa_ok($info, 'HASH');


## Connection handling

ok($o->ping,  'ping() is true');
ok($o->quit,  'quit');
ok(!$o->ping, '... but after quit() returns false');

## All done
done_testing();
