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