lib/Plack/Session/Store/DBI.pm

   1 package Plack::Session::Store::DBI;
   2 use strict;
   3 use warnings;
   4
   5 # XXX Is there a notion of auto-expiry?
   6
   7 our $VERSION   = '0.10';
   8 our $AUTHORITY = 'cpan:STEVAN';
   9
  10 use MIME::Base64 ();
  11 use Storable ();
  12
  13 use parent 'Plack::Session::Store';
  14
  15 use Plack::Util::Accessor qw[ dbh get_dbh table_name serializer deserializer ];
  16
  17 sub new {
  18     my ($class, %params) = @_;
  19
  20     if (! $params{dbh} && ! $params{get_dbh}) {
  21         die "DBI instance or a callback was not available in the argument list";
  22     }
  23
  24     $params{table_name}   ||= 'sessions';
  25     $params{serializer}   ||=
  26         sub { MIME::Base64::encode_base64( Storable::nfreeze( $_[0] ) ) };
  27     $params{deserializer} ||=
  28         sub { Storable::thaw( MIME::Base64::decode_base64( $_[0] ) ) };
  29
  30     my $self = bless { %params }, $class;
  31     return $self;
  32 }
  33
  34 sub _dbh {
  35     my $self =shift;
  36     ( exists $self->{get_dbh} ) ? $self->{get_dbh}->() : $self->{dbh};
  37 }
  38
  39 sub fetch {
  40     my ($self, $session_id) = @_;
  41     my $table_name = $self->{table_name};
  42     my $dbh = $self->_dbh;
  43     my $sth = $dbh->prepare_cached("SELECT session_data FROM $table_name WHERE id = ?");
  44     $sth->execute( $session_id );
  45     my ($data) = $sth->fetchrow_array();
  46     $sth->finish;
  47     return $data ? $self->deserializer->( $data ) : ();
  48 }
  49
  50 sub store {
  51     my ($self, $session_id, $session) = @_;
  52     my $table_name = $self->{table_name};
  53
  54     # XXX To be honest, I feel like there should be a transaction
  55     # call here.... but Catalyst didn't have it, so I'm not so sure
  56
  57     my $sth = $self->_dbh->prepare_cached("SELECT 1 FROM $table_name WHERE id = ?");
  58     $sth->execute($session_id);
  59
  60     # need to fetch. on some DBD's execute()'s return status and
  61     # rows() is not reliable
  62     my ($exists) = $sth->fetchrow_array();
  63
  64     $sth->finish;
  65
  66     if ($exists) {
  67         my $sth = $self->_dbh->prepare_cached("UPDATE $table_name SET session_data = ? WHERE id = ?");
  68         $sth->execute( $self->serializer->($session), $session_id );
  69     }
  70     else {
  71         my $sth = $self->_dbh->prepare_cached("INSERT INTO $table_name (id, session_data) VALUES (?, ?)");
  72         $sth->execute( $session_id , $self->serializer->($session) );
  73     }
  74
  75 }
  76
  77 sub remove {
  78     my ($self, $session_id) = @_;
  79     my $table_name = $self->{table_name};
  80     my $sth = $self->_dbh->prepare_cached("DELETE FROM $table_name WHERE id = ?");
  81     $sth->execute( $session_id );
  82     $sth->finish;
  83 }
  84
  85 1;
  86
  87 __END__
  88
  89 =head1 NAME
  90
  91 Plack::Session::Store::DBI - DBI-based session store
  92
  93 =head1 SYNOPSIS
  94
  95   use Plack::Builder;
  96   use Plack::Middleware::Session;
  97   use Plack::Session::Store::DBI;
  98
  99   my $app = sub {
 100       return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello Foo' ] ];
 101   };
 102
 103   builder {
 104       enable 'Session',
 105           store => Plack::Session::Store::DBI->new(
 106               dbh => DBI->connect( @connect_args )
 107           );
 108       $app;
 109   };
 110
 111   # set get_dbh callback for ondemand
 112
 113   builder {
 114       enable 'Session',
 115           store => Plack::Session::Store::DBI->new(
 116               get_dbh => sub { DBI->connect( @connect_args ) }
 117           );
 118       $app;
 119   };
 120
 121   # with custom serializer/deserializer
 122
 123   builder {
 124       enable 'Session',
 125           store => Plack::Session::Store::DBI->new(
 126               dbh => DBI->connect( @connect_args )
 127               # YAML takes it's args the opposite order
 128               serializer   => sub { YAML::DumpFile( reverse @_ ) },
 129               deserializer => sub { YAML::LoadFile( @_ ) },
 130           );
 131       $app;
 132   };
 133
 134 =head1 DESCRIPTION
 135
 136 This implements a DBI based storage for session data. By
 137 default it will use L<Storable> and L<MIME::Base64> to serialize and
 138 deserialize the data, but this can be configured easily.
 139
 140 This is a subclass of L<Plack::Session::Store> and implements
 141 its full interface.
 142
 143 =head1 SESSION TABLE SCHEMA
 144
 145 Your session table must have at least the following schema structure:
 146
 147     CREATE TABLE sessions (
 148         id           CHAR(72) PRIMARY KEY,
 149         session_data TEXT
 150     );
 151
 152 Note that MySQL TEXT fields only store 64KB, so if your session data
 153 will exceed that size you'll want to move to MEDIUMTEXT, MEDIUMBLOB,
 154 or larger.
 155
 156 =head1 AUTHORS
 157
 158 Many aspects of this module were partially based upon Catalyst::Plugin::Session::Store::DBI
 159
 160 Daisuke Maki
 161
 162 =head1 COPYRIGHT AND LICENSE
 163
 164 Copyright 2009, 2010 Daisuke Maki C<< <daisuke@endeworks.jp> >>
 165
 166 This library is free software; you can redistribute it and/or modify
 167 it under the same terms as Perl itself.
 168 =cut
 169