1N/A# Format: [0: STORAGE, 1: EXISTS-CACHE, 2: FETCH_function; 1N/A# 3: EXISTS_function, 4: DATA, 5: EXISTS_different ] 1N/A my ($h,$
key) = ($_[
0][
0], $_[
1]);
1N/A return $
res if defined $
res;
# Shortcut if accessible 1N/A return $
res if exists $h->{$
key};
# Accessible, but undef 1N/A my @
res = $_[
0][
2]->($
key, $_[
0][
4]);
# Autoload 1N/A $_[
0][
1]{$
key} =
0,
return unless @
res;
# Cache non-existence 1N/A delete $_[
0][
1]{$
key};
# Clear existence cache, not needed any more 1N/A $_[
0][
0]{$
key} = $
res[
0];
# Store data and return 1N/A my ($a,$
key) = (
shift,
shift);
1N/A return 1 if exists $a->[
0]{$
key};
# Have data 1N/A $_[
0][
1]{$
key} =
0,
return unless @
res;
# Cache non-existence 1N/A # Now we know it exists 1N/A return ($_[
0][
1]{$
key} =
1)
if $a->[
5];
# Only existence reported 1N/A # Now know the value 1N/A croak 'syntax: tie %hash, \'Tie::AutoLoad\', \&fetch_subr' if @_ <
2;
1N/A croak 'syntax: tie %hash, \'Tie::AutoLoad\', \&fetch_subr, $data, \&exists_subr, \%data_cache, \%existence_cache' if @_ >
6;
1N/A push @_,
undef if @_ <
3;
# Data 1N/A push @_, $_[
1]
if @_ <
4;
# exists 1N/A push @_, {}
while @_ <
6;
# initial value and caches 1N/A bless [ @_[
4,
5,
1,
3,
2], $_[
1]
ne $_[
3]], $_[
0]
1N/ATie::Memoize - add data to hash when needed 1N/A require Tie::Memoize; 1N/A tie %hash, 'Tie::Memoize', 1N/A \&fetch, # The rest is optional 1N/A {%ini_value}, {%ini_existence}; 1N/AThis package allows a tied hash to autoload its values on the first access, 1N/Aand to use the cached value on the following accesses. 1N/AOnly read-accesses (via fetching the value or C<exists>) result in calls to 1N/Athe functions; the modify-accesses are performed as on a normal hash. 1N/AThe required arguments during C<tie> are the hash, the package, and 1N/Athe reference to the C<FETCH>ing function. The optional arguments are 1N/Aan arbitrary scalar $data, the reference to the C<EXISTS> function, 1N/Aand initial values of the hash and of the existence cache. 1N/ABoth the C<FETCH>ing function and the C<EXISTS> functions have the 1N/Asame signature: the arguments are C<$key, $data>; $data is the same 1N/Avalue as given as argument during tie()ing. Both functions should 1N/Areturn an empty list if the value does not exist. If C<EXISTS> 1N/Afunction is different from the C<FETCH>ing function, it should return 1N/Aa TRUE value on success. The C<FETCH>ing function should return the 1N/Aintended value if the key is valid. 1N/A=head1 Inheriting from B<Tie::Memoize> 1N/AThe structure of the tied() data is an array reference with elements 1N/A 0: cache of known values 1N/A 1: cache of known existence of keys 1N/AThe rest is for internal usage of this package. In particular, if 1N/ATIEHASH is overwritten, it should call SUPER::TIEHASH. 1N/A my ($key, $dir) = shift; 1N/A open my $h, '<', "$dir/$key" or return; 1N/A local $/; <$h> # slurp it all 1N/A sub exists { my ($key, $dir) = shift; return -f "$dir/$key" } 1N/A tie %hash, 'Tie::Memoize', \&slurp, $directory, \&exists, 1N/A { fake_file1 => $content1, fake_file2 => $content2 }, 1N/A { pretend_does_not_exists => 0, known_to_exist => 1 }; 1N/AThis example treats the slightly modified contents of $directory as a 1N/Ahash. The modifications are that the keys F<fake_file1> and 1N/AF<fake_file2> fetch values $content1 and $content2, and 1N/AF<pretend_does_not_exists> will never be accessed. Additionally, the 1N/Aexistence of F<known_to_exist> is never checked (so if it does not 1N/Aexists when its content is needed, the user of %hash may be confused). 1N/AFIRSTKEY and NEXTKEY methods go through the keys which were already read, 1N/Anot all the possible keys of the hash. 1N/AIlya Zakharevich L<mailto:perl-module-hash-memoize@ilyaz.org>.