1use strict;
2package Tie::Memoize;
3use Tie::Hash;
4our @ISA = 'Tie::ExtraHash';
5our $VERSION = '1.1';
6
7our $exists_token = \undef;
8
9sub 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
14sub 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
27sub 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
41sub 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
501;
51
52=head1 NAME
53
54Tie::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
66This package allows a tied hash to autoload its values on the first access,
67and to use the cached value on the following accesses.
68
69Only read-accesses (via fetching the value or C<exists>) result in calls to
70the functions; the modify-accesses are performed as on a normal hash.
71
72The required arguments during C<tie> are the hash, the package, and
73the reference to the C<FETCH>ing function.  The optional arguments are
74an arbitrary scalar $data, the reference to the C<EXISTS> function,
75and initial values of the hash and of the existence cache.
76
77Both the C<FETCH>ing function and the C<EXISTS> functions have the
78same signature: the arguments are C<$key, $data>; $data is the same
79value as given as argument during tie()ing.  Both functions should
80return an empty list if the value does not exist.  If C<EXISTS>
81function is different from the C<FETCH>ing function, it should return
82a TRUE value on success.  The C<FETCH>ing function should return the
83intended value if the key is valid.
84
85=head1 Inheriting from B<Tie::Memoize>
86
87The 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
95The rest is for internal usage of this package.  In particular, if
96TIEHASH 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
111This example treats the slightly modified contents of $directory as a
112hash.  The modifications are that the keys F<fake_file1> and
113F<fake_file2> fetch values $content1 and $content2, and
114F<pretend_does_not_exists> will never be accessed.  Additionally, the
115existence of F<known_to_exist> is never checked (so if it does not
116exists when its content is needed, the user of %hash may be confused).
117
118=head1 BUGS
119
120FIRSTKEY and NEXTKEY methods go through the keys which were already read,
121not all the possible keys of the hash.
122
123=head1 AUTHOR
124
125Ilya Zakharevich L<mailto:perl-module-hash-memoize@ilyaz.org>.
126
127=cut
128
129