File Coverage

blib/lib/Tie/Scalar/Transactional.pm

Criterion	Covered	Total	%
statement	45	55	81.8
branch	10	20	50.0
condition	1	3	33.3
subroutine	11	12	91.6
pod	3	3	100.0
total	70	93	75.2

# ----------------------------------------------------------------------------#
# Tie::Scalar::Transactional                                                  #
#                                                                             #
# Copyright (c) 2002-03 Arun Kumar U .                 #
# All rights reserved.                                                        #
#                                                                             #
# This program is free software; you can redistribute it and/or               #
# modify it under the same terms as Perl itself.                              #
# ----------------------------------------------------------------------------#

package Tie::Scalar::Transactional;

use strict;
use Carp;

use Exporter;
use vars qw($VERSION @EXPORT_OK @ISA %EXPORT_TAGS);

$VERSION = '0.01';

@EXPORT_OK   = qw( commit rollback );
%EXPORT_TAGS = ( commit => \@EXPORT_OK, rollback => \@EXPORT_OK );

@ISA = qw(Exporter);

sub new
{
	my $class = $_[0];
	my $var   = $_[1];

	if (!defined($var)) { croak('Usage: ' . __PACKAGE__ . '->new($var)'); }
	elsif (ref($var)) {
		my $message = "References are not allowed\n";
		croak("$message\nUsage: " . __PACKAGE__ . '->new($var)');
	}

	my $self = tie $_[1], $class, $_[1];
	return $self;
}

sub TIESCALAR
{
	my ($proto, $var) = @_;
	my ($self, $class);

	$self = {};
	$class = ref($proto) || $proto;
	bless $self, $class;

	$self->_initialize($var);
	return $self;
}

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

	$self->{'_committedValue'} = $value;
	$self->{'_currentValue'}   = $value;
}

sub FETCH
{
	my ($self) = @_;
	return $self->{'_currentValue'};
}

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

sub DESTROY
{
	## Nothing to be done (atleast in this version !!)
}

sub commit
{
	my $self;

	if (@_ == 1) {
		if (UNIVERSAL::isa($_[0], __PACKAGE__)) { $self = $_[0]; }
		else {
			$self = tied($_[0]) if (!ref($_[0]));
		}
  }
	elsif (@_ == 2) { $self = tied($_[1]); }
	else {
		my $package = __PACKAGE__;
		croak(<<"USAGE");
Usage: $package->commit(\$var);
       tied(\$var)->commit();
       commit(\$a);  # (if explicitely imported)
USAGE
	}

	$self->{'_committedValue'} = $self->{'_currentValue'};
	return 1;
}

sub rollback
{
	my $self;

	if (@_ == 1) {
		if (UNIVERSAL::isa($_[0], __PACKAGE__)) { $self = $_[0]; }
		else {
			$self = tied($_[0]) if (!ref($_[0]));
		}
  }
	elsif (@_ == 2) { $self = tied($_[1]); }
	else {
		my $package = __PACKAGE__;
		croak(<<"USAGE");
Usage: $package->rollback(\$var);
       tied(\$var)->rollback();
			 rollback(\$a);  # (if explicitely imported)
USAGE
	}

	$self->{'_currentValue'} = $self->{'_committedValue'};
	return 1;
}

1;

__END__