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