lib/Memoize/Saves.pm

   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