package Dancer2::Session::DBIx; use Modern::Perl; use Data::Printer; use Storable qw(freeze thaw); use Local::DB; use Local::MooX::Types qw/HashReference/; use Moo; # passed in from config as engines/Session/DBIx: has $_ => ( is => 'ro' ) for qw( dsn dbname ); has dbix => ( is => 'lazy', builder => sub { Local::DB->dbix(shift->dbname) }, # or for new dbh for sessions: # builder => sub { DBIx::Simple->connect(shift->dsn); }, ); has cache => ( is => 'rw', isa => HashReference, default => sub { {} } ); with 'Dancer2::Core::Role::SessionFactory'; #--------------------------------------------------------------------------# # SessionFactory implementation methods #--------------------------------------------------------------------------# sub _retrieve { my ( $self, $id ) = @_; my $session = $self->dbix->select('sessions', '*', { id => $id } )->hash; my $data = $self->_deserialize($session->{a_session}); # ddp $data; return $data; } sub _flush { my ( $self, $id, $data ) = @_; # ddp $data; local $ENV{SQL_TRACE} = 0; # to prevent query output for storable data my $store = $self->_serialize($data); # if ( $self->dbix->select('sessions', 1, { id => $id } )->list ) { # update: if ( $self->cache->{session_id} ) { # need to delete before insert in case app restarted, or get duplicate key err: $self->dbix->update('sessions', { a_session => $store }, { id => $id }); #my $user = $data->{user_profile}; # to update userid col #my $userid = join '.', $user->{first_name}, $user->{last_name}; } else { # insert: $self->_destroy($id); # need to delete 1st if using cache in case app restarted $self->dbix->insert('sessions', { id => $id, a_session => $store } ); $self->cache( { session_id => $id } ); # to prevent any more queries for $id } } sub _destroy { my ( $self, $id ) = @_; $self->dbix->delete('sessions', { id => $id }); } sub _sessions { my ($self) = @_; my $all = $self->dbix->select('sessions', 'id')->list; return $all; } #------------------------------------------------------------------------------- sub _serialize { my ($self, $data) = @_; return freeze $data; } sub _deserialize { my ($self, $serialised) = @_; return thaw $serialised; } 1;