# tests for functions documented in memcached_get.pod # (except for memcached_fetch_result) use strict; use warnings; use Test::More; use Memcached::libmemcached # functions explicitly tested by this file qw( ), # other functions used by the tests qw( memcached_set memcached_get memcached_mget memcached_mget_into_hashref ); use lib 't/lib'; use libmemcached_test; my $memc = libmemcached_test_create(); my $items = 2; plan tests => 15; my ($rv, $rc, $flags); my $t1= time(); my $flag_orig = 0xF000F00F; my %data = map { ("k$_.$t1" => "v$_.$t1") } (1..$items); my ($get_cb_expected_defsv, @get_cb_expected_args); my $get_cb_called = 0; my $get_cb = sub { ++$get_cb_called; print "get_cb(@_)\n"; is $_, $get_cb_expected_defsv, '$_ should be the value'; is_deeply \@_, \@get_cb_expected_args, '@_ should be $key and $flags'; return; }; $memc->set_callback_coderefs(undef, $get_cb); print "test read-only access to values from callback\n"; ok memcached_set($memc, $_, $data{$_}, 0, $flag_orig) for keys %data; for my $k (keys %data) { $get_cb_expected_defsv = $data{$k}; @get_cb_expected_args = ( $k, $flag_orig ); is memcached_get($memc, $k), $data{$k}; } is $get_cb_called, scalar keys %data; $get_cb_called = 0; $memc->set_callback_coderefs(undef, sub { ++$get_cb_called; return }); my %got; ok memcached_mget_into_hashref($memc, [ keys %data ], \%got); is_deeply \%got, \%data; print "test modification of values by callback\n"; $get_cb = sub { $_ = uc($_).lc($_); $_[1] = 0xE0E0E0E0; return; }; $memc->set_callback_coderefs(undef, $get_cb); for my $k (keys %data) { my $v = $data{$k}; is memcached_get($memc, $k, my $flags), uc($v).lc($v); is $flags, 0xE0E0E0E0; }