Commit | Line | Data |
---|---|---|
86530b38 AT |
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; |