CGI::Session::Driver::postgresql - PostgreSQL driver for CGI::Session

CGI-Session documentation Contained in the CGI-Session distribution.

Index

Code Index:

NAME

Top

CGI::Session::Driver::postgresql - PostgreSQL driver for CGI::Session

SYNOPSIS

Top

    use CGI::Session;
    $session = CGI::Session->new("driver:PostgreSQL", undef, {Handle=>$dbh});

DESCRIPTION

Top

CGI::Session::PostgreSQL is a CGI::Session driver to store session data in a PostgreSQL table.

STORAGE

Top

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:

    CREATE TABLE sessions (
        id CHAR(32) NOT NULL PRIMARY KEY,
        a_session BYTEA NOT NULL
    );

and within your code use:

    use CGI::Session;
    $session = CGI::Session->new("driver:PostgreSQL", undef, {Handle=>$dbh, ColumnType=>"binary"});

Please note the ColumnType argument. PostgreSQL's text type has problems when trying to hold a null character. (Known as "\0" in Perl, not to be confused with SQL NULL). If you know there is no chance of ever having a null character in the serialized data, you can leave off the ColumnType attribute. Using a BYTEA column type and ColumnType => 'binary' is recommended when using Storable as the serializer or if there's any possibility that a null value will appear in any of the serialized data.

To use different column names, change the 'create table' statement, and then simply do this:

    $s = CGI::Session->new('driver:pg', undef,
    {
        TableName=>'session',
        IdColName=>'my_id',
        DataColName=>'my_data',
        DataSource=>'dbi:pg:dbname=project',
    });

or

    $s = CGI::Session->new('driver:pg', undef,
    {
        TableName=>'session',
        IdColName=>'my_id',
        DataColName=>'my_data',
        Handle=>$dbh,
    });

For more details see CGI::Session::Driver::DBI, parent class.

Also see sqlite driver, which exercises different method for dealing with binary data.

COPYRIGHT

Top

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.

AUTHORS

Top

Cosimo Streppone <cosimo@cpan.org>, heavily based on the CGI::Session::MySQL driver by Sherzod Ruzmetov, original author of CGI::Session.

Matt LeBlanc contributed significant updates for the 4.0 release.

LICENSING

Top

For additional support and licensing see CGI::Session

CGI-Session documentation Contained in the CGI-Session distribution. 
package CGI::Session::Driver::postgresql;

# $Id$

# CGI::Session::Driver::postgresql - PostgreSQL driver for CGI::Session
#
# Copyright (C) 2002 Cosimo Streppone, cosimo@cpan.org
# This module is based on CGI::Session::Driver::mysql module
# by Sherzod Ruzmetov, original author of CGI::Session modules
# and CGI::Session::Driver::mysql driver.

use strict;
use Carp "croak";

use CGI::Session::Driver::DBI;
use DBD::Pg qw(PG_BYTEA PG_TEXT);

$CGI::Session::Driver::postgresql::VERSION = '4.43';
@CGI::Session::Driver::postgresql::ISA     = qw( CGI::Session::Driver::DBI );


sub init {
    my $self = shift;
    my $ret = $self->SUPER::init(@_);

    # Translate external ColumnType into internal value. See POD for details.
    $self->{PgColumnType} ||= (defined $self->{ColumnType} and (lc $self->{ColumnType} eq 'binary'))
        ? PG_BYTEA
        : PG_TEXT
        ;

    return $ret;
}

sub store {
    my $self = shift;
    my ($sid, $datastr) = @_;
    croak "store(): usage error" unless $sid && $datastr;

    my $dbh = $self->{Handle};
    my $type = $self->{PgColumnType};

    if ($type == PG_TEXT && $datastr =~ tr/\x00//) {
        croak "Unallowed characters used in session data. Please see CGI::Session::Driver::postgresql ".
            "for more information about null characters in text columns.";
    }

    local $dbh->{RaiseError} = 1;
    eval {
        # There is a race condition were two clients could run this code concurrently,
        # and both end up trying to insert. That's why we check for "duplicate" below
        my $sth = $dbh->prepare(
             "INSERT INTO " . $self->table_name . " ($self->{DataColName},$self->{IdColName})  SELECT ?, ? 
                                WHERE NOT EXISTS (SELECT 1 FROM " . $self->table_name . " WHERE $self->{IdColName}=? LIMIT 1)");

        $sth->bind_param(1,$datastr,{ pg_type => $type });
        $sth->bind_param(2, $sid);
        $sth->bind_param(3, $sid); # in the SELECT statement
        my $rv = '';
        eval { $rv = $sth->execute(); };
        if ( $rv eq '0E0' or (defined $@ and $@ =~ m/duplicate/i) ) {
            my $sth = $dbh->prepare("UPDATE " . $self->table_name . " SET $self->{DataColName}=? WHERE $self->{IdColName}=?");
            $sth->bind_param(1,$datastr,{ pg_type => $type });
            $sth->bind_param(2,$sid);
            $sth->execute;
        } 
        else {
            # Nothing. Our insert has already happened
        }
    };
    if ($@) { 
      return $self->set_error( "store(): failed with message: $@ " . $dbh->errstr );

    } 
    else {
        return 1;

    }


}

1;