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