HTTP::Session::Store::DBM - DBM session store

    HTTP::Session->new(
        store => HTTP::Session::Store::DBM->new(
            file      => '/path/to/file',
            dbm_class => 'GDBM_File',
        ),
        state => ...,
        request => ...,
    );

package HTTP::Session::Store::DBM;
use strict;
use warnings;
use base qw/Class::Accessor::Fast/;
use Fcntl;
use Storable;
use UNIVERSAL::require;

__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;
        $self->dbm_class->use 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__