[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/5.10.0/Memoize/ -> SDBM_File.pm (source)

   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;


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1