File Coverage

blib/lib/Acme/DarmstadtPM/TieHash.pm

Criterion	Covered	Total	%
statement	22	49	44.9
branch	3	16	18.7
condition			n/a
subroutine	5	11	45.4
pod			n/a
total	30	76	39.4

package Acme::DarmstadtPM::TieHash;

# ABSTRACT: a module that shows that Perl can do all the Ruby things ;-)

use strict;
use warnings;

use Tie::ListKeyedHash;

our $VERSION = '0.4';

sub TIEHASH{
    my ($class,$code) = @_;


    my $self = {};
    my %hash;
    bless $self,$class;

    tie %hash,'Tie::ListKeyedHash';
    $self->{HASH} = \%hash;
    $self->{CODE} = $code;

    return $self;
}

sub FETCH{
    my ($self,$key) = @_;

    if (not ref $key) {
        $key = [split(/$;/,$key)];
    }

    unless(exists $self->{HASH}->{$key}){
        $self->{HASH}->{$key} = $self->{CODE}->(@$key);
    }

    return $self->{HASH}->{$key};
}

sub STORE{
    my ($self,$key,$value) = @_;

    if (not ref $key) {
        $key = [split(/$;/,$key)];
    }

    $self->{HASH}->{$key} = $value;
}

sub DELETE{
    my ($self,$key) = @_;

    if (not ref $key) {
        $key = [split(/$;/,$key)];
    }

    delete $self->{HASH}->{$key};
}

sub EXISTS{
    my ($self,$key) = @_;

    if (not ref $key) {
        $key = [split(/$;/,$key)];
    }

    return exists $self->{HASH}->{$key} ? 1 : 0;
}

sub CLEAR{
    my ($self) = @_;
    $self->{HASH} = ();
}

sub FIRSTKEY{
	my ($self) = @_;

	my $a = keys %{$self->{HASH}};
	my $key = scalar each %{$self->{HASH}};
	return if (not defined $key);
	return [$key];
}

sub NEXTKEY {
	my ($self,$last_key) = @_;
	my $key = scalar each %{$self->{HASH}};
	return if (not defined $key);
	return [$key];
}

1;

__END__