Commit | Line | Data |
a0cb3900 |
1 | |
2 | package Memoize::Expire; |
3 | # require 5.00556; |
4 | use Carp; |
5 | $DEBUG = 0; |
899dc88a |
6 | $VERSION = '0.65'; |
a0cb3900 |
7 | |
8 | # This package will implement expiration by prepending a fixed-length header |
9 | # to the font of the cached data. The format of the header will be: |
10 | # (4-byte number of last-access-time) (For LRU when I implement it) |
11 | # (4-byte expiration time: unsigned seconds-since-unix-epoch) |
12 | # (2-byte number-of-uses-before-expire) |
13 | |
14 | sub _header_fmt () { "N N n" } |
15 | sub _header_size () { length(_header_fmt) } |
16 | |
17 | # Usage: memoize func |
18 | # TIE => [Memoize::Expire, LIFETIME => sec, NUM_USES => n, |
19 | # TIE => [...] ] |
20 | |
21 | sub TIEHASH { |
22 | my ($package, %args) = @_; |
23 | my %cache; |
24 | if ($args{TIE}) { |
25 | my ($module, @opts) = @{$args{TIE}}; |
26 | my $modulefile = $module . '.pm'; |
27 | $modulefile =~ s{::}{/}g; |
28 | eval { require $modulefile }; |
29 | if ($@) { |
30 | croak "Memoize::Expire: Couldn't load hash tie module `$module': $@; aborting"; |
31 | } |
32 | my $rc = (tie %cache => $module, @opts); |
33 | unless ($rc) { |
34 | croak "Memoize::Expire: Couldn't tie hash to `$module': $@; aborting"; |
35 | } |
36 | } |
37 | $args{LIFETIME} ||= 0; |
38 | $args{NUM_USES} ||= 0; |
39 | $args{C} = \%cache; |
40 | bless \%args => $package; |
41 | } |
42 | |
43 | sub STORE { |
44 | $DEBUG and print STDERR " >> Store $_[1] $_[2]\n"; |
45 | my ($self, $key, $value) = @_; |
46 | my $expire_time = $self->{LIFETIME} > 0 ? $self->{LIFETIME} + time : 0; |
47 | # The call that results in a value to store into the cache is the |
48 | # first of the NUM_USES allowed calls. |
49 | my $header = _make_header(time, $expire_time, $self->{NUM_USES}-1); |
50 | $self->{C}{$key} = $header . $value; |
51 | $value; |
52 | } |
53 | |
54 | sub FETCH { |
55 | $DEBUG and print STDERR " >> Fetch cached value for $_[1]\n"; |
56 | my ($data, $last_access, $expire_time, $num_uses_left) = _get_item($_[0]{C}{$_[1]}); |
57 | $DEBUG and print STDERR " >> (ttl: ", ($expire_time-time), ", nuses: $num_uses_left)\n"; |
58 | $num_uses_left--; |
59 | $last_access = time; |
60 | _set_header(@_, $data, $last_access, $expire_time, $num_uses_left); |
61 | $data; |
62 | } |
63 | |
64 | sub EXISTS { |
65 | $DEBUG and print STDERR " >> Exists $_[1]\n"; |
66 | unless (exists $_[0]{C}{$_[1]}) { |
67 | $DEBUG and print STDERR " Not in underlying hash at all.\n"; |
68 | return 0; |
69 | } |
70 | my $item = $_[0]{C}{$_[1]}; |
71 | my ($last_access, $expire_time, $num_uses_left) = _get_header($item); |
72 | my $ttl = $expire_time - time; |
73 | if ($DEBUG) { |
74 | $_[0]{LIFETIME} and print STDERR " Time to live for this item: $ttl\n"; |
75 | $_[0]{NUM_USES} and print STDERR " Uses remaining: $num_uses_left\n"; |
76 | } |
77 | if ( (! $_[0]{LIFETIME} || $expire_time > time) |
78 | && (! $_[0]{NUM_USES} || $num_uses_left > 0 )) { |
79 | $DEBUG and print STDERR " (Still good)\n"; |
80 | return 1; |
81 | } else { |
82 | $DEBUG and print STDERR " (Expired)\n"; |
83 | return 0; |
84 | } |
85 | } |
86 | |
87 | # Arguments: last access time, expire time, number of uses remaining |
88 | sub _make_header { |
89 | pack "N N n", @_; |
90 | } |
91 | |
92 | sub _strip_header { |
93 | substr($_[0], 10); |
94 | } |
95 | |
96 | # Arguments: last access time, expire time, number of uses remaining |
97 | sub _set_header { |
98 | my ($self, $key, $data, @header) = @_; |
99 | $self->{C}{$key} = _make_header(@header) . $data; |
100 | } |
101 | |
102 | sub _get_item { |
103 | my $data = substr($_[0], 10); |
104 | my @header = unpack "N N n", substr($_[0], 0, 10); |
105 | # print STDERR " >> _get_item: $data => $data @header\n"; |
106 | ($data, @header); |
107 | } |
108 | |
109 | # Return last access time, expire time, number of uses remaining |
110 | sub _get_header { |
111 | unpack "N N n", substr($_[0], 0, 10); |
112 | } |
113 | |
114 | 1; |
115 | |
116 | # Below is the stub of documentation for your module. You better edit it! |
117 | |
118 | =head1 NAME |
119 | |
120 | Memoize::Expire - Plug-in module for automatic expiration of memoized values |
121 | |
122 | =head1 SYNOPSIS |
123 | |
124 | use Memoize; |
899dc88a |
125 | use Memoize::Expire; |
126 | tie my %cache => 'Memoize::Expire', |
a0cb3900 |
127 | LIFETIME => $lifetime, # In seconds |
899dc88a |
128 | NUM_USES => $n_uses; |
129 | |
130 | memoize 'function', SCALAR_CACHE => [HASH => \%cache ]; |
a0cb3900 |
131 | |
132 | =head1 DESCRIPTION |
133 | |
134 | Memoize::Expire is a plug-in module for Memoize. It allows the cached |
135 | values for memoized functions to expire automatically. This manual |
136 | assumes you are already familiar with the Memoize module. If not, you |
137 | should study that manual carefully first, paying particular attention |
899dc88a |
138 | to the HASH feature. |
a0cb3900 |
139 | |
140 | Memoize::Expire is a layer of software that you can insert in between |
141 | Memoize itself and whatever underlying package implements the cache. |
899dc88a |
142 | The layer presents a hash variable whose values expire whenever they |
143 | get too old, have been used too often, or both. You tell C<Memoize> to |
144 | use this forgetful hash as its cache instead of the default, which is |
145 | an ordinary hash. |
a0cb3900 |
146 | |
899dc88a |
147 | To specify a real-time timeout, supply the C<LIFETIME> option with a |
a0cb3900 |
148 | numeric value. Cached data will expire after this many seconds, and |
149 | will be looked up afresh when it expires. When a data item is looked |
150 | up afresh, its lifetime is reset. |
151 | |
899dc88a |
152 | If you specify C<NUM_USES> with an argument of I<n>, then each cached |
a0cb3900 |
153 | data item will be discarded and looked up afresh after the I<n>th time |
154 | you access it. When a data item is looked up afresh, its number of |
155 | uses is reset. |
156 | |
157 | If you specify both arguments, data will be discarded from the cache |
899dc88a |
158 | when either expiration condition holds. |
159 | |
160 | Memoize::Expire uses a real hash internally to store the cached data. |
161 | You can use the C<HASH> option to Memoize::Expire to supply a tied |
162 | hash in place of the ordinary hash that Memoize::Expire will normally |
163 | use. You can use this feature to add Memoize::Expire as a layer in |
164 | between a persistent disk hash and Memoize. If you do this, you get a |
165 | persistent disk cache whose entries expire automatically. For |
166 | example: |
167 | |
168 | # Memoize |
169 | # | |
170 | # Memoize::Expire enforces data expiration policy |
171 | # | |
172 | # DB_File implements persistence of data in a disk file |
173 | # | |
174 | # Disk file |
a0cb3900 |
175 | |
176 | use Memoize; |
899dc88a |
177 | use Memoize::Expire; |
a0cb3900 |
178 | use DB_File; |
a0cb3900 |
179 | |
899dc88a |
180 | # Set up persistence |
181 | tie my %disk_cache => 'DB_File', $filename, O_CREAT|O_RDWR, 0666]; |
a0cb3900 |
182 | |
899dc88a |
183 | # Set up expiration policy, supplying persistent hash as a target |
184 | tie my %cache => 'Memoize::Expire', |
185 | LIFETIME => $lifetime, # In seconds |
186 | NUM_USES => $n_uses, |
187 | HASH => \%disk_cache; |
188 | |
189 | # Set up memoization, supplying expiring persistent hash for cache |
190 | memoize 'function', SCALAR_CACHE => [ HASH => \%cache ]; |
a0cb3900 |
191 | |
192 | =head1 INTERFACE |
193 | |
194 | There is nothing special about Memoize::Expire. It is just an |
195 | example. If you don't like the policy that it implements, you are |
196 | free to write your own expiration policy module that implements |
197 | whatever policy you desire. Here is how to do that. Let us suppose |
198 | that your module will be named MyExpirePolicy. |
199 | |
200 | Short summary: You need to create a package that defines four methods: |
201 | |
202 | =over 4 |
203 | |
204 | =item |
205 | TIEHASH |
206 | |
207 | Construct and return cache object. |
208 | |
209 | =item |
210 | EXISTS |
211 | |
212 | Given a function argument, is the corresponding function value in the |
213 | cache, and if so, is it fresh enough to use? |
214 | |
215 | =item |
216 | FETCH |
217 | |
218 | Given a function argument, look up the corresponding function value in |
219 | the cache and return it. |
220 | |
221 | =item |
222 | STORE |
223 | |
224 | Given a function argument and the corresponding function value, store |
225 | them into the cache. |
226 | |
227 | =back |
228 | |
229 | The user who wants the memoization cache to be expired according to |
230 | your policy will say so by writing |
231 | |
899dc88a |
232 | tie my %cache => 'MyExpirePolicy', args...; |
233 | memoize 'function', SCALAR_CACHE => [HASH => \%cache]; |
a0cb3900 |
234 | |
899dc88a |
235 | This will invoke C<< MyExpirePolicy->TIEHASH(args) >>. |
a0cb3900 |
236 | MyExpirePolicy::TIEHASH should do whatever is appropriate to set up |
899dc88a |
237 | the cache, and it should return the cache object to the caller. |
a0cb3900 |
238 | |
239 | For example, MyExpirePolicy::TIEHASH might create an object that |
240 | contains a regular Perl hash (which it will to store the cached |
241 | values) and some extra information about the arguments and how old the |
242 | data is and things like that. Let us call this object `C'. |
243 | |
244 | When Memoize needs to check to see if an entry is in the cache |
899dc88a |
245 | already, it will invoke C<< C->EXISTS(key) >>. C<key> is the normalized |
a0cb3900 |
246 | function argument. MyExpirePolicy::EXISTS should return 0 if the key |
247 | is not in the cache, or if it has expired, and 1 if an unexpired value |
248 | is in the cache. It should I<not> return C<undef>, because there is a |
249 | bug in some versions of Perl that will cause a spurious FETCH if the |
250 | EXISTS method returns C<undef>. |
251 | |
252 | If your EXISTS function returns true, Memoize will try to fetch the |
899dc88a |
253 | cached value by invoking C<< C->FETCH(key) >>. MyExpirePolicy::FETCH should |
a0cb3900 |
254 | return the cached value. Otherwise, Memoize will call the memoized |
255 | function to compute the appropriate value, and will store it into the |
899dc88a |
256 | cache by calling C<< C->STORE(key, value) >>. |
a0cb3900 |
257 | |
258 | Here is a very brief example of a policy module that expires each |
259 | cache item after ten seconds. |
260 | |
261 | package Memoize::TenSecondExpire; |
262 | |
263 | sub TIEHASH { |
899dc88a |
264 | my ($package, %args) = @_; |
265 | my $cache = $args{$HASH} || {}; |
266 | bless $cache => $package; |
a0cb3900 |
267 | } |
268 | |
269 | sub EXISTS { |
270 | my ($cache, $key) = @_; |
271 | if (exists $cache->{$key} && |
272 | $cache->{$key}{EXPIRE_TIME} > time) { |
273 | return 1 |
274 | } else { |
275 | return 0; # Do NOT return `undef' here. |
276 | } |
277 | } |
278 | |
279 | sub FETCH { |
280 | my ($cache, $key) = @_; |
281 | return $cache->{$key}{VALUE}; |
282 | } |
283 | |
284 | sub STORE { |
285 | my ($cache, $key, $newvalue) = @_; |
286 | $cache->{$key}{VALUE} = $newvalue; |
287 | $cache->{$key}{EXPIRE_TIME} = time + 10; |
288 | } |
289 | |
290 | To use this expiration policy, the user would say |
291 | |
292 | use Memoize; |
899dc88a |
293 | tie my %cache10sec => 'Memoize::TenSecondExpire'; |
294 | memoize 'function', SCALAR_CACHE => [HASH => \%cache10sec]; |
a0cb3900 |
295 | |
296 | Memoize would then call C<function> whenever a cached value was |
297 | entirely absent or was older than ten seconds. |
298 | |
899dc88a |
299 | You should always support a C<HASH> argument to C<TIEHASH> that ties |
300 | the underlying cache so that the user can specify that the cache is |
301 | also persistent or that it has some other interesting semantics. The |
302 | example above demonstrates how to do this, as does C<Memozie::Expire>. |
a0cb3900 |
303 | |
304 | Another sample module, C<Memoize::Saves>, is included with this |
305 | package. It implements a policy that allows you to specify that |
306 | certain function values whould always be looked up afresh. See the |
307 | documentation for details. |
308 | |
309 | =head1 ALTERNATIVES |
310 | |
899dc88a |
311 | Brent Powers has a C<Memoize::ExpireLRU> module that was designed to |
312 | wotk with Memoize and provides expiration of least-recently-used data. |
313 | The cache is held at a fixed number of entries, and when new data |
314 | comes in, the least-recently used data is expired. See |
315 | L<http://search.cpan.org/search?mode=module&query=ExpireLRU>. |
316 | |
a0cb3900 |
317 | Joshua Chamas's Tie::Cache module may be useful as an expiration |
318 | manager. (If you try this, let me know how it works out.) |
319 | |
320 | If you develop any useful expiration managers that you think should be |
321 | distributed with Memoize, please let me know. |
322 | |
323 | =head1 CAVEATS |
324 | |
325 | This module is experimental, and may contain bugs. Please report bugs |
326 | to the address below. |
327 | |
328 | Number-of-uses is stored as a 16-bit unsigned integer, so can't exceed |
329 | 65535. |
330 | |
331 | Because of clock granularity, expiration times may occur up to one |
332 | second sooner than you expect. For example, suppose you store a value |
333 | with a lifetime of ten seconds, and you store it at 12:00:00.998 on a |
334 | certain day. Memoize will look at the clock and see 12:00:00. Then |
335 | 9.01 seconds later, at 12:00:10.008 you try to read it back. Memoize |
336 | will look at the clock and see 12:00:10 and conclude that the value |
337 | has expired. Solution: Build an expiration policy module that uses |
338 | Time::HiRes to examine a clock with better granularity. Contributions |
339 | are welcome. Send them to: |
340 | |
341 | =head1 AUTHOR |
342 | |
343 | Mark-Jason Dominus (mjd-perl-memoize+@plover.com) |
344 | |
345 | Mike Cariaso provided valuable insight into the best way to solve this |
899dc88a |
346 | problem. |
a0cb3900 |
347 | |
348 | =head1 SEE ALSO |
349 | |
350 | perl(1) |
351 | |
352 | The Memoize man page. |
353 | |
354 | http://www.plover.com/~mjd/perl/Memoize/ (for news and updates) |
355 | |
356 | I maintain a mailing list on which I occasionally announce new |
357 | versions of Memoize. The list is for announcements only, not |
358 | discussion. To join, send an empty message to |
359 | mjd-perl-memoize-request@Plover.com. |
360 | |
361 | =cut |