4 our @ISA = 'Tie::ExtraHash';
6 our $exists_token = \undef;
8 sub croak {require Carp; goto &Carp::croak}
10 # Format: [0: STORAGE, 1: EXISTS-CACHE, 2: FETCH_function;
11 # 3: EXISTS_function, 4: DATA, 5: EXISTS_different ]
14 my ($h,$key) = ($_[0][0], $_[1]);
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
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
36 $_[0][0]{$key} = $res[0]; # Store data
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]
53 Tiel::Memoize - add data to hash when needed
58 tie %hash, 'Tie::Memoize',
59 \&fetch, # The rest is optional
61 {%ini_value}, {%ini_existence};
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.
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.
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.
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.
84 =head1 Inheriting from B<Tie::Memoize>
86 The structure of the tied() data is an array reference with elements
88 0: cache of known values
89 1: cache of known existence of keys
94 The rest is for internal usage of this package. In particular, if
95 TIEHASH is overwritten, it should call SUPER::TIEHASH.
100 my ($key, $dir) = shift;
101 open my $h, '<', "$dir/$key" or return;
102 local $/; <$h> # slurp it all
104 sub exists { my ($key, $dir) = shift; return -f "$dir/$key" }
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 };
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).
119 FIRSTKEY and NEXTKEY methods go through the keys which were already read,
120 not all the possible keys of the hash.
124 Ilya Zakharevich L<mailto:perl-module-hash-memoize@ilyaz.org>.