Commit | Line | Data |
---|---|---|
a0cb3900 | 1 | package Memoize::SDBM_File; |
9038e305 JH |
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 | ||
a0cb3900 JH |
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; |