lib/Tie/Memoize.pm

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