File Coverage

blib/lib/Tie/Hash/Transactional.pm

Criterion	Covered	Total	%
statement	36	38	94.7
branch	4	4	100.0
condition			n/a
subroutine	11	12	91.6
pod	3	3	100.0
total	54	57	94.7

package Tie::Hash::Transactional;

use strict;

my $VERSION='1.1';

sub TIEHASH {
	my $class = shift;
        my %params = @_;
	my $self = {
		STACK		=> [],
		CURRENT_STATE	=> {},
	};

        warn(__PACKAGE__." is deprecated\n") unless($params{nowarn});

	return bless $self, $class;
}

sub checkpoint {
	my $self = shift;
	# make a new copy of CURRENT_STATE before putting on stack,
	# otherwise CURRENT_STATE and top-of-STACK will reference the
	# same data structure, which would be a Bad Thing
	my %hash_for_stack = %{$self->{CURRENT_STATE}};
	push @{$self->{STACK}}, \%hash_for_stack;
}

sub commit {
	my $self = shift;
	$self->{STACK}=[];                     # clear all checkpoints
}

sub rollback {
	my $self = shift;
	die("Attempt to rollback too far") unless(scalar @{$self->{STACK}});
	# no copying required, just update a pointer
	$self->{CURRENT_STATE}=pop @{$self->{STACK}};
}

sub CLEAR {
	my $self=shift;
	$self->{CURRENT_STATE}={};
}

sub STORE {
        my($self, $key, $value)=@_;
        $self->{CURRENT_STATE}->{$key}=$value;
}

sub FETCH {
	my($self, $key) = @_;
	$self->{CURRENT_STATE}->{$key};
}

sub FIRSTKEY {
	my $self = shift;
	scalar keys %{$self->{CURRENT_STATE}};
	scalar each %{$self->{CURRENT_STATE}};
}

sub NEXTKEY { my $self = shift; scalar each %{$self->{CURRENT_STATE}}; }
sub DELETE { my($self, $key) = @_; delete $self->{CURRENT_STATE}->{$key}; }
sub EXISTS { my($self, $key) = @_; exists($self->{CURRENT_STATE}->{$key}); }

1;
__END__