root/lang/perl/MooseX-WithCache/trunk/t/02_memcached.t @ 34514

Revision 34514, 5.5 kB (checked in by daisuke, 5 years ago)

update tests

Line 
1use strict;
2use Test::More;
3use Test::Exception;
4use IO::Socket::INET;
5use Moose::Meta::Class;
6
7our @MEMDTYPES;
8
9{
10    package Hoge;
11    use MooseX::WithCache;
12}
13
14BEGIN
15{
16    my $socket = IO::Socket::INET->new(
17        PeerPort => '11211',
18        PeerAddr => '127.0.0.1',
19    );
20
21    if (! $socket) {
22        plan(skip_all => "no memcached server found");
23    } else {
24        my $tests = 0;
25        foreach my $class qw(Cache::Memcached Cache::Memcached::Fast Cache::memcached::libmemcached) {
26            eval "require $class";
27            next if $@;
28
29            diag("found $class...");
30            $tests += 27;
31            push @MEMDTYPES, $class;
32        }
33
34        if (! @MEMDTYPES) {
35            plan(skip_all => "No memcached client found");
36        } else {
37            plan(tests => $tests);
38        }
39    }
40}
41
42foreach my $memd (@MEMDTYPES) {
43    diag("testig with $memd...");
44    my $class = Moose::Meta::Class->create_anon_class(
45        superclasses => [ 'Moose::Object' ]
46    );
47   
48    MooseX::WithCache::with_cache($class->name, 'cache', backend => 'Cache::Memcached');
49
50    my $object = $class->new_object(
51        cache => $memd->new({
52            servers => [ '127.0.0.1:11211' ],
53            namespace => join('.', rand(), time, $$, {}),
54        }),
55    );
56
57
58    {
59        my $value = time();
60        my $key   = 'foo';
61        lives_ok { $object->cache_del($key) }
62            "delete key '$key' first to make sure";
63        lives_ok { $object->cache_set($key => $value) }
64            "set value '$key' to '$value'";
65        lives_and {
66            my $v = $object->cache_get($key);
67            is($v, $value, "value gotten from cache '$v' should match '$value'");
68        } "get value '$key' to '$value' should live";
69        lives_ok { $object->cache_del($key) }
70            "delete key '$key' to purge";
71    }
72
73    {
74        require MooseX::WithCache::KeyGenerator::DumpChecksum;
75        $object->cache_key_generator(
76            MooseX::WithCache::KeyGenerator::DumpChecksum->new
77        );
78        my $value = time();
79        my $key   = [ qw(1 2 3), { foo => 'bar' } ];
80        lives_ok { $object->cache_del($key) }
81            "delete key '$key' first to make sure";
82        lives_ok { $object->cache_set($key => $value) }
83            "set value '$key' to '$value'";
84        lives_and {
85            my $v = $object->cache_get($key);
86            is($v, $value, "value gotten from cache '$v' should match '$value'");
87        } "get value '$key' to '$value' should live";
88        lives_and {
89            my $v = $object->cache_get([ qw(1 2 3), { foo => 'bar' } ]);
90            is($v, $value, "value gotten from cache '$v' should match '$value' (same structure, different object)");
91        } "get value '$key' to '$value' should live (same structure, different key object)";
92
93        lives_and {
94            $object->cache_disabled(1);
95            ok( ! $object->cache_get($key), "cache disabled, fetch should fail" );
96            $object->cache_set($key, "foo");
97            ok( ! $object->cache_get($key), "cache disabled, fetch should fail (even if cache_set was called)" );
98            $object->cache_set($key, "foo");
99            ok( ! $object->cache_get($key), "cache disabled, fetch should fail (even if cache_set was called)" );
100
101            $object->cache_set($key, "foo");
102            $object->cache_disabled(0);
103            is($object->cache_get($key), $value, "cache wasn't changed while it was disabled");
104
105        } "no errors while testing cache disable";
106        $object->cache_disabled(0);
107
108        lives_ok { $object->cache_del($key) }
109            "delete key '$key' to purge";
110    }
111
112    { # memcached specific
113        my $value = time();
114        my $key   = [ qw(incr decr test) ];
115
116        $object->cache_set($key, $value);
117        is( $object->cache_incr($key), $value + 1, "incr returns correct result");
118        is( $object->cache_get($key), $value + 1, "effect of incr is saved" );
119        is( $object->cache_decr($key), $value, "decr returns correct result");
120        is( $object->cache_get($key), $value, "effect of decr is saved" );
121
122        lives_and {
123            $object->cache_disabled(1);
124
125            ok( ! $object->cache_incr($key), "incr while cache disabled" );
126            ok( ! $object->cache_decr($key), "decr while cache disabled" );
127        } "no errors while testing cache disable";
128        $object->cache_disabled(0);
129        lives_ok { $object->cache_del($key) }
130            "delete key '$key' to purge";
131    }
132
133    {
134        my %data = (
135            a => 1,
136            b => 2,
137            c => 3,
138            d => 4
139        );
140
141        while(my($key, $value) = each %data) {
142            $object->cache_set($key, $value);
143        }
144
145        lives_and {
146            my @keys = keys %data;
147            my @ret  = $object->cache_get_multi(@keys);
148
149            is( scalar @ret, scalar @keys, "got the same number of values" );
150            is_deeply( \@ret, [ @data{@keys} ], "data validates" );
151        } "get_multi";
152
153        lives_and {
154            my @keys = keys %data;
155            push @keys, 'missing';
156            my @ret  = $object->cache_get_multi(@keys);
157
158            is( scalar @ret, scalar @keys - 1, "got the less results than requested" );
159            is_deeply( \@ret, [ @data{ keys %data } ], "data validates" );
160
161            my $ret  = $object->cache_get_multi(@keys);
162            is( scalar keys(%{$ret->{results}}) + 1, scalar @keys, "got the less results than requested" );
163            is_deeply( $ret->{results}, \%data, "data validates" );
164            is_deeply( $ret->{missing}, [ 'missing' ], "missing key validates" );
165        } "get_multi with missing keys";
166    }
167}
Note: See TracBrowser for help on using the browser.