Dancer2-Session-DatabasePlugin/lib/Dancer2/Session/DatabasePlugin.pm
package Dancer2::Session::DatabasePlugin;
use Modern::Perl;
use Moo;
use Data::Dumper;
use Dancer2::Core::Types;
use Dancer2::Plugin::Database;
use Carp qw(croak);
use Ref::Util qw(is_plain_hashref);
use Storable qw(nfreeze thaw);
with 'Dancer2::Core::Role::SessionFactory';
our $VERSION="1.0014";
our $HANDLE_SQL_STRING=\&stub_function;
our $HANDLE_EXECUTE=\&handle_execute;
sub stub_function { }
sub handle_execute {
my ($name,$sth,@args)=@_;
$sth->execute(@args);
}
our $CACHE={};
our $FREEZE=\&nfreeze;
our $THAW=\&thaw;
has no_create=>(
ias=>HashRef,
is=>'ro',
default=>sub { return {}},
);
has cache =>(
isa=>Bool,
is=>'rw',
default=>0,
);
has cache_sth=>(
isa=>Bool,
is=>'ro',
default=>0,
);
has sth_cache=>(
isa=>HashRef,
default=>sub { $CACHE },
is=>'ro',
);
has connection=>(
isa=>Str,
is=>'rw',
default=>'foo',
required=>1,
);
has session_table=>(
isa=>Str,
required=>1,
is=>'rw',
default=>'SESSIONS',
);
has id_column=>(
isa=>Str,
required=>1,
is=>'rw',
default=>'SESSION_ID',
);
has data_column=>(
isa=>Str,
required=>1,
is=>'rw',
default=>'SESSION_DATA',
);
has dbh=>(
is=>'rw',
);
=head1 NAME
Dancer2::Session::DatabasePlugin - Dancer2 Session implementation for databases
=head1 SYNOPSIS
use Dancer2;
use Dancer2::Plugin::Database;
use Dancer2::Plugin::SessionDatabase;
=head1 DESCRIPTION
This class extends Dancer2::Core::Role::SessionFactory, and makes use of Dancer2::Plugin::Database for managing database connections.
=head1 CONFIGURATION
The session should be set to "DatabasePlugin" in order to use this session engine in your Dancer2 Application.
session: "DatabasePlugin"
engines:
session:
DatabasePlugin:
cache: 0 # default 0, when 1 statement handles are cached
connection: "foo"
session_table: "SESSIONS"
id_column: "SESSION_ID"
data_column: "SESSION_DATA"
cache_sth: 0 # default 0, when set to 1 statement handles are cached
plugins:
Database:
connections:
foo:
driver: "SQLite"
database: "foo.sqlite"
=head1 Expected Schema
The code was developed to use a table with 2 columns: SESSION_ID, SESSION_DATA, additional columns will not impact the code. No records are deleted unless the session destroy is called, so cleanup is something that may need to be done over time.
The sql statements are generated based on the configuration options, session_table, id_column, and data_column.
=head2 Example Schema
Testing and development was done using SQLite3.
Create statement is as follows:
create table sessions (session_id varchar unique,session_data blob);
=head1 How Queries are generated
All queries are generated using sprintf statements against constatins.
=head2 Column SESSION_ID
This column must have constraint defining the values as unique. The id is a string representing the current session, internals from Dancer2::Core::Session seems to return a 32 byte long string. It is highly recommended this column be indexed.
=head2 Column SESSION_DATA
This field is expected to be a BLOB or binary data type, although a large text field should work. The data being written to this column is generated by using Storable::nfreeze($ref).
=head1 SQL Statements
All SQL Statements are generated based on the given configuration.
=head2 Insert
Default Query Shown:
INSERT into SESSIONS (SESSION_ID,SESSION_DATA) values (?,?)
Sprintf Template:
INSERT into %s (%s,%s) values (?,?)
=cut
sub INSERT { 'INSERT into %s (%s,%s) values (?,?)' }
sub create_flush_query {
my ($self)=@_;
return sprintf $self->INSERT,$self->session_table,$self->id_column,$self->data_column;
}
=head2 Update Existing session
Default Query Shown:
UPDATE SESSIONS SET SESSION_DATA=? WHERE SESSION_ID=?
Sprintf Template:
UPDATE %s SET %s=? WHERE %s=?
=cut
sub UPDATE { 'UPDATE %s SET %s=? WHERE %s=?' }
sub create_update_query {
my ($self)=@_;
my $query=sprintf $self->UPDATE,$self->session_table,$self->data_column,$self->id_column;
}
=head2 Delete
Default Query Shown:
DELETE FROM SESSIONS WHERE SESSION_ID=?
Sprintf Template:
DELETE FROM %s WHERE %s=?
=cut
sub DELETE { 'DELETE FROM %s WHERE %s=?' }
sub create_destroy_query {
my ($self)=@_;
my $query=sprintf $self->DELETE,$self->session_table,$self->id_column;
return $query;
}
=head2 SELECT Current Session
Default Query Shown:
SELECT SESSION_DATA FROM SESSIONS WHERE SESSION_ID=?
Sprintf Template:
SELECT %s FROM %s WHERE %s=?
=cut
sub SELECT { 'SELECT %s FROM %s WHERE %s=?' }
sub create_retrieve_query {
my ($self)=@_;
my $query=sprintf $self->SELECT,$self->data_column,$self->session_table,$self->id_column;
return $query;
}
=head2 SELECT All Session Keys
Default Query Shown:
SELECT SESSION_ID FROM SESSIONS
Sprintf Template
SELECT %s FROM %s
=cut
sub SELECT_ALL { 'SELECT %s FROM %s' }
sub create_sessions_query {
my ($self)=@_;
my $query=sprintf $self->SELECT_ALL,$self->id_column,$self->session_table;
return $query;
}
=head2 Rename Session
Default Query Shown:
UPDATE SESSIONS SET SESSION_ID=? WHERE SESSION_ID=?
Sprintf Template:
UPDATE %s SET %s=? WHERE %s=?
=cut
sub RENAME { 'UPDATE %s SET %s=? WHERE %s=?' }
sub create_change_query {
my ($self)=@_;
my $query=sprintf $self->RENAME,$self->session_table,$self->id_column,$self->id_column;
return $query;
}
sub get_sth($) {
my ($self,$method)=@_;
if($self->no_create->{$method}) {
return undef;
}
return $self->sth_cache->{$method} if $self->cache && exists $self->sth_cache->{$method};
my $query=$self->$method;
my $sth;
$HANDLE_SQL_STRING->($method,$query,$self->get_dbh,$sth);
$sth=$self->get_dbh->prepare($query) unless defined($sth);
# only cache the statement handle if we are told too
return $sth unless $self->cache_sth;
return $sth unless $self->cache;
return $self->sth_cache->{$method}=$sth;
}
sub _sessions {
my ($self) = @_;
my $data=[];
my $sth=$self->get_sth('create_sessions_query');$HANDLE_EXECUTE->('create_sessions_query',$sth,);
while(my $row=$sth->fetchtow_arrayref) {
push @{$data},@{$row};
}
return $data;
}
sub find_session {
my ( $self, $id ) = @_;
my $sth=$self->get_sth('create_retrieve_query');$HANDLE_EXECUTE->('create_retrieve_query',$sth,$id);
my ($s)=$sth->fetchrow_array;
return $s;
}
sub _retrieve {
my ( $self, $id ) = @_;
my $s=$self->find_session($id);
return undef unless defined($s);
return $THAW->($s);
}
sub _change_id {
my ( $self, $old_id, $new_id ) = @_;
my $sth=$self->get_sth('create_change_query');$HANDLE_EXECUTE->('create_change_query',$sth,$new_id,$old_id);
}
sub _destroy {
my ( $self, $id ) = @_;
my $sth=$self->get_sth('create_destroy_query');$HANDLE_EXECUTE->('create_destroy_query',$sth,$id);
}
sub _flush {
my ( $self, $id, $data ) = @_;
$data={} unless is_plain_hashref $data;
my $s=$self->find_session($id);
my $string=$FREEZE->($data);
if(defined($s)) {
my $sth=$self->get_sth('create_update_query');$HANDLE_EXECUTE->('create_update_query',$sth,$string,$id);
} else {
my $sth=$self->get_sth('create_flush_query');$HANDLE_EXECUTE->('create_flush_query',$sth,$id,$string);
}
}
sub get_dbh {
my ($self)=@_;
#return Dancer2::Plugin::SessionDatabase::DBC($self->connection);
$self->execute_hook( 'engine.session.before_db', $self );
return $self->dbh;
}
=head1 hooks created
This package supports the default session engine hooks along with the following addtional hooks documented in this section.
=cut
sub supported_hooks {
qw/
engine.session.before_retrieve
engine.session.after_retrieve
engine.session.before_create
engine.session.after_create
engine.session.before_change_id
engine.session.after_change_id
engine.session.before_destroy
engine.session.after_destroy
engine.session.before_flush
engine.session.after_flush
engine.session.before_db
/;
}
=head2 engine.session.before_db
This hook is run before the session engine calls the database function from Dancer2::Plugin::Database.
hook=>'engine.session.before_db'=>sub {
my ($session)=@_;
};
Note: This hook is used by Dancer2::Plugin::SessionDatabase to set the database handle in the session object at runtime.
=head1 hooks used in Dancer2::Plugin::Database
This package makes use of hooks provdied by Dancer2::Database::Plugin.
=head2 "database_connection_lost"
This hook is used to clear the existing database statement handle cache.
=head2 "database_error"
This hook is used to clear the existing database statement handle cache.
=head1 Notes
=head2 Database Acces Pre-Fork
If you access sessions preforking, you will need to reset the statement handle session cache.
Example:
=head3 Clearing the Statement Handle Cache
The following code snippit will reset the built in statement handle cache to empty.
%{$Dancer2::Session::DatabasePlugin::CACHE}=();
=head3 Clearing the Database Connection
To release the current database session, use the following code snippet.
$Dancer2::Plugin::SessionDatabase::DBH=undef;
=head1 Specal Examples
=head2 Changing the freeze and thaw functions
Your database may not support globs or glob syntax, when this is the case it is possible to set a new subrouteens in place that handle the freezing and thawing of data.
=head3 Freeze
The nfreeze code reference is stored here
$Dancer2::Session::DatabasePlugin::FREEZE
=head3 Thaw
The thaw code reference is stored here
$Dancer2::Session::DatabasePlugin::THAW
=head2 Oracle in general
Oracle has some odd quirks, here is an example configuration that may help solve more than a few problems.
Database:
connections:
myoracledb:
driver: "Oracle:(DESCRIPTION = (ADDRESS = (PROTOCOL = TCP)(HOST = my.oracle.server.com)(PORT = 1521)) (CONNECT_DATA = (SERVER = DEDICATED) (SERVICE_NAME=ORACLE.SERVICE.COM)))"
username: OracleUser
password: 'xxxxxxx'
dbi_params:
RaiseError: 1
AutoCommit: 1
FetchHashKeyName: 'NAME_uc'
LongReadLen: 1000000
=head2 The manual bind example ( Oracle and the like )
Some databases require manual binds for blob. Here is an example of how to do this for Oracle.
use DBD::Oracle qw(:ora_types);
use Dancer2;
use Dancer2::Plugin::Database;
use Dancer2::Plugin::SessionDatabase;
$Dancer2::Session::DatabasePlugin::HANDLE_EXECUTE=sub {
my ($name,$sth,@bind)=@_;
if($name eq 'create_update_query') {
my ($string,$id)=@bind;
$sth->bind_param(1,$string,{ora_type => ORA_BLOB });
$sth->bind_param(2,$id,{ora_type => ORA_VARCHAR2});
$sth->execute();
} elsif($name eq 'create_flush_query') {
my ($id,$string)=@bind;
$sth->bind_param(1,$id,{ora_type => ORA_VARCHAR2});
$sth->bind_param(2,$string,{ora_type => ORA_BLOB });
$sth->execute();
} else {
$sth->execute(@bind);
}
};
=head2 Completly Changing an SQL statement
Sometimes you may want to replace the query created with something entierly new. To do this you will need to set $HANDLE_SQL_STRING function refrerence.
use Dancer2;
use Dancer2::Plugin::Database;
use Dancer2::Plugin::SessionDatabase;
$Dancer2::Session::DatabasePlugin::HANDLE_SQL_STRING=sub {
my ($name)=@_;
if($name eq 'query_to_alter') {
$_[1]='some new sql statement';
}
};
=head2 DBD::Sybase MSSQL FreeTDS Example
This example represents how to deal with some of the strange limitations when connecting via MSSQL via DBD::Sybase with FreeTDS.
The limitations are as follows: DBD::Sybase does not support multiple open statement handls when AuttoCommit is true. DBD::Sybase doesn't handle placeholders properly, and has some issues with binary data as well.
=head3 Session Configuration
In our session configuration we need to do the following: Disable statement handle caching and turn off the standard query generation code for the following functions: [create_update_query,create_flush_query].
engines:
session:
DatabasePlugin:
connection: "myconnection"
session_table: "SESSIONS"
id_column: "SESSION_ID"
data_column: "SESSION_DATA"
# Disable Caching of Statement handles
cache: 0
# skip internal Statment handler creation code for the following
no_create:
create_update_query: 1
create_flush_query: 1
=head3 Database Configuration
Our example database has AutoCommit Disabled.
plugins:
Database:
connections:
socmon:
driver: Sybase
server: SOCMON_DEV
username: username
password: xxx
database: myconnection
dbi_params:
RaiseError: 1
AutoCommit: 1
FetchHashKeyName: 'NAME_lc'
=head3 MSSQL Table Creation
MSSQL has some odd quirks when it comes to binary data, so in this case we will use varchar(max).
create table SESSIONS (
session_id varchar(32) ,
session_data varchar(max),
l astUpdate TimeStamp,
CONSTRAINT AK_session_id UNIQUE(session_id)
)
=head3 Code Example
Finnaly in your Dancer2 App we add the following code.
use JSON qw(to_json from_jsom);
$Dancer2::Session::DatabasePlugin::FREEZE=\&to_json;
$Dancer2::Session::DatabasePlugin::THAW=\&from_json;
$Dancer2::Session::DatabasePlugin::HANDLE_EXECUTE=sub {
my ($name,$sth,@bind)=@_;
if($name eq 'create_update_query') {
my ($string,$id)=@bind;
$string=~ s/'/''/g;
$id=~ s/'/''/g;
$Dancer2::Plugin::SessionDatabase::DBH->do("update sessions set session_data='$string' where session_id='$id'");
} elsif($name eq 'create_flush_query') {
my ($id,$string)=@bind;
$string=~ s/'/''/g;
$id=~ s/'/''/g;
$Dancer2::Plugin::SessionDatabase::DBH->do("insert into sessions (session_data,session_id) values ('$string','$id')");
} else {
$sth->execute(@bind);
}
};
=head1 See Also
Dancer2::Plugin::Database
Dancer2::Session::YAML
=head1 LICENSE
This softare is distributed under the Perl 5 License.
=head1 AUTHOR
Michael Shipper <AKALINUX@cpan.org>
=cut
1;