The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package libmemcached_test;

# functions to support the Memcached::libmemcached test suite

use strict;
use warnings;
use base 'Exporter';

use Test::More;

our @EXPORT = qw(
    libmemcached_test_create
    libmemcached_test_key
    libmemcached_version_ge
    libmemcached_test_servers
);

use Memcached::libmemcached qw(
    memcached_behavior_set
    memcached_create
    memcached_errstr
    memcached_get
    memcached_server_add
    memcached_version
    MEMCACHED_BEHAVIOR_BINARY_PROTOCOL
);


sub libmemcached_test_servers {
    my $servers = $ENV{PERL_LIBMEMCACHED_TEST_SERVERS};
    # XXX add the default port as well to stop uninit
    # warnings from the test suite
    $servers ||= 'localhost:11211';
    return split(/\s*,\s*/, $servers);
}


sub libmemcached_test_create {
    my ($args) = @_;

    my $memc = memcached_create()
        or die "memcached_create failed";

    if ($ENV{LIBMEMCACHED_BINARY_PROTOCOL}) {
        memcached_behavior_set($memc, MEMCACHED_BEHAVIOR_BINARY_PROTOCOL, 1 );
    }

    # XXX would be good to filter this list by those we can communicate with
    # (and have sufficient version number)
    # then pick the first of those to use as the default test server
    my ($server,$port) = split /:/, (libmemcached_test_servers())[0];

    # XXX may change to memcached_parse_options or somesuch so the env
    # var can set behaviours etc   
    my $rc = memcached_server_add($memc, $server, $port);
    die "libmemcached_test_create: memcached_server_add($server) failed: ".memcached_errstr($memc)
        if not $rc;

    # XXX ideally this should be a much 'simpler/safer' command
    memcached_get($memc, "foo");
    plan skip_all => "Can't talk to any memcached servers"
        if memcached_errstr($memc) !~ /SUCCESS|NOT FOUND|SERVER END/;

    plan skip_all => "memcached server version less than $args->{min_version}"
        if $args->{min_version}
        && not libmemcached_version_ge($memc, $args->{min_version});

    return $memc;
}


sub libmemcached_version_ge {
    my ($memc, $min_version) = @_;
    my $numify = sub {
        my $version = shift;
        my @version = split /\./, $version;
        return $version[0] + $version[1] / 100 + $version[2] / 100_000;
    };

    my @memcached_version = memcached_version($memc);

    $min_version = $numify->( $min_version );
    foreach my $version (map { $numify->($_) } @memcached_version) {
        return 1 if $version >= $min_version;
        return 0 if $version <  $min_version;
    }
    return 1; # identical versions
}


sub libmemcached_test_key {
    # return a value suitable for use as a memcached key
    # that is unique for each run of the script
    # but returns the same value for the life of the script
    our $time_rand ||= ($^T + rand());
    return $time_rand;
}

1;