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__
=head1 NAME
Egg::Model::Session::Base::DBI - Session management by DBI.
=head1 SYNOPSIS
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
);
=head1 DESCRIPTION
The session data is preserved by using DBI.
'L<Egg::Model::DBI>' should be able to be used for use.
And, L<Egg::Helper::Model::Session>. 'Base::DBI' is added to startup of the
component module that generates.
'Base::FileCache' in this systemIt is not possible to cooperate and delete it,
please.
Moreover, it is necessary to load Store system module to treat the session data
appropriately.
__PACKAGE__->startup(
Base::DBI
Store::Base64
ID::SHA1
Bind::Cookie
);
If L<Egg::Plugin::EasyDBI> is effective, it is late commit.
=head1 CONFIGURATION
It sets in config of the session component module and it sets it to 'dbi' key
with HASH.
=head3 label
Label name to use L<Egg::Model::DBI>.
Default is 'dbi::main'.
=head3 dbname
Table name that preserves session data.
Default is 'sessions'.
Please make this table beforehand by the following compositions.
CREATE TABLE [dbname] (
id char(32) primary key,
lastmod timestamp,
a_session text
);
=head3 id_field
Name of session ID column.
Default is 'id'.
=head3 data_field
Name of session data column.
Default is 'a_session'.
=head3 time_field
Name of updated day and hour column.
Default is 'lastmod'.
=head3 prepare_cache
When this item is made effective, 'prepare_cached' method of DBI comes to be
used by the restore method.
Default is undefined.
=head1 METHODS
Because most of these methods is the one that L<Egg::Model::Session> internally
uses it, it is not necessary to usually consider it on the application side.
=head2 _label
The label name of the model used is returned.
=head2 _insert
SQL statement used by the insert method is returned.
=head2 _update
SQL statement used by the update method is returned.
=head2 _delete
SQL statement used by the delete method is returned.
=head2 _clear
SQL statement used by the clear method is returned.
=head2 restore ([SESSION_ID])
The session data obtained by received SESSION_ID is returned.
When SESSION_ID is not obtained, it acquires it in 'session_id' method.
=head2 insert ([SESSION_DATA], [SESSION_ID])
New session data is preserved.
SESSION_DATA is indispensable.
When SESSION_ID is not obtained, it acquires it in 'Session_id' method.
=head2 update ([SESSION_DATA], [SESSION_ID])
Existing session data is updated.
SESSION_DATA is indispensable.
When SESSION_ID is not obtained, it acquires it in 'session_id' method.
=head2 delete ([SESSION_ID])
The session data is deleted.
SESSION_ID is indispensable.
$session->delete('abcdefghijkemn12345');
=head2 clear_sessions ([TIME_VALUE])
All the session data before TIME_VALUE is deleted.
# The update on deletes all the session data that not is.
$session->clear_sessions( time - (24 * 60 * 60) );
=head2 close
L<Egg::Model::Session::Manager::TieHash> Commit is done back.
However, if 'is_update' method is invalid, rollback is issued.
In a word, if data was not substituted for the session, the data is annulled.
When L<Egg::Plugin::EasyDBI> is loaded, nothing is done.
=head1 SEE ALSO
L<Egg::Release>,
L<Egg::Model::Session>,
L<Egg::Model::Session::Manager::Base>,
L<Egg::Model::Session::Manager::TieHash>,
L<Egg::Model>,
L<Egg::Model::DBI>,
L<Time::Piece::MySQL>,
=head1 AUTHOR
Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2008 Bee Flag, Corp. E<lt>L<http://egg.bomcity.com/>E<gt>, All Rights Reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.6 or,
at your option, any later version of Perl 5 you may have available.
=cut