Commit | Line | Data |
---|---|---|
a0cb3900 JH |
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 |