File Coverage

blib/lib/Dancer/Plugin/MemcachedFast.pm
Criterion Covered Total %
statement 12 60 20.0
branch 0 60 0.0
condition 0 31 0.0
subroutine 4 21 19.0
pod n/a
total 16 172 9.3


line stmt bran cond sub pod time code
1             package Dancer::Plugin::MemcachedFast;
2             $Dancer::Plugin::MemcachedFast::VERSION = '0.150740';
3 3     3   474578 use strict;
  3         6  
  3         102  
4 3     3   14 use warnings;
  3         3  
  3         73  
5              
6             # ABSTRACT: Dancer::Plugin::MemcachedFast - Cache things using Cache::Memcached::Fast
7              
8 3     3   1415 use Dancer::Plugin;
  3         62805  
  3         202  
9              
10 3     3   1762 use Cache::Memcached::Fast;
  3         7633  
  3         2942  
11              
12             my $default_timeout = 3600;
13             my $ok_to_compress = 0;
14             my $cache = do {
15             my $config = plugin_setting;
16             $config->{servers} = [$ENV{HAVE_TEST_MEMCACHED_SERVER_LOCALHOST}]
17             if exists $ENV{HAVE_TEST_MEMCACHED_SERVER_LOCALHOST};
18             $default_timeout = delete $config->{default_timeout}
19             if exists $config->{default_timeout};
20             $ok_to_compress =
21             ( defined $config->{compress_threshold}
22             and int($config->{compress_threshold}) > 1
23             and defined $config->{compress_method});
24             Cache::Memcached::Fast->new($config);
25             };
26              
27             register memcached_compress => sub {
28 0 0   0     unless ($ok_to_compress) {
29 0           warn
30             "Cannot compress. Check the 'compress_threshold' and 'compress_method' configuration options";
31 0           return;
32             }
33             $cache->compress(
34 0           !!$_[0]
35             );
36             };
37              
38             register memcached_get_or_set => sub {
39 0 0 0 0     $cache->get($_[0]) or do {
40 0           my $ret;
41 0 0         $cache->set($_[0], $ret = ref $_[1] eq 'CODE' ? $_[1]->() : $_[1]);
42 0           $ret;
43             }
44             or $_[1];
45             };
46              
47             register memcached_get => sub {
48 0 0 0 0     return $cache->get($_[0]) if $#_ == 0 and !ref $_[0];
49 0 0         $cache->get_multi(map {ref $_ and ref $_ eq 'ARRAY' ? @$_ : $_} @_);
  0 0          
50             };
51              
52             register memcached_gets => sub {
53 0 0 0 0     return $cache->gets($_[0]) if $#_ == 0 and !ref $_[0];
54 0 0         $cache->gets_multi(map {ref $_ and ref $_ eq 'ARRAY' ? @$_ : $_} @_);
  0 0          
55             };
56              
57             register memcached_set => sub {
58 0 0   0     return $cache->set(
    0          
    0          
59             $_[0],
60             ref $_[1] eq 'CODE' ? $_[1]->() : $_[1],
61             defined $_[2] ? $_[2] : $default_timeout
62             ) if ref $_[0] ne 'ARRAY';
63 0 0         $cache->set_multi(
    0          
64 0           map {[
65             $_->[0],
66             ref $_->[1] eq 'CODE' ? $_->[1]->() : $_->[1],
67             defined $_->[2] ? $_->[2] : $default_timeout
68             ]
69 0           } grep {ref $_ eq 'ARRAY'} @_
70             );
71             };
72              
73             register memcached_add => sub {
74 0 0   0     return $cache->add(
    0          
    0          
75             $_[0],
76             ref $_[1] eq 'CODE' ? $_[1]->() : $_[1],
77             defined $_[2] ? $_[2] : $default_timeout
78             ) if ref $_[0] ne 'ARRAY';
79 0 0         $cache->add_multi(
    0          
80 0           map {[
81             $_->[0],
82             ref $_->[1] eq 'CODE' ? $_->[1]->() : $_->[1],
83             defined $_->[2] ? $_->[2] : $default_timeout
84             ]
85 0           } grep {ref $_ eq 'ARRAY'} @_
86             );
87             };
88              
89             register memcached_replace => sub {
90 0 0   0     return $cache->replace(
    0          
    0          
91             $_[0],
92             ref $_[1] eq 'CODE' ? $_[1]->() : $_[1],
93             defined $_[2] ? $_[2] : $default_timeout
94             ) if ref $_[0] ne 'ARRAY';
95 0 0         $cache->replace_multi(
    0          
96 0           map {[
97             $_->[0],
98             ref $_->[1] eq 'CODE' ? $_->[1]->() : $_->[1],
99             defined $_->[2] ? $_->[2] : $default_timeout
100             ]
101 0           } grep {ref $_ eq 'ARRAY'} @_
102             );
103             };
104              
105             register memcached_delete => sub {
106 0 0 0 0     return $cache->delete($_[0]) if $#_ == 0 and !ref $_[0];
107 0 0 0       $cache->delete_multi(
108 0           map {(ref $_ and ref $_ eq 'ARRAY') ? @$_ : $_} @_
109             );
110             };
111              
112             register memcached_append => sub {
113 0 0 0 0     return $cache->append(@_) if ($#_ == 1 and !ref $_[0] and !ref $_[1]);
      0        
114 0           $cache->append_multi(
115 0           grep {ref $_ eq 'ARRAY'} @_
116             );
117             };
118              
119             register memcached_prepend => sub {
120 0 0 0 0     return $cache->prepend(@_) if ($#_ == 1 and !ref $_[0] and !ref $_[1]);
      0        
121 0           $cache->prepend_multi(
122 0           grep {ref $_ eq 'ARRAY'} @_
123             );
124             };
125              
126             register memcached_incr => sub {
127 0 0 0 0     return $cache->incr(@_) if ($#_ <= 2 and scalar grep {!ref $_} @_);
  0            
128 0           $cache->incr_multi(
129 0           grep {ref $_ eq 'ARRAY'} @_
130             );
131             };
132              
133             register memcached_decr => sub {
134 0 0 0 0     return $cache->decr(@_) if ($#_ <= 2 and scalar grep {!ref $_} @_);
  0            
135 0           $cache->decr_multi(
136 0           grep {ref $_ eq 'ARRAY'} @_
137             );
138             };
139              
140             register memcached_flush_all => sub {
141 0     0     $cache->flush_all(
142             @_);
143             };
144              
145             register memcached_nowait_push => sub {
146 0     0     $cache->nowait_push;
147             };
148              
149             register memcached_server_versions => sub {
150 0     0     $cache->server_versions;
151             };
152              
153             register memcached_disconnect_all => sub {
154 0     0     $cache->disconnect_all;
155             };
156              
157             register memcached_namespace => sub {
158 0     0     $cache->namespace(
159             $_[0]
160             );
161             };
162              
163             register_plugin;
164              
165             1;
166              
167             __END__