view release on metacpan or  search on metacpan

lib/Apache/Session/DBIBase64Store.pm  view on Meta::CPAN

use strict;

use DBI;
use Storable qw( nfreeze thaw );
use MIME::Base64;

use vars qw($VERSION);

BEGIN {
    ($VERSION) = '$Revision: 1.2 $' =~ /Revision: ([\d.]+)/ ;
}

sub new {
    my $class = shift;

    return bless {}, $class;
}

sub get_handle {
    my ($self,$session) = @_;

    my $dbh = $session->{args}{dbh} || $self->{dbh};
    unless ( $dbh ) {
	my $dsn		= $session->{args}{DataSource};
	my $username	= $session->{args}{UserName};
	my $password	= $session->{args}{Password};

	die "No opened database connection and no DSN\n" unless $dsn;
	$dbh = DBI->connect( $dsn, $username, $password, { AutoCommit => 0,
							   RaiseError => 1,
							 } );

	# Save it for future use
	$self->{dbh}   = $dbh;
    }
    die "No opened database connection\n" unless $dbh;

    return $dbh;
}

sub insert {
    my $self    = shift;
    my $session = shift;

    my $dbh = $self->get_handle( $session );

    my $sth =$dbh->prepare(qq{ INSERT INTO sessions (id, created, last_update,
						     length, a_session)
			   	    VALUES (?,'now()', 'now()', ?, ? ) } );

    my $serialized = encode_base64( nfreeze $session->{data} );

    $sth->execute ( $session->{data}{_session_id}, length $serialized,
		    $serialized );
    $sth->finish;
    $dbh->commit;
}


sub update {
    my $self    = shift;
    my $session = shift;

    my $dbh = $self->get_handle( $session );

    my $sth = $dbh->prepare( qq{ UPDATE sessions
				    SET length = ?, a_session = ?,
					last_update = now()
				  WHERE id = ?} );

    my $serialized = encode_base64( nfreeze $session->{data} );

    $sth->execute( length $serialized, $serialized,
		   $session->{data}{_session_id} );
    $sth->finish;
    $dbh->commit;
}

sub materialize {
    my $self    = shift;
    my $session = shift;

    my $dbh = $self->get_handle( $session );

    my $sth = $dbh->prepare( qq{ SELECT a_session FROM sessions WHERE id = ?});
    $sth->execute( $session->{data}{_session_id} );

    my $results = $sth->fetchrow_arrayref;
    die "Object does not exist in the data store" unless defined $results;

    $sth->finish;

    $session->{data} = thaw decode_base64( $results->[0] );

    die "Session is corrupted\n" unless $session->{data};

    $dbh->commit;
}

sub remove {
    my $self    = shift;
    my $session = shift;

    my $dbh = $self->get_handle( $session );

    my $sth = $dbh->prepare( qq{ DELETE FROM sessions WHERE id = ?} );
    $sth->execute( $session->{data}{_session_id} );
    $sth->finish;

    $dbh->commit;
}

sub DESTROY {
    my $self = shift;

    if ( $self->{dbh} ) {
	# Close connection to the database if we opened
	# it. If it is not ours, it is up to the owner
	# to dispose of it.
	$self->{dbh}->disconnect;