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