home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _0d13b27571057b7cdb44319f6911e986 < prev    next >
Text File  |  2004-06-01  |  2KB  |  78 lines
  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;
  78.