lib/Memoize/SDBM_File.pm

   1 package Memoize::SDBM_File;
   2
   3 =head1 NAME
   4
   5 Memoize::SDBM_File - glue to provide EXISTS for SDBM_File for Storable use
   6
   7 =head1 DESCRIPTION
   8
   9 See L<Memoize>.
  10
  11 =cut
  12
  13 use SDBM_File;
  14 @ISA = qw(SDBM_File);
  15 $VERSION = 0.65;
  16
  17 $Verbose = 0;
  18
  19 sub AUTOLOAD {
  20   warn "Nonexistent function $AUTOLOAD invoked in Memoize::SDBM_File\n";
  21 }
  22
  23 sub import {
  24   warn "Importing Memoize::SDBM_File\n" if $Verbose;
  25 }
  26
  27
  28 my %keylist;
  29
  30 # This is so ridiculous...
  31 sub _backhash {
  32   my $self = shift;
  33   my %fakehash;
  34   my $k;
  35   for ($k = $self->FIRSTKEY(); defined $k; $k = $self->NEXTKEY($k)) {
  36     $fakehash{$k} = undef;
  37   }
  38   $keylist{$self} = \%fakehash;
  39 }
  40
  41 sub EXISTS {
  42   warn "Memoize::SDBM_File EXISTS (@_)\n" if $Verbose;
  43   my $self = shift;
  44   _backhash($self)  unless exists $keylist{$self};
  45   my $r = exists $keylist{$self}{$_[0]};
  46   warn "Memoize::SDBM_File EXISTS (@_) ==> $r\n" if $Verbose;
  47   $r;
  48 }
  49
  50 sub DEFINED {
  51   warn "Memoize::SDBM_File DEFINED (@_)\n" if $Verbose;
  52   my $self = shift;
  53   _backhash($self)  unless exists $keylist{$self};
  54   defined $keylist{$self}{$_[0]};
  55 }
  56
  57 sub DESTROY {
  58   warn "Memoize::SDBM_File DESTROY (@_)\n" if $Verbose;
  59   my $self = shift;
  60   delete $keylist{$self};   # So much for reference counting...
  61   $self->SUPER::DESTROY(@_);
  62 }
  63
  64 # Maybe establish the keylist at TIEHASH time instead?
  65
  66 sub STORE {
  67   warn "Memoize::SDBM_File STORE (@_)\n" if $VERBOSE;
  68   my $self = shift;
  69   $keylist{$self}{$_[0]} = undef;
  70   $self->SUPER::STORE(@_);
  71 }
  72
  73 # Inherit FETCH and TIEHASH
  74
  75 1;