Commit | Line | Data |
6f28db48 |
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 | |
7c2aa126 |
21 | if (! $params{dbh} ) { |
22 | die "DBI instance was not available in the argument list"; |
6f28db48 |
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; |
6f28db48 |
38 | |
7c2aa126 |
39 | my $dbh = $self->{dbh}; |
6f28db48 |
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 | |
7c2aa126 |
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 | |
6f28db48 |
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. |
6f28db48 |
165 | |
166 | =head1 AUTHORS |
167 | |
168 | Many aspects of this module were partially based upon Catalyst::Plugin::Session::Store::DBI |
169 | |
7c2aa126 |
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 | |