view release on metacpan or  search on metacpan

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

#
#    DBIBase64Store.pm - Session store implemented with DBI database.
#
#    This file is part of Apache::iNcom.
#
#    Author: Francis J. Lacoste <francis.lacoste@iNsu.COM>
#    Based on Apache::Session:DBIStore from Jeffrey William Baker
#
#    Copyright (C) 1999 Francis J. Lacoste, iNsu Innovations
#    Parts Copyright(c) 1998, 1999 Jeffrey William Baker (jeffrey@kathyandjeffrey.net)
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms same terms as perl itself.
#

package Apache::Session::DBIBase64Store;

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;