File Coverage

blib/lib/Tie/Hash/Check.pm

Criterion	Covered	Total	%
statement	61	61	100.0
branch	10	10	100.0
condition			n/a
subroutine	14	14	100.0
pod			n/a
total	85	85	100.0

package Tie::Hash::Check;

# Pragmas.
use strict;
use warnings;

# Modules.
use Error::Pure qw(err);
use Error::Pure::Utils;

# Version.
our $VERSION = 0.08;

# Error level.
$Error::Pure::Utils::LEVEL = 5;

# Hash create.
sub TIEHASH {
	my ($class, $hash_hr, $stack_ar) = @_;
	if (ref $hash_hr ne 'HASH') {
		err 'Parameter isn\'t hash.';
	}
	if (! $stack_ar) {
		$stack_ar = [];
	}
	if (ref $stack_ar ne 'ARRAY') {
		err 'Stack isn\'t array.';
	}
	my $self = bless {}, $class;
	$self->{'data'} = {};
	foreach my $key (keys %{$hash_hr}) {
		_add_hash_value($self->{'data'}, $key, $hash_hr->{$key},
			$stack_ar);
	}
	$self->{'stack'} = $stack_ar;
	return $self;
}

# Hash clear.
sub CLEAR {
	my $self = shift;
	$self->{'data'} = {};
	return;
}

# Hash delete.
sub DELETE {
	my ($self, $key) = @_;
	delete $self->{'data'}->{$key};
	return;
}

# Hash exists.
sub EXISTS {
	my ($self, $key) = @_;
	return exists $self->{'data'}->{$key};
}

# Hash fetch.
sub FETCH {
	my ($self, $key) = @_;
	if (! exists $self->{'data'}->{$key}) {
		my @stack = (@{$self->{'stack'}}, $key);
		err 'Key \''.join('->', @stack).'\' doesn\'t exist.';
	}
	return $self->{'data'}->{$key};
}

# Hash first key.
sub FIRSTKEY {
	my $self = shift;

	# Resets each.
	my $a = scalar keys %{$self->{'data'}};

	return each %{$self->{'data'}};
}

# Hash nextkey.
sub NEXTKEY {
	my $self= shift;
	return each %{$self->{'data'}};
}

# Hash scalar.
sub SCALAR {
	my $self = shift;
	return scalar %{$self->{'data'}};
}

# Hash store.
sub STORE {
	my ($self, $key, $value) = @_;
	_add_hash_value($self->{'data'}, $key, $value, $self->{'stack'});
	return;
}

# Add hash value to storage.
sub _add_hash_value {
	my ($hash_hr, $key, $value, $stack_ar) = @_;
	if (ref $value eq 'HASH') {
		tie my %tmp, 'Tie::Hash::Check', $value,
			[@{$stack_ar}, $key];
		$hash_hr->{$key} = \%tmp;
	} else {
		$hash_hr->{$key} = $value;
	}
	return;
}

1;

__END__