File Coverage

blib/lib/Apache/Session/Store/CacheAny.pm

Criterion	Covered	Total	%
statement	29	32	90.6
branch	9	10	90.0
condition	2	3	66.6
subroutine	7	8	87.5
pod	0	5	0.0
total	47	58	81.0

package Apache::Session::Store::CacheAny;

use strict;
use vars qw($VERSION);
$VERSION = '0.02';


sub new {
    my($class, $session) = @_;
    bless { cache => undef }, $class;
}

sub insert {
    my($self, $session) = @_;
    my $cache = $self->_cache($session);

    if ($cache->get_object($session->{data}->{_session_id})) {
	die "Object already exists in the data store.";
    }

    $cache->set($session->{data}->{_session_id} => $session->{serialized});
}

sub update {
    my($self, $session) = @_;
    my $cache = $self->_cache($session);
    $cache->set($session->{data}->{_session_id} => $session->{serialized});
}

sub materialize {
    my($self, $session) = @_;
    my $cache = $self->_cache($session);
    $session->{serialized} = $cache->get($session->{data}->{_session_id})
	or die "Object does not exist in data store.";
}

sub remove {
    my($self, $session) = @_;
    $self->_cache($session)->remove($session->{data}->{_session_id});
}

sub _cache {
    my($self, $session) = @_;
    unless ($self->{cache}) {
	# Tries to load implementation
	# We ignore "Can't locate" exception
	my $impl = $session->{args}->{CacheImpl};
	eval qq{require $impl};
	if ($@ && !$impl->can('new')) {
	    die "Failed to load $impl: $@";
	}

	# Different named parameter style here
	my %arg2opt = (
	    Namespace         => 'namespace',
	    DefaultExpiresIn  => 'default_expires_in',
	    AutoPurgeInterval => 'auto_purge_interval',
	    AutoPurgeOnSet    => 'auto_purge_on_set',
	    AutoPurgeOnGet    => 'auto_purge_on_get',
	    MaxSize           => 'max_size',
	    CacheRoot         => 'cache_root',
	    CacheDepth        => 'cache_depth',
	    DirectoryUmask    => 'directory_umask',
	);

	my %opt = map {
	    exists $session->{args}->{$_} ?
		($arg2opt{$_} => $session->{args}->{$_}) : ();
	} keys %arg2opt;
	$self->{cache} = $impl->new(\%opt);
    }
    $self->{cache};
}

1;
__END__