[Summary view] [Print] [Text view]

   1  use strict;
   2  package Tie::Memoize;
   3  use Tie::Hash;
   4  our @ISA = 'Tie::ExtraHash';
   5  our $VERSION = '1.1';
   6  
   7  our $exists_token = \undef;
   8  
   9  sub croak {require Carp; goto &Carp::croak}
  10  
  11  # Format: [0: STORAGE, 1: EXISTS-CACHE, 2: FETCH_function;
  12  #       3: EXISTS_function, 4: DATA, 5: EXISTS_different ]
  13  
  14  sub FETCH {
  15    my ($h,$key) = ($_[0][0], $_[1]);
  16    my $res = $h->{$key};
  17    return $res if defined $res;    # Shortcut if accessible
  18    return $res if exists $h->{$key}; # Accessible, but undef
  19    my $cache = $_[0][1]{$key};
  20    return if defined $cache and not $cache; # Known to not exist
  21    my @res = $_[0][2]->($key, $_[0][4]);    # Autoload
  22    $_[0][1]{$key} = 0, return unless @res; # Cache non-existence
  23    delete $_[0][1]{$key};    # Clear existence cache, not needed any more
  24    $_[0][0]{$key} = $res[0];    # Store data and return
  25  }
  26  
  27  sub EXISTS   {
  28    my ($a,$key) = (shift, shift);
  29    return 1 if exists $a->[0]{$key}; # Have data
  30    my $cache = $a->[1]{$key};
  31    return $cache if defined $cache; # Existence cache
  32    my @res = $a->[3]($key,$a->[4]);
  33    $a->[1]{$key} = 0, return unless @res; # Cache non-existence
  34    # Now we know it exists
  35    return ($a->[1]{$key} = 1) if $a->[5]; # Only existence reported
  36    # Now know the value
  37    $a->[0]{$key} = $res[0];    # Store data
  38    return 1
  39  }
  40  
  41  sub TIEHASH  {
  42    croak 'syntax: tie %hash, \'Tie::AutoLoad\', \&fetch_subr' if @_ < 2;
  43    croak 'syntax: tie %hash, \'Tie::AutoLoad\', \&fetch_subr, $data, \&exists_subr, \%data_cache, \%existence_cache' if @_ > 6;
  44    push @_, undef if @_ < 3;    # Data
  45    push @_, $_[1] if @_ < 4;    # exists
  46    push @_, {} while @_ < 6;    # initial value and caches
  47    bless [ @_[4,5,1,3,2], $_[1] ne $_[3]], $_[0]
  48  }
  49  
  50  1;
  51  
  52  =head1 NAME
  53  
  54  Tie::Memoize - add data to hash when needed
  55  
  56  =head1 SYNOPSIS
  57  
  58    require Tie::Memoize;
  59    tie %hash, 'Tie::Memoize',
  60        \&fetch,            # The rest is optional
  61        $DATA, \&exists,
  62        {%ini_value}, {%ini_existence};
  63  
  64  =head1 DESCRIPTION
  65  
  66  This package allows a tied hash to autoload its values on the first access,
  67  and to use the cached value on the following accesses.
  68  
  69  Only read-accesses (via fetching the value or C<exists>) result in calls to
  70  the functions; the modify-accesses are performed as on a normal hash.
  71  
  72  The required arguments during C<tie> are the hash, the package, and
  73  the reference to the C<FETCH>ing function.  The optional arguments are
  74  an arbitrary scalar $data, the reference to the C<EXISTS> function,
  75  and initial values of the hash and of the existence cache.
  76  
  77  Both the C<FETCH>ing function and the C<EXISTS> functions have the
  78  same signature: the arguments are C<$key, $data>; $data is the same
  79  value as given as argument during tie()ing.  Both functions should
  80  return an empty list if the value does not exist.  If C<EXISTS>
  81  function is different from the C<FETCH>ing function, it should return
  82  a TRUE value on success.  The C<FETCH>ing function should return the
  83  intended value if the key is valid.
  84  
  85  =head1 Inheriting from B<Tie::Memoize>
  86  
  87  The structure of the tied() data is an array reference with elements
  88  
  89    0:  cache of known values
  90    1:  cache of known existence of keys
  91    2:  FETCH  function
  92    3:  EXISTS function
  93    4:  $data
  94  
  95  The rest is for internal usage of this package.  In particular, if
  96  TIEHASH is overwritten, it should call SUPER::TIEHASH.
  97  
  98  =head1 EXAMPLE
  99  
 100    sub slurp {
 101      my ($key, $dir) = shift;
 102      open my $h, '<', "$dir/$key" or return;
 103      local $/; <$h>            # slurp it all
 104    }
 105    sub exists { my ($key, $dir) = shift; return -f "$dir/$key" }
 106  
 107    tie %hash, 'Tie::Memoize', \&slurp, $directory, \&exists,
 108        { fake_file1 => $content1, fake_file2 => $content2 },
 109        { pretend_does_not_exists => 0, known_to_exist => 1 };
 110  
 111  This example treats the slightly modified contents of $directory as a
 112  hash.  The modifications are that the keys F<fake_file1> and
 113  F<fake_file2> fetch values $content1 and $content2, and
 114  F<pretend_does_not_exists> will never be accessed.  Additionally, the
 115  existence of F<known_to_exist> is never checked (so if it does not
 116  exists when its content is needed, the user of %hash may be confused).
 117  
 118  =head1 BUGS
 119  
 120  FIRSTKEY and NEXTKEY methods go through the keys which were already read,
 121  not all the possible keys of the hash.
 122  
 123  =head1 AUTHOR
 124  
 125  Ilya Zakharevich L<mailto:perl-module-hash-memoize@ilyaz.org>.
 126  
 127  =cut
 128