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