lib/CPAN/lib/CGI/Session/Driver/postgresql.pm
changeset 0 414e01d06fd5
     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