File Coverage

blib/lib/HTTP/Session/Store/DBM.pm

Criterion	Covered	Total	%
statement	34	39	87.1
branch	4	8	50.0
condition	4	5	80.0
subroutine	10	13	76.9
pod	5	7	71.4
total	57	72	79.1

package HTTP::Session::Store::DBM;
use strict;
use warnings;
use base qw/Class::Accessor::Fast/;
use Fcntl;
use Storable;
use Module::Runtime ();

__PACKAGE__->mk_ro_accessors(qw/file dbm_class/);

sub new {
    my $class = shift;
    my %args = ref($_[0]) ? %{$_[0]} : @_;
    # check required parameters
    for (qw/file/) {
        Carp::croak "missing parameter $_" unless $args{$_};
    }
    # set default values
    $args{dbm_class} ||= 'SDBM_File';
    bless {%args}, $class;
}

sub dbm {
    my $self = shift;
    $self->{dbm} ||= do {
        my %hash;
        Module::Runtime::require_module($self->dbm_class) or die $@;
        tie %hash, $self->dbm_class, $self->file, O_CREAT | O_RDWR, oct("600") or die "Cannot open dbm file for session: $self->{dbm_class}, $self->{file}";
        \%hash;
    };
}

sub select {
    my ( $self, $key ) = @_;
    Storable::thaw $self->dbm->{$key};
}

sub insert {
    my ( $self, $key, $value ) = @_;
    $self->dbm->{$key} = Storable::freeze $value;
}
sub update { shift->insert(@_) }

sub delete {
    my ( $self, $key ) = @_;
    delete $self->dbm->{$key};
}

sub cleanup { Carp::croak "This storage doesn't support cleanup" }

1;
__END__