Commit | Line | Data |
a0cb3900 |
1 | package Memoize::Saves; |
2 | |
899dc88a |
3 | $VERSION = 0.65; |
4 | |
a0cb3900 |
5 | $DEBUG = 0; |
6 | |
7 | sub TIEHASH |
8 | { |
9 | my ($package, %args) = @_; |
899dc88a |
10 | my $cache = $args{HASH} || {}; |
a0cb3900 |
11 | |
12 | # Convert the CACHE to a referenced hash for quick lookup |
13 | # |
14 | if( $args{CACHE} ) |
15 | { |
16 | my %hash; |
17 | $args{CACHE} = [ $args{CACHE} ] unless ref $args{CACHE} eq "ARRAY"; |
18 | foreach my $value ( @{$args{CACHE}} ) |
19 | { |
20 | $hash{$value} = 1; |
21 | } |
22 | $args{CACHE} = \%hash; |
23 | } |
24 | |
25 | # Convert the DUMP list to a referenced hash for quick lookup |
26 | # |
27 | if( $args{DUMP} ) |
28 | { |
29 | my %hash; |
30 | $args{DUMP} = [ $args{DUMP} ] unless ref $args{DUMP} eq "ARRAY"; |
31 | foreach my $value ( @{$args{DUMP}} ) |
32 | { |
33 | $hash{$value} = 1; |
34 | } |
35 | $args{DUMP} = \%hash; |
36 | } |
37 | |
38 | if ($args{TIE}) |
39 | { |
40 | my ($module, @opts) = @{$args{TIE}}; |
41 | my $modulefile = $module . '.pm'; |
42 | $modulefile =~ s{::}{/}g; |
43 | eval { require $modulefile }; |
44 | if ($@) { |
45 | die "Memoize::Saves: Couldn't load hash tie module `$module': $@; aborting"; |
46 | } |
899dc88a |
47 | my $rc = (tie %$cache => $module, @opts); |
a0cb3900 |
48 | unless ($rc) { |
49 | die "Memoize::Saves: Couldn't tie hash to `$module': $@; aborting"; |
50 | } |
51 | } |
52 | |
899dc88a |
53 | $args{C} = $cache; |
a0cb3900 |
54 | bless \%args => $package; |
55 | } |
56 | |
57 | sub EXISTS |
58 | { |
59 | my $self = shift; |
60 | my $key = shift; |
61 | |
62 | if( exists $self->{C}->{$key} ) |
63 | { |
64 | return 1; |
65 | } |
66 | |
67 | return 0; |
68 | } |
69 | |
70 | |
71 | sub FETCH |
72 | { |
73 | my $self = shift; |
74 | my $key = shift; |
75 | |
76 | return $self->{C}->{$key}; |
77 | } |
78 | |
79 | sub STORE |
80 | { |
81 | my $self = shift; |
82 | my $key = shift; |
83 | my $value = shift; |
84 | |
85 | # If CACHE defined and this is not in our list don't save it |
86 | # |
87 | if(( defined $self->{CACHE} )&& |
88 | ( ! defined $self->{CACHE}->{$value} )) |
89 | { |
90 | print "$value not in CACHE list.\n" if $DEBUG; |
91 | return; |
92 | } |
93 | |
94 | # If DUMP is defined and this is in our list don't save it |
95 | # |
96 | if(( defined $self->{DUMP} )&& |
97 | ( defined $self->{DUMP}->{$value} )) |
98 | { |
99 | print "$value in DUMP list.\n" if $DEBUG; |
100 | return; |
101 | } |
102 | |
103 | # If REGEX is defined we will store it only if its true |
104 | # |
105 | if(( defined $self->{REGEX} )&& |
106 | ( $value !~ /$self->{REGEX}/ )) |
107 | { |
108 | print "$value did not match regex.\n" if $DEBUG; |
109 | return; |
110 | } |
111 | |
112 | # If we get this far we should save the value |
113 | # |
114 | print "Saving $key:$value\n" if $DEBUG; |
115 | $self->{C}->{$key} = $value; |
116 | } |
117 | |
118 | 1; |
119 | |
120 | # Documentation |
121 | # |
122 | |
123 | =head1 NAME |
124 | |
125 | Memoize::Saves - Plug-in module to specify which return values should be memoized |
126 | |
127 | =head1 SYNOPSIS |
128 | |
129 | use Memoize; |
130 | |
131 | memoize 'function', |
132 | SCALAR_CACHE => [TIE, Memoize::Saves, |
133 | CACHE => [ "word1", "word2" ], |
134 | DUMP => [ "word3", "word4" ], |
135 | REGEX => "Regular Expression", |
899dc88a |
136 | HASH => $cache_hashref, |
137 | ], |
a0cb3900 |
138 | |
139 | =head1 DESCRIPTION |
140 | |
141 | Memoize::Saves is a plug-in module for Memoize. It allows the |
142 | user to specify which values should be cached or which should be |
143 | dumped. Please read the manual for Memoize for background |
144 | information. |
145 | |
146 | Use the CACHE option to specify a list of return values which should |
147 | be memoized. All other values will need to be recomputed each time. |
148 | |
149 | Use the DUMP option to specify a list of return values which should |
150 | not be memoized. Only these values will need to be recomputed each |
151 | time. |
152 | |
153 | Use the REGEX option to specify a Regular Expression which must match |
154 | for the return value to be saved. You can supply either a plain text |
155 | string or a compiled regular expression using qr//. Obviously the |
156 | second method is prefered. |
157 | |
158 | Specifying multiple options will result in the least common denominator |
159 | being saved. |
160 | |
899dc88a |
161 | You can use the HASH option to string multiple Memoize Plug-ins together: |
a0cb3900 |
162 | |
899dc88a |
163 | tie my %disk_hash => 'GDBM_File', $filename, O_RDWR|O_CREAT, 0666; |
164 | tie my %expiring_cache => 'Memoize::Expire', |
165 | LIFETIME => 5, HASH => \%disk_cache; |
166 | tie my %cache => 'Memoize::Saves', |
167 | REGEX => qr/my/, HASH => \%expiring_cache; |
a0cb3900 |
168 | |
899dc88a |
169 | memoize ('printme', SCALAR_CACHE => [HASH => \%cache]); |
a0cb3900 |
170 | |
171 | =head1 CAVEATS |
172 | |
173 | This module is experimental, and may contain bugs. Please report bugs |
899dc88a |
174 | to C<mjd-perl-memoize+@plover.com>. |
a0cb3900 |
175 | |
176 | If you are going to use Memoize::Saves with Memoize::Expire it is |
899dc88a |
177 | important to use it in that order. Memoize::Expire changes the return |
a0cb3900 |
178 | value to include expire information and it may no longer match |
179 | your CACHE, DUMP, or REGEX. |
180 | |
181 | |
182 | =head1 AUTHOR |
183 | |
184 | Joshua Gerth <gerth@teleport.com> |
185 | |
186 | =head1 SEE ALSO |
187 | |
188 | perl(1) |
189 | |
899dc88a |
190 | L<Memoize> |
a0cb3900 |
191 | |
192 | |
193 | |