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