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.0005;

our $CACHE={};

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',
);

=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:
        connection: "foo"
        session_table: "SESSIONS"
        id_column:     "SESSION_ID"
        data_column:   "SESSION_DATA"

  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)=@_;

  return $self->sth_cache->{$method} if exists $self->sth_cache->{$method};

  my $query=$self->$method;
  my $sth=$self->dbh->prepare($query);
  return $self->sth_cache->{$method}=$sth;
}

sub _sessions {
  my ($self) = @_;
  my $data=[];
  my $sth=$self->get_sth('create_sessions_query');

  $sth->execute();

  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');
  $sth->execute($id);
  my ($s)=$sth->fetchrow_array;
  $sth->finish;
  return $s;
}

sub _retrieve {
  my ( $self, $id ) = @_;
  my $s=$self->find_session($id);
  
  croak "Invalid session ID: $id"
    if !defined $s;

  return thaw($s);
}

sub _change_id {
  my ( $self, $old_id, $new_id ) = @_;
  my $sth=$self->get_sth('create_change_query');
  $sth->execute($new_id,$old_id);
}

sub _destroy {
  my ( $self, $id ) = @_;
  my $sth=$self->get_sth('create_destroy_query');
  $sth->execute($id);
}

sub _flush {
  my ( $self, $id, $data ) = @_;

  $data={} unless is_plain_hashref $data;
   
  my $s=$self->find_session($id);
  my $string=nfreeze($data);
    
  if(defined($s)) {
    my $sth=$self->get_sth('create_update_query');
    $sth->execute($string,$id);;
  } else {
    my $sth=$self->get_sth('create_flush_query');
    $sth->execute($id,$string);
  }
}

sub dbh {
  my ($self)=@_;
  return Dancer2::Plugin::SessionDatabase::DBC($self->connection);
}

=head1 Dancer2::Plugin::Database hooks

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:

  %{$Dancer2::Session::DatabasePlugin::CACHE}=();

=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;
