lib/CPAN/lib/CGI/Session/Driver/postgresql.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
permissions -rw-r--r--
RELEASE 4.2.0 freetown
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