| 1 | package Memoize::ExpireTest; |
| 2 | |
| 3 | =head1 NAME |
| 4 | |
| 5 | Memoize::ExpireTest - test for Memoize expiration semantics |
| 6 | |
| 7 | =head1 DESCRIPTION |
| 8 | |
| 9 | This module is just for testing expiration semantics. It's not a very |
| 10 | good example of how to write an expiration module. |
| 11 | |
| 12 | If you are looking for an example, I recommend that you look at the |
| 13 | simple example in the Memoize::Expire documentation, or at the code |
| 14 | for Memoize::Expire itself. |
| 15 | |
| 16 | If you have questions, I will be happy to answer them if you send them |
| 17 | to mjd-perl-memoize+@plover.com. |
| 18 | |
| 19 | =cut |
| 20 | |
| 21 | $VERSION = 0.65; |
| 22 | my %cache; |
| 23 | |
| 24 | sub TIEHASH { |
| 25 | my ($pack) = @_; |
| 26 | bless \%cache => $pack; |
| 27 | } |
| 28 | |
| 29 | sub EXISTS { |
| 30 | my ($cache, $key) = @_; |
| 31 | exists $cache->{$key} ? 1 : 0; |
| 32 | } |
| 33 | |
| 34 | sub FETCH { |
| 35 | my ($cache, $key) = @_; |
| 36 | $cache->{$key}; |
| 37 | } |
| 38 | |
| 39 | sub STORE { |
| 40 | my ($cache, $key, $val) = @_; |
| 41 | $cache->{$key} = $val; |
| 42 | } |
| 43 | |
| 44 | sub expire { |
| 45 | my ($key) = @_; |
| 46 | delete $cache{$key}; |
| 47 | } |
| 48 | |
| 49 | 1; |