diff options
author | Steffen Mueller <smueller@cpan.org> | 2009-09-03 17:29:56 +0200 |
---|---|---|
committer | Steffen Mueller <smueller@cpan.org> | 2009-09-03 18:42:11 +0200 |
commit | b7d7e1dad734d27d791c1f48094cb4b84f6c6165 (patch) | |
tree | 2ce553ae2e8814f1c706e1c99ee1725d62428e1c /lib/Tie | |
parent | d9268716ae5100c271d6031c5c04fc4b1d4b48ff (diff) | |
download | perl-b7d7e1dad734d27d791c1f48094cb4b84f6c6165.tar.gz |
Move Tie::Memoize from lib to ext
Diffstat (limited to 'lib/Tie')
-rw-r--r-- | lib/Tie/Memoize.pm | 128 | ||||
-rw-r--r-- | lib/Tie/Memoize.t | 61 |
2 files changed, 0 insertions, 189 deletions
diff --git a/lib/Tie/Memoize.pm b/lib/Tie/Memoize.pm deleted file mode 100644 index dbe1442828..0000000000 --- a/lib/Tie/Memoize.pm +++ /dev/null @@ -1,128 +0,0 @@ -use strict; -package Tie::Memoize; -use Tie::Hash; -our @ISA = 'Tie::ExtraHash'; -our $VERSION = '1.1'; - -our $exists_token = \undef; - -sub croak {require Carp; goto &Carp::croak} - -# Format: [0: STORAGE, 1: EXISTS-CACHE, 2: FETCH_function; -# 3: EXISTS_function, 4: DATA, 5: EXISTS_different ] - -sub FETCH { - my ($h,$key) = ($_[0][0], $_[1]); - my $res = $h->{$key}; - return $res if defined $res; # Shortcut if accessible - return $res if exists $h->{$key}; # Accessible, but undef - my $cache = $_[0][1]{$key}; - return if defined $cache and not $cache; # Known to not exist - my @res = $_[0][2]->($key, $_[0][4]); # Autoload - $_[0][1]{$key} = 0, return unless @res; # Cache non-existence - delete $_[0][1]{$key}; # Clear existence cache, not needed any more - $_[0][0]{$key} = $res[0]; # Store data and return -} - -sub EXISTS { - my ($a,$key) = (shift, shift); - return 1 if exists $a->[0]{$key}; # Have data - my $cache = $a->[1]{$key}; - return $cache if defined $cache; # Existence cache - my @res = $a->[3]($key,$a->[4]); - $a->[1]{$key} = 0, return unless @res; # Cache non-existence - # Now we know it exists - return ($a->[1]{$key} = 1) if $a->[5]; # Only existence reported - # Now know the value - $a->[0]{$key} = $res[0]; # Store data - return 1 -} - -sub TIEHASH { - croak 'syntax: tie %hash, \'Tie::AutoLoad\', \&fetch_subr' if @_ < 2; - croak 'syntax: tie %hash, \'Tie::AutoLoad\', \&fetch_subr, $data, \&exists_subr, \%data_cache, \%existence_cache' if @_ > 6; - push @_, undef if @_ < 3; # Data - push @_, $_[1] if @_ < 4; # exists - push @_, {} while @_ < 6; # initial value and caches - bless [ @_[4,5,1,3,2], $_[1] ne $_[3]], $_[0] -} - -1; - -=head1 NAME - -Tie::Memoize - add data to hash when needed - -=head1 SYNOPSIS - - require Tie::Memoize; - tie %hash, 'Tie::Memoize', - \&fetch, # The rest is optional - $DATA, \&exists, - {%ini_value}, {%ini_existence}; - -=head1 DESCRIPTION - -This package allows a tied hash to autoload its values on the first access, -and to use the cached value on the following accesses. - -Only read-accesses (via fetching the value or C<exists>) result in calls to -the functions; the modify-accesses are performed as on a normal hash. - -The required arguments during C<tie> are the hash, the package, and -the reference to the C<FETCH>ing function. The optional arguments are -an arbitrary scalar $data, the reference to the C<EXISTS> function, -and initial values of the hash and of the existence cache. - -Both the C<FETCH>ing function and the C<EXISTS> functions have the -same signature: the arguments are C<$key, $data>; $data is the same -value as given as argument during tie()ing. Both functions should -return an empty list if the value does not exist. If C<EXISTS> -function is different from the C<FETCH>ing function, it should return -a TRUE value on success. The C<FETCH>ing function should return the -intended value if the key is valid. - -=head1 Inheriting from B<Tie::Memoize> - -The structure of the tied() data is an array reference with elements - - 0: cache of known values - 1: cache of known existence of keys - 2: FETCH function - 3: EXISTS function - 4: $data - -The rest is for internal usage of this package. In particular, if -TIEHASH is overwritten, it should call SUPER::TIEHASH. - -=head1 EXAMPLE - - sub slurp { - my ($key, $dir) = shift; - open my $h, '<', "$dir/$key" or return; - local $/; <$h> # slurp it all - } - sub exists { my ($key, $dir) = shift; return -f "$dir/$key" } - - tie %hash, 'Tie::Memoize', \&slurp, $directory, \&exists, - { fake_file1 => $content1, fake_file2 => $content2 }, - { pretend_does_not_exists => 0, known_to_exist => 1 }; - -This example treats the slightly modified contents of $directory as a -hash. The modifications are that the keys F<fake_file1> and -F<fake_file2> fetch values $content1 and $content2, and -F<pretend_does_not_exists> will never be accessed. Additionally, the -existence of F<known_to_exist> is never checked (so if it does not -exists when its content is needed, the user of %hash may be confused). - -=head1 BUGS - -FIRSTKEY and NEXTKEY methods go through the keys which were already read, -not all the possible keys of the hash. - -=head1 AUTHOR - -Ilya Zakharevich L<mailto:perl-module-hash-memoize@ilyaz.org>. - -=cut - diff --git a/lib/Tie/Memoize.t b/lib/Tie/Memoize.t deleted file mode 100644 index defb437523..0000000000 --- a/lib/Tie/Memoize.t +++ /dev/null @@ -1,61 +0,0 @@ -#!./perl -w - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -use strict; -use Tie::Memoize; -use Test::More tests => 28; -use File::Spec; - -sub slurp { - my ($key, $dir) = @_; - open my $h, '<', File::Spec->catfile($dir, $key) or return; - local $/; - <$h> # slurp it all -} -sub exists { my ($key, $dir) = @_; return -f File::Spec->catfile($dir, $key) } - -my $directory = File::Spec->catdir(File::Spec->updir, 'lib'); - -tie my %hash, 'Tie::Memoize', \&slurp, $directory, \&exists, - { fake_file1 => 123, fake_file2 => 45678 }, - { 'strict.pm' => 0, known_to_exist => 1 }; - -ok(not exists $hash{'strict.pm'}); -ok(exists $hash{known_to_exist}); -ok($hash{fake_file2} eq 45678); -ok($hash{fake_file1} eq 123); -ok(exists $hash{known_to_exist}); -ok(not exists $hash{'strict.pm'}); -ok(not defined $hash{fake_file3}); -ok(not defined $hash{known_to_exist}); -ok(not exists $hash{known_to_exist}); -ok(not exists $hash{'strict.pm'}); -my $c = slurp('constant.pm', $directory); -ok($c); -ok($hash{'constant.pm'} eq $c); -ok($hash{'constant.pm'} eq $c); -ok(not exists $hash{'strict.pm'}); -ok(exists $hash{'blib.pm'}); - -untie %hash; - -tie %hash, 'Tie::Memoize', \&slurp, $directory; - -ok(exists $hash{'strict.pm'}, 'existing file'); -ok(not exists $hash{fake_file2}); -ok(not exists $hash{fake_file1}); -ok(not exists $hash{known_to_exist}); -ok(exists $hash{'strict.pm'}, 'existing file again'); -ok(not defined $hash{fake_file3}); -ok(not defined $hash{known_to_exist}); -ok(not exists $hash{known_to_exist}); -ok(exists $hash{'strict.pm'}, 'existing file again'); -ok($hash{'constant.pm'} eq $c); -ok($hash{'constant.pm'} eq $c); -ok(exists $hash{'strict.pm'}, 'existing file again'); -ok(exists $hash{'blib.pm'}, 'another existing file'); - |