colas@0
|
1 |
package CGI::Session::Driver::postgresql;
|
colas@0
|
2 |
|
colas@0
|
3 |
# $Id: postgresql.pm 351 2006-11-24 14:16:50Z markstos $
|
colas@0
|
4 |
|
colas@0
|
5 |
# CGI::Session::Driver::postgresql - PostgreSQL driver for CGI::Session
|
colas@0
|
6 |
#
|
colas@0
|
7 |
# Copyright (C) 2002 Cosimo Streppone, cosimo@cpan.org
|
colas@0
|
8 |
# This module is based on CGI::Session::Driver::mysql module
|
colas@0
|
9 |
# by Sherzod Ruzmetov, original author of CGI::Session modules
|
colas@0
|
10 |
# and CGI::Session::Driver::mysql driver.
|
colas@0
|
11 |
|
colas@0
|
12 |
use strict;
|
colas@0
|
13 |
use Carp "croak";
|
colas@0
|
14 |
|
colas@0
|
15 |
use CGI::Session::Driver::DBI;
|
colas@0
|
16 |
use DBD::Pg qw(PG_BYTEA PG_TEXT);
|
colas@0
|
17 |
|
colas@0
|
18 |
$CGI::Session::Driver::postgresql::VERSION = '4.20';
|
colas@0
|
19 |
@CGI::Session::Driver::postgresql::ISA = qw( CGI::Session::Driver::DBI );
|
colas@0
|
20 |
|
colas@0
|
21 |
|
colas@0
|
22 |
sub init {
|
colas@0
|
23 |
my $self = shift;
|
colas@0
|
24 |
my $ret = $self->SUPER::init(@_);
|
colas@0
|
25 |
|
colas@0
|
26 |
# Translate external ColumnType into internal value. See POD for details.
|
colas@0
|
27 |
$self->{PgColumnType} ||= (defined $self->{ColumnType} and (lc $self->{ColumnType} eq 'binary'))
|
colas@0
|
28 |
? PG_BYTEA
|
colas@0
|
29 |
: PG_TEXT
|
colas@0
|
30 |
;
|
colas@0
|
31 |
|
colas@0
|
32 |
return $ret;
|
colas@0
|
33 |
}
|
colas@0
|
34 |
|
colas@0
|
35 |
sub store {
|
colas@0
|
36 |
my $self = shift;
|
colas@0
|
37 |
my ($sid, $datastr) = @_;
|
colas@0
|
38 |
croak "store(): usage error" unless $sid && $datastr;
|
colas@0
|
39 |
|
colas@0
|
40 |
my $dbh = $self->{Handle};
|
colas@0
|
41 |
my $type = $self->{PgColumnType};
|
colas@0
|
42 |
|
colas@0
|
43 |
if ($type == PG_TEXT && $datastr =~ tr/\x00//) {
|
colas@0
|
44 |
croak "Unallowed characters used in session data. Please see CGI::Session::Driver::postgresql ".
|
colas@0
|
45 |
"for more information about null characters in text columns.";
|
colas@0
|
46 |
}
|
colas@0
|
47 |
|
colas@0
|
48 |
local $dbh->{RaiseError} = 1;
|
colas@0
|
49 |
eval {
|
colas@0
|
50 |
# There is a race condition were two clients could run this code concurrently,
|
colas@0
|
51 |
# and both end up trying to insert. That's why we check for "duplicate" below
|
colas@0
|
52 |
my $sth = $dbh->prepare(
|
colas@0
|
53 |
"INSERT INTO " . $self->table_name . " (a_session,id) SELECT ?, ?
|
colas@0
|
54 |
WHERE NOT EXISTS (SELECT 1 FROM " . $self->table_name . " WHERE id=? LIMIT 1)");
|
colas@0
|
55 |
|
colas@0
|
56 |
$sth->bind_param(1,$datastr,{ pg_type => $type });
|
colas@0
|
57 |
$sth->bind_param(2, $sid);
|
colas@0
|
58 |
$sth->bind_param(3, $sid); # in the SELECT statement
|
colas@0
|
59 |
my $rv = '';
|
colas@0
|
60 |
eval { $rv = $sth->execute(); };
|
colas@0
|
61 |
if ( $rv eq '0E0' or (defined $@ and $@ =~ m/duplicate/i) ) {
|
colas@0
|
62 |
my $sth = $dbh->prepare("UPDATE " . $self->table_name . " SET a_session=? WHERE id=?");
|
colas@0
|
63 |
$sth->bind_param(1,$datastr,{ pg_type => $type });
|
colas@0
|
64 |
$sth->bind_param(2,$sid);
|
colas@0
|
65 |
$sth->execute;
|
colas@0
|
66 |
}
|
colas@0
|
67 |
else {
|
colas@0
|
68 |
# Nothing. Our insert has already happened
|
colas@0
|
69 |
}
|
colas@0
|
70 |
};
|
colas@0
|
71 |
if ($@) {
|
colas@0
|
72 |
return $self->set_error( "store(): failed with message: $@ " . $dbh->errstr );
|
colas@0
|
73 |
|
colas@0
|
74 |
}
|
colas@0
|
75 |
else {
|
colas@0
|
76 |
return 1;
|
colas@0
|
77 |
|
colas@0
|
78 |
}
|
colas@0
|
79 |
|
colas@0
|
80 |
|
colas@0
|
81 |
}
|
colas@0
|
82 |
|
colas@0
|
83 |
1;
|
colas@0
|
84 |
|
colas@0
|
85 |
=pod
|
colas@0
|
86 |
|
colas@0
|
87 |
=head1 NAME
|
colas@0
|
88 |
|
colas@0
|
89 |
CGI::Session::Driver::postgresql - PostgreSQL driver for CGI::Session
|
colas@0
|
90 |
|
colas@0
|
91 |
=head1 SYNOPSIS
|
colas@0
|
92 |
|
colas@0
|
93 |
use CGI::Session;
|
colas@0
|
94 |
$session = new CGI::Session("driver:PostgreSQL", undef, {Handle=>$dbh});
|
colas@0
|
95 |
|
colas@0
|
96 |
=head1 DESCRIPTION
|
colas@0
|
97 |
|
colas@0
|
98 |
CGI::Session::PostgreSQL is a L<CGI::Session|CGI::Session> driver to store session data in a PostgreSQL table.
|
colas@0
|
99 |
|
colas@0
|
100 |
=head1 STORAGE
|
colas@0
|
101 |
|
colas@0
|
102 |
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:
|
colas@0
|
103 |
|
colas@0
|
104 |
CREATE TABLE sessions (
|
colas@0
|
105 |
id CHAR(32) NOT NULL PRIMARY KEY,
|
colas@0
|
106 |
a_session BYTEA NOT NULL
|
colas@0
|
107 |
);
|
colas@0
|
108 |
|
colas@0
|
109 |
and within your code use:
|
colas@0
|
110 |
|
colas@0
|
111 |
use CGI::Session;
|
colas@0
|
112 |
$session = new CGI::Session("driver:PostgreSQL", undef, {Handle=>$dbh, ColumnType=>"binary"});
|
colas@0
|
113 |
|
colas@0
|
114 |
Please note the I<ColumnType> argument. PostgreSQL's text type has problems when trying to hold a null character. (Known as C<"\0"> in Perl, not to be confused with SQL I<NULL>). If you know there is no chance of ever having a null character in the serialized data, you can leave off the I<ColumnType> attribute. Using a I<BYTEA> column type and C<< ColumnType => 'binary' >> is recommended when using L<Storable|CGI::Session::Serialize::storable> as the serializer or if there's any possibility that a null value will appear in any of the serialized data.
|
colas@0
|
115 |
|
colas@0
|
116 |
For more details see L<CGI::Session::Driver::DBI|CGI::Session::Driver::DBI>, parent class.
|
colas@0
|
117 |
|
colas@0
|
118 |
Also see L<sqlite driver|CGI::Session::Driver::sqlite>, which exercises different method for dealing with binary data.
|
colas@0
|
119 |
|
colas@0
|
120 |
=head1 COPYRIGHT
|
colas@0
|
121 |
|
colas@0
|
122 |
Copyright (C) 2002 Cosimo Streppone. All rights reserved. This library is free software and can be modified and distributed under the same terms as Perl itself.
|
colas@0
|
123 |
|
colas@0
|
124 |
=head1 AUTHORS
|
colas@0
|
125 |
|
colas@0
|
126 |
Cosimo Streppone <cosimo@cpan.org>, heavily based on the CGI::Session::MySQL driver by Sherzod Ruzmetov, original author of CGI::Session.
|
colas@0
|
127 |
|
colas@0
|
128 |
Matt LeBlanc contributed significant updates for the 4.0 release.
|
colas@0
|
129 |
|
colas@0
|
130 |
=head1 LICENSING
|
colas@0
|
131 |
|
colas@0
|
132 |
For additional support and licensing see L<CGI::Session|CGI::Session>
|
colas@0
|
133 |
|
colas@0
|
134 |
=cut
|