Egg::Model::Session::Base::DBI - Session management by DBI.

  package MyApp::Model::Sesion;

  __PACKAGE__->config(
   dbi => {
     label         => 'dbi_label_name',
     dbname        => 'sessions',
     id_field      => 'id',
     data_field    => 'a_session',
     time_field    => 'lastmod',
     prepare_cache => 1,
     },
   );

  __PACKAGE__->startup(
   Base::DBI
   Store::Base64
   ID::SHA1
   Bind::Cookie
   );

  __PACKAGE__->startup(
   Base::DBI
   Store::Base64
   ID::SHA1
   Bind::Cookie
   );

  CREATE TABLE [dbname] (
    id          char(32)  primary key,
    lastmod     timestamp,
    a_session   text
    );

  $session->delete('abcdefghijkemn12345');

  # The update on deletes all the session data that not is.
  $session->clear_sessions( time - (24 * 60 * 60) );

package Egg::Model::Session::Base::DBI;
#
# Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
#
# $Id: DBI.pm 303 2008-03-05 07:47:05Z lushe $
#
use strict;
use warnings;
use Carp qw/ croak /;
use Time::Piece::MySQL;

our $VERSION= '0.03';

sub _setup {
	my($class, $e)= @_;
	$e->model_manager->isa('Egg::Model::DBI')
	   || die q{ I want setup 'Egg::Model::DBI'.};

	$class->mk_classdata($_) for qw/ _label _insert _update _delete _clear /;
	my $c= $class->config->{dbi} ||= {};
	my $dbname = $c->{dbname}     || 'sessions';
	my $idcol  = $c->{id_field}   || 'id';
	my $datacol= $c->{data_field} || 'a_session';
	my $timecol= $c->{time_field} || 'lastmod';

	$class->_insert
	  (qq{INSERT INTO $dbname ($idcol, $datacol, $timecol) VALUES (?, ?, ?)});
	$class->_update
	  (qq{UPDATE $dbname SET $datacol = ?, $timecol = ? WHERE $idcol = ? });
	$class->_delete
	  (qq{DELETE FROM $dbname WHERE $idcol = ?});
	$class->_clear
	  (qq{DELETE FROM $dbname WHERE $timecol < ? });

	my $restore_sql= qq{SELECT $datacol FROM $dbname WHERE $idcol = ? };

	no strict 'refs';  ## no critic.
	no warnings 'redefine';
	*{"${class}::_restore"}= ($c->{prepare_cache} or $c->{prepare_cached})
	     ? sub { $_[0]->_dbh->prepare_cached($restore_sql) }
	     : sub { $_[0]->_dbh->prepare($restore_sql) };
	if ($e->isa('Egg::Plugin::EasyDBI')) {
		*{"${class}::_commit"}= sub {
			if ($_[1]) {
				my $db= $_[0]->e->dbh($_[0]->_label) || return 0;
				$db->commit_ok(1);
			}
		  };
		*{"${class}::_dbh"}= sub {
			$_[0]->attr->{dbh} || do {
				my $db= $_[0]->e->dbh($_[0]->_label) || return 0;
				$db->dbh;
			  };
		  };
	} else {
		*{"${class}::_commit"}= sub {
			$_[1] ? $_[0]->_dbh->commit
			      : $_[0]->_dbh->rollback;
		  };
		*{"${class}::_dbh"}= sub { $_[0]->e->model($_[0]->_label)->dbh; };
	}
	$class->_label($c->{label} || 'dbi::main');
	$class->next::method($e);
}
sub restore {
	my $self= shift;
	my $id  = shift || $self->session_id || croak q{I want session id.};
	my $sesson;
	my $sth= $self->_restore;
	$sth->execute($id);
	$sth->bind_columns(\$sesson);
	$sth->fetch; $sth->finish;
	$sesson ? \$sesson: 0;
}
sub insert {
	my $self= shift;
	my $data= shift || croak q{I want session data.};
	my $id  = shift || $self->session_id || croak q{I want session id.};
	$self->_do($self->_insert, $id, $$data, localtime(time)->mysql_datetime);
}
sub update {
	my $self= shift;
	my $data= shift || croak q{I want session data.};
	my $id  = shift || $self->session_id || croak q{I want session id.};
	$self->_do($self->_update, $$data, localtime(time)->mysql_datetime, $id);
}
sub delete {
	my $self= shift;
	my $id  = shift || croak q{I want session id.};
	$self->_do($self->_delete, $id);
}
sub clear_sessions {
	my $self= shift;
	my $datetime= shift || die q{ I want time. };
	$self->_do($self->_clear, undef, localtime($datetime)->mysql_datetime);
}
sub _do {
	my $self= shift;
	my $sql = shift;
	my $result;
	eval {
		$self->e->debug_out("# + session Base::DBI : $sql");
		$result= $self->_dbh->do($sql, undef, @_);
		$self->_commit(1);
	  };
	return $result unless $@;
	$self->_dbh->rollback;
	die $@;
}
sub close {
	my($self)= @_;
	my $update_ok= $self->is_update;
	$self->next::method;
	$self->_commit($update_ok);
	$self;
}

1;

__END__