File Coverage

blib/lib/Cache/CacheFactory/Expiry/Base.pm
Criterion Covered Total %
statement 32 39 82.0
branch 5 8 62.5
condition 1 3 33.3
subroutine 10 15 66.6
pod 12 12 100.0
total 60 77 77.9


line stmt bran cond sub pod time code
1             ###############################################################################
2             # Purpose : Cache Expiry Base Class.
3             # Author : Sam Graham
4             # Created : 25 Jun 2008
5             # CVS : $Id: Base.pm,v 1.8 2010-02-16 12:25:41 illusori Exp $
6             ###############################################################################
7              
8             package Cache::CacheFactory::Expiry::Base;
9              
10 4     4   23 use warnings;
  4         7  
  4         112  
11 4     4   19 use strict;
  4         9  
  4         2470  
12              
13             $Cache::CacheFactory::Expiry::Base::VERSION = '1.10';
14              
15             sub new
16             {
17 5     5 1 10 my ( $class, $param ) = @_;
18 5         10 my ( $self );
19              
20 5         10 $self = {};
21 5   33     39 bless $self, ( ref( $class ) || $class );
22              
23             # Common options.
24             $self->set_purge_order( $param->{ purge_order } )
25 5 50       23 if exists $param->{ purge_order };
26              
27 5         22 $self->read_startup_options( $param );
28              
29 5         57 return( $self );
30             }
31              
32             sub read_startup_options
33             {
34 0     0 1 0 my ( $self, $param ) = @_;
35              
36             }
37              
38             sub set_object_validity
39             {
40 0     0 1 0 my ( $self, $key, $object, $param ) = @_;
41             }
42              
43             sub set_object_pruning
44             {
45 0     0 1 0 my ( $self, $key, $object, $param ) = @_;
46             }
47              
48             sub should_keep
49             {
50 0     0 1 0 my ( $self, $cache, $storage, $policytype, $object ) = @_;
51              
52 0         0 return( 1 );
53             }
54              
55             sub is_valid
56             {
57 11     11 1 24 my ( $self, $cache, $storage, $object ) = @_;
58              
59 11         42 return( $self->should_keep( $cache, $storage, 'validity', $object ) );
60             }
61              
62             sub set_purge_order
63             {
64 0     0 1 0 my ( $self, $purge_order ) = @_;
65              
66 0         0 $self->{ purge_order } = $purge_order;
67             }
68              
69             sub purge
70             {
71 6     6 1 12 my ( $self, $cache ) = @_;
72              
73 6 50       29 return unless $self->pre_purge_hook( $cache );
74              
75             # This processes the objects in no particular order, if the order
76             # matters to you, you will need to redefine it.
77             $cache->foreach_policy( 'storage',
78             sub
79             {
80 6     6   13 my ( $cache, $policy, $storage ) = @_;
81              
82             return
83 6 50       29 unless $self->pre_purge_per_storage_hook( $cache, $storage );
84              
85             # TODO: take into account purge-order.
86 6         27 foreach my $key ( $storage->get_keys() )
87             {
88 8         108 my ( $object );
89              
90 8         28 $object = $storage->get_object( $key );
91              
92 8 100       781 $storage->remove( $key )
93             unless $self->should_keep(
94             $cache, $storage, 'pruning', $object );
95             }
96              
97 6         107 $self->post_purge_per_storage_hook( $cache, $storage );
98 6         53 } );
99              
100 6         52 $self->post_purge_hook( $cache );
101             }
102              
103             #
104             # Redefine these to do anything funky.
105             sub pre_purge_hook
106             {
107 6     6 1 12 my ( $self, $cache ) = @_;
108              
109 6         28 return( 1 );
110             }
111              
112             sub post_purge_hook
113             {
114 6     6 1 19 my ( $self, $cache ) = @_;
115             }
116              
117             sub pre_purge_per_storage_hook
118             {
119 6     6 1 11 my ( $self, $cache, $storage ) = @_;
120              
121 6         23 return( 1 );
122             }
123              
124             sub post_purge_per_storage_hook
125             {
126 6     6 1 23 my ( $self, $cache, $storage ) = @_;
127             }
128              
129             1;
130              
131             =pod
132              
133             =head1 NAME
134              
135             Cache::CacheFactory::Expiry::Base - Base class for Cache::CacheFactory expiry policies.
136              
137             =head1 DESCRIPTION
138              
139             L
140             is the base class for L expiry
141             (pruning and validity) policies.
142              
143             It provides the base API to adhere to when writing your own custom
144             policies.
145              
146             =head1 METHODS
147              
148             =over
149              
150             =item $policy = Cache::CacheFactory::Expiry::Base->new( $options )
151              
152             Construct a new expiry policy object with the specified options supplied
153             as a hashref.
154              
155             What options are avaiable depends on the subclass, you should check the
156             documentation there.
157              
158             The C constructor should never need to be called directly, this
159             is handled for you automatically when a policy is set for a cache.
160              
161             =item $policy->read_startup_options( $options )
162              
163             This method is called by the base C constructor, it allows
164             subclasses to read and process their startup options without having
165             to mess around with redefining the constructor.
166              
167             =item $policy->set_object_validity( $key, $object, $param )
168              
169             =item $policy->set_object_pruning( $key, $object, $param )
170              
171             These two methods are invoked when a piece of data is first stored
172             in the cache, just prior to the actual storage, this allows the
173             validity and pruning policies to store any neccessary meta-data
174             against the object for when it is fetched from the cache again.
175              
176             C<$key> is the key the data is being stored against.
177              
178             C<$object> is the L wrapper around
179             the data. If you're storing meta-data against the object you will
180             want to look at the C<< $object->set_policy_metadata() >> method.
181              
182             C<$param> is a hashref to %additional_param supplied to
183             C<< $cache->set() >>.
184              
185             =item $boolean = $policy->should_keep( $cache, $storage, $policytype, $object );
186              
187             C<< $policy->should_keep() >> is the core of a expiry policy, it should
188             return a true value if the object should be kept or a false value if the
189             object should be considered invalid or be pruned.
190              
191             C<$cache> is the parent L,
192             this may or may not be useful to you.
193              
194             C<$storage> is the storage object instance in case you need it.
195              
196             C<$policytype> is the policy type, for an expiry policy it will be set
197             to either C<'validity'> if the validity of an object is being tested,
198             or C<'pruning'> if we're checking if the object should be pruned. I
199             policies will only care about the C<$policytype> if they need to access
200             per-policy meta-data on the object.
201              
202             C<$object> is the L
203             instance for the cache entry being tested. You'll probably want to call
204             some methods on this to make a decision about whether it should be kept
205             or not. C<< $object->get_policy_metadata() >> may prove useful here if
206             you've stored data during C<< $policy->set_object_validity() >> or
207             C<< $policy->set_object_pruning() >>.
208              
209             =item $boolean = $policy->is_valid( $cache, $storage, $object );
210              
211             Wrapper function around C<< $policy->should_keep() >>, this is called
212             when the policy is being used as a validity policy. You shouldn't need
213             to change anything about this method.
214              
215             =item $policy->purge( $cache );
216              
217             This function iterates over each storage policy getting a list of all
218             their keys, then calls C<< $policy->should_keep() >> with C<$policytype>
219             set to C<'pruning'>, if the returned value is false then the key is
220             removed from that storage policy, if the returned value is true then no
221             change occurs.
222              
223             If you're writing your own policy you may need to redefine this method
224             if you care about the order in which objects are tested for pruning.
225              
226             =item $policy->set_purge_order( $purge_order );
227              
228             Currently unimplemented, reserved against future development.
229              
230             =item $boolean = $policy->pre_purge_hook( $cache );
231              
232             =item $policy->post_purge_hook( $cache );
233              
234             Hooks to allow a subclass to do a little setup or cleanup before
235             or after a C is run. If a false value is returned from
236             C<< $policy->pre_purge_hook() >> then the purge will be aborted
237             for B pruning policy. No other policies will be effected.
238              
239             It's good practice to include a call to C<< $policy->SUPER::pre_purge_hook() >>
240             or C<< $policy->SUPER::post_purge_hook() >> if you're redefining
241             these methods.
242              
243             =item $boolean = $policy->pre_purge_per_storage_hook( $cache, $storage );
244              
245             =item $policy->post_purge_per_storage_hook( $cache, $storage );
246              
247             Hooks to allow a subclass to do a little setup or cleanup before
248             or after the C against each storage policy. If a false
249             value is returned from C<< $policy->pre_purge_per_storage_hook() >>
250             then the purge will be aborted for B storage policy for B
251             pruning policy. No other policies will be effected.
252              
253             It's good practice to include a call to
254             C<< $policy->SUPER::pre_purge_per_storage_hook() >>
255             or C<< $policy->SUPER::post_purge_per_storage_hook() >> if you're
256             redefining these methods.
257              
258             =back
259              
260             =head1 SEE ALSO
261              
262             L, L, L
263              
264             =head1 AUTHORS
265              
266             Original author: Sam Graham
267              
268             Last author: $Author: illusori $
269              
270             =head1 COPYRIGHT
271              
272             Copyright 2008-2010 Sam Graham.
273              
274             This library is free software; you can redistribute it and/or
275             modify it under the same terms as Perl itself.
276              
277             =cut