The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Tie::Func;

use strict;
use warnings;
use vars qw($VERSION);

$VERSION = '1.10';

sub TIEHASH {
    my ($class, $fetch, $store, $del, %const) = @_;
    foreach (qw($fetch $store $del)) {
        eval "$_ = &$_ if ($_ && ref($_) !~ /CODE/);";
    }
    bless {'data' => \%const, '__fetch' => $fetch, '__store' => $store,
              '__del' => $del }, $class;
}

sub TIESCALAR {
    TIEHASH(shift, shift, shift, shift, 'this' => $_[3]);
}

sub FETCH {
    my ($this, $key) = @_;
    $key ||= 'this';
    my $code = $this->{'__fetch'};
    my $val = $this->{'data'}->{$key};
    $val = &$code($this, $key, $val) if ($code);
    $val;
}

sub STORE {
    my ($this, $key, $value) = @_;
    if (!defined($value)) {
        $value = $key;
        $key = 'this';
    }
    my $code = $this->{'__store'};
    $this->{'data'}->{$key} = $value if ($code && &$code($this, 
          $key, $value));
    return 1;
}

sub DELETE {
    my ($this, $key) = @_;
    my $code = $this->{'__del'};
    my $value = $this->{'data'}->{$key};
    return undef if ($code && !&$code($this, $key, $value));
    delete $this->{'data'}->{$key};
    1;
}

sub EXISTS {
    my ($this, $key) = @_;
    exists $this->{'data'}->{$key};
}

sub FIRSTKEY {
    my $this = shift;
    keys %{$this->{'data'}};
    each %{$this->{'data'}};
}

sub NEXTKEY {
    my $this = shift;
    each %{$this->{'data'}};
}

1;

__END__

=head1 NAME

Tie::Func

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 SUBROUTINES/METHODS

=head2 TIEHASH

=head2 TIESCALAR

=head2 FETCH

=head2 STORE

=head2 DELETE

=head2 EXISTS

=head2 FIRSTKEY

=head2 NEXTKEY

=head1 AUTHOR

Ariel Brosh, schop@cpan.org.
B<Tie::Cache> was written by Joshua Chamas, chamas@alumni.stanford.org

=head1 SEE ALSO

perl(1), L<Tie::Cache>.

=head1 COPYRIGHT

Tie::Collection is part of the HTPL package. See L<HTML::HTPL>

=cut