lib/Memoize/Saves.pm

   1 package Memoize::Saves;
   2
   3 $VERSION = 0.65;
   4
   5 $DEBUG = 0;
   6
   7 sub TIEHASH
   8 {
   9     my ($package, %args) = @_;
  10     my $cache = $args{HASH} || {};
  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         }
  47         my $rc = (tie %$cache => $module, @opts);
  48         unless ($rc)    {
  49             die "Memoize::Saves: Couldn't tie hash to `$module': $@; aborting";
  50         }
  51     }
  52
  53     $args{C} = $cache;
  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",
 136                        HASH  => $cache_hashref,
 137                       ],
 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
 161 You can use the HASH option to string multiple Memoize Plug-ins together:
 162
 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;
 168
 169    memoize ('printme', SCALAR_CACHE => [HASH => \%cache]);
 170
 171 =head1 CAVEATS
 172
 173 This module is experimental, and may contain bugs.  Please report bugs
 174 to C<mjd-perl-memoize+@plover.com>.
 175
 176 If you are going to use Memoize::Saves with Memoize::Expire it is
 177 important to use it in that order.  Memoize::Expire changes the return
 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
 190 L<Memoize>
 191
 192
 193