Line | |
---|
1 | package Memoize::NDBM_File;
|
---|
2 |
|
---|
3 | =head1 NAME
|
---|
4 |
|
---|
5 | Memoize::NDBM_File - glue to provide EXISTS for NDBM_File for Storable use
|
---|
6 |
|
---|
7 | =head1 DESCRIPTION
|
---|
8 |
|
---|
9 | See L<Memoize>.
|
---|
10 |
|
---|
11 | =cut
|
---|
12 |
|
---|
13 | use NDBM_File;
|
---|
14 | @ISA = qw(NDBM_File);
|
---|
15 | $VERSION = 0.65;
|
---|
16 |
|
---|
17 | $Verbose = 0;
|
---|
18 |
|
---|
19 | sub AUTOLOAD {
|
---|
20 | warn "Nonexistent function $AUTOLOAD invoked in Memoize::NDBM_File\n";
|
---|
21 | }
|
---|
22 |
|
---|
23 | sub import {
|
---|
24 | warn "Importing Memoize::NDBM_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::NDBM_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::NDBM_File EXISTS (@_) ==> $r\n" if $Verbose;
|
---|
47 | $r;
|
---|
48 | }
|
---|
49 |
|
---|
50 | sub DEFINED {
|
---|
51 | warn "Memoize::NDBM_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::NDBM_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::NDBM_File STORE (@_)\n" if $VERBOSE;
|
---|
68 | my $self = shift;
|
---|
69 | $keylist{$self}{$_[0]} = undef;
|
---|
70 | $self->SUPER::STORE(@_);
|
---|
71 | }
|
---|
72 |
|
---|
73 |
|
---|
74 |
|
---|
75 | # Inherit FETCH and TIEHASH
|
---|
76 |
|
---|
77 | 1;
|
---|
Note:
See
TracBrowser
for help on using the repository browser.