The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use utf8;
use Test::More;

use Test::TCP qw/empty_port wait_port/;
use Test::Skip::UnlessExistsExecutable;
use File::Which qw(which);
use Proc::Guard;
use Cache::Memcached::Fast::Safe;
use Encode;
#use Log::Minimal;
#$Log::Minimal::AUTODUMP =1;

skip_all_unless_exists 'memcached';

my @memcached;
my @user = ();
if ( $> == 0 ) {
    @user = ('-u','nobody');
}

for ( 1..5 ) {
    my $port = empty_port();
    my $proc = proc_guard( scalar which('memcached'), '-p', $port, '-U', 0, '-l', '127.0.0.1', @user );
    wait_port($port);
    push @memcached, { proc => $proc, port => $port };
}

my $cache = Cache::Memcached::Fast::Safe->new({
    servers => [map { "localhost:" . $_->{port} } @memcached],
    utf8 => 1,
});
my $version = $cache->server_versions;
my $version_num = 2 ** 31;
while (my ($s, $v) = each %$version) {
    if ($v =~ /(\d+)\.(\d+)\.(\d+)/) {
        my $n = $1 * 10000 + $2 * 100 + $3;
        if ($n < $version_num) {
            $version_num = $n;
        }
    }
}

use constant count => 100;

my @keys1 = ('c o m m a n d s あ', "あ"x100);

for my $key ( @keys1 ) {
    $cache->delete($key);
    ok($cache->add($key, 'v1', undef), 'Add');

    is($cache->get($key), 'v1', 'Fetch');
    ok($cache->set($key, 'v2', undef), 'Set');
    is($cache->get($key), 'v2', 'Fetch');
    ok($cache->replace($key, 'v3'), 'Replace');
    is($cache->get($key), 'v3', 'Fetch');

    ok($cache->replace($key, 0), 'replace with numeric');
    ok($cache->incr($key), 'Incr');
    ok($cache->get($key) == 1, 'Fetch');
    ok($cache->incr($key, 5), 'Incr');
    ok((not $cache->incr('no-such-key', 5)), 'Incr no_such_key');
    ok((defined $cache->incr('no-such-key', 5)),
       'Incr no_such_key returns defined value');
    ok($cache->get($key) == 6, 'Fetch');
    ok($cache->decr($key), 'Decr');
    ok($cache->get($key) == 5, 'Fetch');
    ok($cache->decr($key, 2), 'Decr');
    ok($cache->get($key) == 3, 'Fetch');
    ok($cache->decr($key, 100) == 0, 'Decr below zero');
    ok($cache->decr($key, 100), 'Decr below zero returns true value');
    ok($cache->get($key) == 0, 'Fetch');
}

ok($cache->get_multi(), 'get_multi() with empty list');

my $res = $cache->set_multi();
isa_ok($res, 'HASH');
is(scalar keys %$res, 0);
my @res = $cache->set_multi();
is(@res, 0);


my @keys = map { "c o m m a n d s あ - $_" } (1..count-1);
push @keys, "c o m m a n d s - 100"x100;
 
@res = $cache->set_multi(map { [$_, $_] } @keys);
is(@res, count);
is((grep { not $_ } @res), 0);

$res = $cache->set_multi(map { [$_, $_] } @keys);
isa_ok($res, 'HASH');
is(keys %$res, count);
is((grep { not $_ } values %$res), 0);


my @extra_keys = @keys;
for (1..count) {
    splice(@extra_keys, int(rand(@extra_keys + 1)), 0, "no_such_key-$_");
}
$res = $cache->get_multi(@extra_keys);

isa_ok($res, 'HASH');
is(scalar keys %$res, scalar @keys, 'Number of entries in result');
my $count = 0;
foreach my $k (@keys) {
    ++$count if exists $res->{$k} and $res->{$k} eq $k;
}
is($count, count);

SKIP: {
    skip "memcached 1.2.4 is required for cas/gets/append/prepend commands", 27
      if $version_num < 10204;
    my $key = $keys1[0];
    ok($cache->set($key, 'value'), 'Store');
    ok($cache->append($key, '-append'), 'Append');
    is($cache->get($key), 'value-append', 'Fetch');
    ok($cache->prepend($key, 'prepend-'), 'Prepend');
    is($cache->get($key), 'prepend-value-append', 'Fetch');

    $res = $cache->gets($key);
    ok($res, 'Gets');
    isa_ok($res, 'ARRAY');
    is(scalar @$res, 2, 'Gets result is an array of two elements');
    ok($res->[0], 'CAS opaque defined');
    is($res->[1], 'prepend-value-append', 'Match value');
    $res->[1] = 'new value';
    ok($cache->cas($key, @$res), 'First update success');
    ok(! $cache->cas($key, @$res), 'Second update failure');
    is($cache->get($key), 'new value', 'Fetch');

    $res = $cache->gets_multi(@extra_keys);
    isa_ok($res, 'HASH');
    is(scalar keys %$res, scalar @keys, 'Number of entries in result');
    $count = 0;
    foreach my $k (@keys) {
        ++$count if ref($res->{$k}) eq 'ARRAY';
        ++$count if @{$res->{$k}} == 2;
        ++$count if defined $res->{$k}->[0];
        ++$count if $res->{$k}->[1] eq $k;
    }
    is($count, count * 4);

    my $hash = $res;
    $res = $cache->cas_multi([$keys[0], @{$hash->{$keys[0]}}],
                                  ['no-such-key', 123, 'value', 10],
                                  [$keys[1], @{$hash->{$keys[1]}}, 1000]);
    isa_ok($res, 'HASH');
    is(scalar keys %$res, 3);
    ok($res->{$keys[0]});
    ok(defined $res->{'no-such-key'} and not $res->{'no-such-key'});
    ok($res->{$keys[1]});

    my @res = $cache->cas_multi([$keys[2], @{$hash->{$keys[2]}}],
                                     ['no-such-key', 123, 'value', 10],
                                     [$keys[3], @{$hash->{$keys[3]}}, 1000]);
    is(@res, 3);
    ok($res[0]);
    ok(not $res[1]);
    ok($res[2]);

    $res = $cache->cas_multi();
    isa_ok($res, 'HASH');
    is(scalar keys %$res, 0);
}


ok($cache->replace_multi(map { [$_,0] } @keys),'replace_multi to reset to numeric');

$res = $cache->incr_multi([$keys[0], 2], [$keys[1]], @keys[2..$#keys]);
ok(values %$res == @keys);
is((grep { $_ != 1 } values %$res), 1);
is($res->{$keys[0]}, 2);

$res = $cache->delete_multi($keys1[0]);
ok($res->{$keys1[0]});
$res = $cache->delete_multi([$keys[0]], $keys[1]);
ok($res->{$keys[0]} and $res->{$keys[1]});

ok($cache->remove($keys[2]));
@res = $cache->delete_multi(@keys);
is(@res, count);
is((grep { not $_ } @res), 3);

done_testing();