1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
|
package CGI::Session::Driver::DBI;
# $Id: DBI.pm 351 2006-11-24 14:16:50Z markstos $
use strict;
use DBI;
use Carp;
use CGI::Session::Driver;
@CGI::Session::Driver::DBI::ISA = ( "CGI::Session::Driver" );
$CGI::Session::Driver::DBI::VERSION = "4.20";
sub init {
my $self = shift;
if ( defined $self->{Handle} ) {
if (ref $self->{Handle} eq 'CODE') {
$self->{Handle} = $self->{Handle}->();
}
else {
# We assume the handle is working, and there is nothing to do.
}
}
else {
$self->{Handle} = DBI->connect(
$self->{DataSource}, $self->{User}, $self->{Password},
{ RaiseError=>1, PrintError=>1, AutoCommit=>1 }
);
unless ( $self->{Handle} ) {
return $self->set_error( "init(): couldn't connect to database: " . DBI->errstr );
}
$self->{_disconnect} = 1;
}
return 1;
}
# A setter/accessor method for the table name, defaulting to 'sessions'
sub table_name {
my $self = shift;
my $class = ref( $self ) || $self;
if ( (@_ == 0) && ref($self) && ($self->{TableName}) ) {
return $self->{TableName};
}
no strict 'refs';
if ( @_ ) {
my $new_name = shift;
$self->{TableName} = $new_name;
${ $class . "::TABLE_NAME" } = $new_name;
}
unless (defined $self->{TableName}) {
$self->{TableName} = "sessions";
}
return $self->{TableName};
}
sub retrieve {
my $self = shift;
my ($sid) = @_;
croak "retrieve(): usage error" unless $sid;
my $dbh = $self->{Handle};
my $sth = $dbh->prepare_cached("SELECT a_session FROM " . $self->table_name . " WHERE id=?", undef, 3);
unless ( $sth ) {
return $self->set_error( "retrieve(): DBI->prepare failed with error message " . $dbh->errstr );
}
$sth->execute( $sid ) or return $self->set_error( "retrieve(): \$sth->execute failed with error message " . $sth->errstr);
my ($row) = $sth->fetchrow_array();
return 0 unless $row;
return $row;
}
sub store {
# die;
my $self = shift;
my ($sid, $datastr) = @_;
croak "store(): usage error" unless $sid && $datastr;
my $dbh = $self->{Handle};
my $sth = $dbh->prepare_cached("SELECT id FROM " . $self->table_name . " WHERE id=?", undef, 3);
unless ( defined $sth ) {
return $self->set_error( "store(): \$dbh->prepare failed with message " . $sth->errstr );
}
$sth->execute( $sid ) or return $self->set_error( "store(): \$sth->execute failed with message " . $sth->errstr );
my $action_sth;
if ( $sth->fetchrow_array ) {
$action_sth = $dbh->prepare_cached("UPDATE " . $self->table_name . " SET a_session=? WHERE id=?", undef, 3);
} else {
$action_sth = $dbh->prepare_cached("INSERT INTO " . $self->table_name . " (a_session, id) VALUES(?, ?)", undef, 3);
}
unless ( defined $action_sth ) {
return $self->set_error( "store(): \$dbh->prepare failed with message " . $dbh->errstr );
}
$action_sth->execute($datastr, $sid)
or return $self->set_error( "store(): \$action_sth->execute failed " . $action_sth->errstr );
return 1;
}
sub remove {
my $self = shift;
my ($sid) = @_;
croak "remove(): usage error" unless $sid;
my $rc = $self->{Handle}->do( 'DELETE FROM '. $self->table_name .' WHERE id= ?',{},$sid );
unless ( $rc ) {
croak "remove(): \$dbh->do failed!";
}
return 1;
}
sub DESTROY {
my $self = shift;
unless ( $self->{Handle}->{AutoCommit} ) {
$self->{Handle}->commit;
}
if ( $self->{_disconnect} ) {
$self->{Handle}->disconnect;
}
}
sub traverse {
my $self = shift;
my ($coderef) = @_;
unless ( $coderef && ref( $coderef ) && (ref $coderef eq 'CODE') ) {
croak "traverse(): usage error";
}
my $tablename = $self->table_name();
my $sth = $self->{Handle}->prepare_cached("SELECT id FROM $tablename", undef, 3)
or return $self->set_error("traverse(): couldn't prepare SQL statement. " . $self->{Handle}->errstr);
$sth->execute() or return $self->set_error("traverse(): couldn't execute statement $sth->{Statement}. " . $sth->errstr);
while ( my ($sid) = $sth->fetchrow_array ) {
$coderef->($sid);
}
return 1;
}
1;
=pod
=head1 NAME
CGI::Session::Driver::DBI - Base class for native DBI-related CGI::Session drivers
=head1 SYNOPSIS
require CGI::Session::Driver::DBI;
@ISA = qw( CGI::Session::Driver::DBI );
=head1 DESCRIPTION
In most cases you can create a new DBI-driven CGI::Session driver by simply creating an empty driver file that inherits from CGI::Session::Driver::DBI. That's exactly what L<sqlite|CGI::Session::Driver::sqlite> does. The only reason why this class doesn't suit for a valid driver is its name isn't in lowercase. I'm serious!
=head2 NOTES
CGI::Session::Driver::DBI defines init() method, which makes DBI handle available for drivers in I<Handle> - object attribute regardless of what C<\%dsn_args> were used in creating session object. Should your driver require non-standard initialization you have to re-define init() method in your F<.pm> file, but make sure to set 'Handle' - object attribute to database handle (returned by DBI->connect(...)) if you wish to inherit any of the methods from CGI::Session::Driver::DBI.
=head1 STORAGE
Before you can use any DBI-based session drivers you need to make sure compatible database table is created for CGI::Session to work with. Following command will produce minimal requirements in most SQL databases:
CREATE TABLE sessions (
id CHAR(32) NOT NULL PRIMARY KEY,
a_session TEXT NOT NULL
);
Your session table can define additional columns, but the above two are required. Name of the session table is expected to be I<sessions> by default. You may use a different name if you wish. To do this you have to pass I<TableName> as part of your C< \%dsn_args >:
$s = new CGI::Session("driver:sqlite", undef, {TableName=>'my_sessions'});
$s = new CGI::Session("driver:mysql", undef, {
TableName=>'my_sessions',
DataSource=>'dbi:mysql:shopping_cart'});
=head1 DRIVER ARGUMENTS
Following driver arguments are supported:
=over 4
=item DataSource
First argument to be passed to L<DBI|DBI>->L<connect()|DBI/connect()>. If the driver makes
the database connection itself, it will also explicitly disconnect from the database when
the driver object is DESTROYed.
=item User
User privileged to connect to the database defined in C<DataSource>.
=item Password
Password of the I<User> privileged to connect to the database defined in C<DataSource>
=item Handle
An existing L<DBI> database handle object. The handle can be created on demand
by providing a code reference as a argument, such as C<<sub{DBI->connect}>>.
This way, the database connection is only created if it actually needed. This can be useful
when combined with a framework plugin like L<CGI::Application::Plugin::Session>, which creates
a CGI::Session object on demand as well.
C<Handle> will override all the above arguments, if any present.
=item TableName
Name of the table session data will be stored in.
=back
=head1 LICENSING
For support and licensing information see L<CGI::Session|CGI::Session>
=cut
|
