File Coverage

blib/lib/Mojo/Redis/Cache.pm
Criterion Covered Total %
statement 57 69 82.6
branch 18 30 60.0
condition 10 20 50.0
subroutine 16 21 76.1
pod 2 2 100.0
total 103 142 72.5


line stmt bran cond sub pod time code
1             package Mojo::Redis::Cache;
2 18     18   145 use Mojo::Base -base;
  18         45  
  18         195  
3              
4 18     18   3440 use Mojo::JSON;
  18         43  
  18         787  
5 18     18   103 use Scalar::Util 'blessed';
  18         44  
  18         776  
6 18     18   13605 use Storable ();
  18         64408  
  18         523  
7 18     18   149 use Time::HiRes ();
  18         39  
  18         562  
8              
9 18     18   115 use constant OFFLINE => $ENV{MOJO_REDIS_CACHE_OFFLINE};
  18         41  
  18         24404  
10              
11             has connection => sub {
12             OFFLINE ? shift->_offline_connection : shift->redis->_dequeue->encoding(undef);
13             };
14             has deserialize => sub { \&Storable::thaw };
15             has default_expire => 600;
16             has namespace => 'cache:mojo:redis';
17             has refresh => 0;
18             has redis => sub { Carp::confess('redis is required in constructor') };
19             has serialize => sub { \&Storable::freeze };
20              
21             sub compute_p {
22 5     5 1 1430 my $compute = pop;
23 5         6 my $self = shift;
24 5         13 my $key = join ':', $self->namespace, shift;
25 5   66     42 my $expire = shift || $self->default_expire;
26              
27 5 100       17 my $p = $self->refresh ? Mojo::Promise->new->resolve : $self->connection->write_p(GET => $key);
28             return $p->then(sub {
29 5 100   5   2198 my $data = $_[0] ? $self->deserialize->(shift) : undef;
30 5 50       42 return $self->_maybe_compute_p($key, $expire, $compute, $data) if $expire < 0;
31 5 100       18 return $self->_compute_p($key, $expire, $compute) unless $data;
32 1         4 return $data->[0];
33 5         747 });
34             }
35              
36             sub memoize_p {
37 4     4 1 5297 my ($self, $obj, $method) = (shift, shift, shift);
38 4 50       16 my $args = ref $_[0] eq 'ARRAY' ? shift : [];
39 4   33     22 my $expire = shift || $self->default_expire;
40 4   33     51 my $key = join ':', '@M' => (ref($obj) || $obj), $method, Mojo::JSON::encode_json($args);
41              
42 4     3   292 return $self->compute_p($key, $expire, sub { $obj->$method(@$args) });
  3         17  
43             }
44              
45             sub _compute_p {
46 4     4   10 my ($self, $key, $expire, $compute) = @_;
47              
48             my $set = sub {
49 3     3   6 my $data = shift;
50             my @set
51 3 50       14 = $expire < 0
52             ? $self->serialize->([$data, _time() + -$expire])
53             : ($self->serialize->([$data]), PX => 1000 * $expire);
54 3         256 $self->connection->write_p(SET => $key => @set)->then(sub {$data});
  3         939  
55 4         18 };
56              
57 4         10 my $data = $compute->();
58 3 50 33 0   24 return (blessed $data and $data->can('then')) ? $data->then(sub { $set->(@_) }) : $set->($data);
  0         0  
59             }
60              
61             sub _maybe_compute_p {
62 0     0   0 my ($self, $key, $expire, $compute, $data) = @_;
63              
64             # Nothing in cache
65 0 0   0   0 return $self->_compute_p($key => $expire, $compute)->then(sub { ($_[0], {computed => 1}) }) unless $data;
  0         0  
66              
67             # No need to refresh cache
68 0 0 0     0 return ($data->[0], {expired => 0}) if $data->[1] and _time() < $data->[1];
69              
70             # Try to refresh, but use old data on error
71 0         0 my $p = Mojo::Promise->new;
72             eval {
73             $self->_compute_p($key => $expire, $compute)->then(
74 0     0   0 sub { $p->resolve(shift, {computed => 1, expired => 1}) },
75 0     0   0 sub { $p->resolve($data->[0], {error => $_[0], expired => 1}) },
76 0         0 );
77 0 0       0 } or do {
78 0         0 $p->resolve($data->[0], {error => $@, expired => 1});
79             };
80              
81 0         0 return $p;
82             }
83              
84             sub _offline_connection {
85 1 50 100 1   9 state $c = eval <<'HERE' or die $@;
  1 50 100 1   2  
  1 100   6   6  
  1 100       113  
  6 100       588  
  6         19  
  3         11  
  3         591  
  3         14  
  3         968  
  3         32  
  3         192  
86             package Mojo::Redis::Connection::Offline;
87             use Mojo::Base 'Mojo::Redis::Connection';
88             our $STORE = {}; # Meant for internal use only
89              
90             sub write_p {
91             my ($conn, $op, $key) = (shift, shift, shift);
92              
93             if ($op eq 'SET') {
94             $STORE->{$conn->url}{$key} = [$_[0], defined $_[2] ? $_[2] + Mojo::Redis::Cache::_time() * 1000 : undef];
95             return Mojo::Promise->new->resolve('OK');
96             }
97             else {
98             my $val = $STORE->{$conn->url}{$key} || [];
99             my $expired = $val->[1] && $val->[1] < Mojo::Redis::Cache::_time() * 1000;
100             delete $STORE->{$conn->url}{$key} if $expired;
101             return Mojo::Promise->new->resolve($expired ? undef : $val->[0]);
102             }
103             }
104              
105             'Mojo::Redis::Connection::Offline';
106             HERE
107 1         10 my $redis = shift->redis;
108 1         25 return $c->new(url => $redis->url);
109             }
110              
111 3     3   38 sub _time { Time::HiRes::time() }
112              
113             1;
114              
115             =encoding utf8
116              
117             =head1 NAME
118              
119             Mojo::Redis::Cache - Simple cache interface using Redis
120              
121             =head1 SYNOPSIS
122              
123             use Mojo::Redis;
124              
125             my $redis = Mojo::Redis->new;
126             my $cache = $redis->cache;
127              
128             # Cache and expire the data after 60.7 seconds
129             $cache->compute_p("some:key", 60.7, sub {
130             my $p = Mojo::Promise->new;
131             Mojo::IOLoop->timer(0.1 => sub { $p->resolve("some data") });
132             return $p;
133             })->then(sub {
134             my $some_key = shift;
135             });
136              
137             # Cache and expire the data after default_expire() seconds
138             $cache->compute_p("some:key", sub {
139             return {some => "data"};
140             })->then(sub {
141             my $some_key = shift;
142             });
143              
144             # Call $obj->get_some_slow_data() and cache the return value
145             $cache->memoize_p($obj, "get_some_slow_data")->then(sub {
146             my $data = shift;
147             });
148              
149             # Call $obj->get_some_data_by_id({id => 42}) and cache the return value
150             $cache->memoize_p($obj, "get_some_data_by_id", [{id => 42}])->then(sub {
151             my $data = shift;
152             });
153              
154             See L
155             for example L application.
156              
157             =head1 DESCRIPTION
158              
159             L provides a simple interface for caching data in the
160             Redis database. There is no "check if exists", "get" or "set" methods in this
161             class. Instead, both L and L will fetch the value
162             from Redis, if the given compute function / method has been called once, and
163             the cached data is not expired.
164              
165             If you need to check if the value exists, then you can manually look up the
166             the key using L.
167              
168             =head1 ENVIRONMENT VARIABLES
169              
170             =head2 MOJO_REDIS_CACHE_OFFLINE
171              
172             Set C to 1 if you want to use this cache without a
173             real Redis backend. This can be useful in unit tests.
174              
175             =head1 ATTRIBUTES
176              
177             =head2 connection
178              
179             $conn = $cache->connection;
180             $cache = $cache->connection(Mojo::Redis::Connection->new);
181              
182             Holds a L object.
183              
184             =head2 default_expire
185              
186             $num = $cache->default_expire;
187             $cache = $cache->default_expire(600);
188              
189             Holds the default expire time for cached data.
190              
191             =head2 deserialize
192              
193             $cb = $cache->deserialize;
194             $cache = $cache->deserialize(\&Mojo::JSON::decode_json);
195              
196             Holds a callback used to deserialize data from Redis.
197              
198             =head2 namespace
199              
200             $str = $cache->namespace;
201             $cache = $cache->namespace("cache:mojo:redis");
202              
203             Prefix for the cache key.
204              
205             =head2 redis
206              
207             $conn = $cache->redis;
208             $cache = $cache->redis(Mojo::Redis->new);
209              
210             Holds a L object used to create the connection to talk with Redis.
211              
212             =head2 refresh
213              
214             $bool = $cache->refresh;
215             $cache = $cache->refresh(1);
216              
217             Will force the cache to be computed again if set to a true value.
218              
219             =head2 serialize
220              
221             $cb = $cache->serialize;
222             $cache = $cache->serialize(\&Mojo::JSON::encode_json);
223              
224             Holds a callback used to serialize before storing the data in Redis.
225              
226             =head1 METHODS
227              
228             =head2 compute_p
229              
230             $promise = $cache->compute_p($key => $expire => $compute_function);
231             $promise = $cache->compute_p($key => $expire => sub { return "data" });
232             $promise = $cache->compute_p($key => $expire => sub { return Mojo::Promise->new });
233              
234             This method will store the return value from the C<$compute_function> the
235             first time it is called and pass the same value to L.
236             C<$compute_function> will not be called the next time, if the C<$key> is
237             still present in Redis, but instead the cached value will be passed on to
238             L.
239              
240             C<$key> will be prefixed by L resulting in "namespace:some-key".
241              
242             C<$expire> is the number of seconds before the cache should expire, and will
243             default to L unless passed in. The last argument is a
244             callback used to calculate cached value.
245              
246             C<$expire> can also be a negative number. This will result in serving old cache
247             in the case where the C<$compute_function> fails. An example usecase would be
248             if you are fetching Twitter updates for your website, but instead of throwing
249             an exception if Twitter is down, you will serve old data instead. Note that the
250             fulfilled promise will get two variables passed in:
251              
252             $promise->then(sub { my ($data, $info) = @_ });
253              
254             C<$info> is a hash and can have these keys:
255              
256             =over 2
257              
258             =item * computed
259              
260             Will be true if the C<$compute_function> was called successfully and C<$data>
261             is fresh.
262              
263             =item * expired
264              
265             Will be true if C<$data> is expired. If this key is present and false, it will
266             indicate that the C<$data> is within the expiration period. The C key
267             can be found together with both L and L.
268              
269             =item * error
270              
271             Will hold a string if the C<$compute_function> failed.
272              
273             =back
274              
275             Negative C<$expire> is currently EXPERIMENTAL, but unlikely to go away.
276              
277             =head2 memoize_p
278              
279             $promise = $cache->memoize_p($obj, $method_name, \@args, $expire);
280             $promise = $cache->memoize_p($class, $method_name, \@args, $expire);
281              
282             L behaves the same way as L, but has a convenient
283             interface for calling methods on an object. One of the benefits is that you
284             do not have to come up with your own cache key. This method is pretty much
285             the same as:
286              
287             $promise = $cache->compute_p(
288             join(":", $cache->namespace, "@M", ref($obj), $method_name, serialize(\@args)),
289             $expire,
290             sub { return $obj->$method_name(@args) }
291             );
292              
293             See L regarding C<$expire>.
294              
295             =head1 SEE ALSO
296              
297             L
298              
299             =cut