/usr/local/CPAN/Tie-Tools/Tie/Func.pm

• package Tie::Func
  • TIEHASH
  • TIESCALAR
  • FETCH
  • STORE
  • DELETE
  • EXISTS
  • FIRSTKEY
  • NEXTKEY
• EOF

package Tie::Func;

# $Id: Func.pm 1049 2003-12-08 21:10:33Z jonasbn $

use strict;
use vars qw($VERSION);

$VERSION = '1.03';

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;