summaryrefslogtreecommitdiff
path: root/lib/Tie
diff options
context:
space:
mode:
authorSteffen Mueller <smueller@cpan.org>2009-09-03 17:29:56 +0200
committerSteffen Mueller <smueller@cpan.org>2009-09-03 18:42:11 +0200
commitb7d7e1dad734d27d791c1f48094cb4b84f6c6165 (patch)
tree2ce553ae2e8814f1c706e1c99ee1725d62428e1c /lib/Tie
parentd9268716ae5100c271d6031c5c04fc4b1d4b48ff (diff)
downloadperl-b7d7e1dad734d27d791c1f48094cb4b84f6c6165.tar.gz
Move Tie::Memoize from lib to ext
Diffstat (limited to 'lib/Tie')
-rw-r--r--lib/Tie/Memoize.pm128
-rw-r--r--lib/Tie/Memoize.t61
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');
-