lib/CPAN/lib/CGI/Session/Driver/postgresql.pm
changeset 0 414e01d06fd5
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     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