view release on metacpan or  search on metacpan

lib/OOPS/TxHash.pm  view on Meta::CPAN

package OOPS::TxHash;

use strict;

sub commit
{
	my $self = shift;
	my ($under, $overlay, $whiteout) = @$self;
	for my $key (keys %$whiteout) {
		delete $under->{$key};
	}
	@$under{keys %$overlay} = values %$overlay;
	%$overlay = ();
	%$whiteout = ();
}

sub abort
{
	my $self = shift;
	my ($under, $overlay, $whiteout, $count) = @$self;
	%$overlay = ();
	%$whiteout = ();
	$$count = keys %$under;
}

sub TIEHASH
{
	my $pkg = shift;
	my ($under) = @_;
	my $count = keys %$under;
	my $doneunder;
	my $self = bless [ $under, {}, {}, \$count, \$doneunder ], $pkg;
	return $self;
}

sub FETCH
{
	my $self = shift;
	my ($under, $overlay, $whiteout) = @$self;
	my $key = shift;
	return undef 		if exists $whiteout->{$key};
	return $overlay->{$key}	if exists $overlay->{$key};
	return $under->{$key};
}

sub STORE
{
	my $self = shift;
	my ($under, $overlay, $whiteout, $count) = @$self;
	my ($key, $value) = @_;
	$$count++ if exists $whiteout->{$key}
		or ! (exists $under->{$key} or exists $overlay->{$key});
	$overlay->{$key} = $value;
	delete $whiteout->{$key};
	return $value;
}

sub DELETE
{
	my $self = shift;
	my ($under, $overlay, $whiteout, $count) = @$self;
	my $key = shift;
	my $old = $self->FETCH($key);
	return $old if exists $whiteout->{$key};
	$$count-- if exists $under->{$key} or exists $overlay->{$key};
	$whiteout->{$key} = 1;
	delete $overlay->{$key};
	return $old;
}

sub CLEAR
{
	my $self = shift;
	my ($under, $overlay, $whiteout, $count) = @$self;
	for my $key (keys %$overlay) {
		$$count-- unless $whiteout->{$key};
	}
	%$overlay = ();
	for my $key (keys %$under) {
		$$count-- unless $whiteout->{$key};
	}
	@$whiteout{keys %$under} = (1) x scalar(keys %$under);
}

sub EXISTS
{
	my $self = shift;
	my ($under, $overlay, $whiteout) = @$self;
	my $key = shift;
	return 0 if exists $whiteout->{$key};
	return 1 if exists $overlay->{$key};
	return 1 if exists $under->{$key};
	return 0;
}

sub FIRSTKEY
{
	my $self = shift;
	my ($under, $overlay, $whiteout, $count, $doneunder) = @$self;
	keys %$under;
	keys %$overlay;
	$$doneunder = 0;
	return $self->NEXTKEY;
}

sub NEXTKEY
{
	my $self = shift;
	my ($under, $overlay, $whiteout, $count, $doneunder) = @$self;
	my ($key, $value);
	unless ($$doneunder) {
		while (($key, $value) = each(%$under)) {
			next if $whiteout->{$key};
			return $key;
		}
		$$doneunder = 1;
	}
	while (($key, $value) = each(%$overlay)) {
		next if $whiteout->{$key};
		return $key;
	}
	return ();
}

sub SCALAR
{
	my $self = shift;
	my ($under, $overlay, $whiteout, $count) = @$self;
	return $$count;
}

1;

__END__

=head1 NAME
 
 OOPS::TxHash - Transactions on a simple hash