This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate Memoize 0.64. Few tweaks were required in
[perl5.git] / lib / Memoize / Saves.pm
CommitLineData
a0cb3900
JH
1package Memoize::Saves;
2
3$DEBUG = 0;
4
5sub 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
55sub 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
69sub FETCH
70{
71 my $self = shift;
72 my $key = shift;
73
74 return $self->{C}->{$key};
75}
76
77sub 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
1161;
117
118# Documentation
119#
120
121=head1 NAME
122
123Memoize::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
139Memoize::Saves is a plug-in module for Memoize. It allows the
140user to specify which values should be cached or which should be
141dumped. Please read the manual for Memoize for background
142information.
143
144Use the CACHE option to specify a list of return values which should
145be memoized. All other values will need to be recomputed each time.
146
147Use the DUMP option to specify a list of return values which should
148not be memoized. Only these values will need to be recomputed each
149time.
150
151Use the REGEX option to specify a Regular Expression which must match
152for the return value to be saved. You can supply either a plain text
153string or a compiled regular expression using qr//. Obviously the
154second method is prefered.
155
156Specifying multiple options will result in the least common denominator
157being saved.
158
159You can use the TIE option to string multiple Memoize Plug-ins together:
160
161
162memoize ('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
177This module is experimental, and may contain bugs. Please report bugs
178to the address below.
179
180If you are going to use Memoize::Saves with Memoize::Expire it is
181import to use it in that order. Memoize::Expire changes the return
182value to include expire information and it may no longer match
183your CACHE, DUMP, or REGEX.
184
185
186=head1 AUTHOR
187
188Joshua Gerth <gerth@teleport.com>
189
190=head1 SEE ALSO
191
192perl(1)
193
194The Memoize man page.
195
196
197