File Coverage

blib/lib/EntityModel/Cache/Perl.pm

Criterion	Covered	Total	%
statement	13	34	38.2
branch	0	4	0.0
condition			n/a
subroutine	4	8	50.0
pod	5	6	83.3
total	22	52	42.3

package EntityModel::Cache::Perl;
{
  $EntityModel::Cache::Perl::VERSION = '0.102';
}
use EntityModel::Class {
	_isa => [qw(EntityModel::Cache)],
};

=head1 NAME

EntityModel::Cache::Perl - simple proof-of-concept Perl-level caching layer

=head1 VERSION

version 0.102

=head1 SYNOPSIS

=head1 DESCRIPTION

=cut

use Tie::Cache::LRU;

our %cache;
tie %cache, 'Tie::Cache::LRU', 1024;

=head1 METHODS

=cut

sub get {
	my $self = shift;
	my $k = shift;
	return $cache{$k};
}

sub remove {
	my $self = shift;
	my $k = shift;
	delete $cache{$k};
	return $self;
}

sub incr {
	my $self = shift;
	my $k = shift;
	++$cache{$k};
}

sub decr {
	my $self = shift;
	my $k = shift;
	--$cache{$k};
}

sub set {
	my $self = shift;
	my $k = shift;
	$cache{$k} = shift;
	return $self;
}

sub atomic {
	my $self = shift;
	die 'This is an instance method' unless ref($self);
	my $k = shift;
	my $f = shift;
	my $v = $self->get($k);

	if($v) {
		logDebug('[%s] is cached, %d bytes', $k, length($v));
		return $v;
	}

	$v = $f->($k); # old memcached without cas support may die here
	$self->set($k, $v, 5);
	return $v;
}

1;

__END__