File Coverage

blib/lib/Cache/Sliding.pm
Criterion Covered Total %
statement 37 37 100.0
branch 5 6 83.3
condition n/a
subroutine 11 11 100.0
pod 4 4 100.0
total 57 58 98.2


line stmt bran cond sub pod time code
1             package Cache::Sliding;
2              
3 3     3   65442 use warnings;
  3         8  
  3         98  
4 3     3   17 use strict;
  3         4  
  3         98  
5 3     3   15 use Carp;
  3         10  
  3         743  
6              
7 3     3   2665 use version; our $VERSION = qv('1.0.2'); # update POD & Changes & README
  3         7782  
  3         17  
8              
9             # update DEPENDENCIES in POD & Makefile.PL & README
10 3     3   430 use Scalar::Util qw( weaken );
  3         9  
  3         364  
11 3     3   3305 use EV;
  3         11783  
  3         1111  
12              
13              
14             sub new {
15 3     3 1 22 my ($class, $expire_after) = @_;
16 3         12 my $self = {
17             L1 => {},
18             L2 => {},
19             t => undef,
20             };
21 3         11 weaken(my $this = $self);
22 34 50   34   48094 $self->{t} = EV::timer $expire_after, $expire_after, sub { if ($this) {
23 34         501 $this->{L2} = $this->{L1};
24 34         1795725 $this->{L1} = {};
25 3         31 } };
26 3         10 return bless $self, $class;
27             }
28              
29             sub get {
30 10     10 1 3055 my ($self, $key) = @_;
31 10 100       70 if (exists $self->{L1}{$key}) {
    100          
32 4         41 return $self->{L1}{$key};
33             }
34             elsif (exists $self->{L2}{$key}) {
35 3         29 return ($self->{L1}{$key} = delete $self->{L2}{$key});
36             }
37 3         31 return;
38             }
39              
40             sub set { ## no critic (ProhibitAmbiguousNames)
41 3     3 1 13 my ($self, $key, $value) = @_;
42 3         14 return ($self->{L1}{$key} = $value);
43             }
44              
45             sub del {
46 1     1 1 1157 my ($self, $key) = @_;
47 1         4 delete $self->{L2}{$key};
48 1         2 delete $self->{L1}{$key};
49 1         3 return;
50             }
51              
52              
53             1; # Magic true value required at end of module
54             __END__
55              
56             =head1 NAME
57              
58             Cache::Sliding - Cache using sliding time-based expiration strategy
59              
60              
61             =head1 VERSION
62              
63             This document describes Cache::Sliding version 1.0.2
64              
65              
66             =head1 SYNOPSIS
67              
68             use Cache::Sliding;
69              
70             $cache = Cache::Sliding->new(10*60);
71              
72             $cache->set($key, $value);
73             $value = $cache->get($key);
74             $cache->del($key);
75              
76              
77             =head1 DESCRIPTION
78              
79             Implement caching object using sliding time-based expiration strategy
80             (data in the cache is invalidated by specifying the amount of time the
81             item is allowed to be idle in the cache after last access time).
82              
83             Use EV::timer, so this module only useful in EV-based applications,
84             because cache expiration will work only while you inside EV::loop.
85              
86              
87             =head1 INTERFACE
88              
89             =over
90              
91             =item new( $expire_after )
92              
93             Create and return new cache object. Elements in this cache will expire
94             between $expire_after seconds and 2*$expire_after seconds.
95              
96             =item set( $key, $value )
97              
98             Add new item into cache. Will replace existing item for that $key, if any.
99              
100             =item get( $key )
101              
102             Return value of cached item for $key. If there no cached item for that $key
103             return nothing.
104              
105             For example, if you may keep undefined values in cache and still wanna be
106             able to check is item was found in cache:
107              
108             $cache->set( 'item 1', undef );
109             $val = $cache->get( 'item 1' ); # $val is undef
110             @val = $cache->get( 'item 1' ); # @val is (undef)
111             $val = $cache->get( 'nosuch' ); # $val is undef
112             @val = $cache->get( 'nosuch' ); # @val is ()
113              
114             =item del( $key )
115              
116             Remove item for $key from cache, if any. Return nothing.
117              
118             =back
119              
120              
121             =head1 DIAGNOSTICS
122              
123             None.
124              
125              
126             =head1 CONFIGURATION AND ENVIRONMENT
127              
128             Cache::Sliding requires no configuration files or environment variables.
129              
130              
131             =head1 DEPENDENCIES
132              
133             version
134             EV
135              
136             =head1 INCOMPATIBILITIES
137              
138             None reported.
139              
140              
141             =head1 BUGS AND LIMITATIONS
142              
143             No bugs have been reported.
144              
145             Please report any bugs or feature requests to
146             C<bug-cache-sliding@rt.cpan.org>, or through the web interface at
147             L<http://rt.cpan.org>.
148              
149              
150             =head1 AUTHOR
151              
152             Alex Efros C<< <powerman-asdf@ya.ru> >>
153              
154              
155             =head1 LICENSE AND COPYRIGHT
156              
157             Copyright (c) 2009, Alex Efros C<< <powerman-asdf@ya.ru> >>. All rights reserved.
158              
159             This module is free software; you can redistribute it and/or
160             modify it under the same terms as Perl itself. See L<perlartistic>.
161              
162              
163             =head1 DISCLAIMER OF WARRANTY
164              
165             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
166             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
167             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
168             PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
169             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
170             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
171             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
172             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
173             NECESSARY SERVICING, REPAIR, OR CORRECTION.
174              
175             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
176             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
177             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
178             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
179             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
180             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
181             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
182             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
183             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
184             SUCH DAMAGES.