File Coverage

blib/lib/MLDBM/Easy.pm

Criterion	Covered	Total	%
statement	14	51	27.4
branch	0	8	0.0
condition			n/a
subroutine	5	13	38.4
pod			n/a
total	19	72	26.3

package MLDBM::Easy;

use warnings;

@ISA = 'MLDBM';
$VERSION = '0.01';

my %cache;

sub import {
  my $pkg = shift;
  require MLDBM;
  MLDBM->import(@_);
}


sub FETCH {
  my ($self, $key) = @_;
  my $ret = $self->{SR}->deserialize($self->{DB}->FETCH($key));
  return $cache{$self,$key} if $cache{$self,$key};

  if (ref($ret) eq "HASH") {
    tie my(%h), 'MLDBM::Easy::Hash', $self, $key, $ret;
    return $cache{$self,$key} = \%h;
  }

  if (ref($ret) eq "ARRAY") {
    tie my(@a), 'MLDBM::Easy::Array', $self, $key, $ret;
    return $cache{$self,$key} = \@a;
  }

  if (ref($ret) eq "SCALAR") {
    tie my($s), 'MLDBM::Easy::Scalar', $self, $key, $ret;
    return $cache{$self,$key} = \$s;
  }
}


sub STORE {
  my ($self, $key, $value) = @_;
  $value = $self->{SR}->serialize($cache{$self,$key});
  $self->{DB}->STORE($key, $value);
}


package MLDBM::Easy::Hash;
use Tie::Hash;
@ISA = 'Tie::StdHash';

sub TIEHASH {
  my ($class, $mldbm, $key, $href) = @_;
  my $self = bless $href, $class;
  $cache{$self} = [$mldbm, $key];
  return $self;
}

sub STORE {
  my ($self, $key, $value) = @_;
  $self->{$key} = $value;
  $cache{$self}->[0]->STORE($cache{$self}->[1], $self);
}


package MLDBM::Easy::Array;
use Tie::Array;
@ISA = 'Tie::StdArray';

sub TIEARRAY {
  my ($class, $mldbm, $key, $href) = @_;
  my $self = bless $href, $class;
  $cache{$self} = [$mldbm, $key];
  return $self;
}

sub STORE {
  my ($self, $idx, $value) = @_;
  $self->[$idx] = $value;
  $cache{$self}->[0]->STORE($cache{$self}->[1], $self);
}


package MLDBM::Easy::Scalar;
use Tie::Scalar;
@ISA = 'Tie::StdScalar';

sub TIESCALAR {
  my ($class, $mldbm, $key, $sref) = @_;
  my $self = bless $sref, $class;
  $cache{$self} = [$mldbm, $key];
  return $self;
}

sub STORE {
  my ($self, $value) = @_;
  $$self = $value;
  $cache{$self}->[0]->STORE($cache{$self}->[1], $self);
}


1;

__END__