1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/lib/CPAN/lib/CGI/Session/Driver/postgresql.pm Sat Jan 26 15:50:53 2008 +0100
1.3 @@ -0,0 +1,134 @@
1.4 +package CGI::Session::Driver::postgresql;
1.5 +
1.6 +# $Id: postgresql.pm 351 2006-11-24 14:16:50Z markstos $
1.7 +
1.8 +# CGI::Session::Driver::postgresql - PostgreSQL driver for CGI::Session
1.9 +#
1.10 +# Copyright (C) 2002 Cosimo Streppone, cosimo@cpan.org
1.11 +# This module is based on CGI::Session::Driver::mysql module
1.12 +# by Sherzod Ruzmetov, original author of CGI::Session modules
1.13 +# and CGI::Session::Driver::mysql driver.
1.14 +
1.15 +use strict;
1.16 +use Carp "croak";
1.17 +
1.18 +use CGI::Session::Driver::DBI;
1.19 +use DBD::Pg qw(PG_BYTEA PG_TEXT);
1.20 +
1.21 +$CGI::Session::Driver::postgresql::VERSION = '4.20';
1.22 +@CGI::Session::Driver::postgresql::ISA = qw( CGI::Session::Driver::DBI );
1.23 +
1.24 +
1.25 +sub init {
1.26 + my $self = shift;
1.27 + my $ret = $self->SUPER::init(@_);
1.28 +
1.29 + # Translate external ColumnType into internal value. See POD for details.
1.30 + $self->{PgColumnType} ||= (defined $self->{ColumnType} and (lc $self->{ColumnType} eq 'binary'))
1.31 + ? PG_BYTEA
1.32 + : PG_TEXT
1.33 + ;
1.34 +
1.35 + return $ret;
1.36 +}
1.37 +
1.38 +sub store {
1.39 + my $self = shift;
1.40 + my ($sid, $datastr) = @_;
1.41 + croak "store(): usage error" unless $sid && $datastr;
1.42 +
1.43 + my $dbh = $self->{Handle};
1.44 + my $type = $self->{PgColumnType};
1.45 +
1.46 + if ($type == PG_TEXT && $datastr =~ tr/\x00//) {
1.47 + croak "Unallowed characters used in session data. Please see CGI::Session::Driver::postgresql ".
1.48 + "for more information about null characters in text columns.";
1.49 + }
1.50 +
1.51 + local $dbh->{RaiseError} = 1;
1.52 + eval {
1.53 + # There is a race condition were two clients could run this code concurrently,
1.54 + # and both end up trying to insert. That's why we check for "duplicate" below
1.55 + my $sth = $dbh->prepare(
1.56 + "INSERT INTO " . $self->table_name . " (a_session,id) SELECT ?, ?
1.57 + WHERE NOT EXISTS (SELECT 1 FROM " . $self->table_name . " WHERE id=? LIMIT 1)");
1.58 +
1.59 + $sth->bind_param(1,$datastr,{ pg_type => $type });
1.60 + $sth->bind_param(2, $sid);
1.61 + $sth->bind_param(3, $sid); # in the SELECT statement
1.62 + my $rv = '';
1.63 + eval { $rv = $sth->execute(); };
1.64 + if ( $rv eq '0E0' or (defined $@ and $@ =~ m/duplicate/i) ) {
1.65 + my $sth = $dbh->prepare("UPDATE " . $self->table_name . " SET a_session=? WHERE id=?");
1.66 + $sth->bind_param(1,$datastr,{ pg_type => $type });
1.67 + $sth->bind_param(2,$sid);
1.68 + $sth->execute;
1.69 + }
1.70 + else {
1.71 + # Nothing. Our insert has already happened
1.72 + }
1.73 + };
1.74 + if ($@) {
1.75 + return $self->set_error( "store(): failed with message: $@ " . $dbh->errstr );
1.76 +
1.77 + }
1.78 + else {
1.79 + return 1;
1.80 +
1.81 + }
1.82 +
1.83 +
1.84 +}
1.85 +
1.86 +1;
1.87 +
1.88 +=pod
1.89 +
1.90 +=head1 NAME
1.91 +
1.92 +CGI::Session::Driver::postgresql - PostgreSQL driver for CGI::Session
1.93 +
1.94 +=head1 SYNOPSIS
1.95 +
1.96 + use CGI::Session;
1.97 + $session = new CGI::Session("driver:PostgreSQL", undef, {Handle=>$dbh});
1.98 +
1.99 +=head1 DESCRIPTION
1.100 +
1.101 +CGI::Session::PostgreSQL is a L<CGI::Session|CGI::Session> driver to store session data in a PostgreSQL table.
1.102 +
1.103 +=head1 STORAGE
1.104 +
1.105 +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:
1.106 +
1.107 + CREATE TABLE sessions (
1.108 + id CHAR(32) NOT NULL PRIMARY KEY,
1.109 + a_session BYTEA NOT NULL
1.110 + );
1.111 +
1.112 +and within your code use:
1.113 +
1.114 + use CGI::Session;
1.115 + $session = new CGI::Session("driver:PostgreSQL", undef, {Handle=>$dbh, ColumnType=>"binary"});
1.116 +
1.117 +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.
1.118 +
1.119 +For more details see L<CGI::Session::Driver::DBI|CGI::Session::Driver::DBI>, parent class.
1.120 +
1.121 +Also see L<sqlite driver|CGI::Session::Driver::sqlite>, which exercises different method for dealing with binary data.
1.122 +
1.123 +=head1 COPYRIGHT
1.124 +
1.125 +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.
1.126 +
1.127 +=head1 AUTHORS
1.128 +
1.129 +Cosimo Streppone <cosimo@cpan.org>, heavily based on the CGI::Session::MySQL driver by Sherzod Ruzmetov, original author of CGI::Session.
1.130 +
1.131 +Matt LeBlanc contributed significant updates for the 4.0 release.
1.132 +
1.133 +=head1 LICENSING
1.134 +
1.135 +For additional support and licensing see L<CGI::Session|CGI::Session>
1.136 +
1.137 +=cut