File Coverage

blib/lib/Tie/Hash/Layered.pm

Criterion	Covered	Total	%
statement	72	72	100.0
branch	7	8	87.5
condition	3	3	100.0
subroutine	17	17	100.0
pod	0	4	0.0
total	99	104	95.1

# Copyright 2001 Simon Wistow
# Distributed under the same terms as Perl itself

package Tie::Hash::Layered;

require 5.005_62;
use strict;
use warnings;

use Exporter;
use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

our $VERSION = '0.9';



# -- Tie ourselves into a hash
# We set up a list of other hashes
# so that we can check from L to R
sub TIEHASH
{
	# get our class
	my $class = shift;

	my $self = {};


	# we assume the rest of our arguments are arrays
	$self->{_HASHES} =  \@_;
	$self->{_OFFSET} = 0;
	$self->{_KEYSSEEN} = {};

	return bless $self, $class;
}


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

	# right, we have the key we need to check for
	# so we iterate down our list of arrays and
 	# check to see if the value exists




	foreach my $hashref (reverse @{$self->{_HASHES}})
	{
		return $hashref->{$key} if defined $hashref->{$key};
	}


	# hmm, none of our hashes have that key,
	# /shurg/ (sic), return undef;
	return undef;

}


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


	# this is dead easy, we just store it in the first
	return $self->{_HASHES}->[_get_max($self)]->{$key} = $value;



}

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

	# just delete the first key in the the first hash
	my $res = delete $self->{_HASHES}->[_get_max($self)]->{$key};
	return $res;
}

sub CLEAR
{
	my ($self) = @_;
	my %hash = ();


	pop @{$self->{_HASHES}};
	push @{$self->{_HASHES}}, \%hash;

}

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

	# again with the iteration :)


	foreach my $hashref (reverse @{$self->{_HASHES}})
	{
		return 1 if (exists $hashref->{$key});
	}

	return 0;
}

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



	$self->{_OFFSET} = 0;
	$self->{_KEYSSEEN} = {};
	my $a = keys %{$self->{_HASHES}->[0]};
	each (%{$self->{_HASHES}->[0]});



}


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

	my $key;


	my %keys = %{$self->{_KEYSSEEN}};

	do
	{
	 	$key = each %{ $self->{_HASHES}->[$self->{_OFFSET}] };
		if (defined $key)
		{
			$key = undef if ($self->{_KEYSSEEN}->{$key}++);

		}
		#print "Offset : ".$self->{_OFFSET};
		#print " Key = $key" if (defined $key);
		#print "\n";

	}
	until (defined $key || ++$self->{_OFFSET} >  _get_max($self));

	#return undef if ($self->{_OFFSET}==_get_max($self));

	return $key;

}


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

	my $arrref = $self->{_HASHES};
	my @arr   = @$arrref;

	return $#arr;


}

sub push
{
	my ($self, $val) = @_;
	return push @{$self->{_HASHES}}, $val;
}

sub pop
{
	my ($self) = @_;
	return pop @{$self->{_HASHES}};
}

sub shift
{
	my ($self) = @_;
	return shift @{$self->{_HASHES}};
}

sub unshift
{
	my ($self, $val) = @_;
	return unshift @{$self->{_HASHES}}, $val;
}

1;
__END__