view release on metacpan or  search on metacpan

lib/Apache/Session/Store/DB_File.pm  view on Meta::CPAN

#############################################################################
#
# Apache::Session::Store::DB_File
# Implements session object storage via Perl's DB_File module
# Copyright(c) 2000 Jeffrey William Baker (jwbaker@acm.org)
# Distribute under the Perl License
#
############################################################################

package Apache::Session::Store::DB_File;

use strict;
use vars qw($VERSION);
use DB_File;

$VERSION = '1.01';

sub new {
    my $class = shift;
    
    return bless {dbm => {}}, $class;
}

sub insert {
    my $self    = shift;
    my $session = shift;
    
    if (!tied %{$self->{dbm}}) {
        my $rv = tie %{$self->{dbm}}, 'DB_File', $session->{args}->{FileName};

        if (!$rv) {
            die "Could not open dbm file $session->{args}->{FileName}: $!";
        }
    }
    
    if (exists $self->{dbm}->{$session->{data}->{_session_id}}) {
        die "Object already exists in the data store";
    }
    
    $self->{dbm}->{$session->{data}->{_session_id}} = $session->{serialized};
}

sub update {
    my $self = shift;
    my $session = shift;
    
    if (!tied %{$self->{dbm}}) {
        my $rv = tie %{$self->{dbm}}, 'DB_File', $session->{args}->{FileName};

        if (!$rv) {
            die "Could not open dbm file $session->{args}->{FileName}: $!";
        }
    }
    
    $self->{dbm}->{$session->{data}->{_session_id}} = $session->{serialized};
}

sub materialize {
    my $self = shift;
    my $session = shift;
    
    if (!tied %{$self->{dbm}}) {
        my $rv = tie %{$self->{dbm}}, 'DB_File', $session->{args}->{FileName};

        if (!$rv) {
            die "Could not open dbm file $session->{args}->{FileName}: $!";
        }
    }
    
    $session->{serialized} = $self->{dbm}->{$session->{data}->{_session_id}};

    if (!defined $session->{serialized}) {
        die "Object does not exist in data store";
    }
}

sub remove {
    my $self = shift;
    my $session = shift;
    
    if (!tied %{$self->{dbm}}) {
        my $rv = tie %{$self->{dbm}}, 'DB_File', $session->{args}->{FileName};

        if (!$rv) {
            die "Could not open dbm file $session->{args}->{FileName}: $!";
        }
    }
    
    delete $self->{dbm}->{$session->{data}->{_session_id}};
}

1;

=pod

=head1 NAME

Apache::Session::Store::DB_File - Use DB_File to store persistent objects

=head1 SYNOPSIS

 use Apache::Session::Store::DB_File;