pkg://DBD-Pg-0.73-1.src.rpm:25732/DBD-Pg-0.73.tar.gz
info downloads
DBD-Pg-0.73/ 40755 620 144 0 6535145770 11020 5 ustar mergl users DBD-Pg-0.73/Changes 100644 620 144 7573 6535145703 12420 0 ustar mergl users Revision history for Perl extension DBD-Pg.
0.73 Jun 03, 1998
- changed include directives in Makefile.PL from
archlib to installarchlib and from sitearch to
installsitearch (Tony.Curtis@vcpc.univie.ac.at).
- applied patch from Junio Hamano <junio@twinsun.com>
quote method also doubles backslash.
0.72 April 20, 1998
- applied patch from Michael J Schout <mschout@gkg.net>
which fixed the bug with queries containing the cast
operator.
- applied patch from "Irving Reid" <irving@tor.securecomputing.com>
which fixed a memory leak.
0.71 April 04, 1998
- applied patch from "Irving Reid"
<irving@tor.securecomputing.com> which fixed the
the problem with the InactiveDestroy message.
0.70 March 28, 1998
- linking again with the shared version of libpq
due to problems on several operating systems.
0.69 March 6, 1998
- expanded the search path for include files
- module is now linked with static libpq.a
0.68 March 3, 1998
- return to UNIX domain sockets in test-scripts
0.67 February 21, 1998
- remove part of Driver.xst due to compile
error on some systems.
0.66 February 19, 1998
- remove defines in Pg.h so that
it compiles also with postgresql-6.2.1
- changed ping method: set RaiseError=0
0.65 February 14, 1998
- adapted to changes in DBI-0.91, so that the
default setting for AutoCommit and PrintError is
again conformant to the DBI specs.
0.64 February 01, 1998
- changed syntax of data_source (ODBC-conformant):
'dbi:Pg:dbname=dbname;host=host;port=port'
!!! PLEASE ADAPT YOUR SCRIPTS !!!
- implemented placeholders
- implemented ping-method
- added support for $dbh->{RaiseError} and $dbh->{PrintError},
note: DBI-default for PrintError is on !
- allow commit and rollback only if AutoCommit = off
- added documentation for $dbh->tables;
- new method to get meta-information about a given table:
$dbh->DBD::Pg::db::attributes($table);
- host-parameter in test.pl is set explicitely to localhost
0.63 October 05, 1997
- adapted to PostgreSQL-6.2:
o $sth->rows as well as $sth->execute
and $sth->do return the number of
affected rows even for non-Select
statements.
o support for password authorization added,
please check the man-page for pg_passwd.
- the data_source parameter of the connect
method accepts two additional parameters
which are treated as host and port:
DBI->connect("dbi:Pg:dbname:host:port", "uid", "pwd")
- support for AutoCommit, please read the
module documentation for impacts on your
scripts !
- more perl-ish handling of data type bool,
please read the module documentation for
impacts on your scripts !
0.62 August 26, 1997
- added blobs/README
0.61 August 23, 1997
- adapted to DBI-0.89/Driver.xst
- added support for blob_read
0.52 August 15, 1997
- added support for literal $sth->{'TYPE'},
pg_type.pl / pg_type.pm.
0.51 August 12, 1997
- changed attributes to be DBI conformant:
o OID_STATUS to pg_oid_status
o CMD_STATUS to pg_cmd_status
0.5 August 05, 1997
- support for user authentication
- support for bind_columns
- added $dbh->tables
0.4 Jun 24, 1997
- adapted to DBI-0.84:
o new syntax for DBI->connect !
o execute returns 0E0 -> n for SELECT stmt
-1 for non SELECT stmt
-2 on error
- new attribute $sth->{'OID_STATUS'}
- new attribute $sth->{'CMD_STATUS'}
0.3 Apr 24, 1997
- bug fix release, ( still alpha ! )
0.2 Mar 13, 1997
- complete rewrite, ( still alpha ! )
0.1 Feb 15, 1997
- creation, ( totally pre-alpha ! )
DBD-Pg-0.73/MANIFEST 100644 620 144 257 6535145703 12226 0 ustar mergl users Changes
MANIFEST
Makefile.PL
Pg.h
Pg.pm
Pg.xs
README
blobs/README
blobs/test.pl
dbdimp.c
dbdimp.h
pg_type/README
pg_type/pg_type.pl
pg_type/pg_type.pm
pg_type/test.pl
test.pl
DBD-Pg-0.73/blobs/ 40755 620 144 0 6535145703 12115 5 ustar mergl users DBD-Pg-0.73/blobs/README 100644 620 144 4202 6535145703 13070 0 ustar mergl users #---------------------------------------------------------
#
# $Id: README,v 1.1 1997/09/15 19:14:07 mergl Exp $
#
#---------------------------------------------------------
Although the DBI documentation has blobs on its list of outstanding issues,
there is a blob_read method, which is now also supported by the DBD-Pg module.
The given template for the blob_read method
$sth->blob_read(field, offset, len, destrv, destoffset)
seems to be heavily influenced by the current implementation of blobs in
Oracle. Nevertheless the DBD-Pg module tries to be as compatible as possible.
Whereas Oracle suffers from the limitation that blobs are related to tables
and every table can have only one blob (data-type LONG), PostgreSQL handles
its blobs independent of any table by using so called object identifiers. This
explains why the blob_read method is blessed into the STATEMENT package and
not part of the DATABASE package. Here the field parameter has been used to
handle this object identifier.
Blobs are usually fetched in chunks which should have an optimized size. This
size is system and database dependent. The current DBD-Oracle implementation
leaves it up to the user to handle the loop of fetching single chunks and
defining the chunk size:
my $blob = '';
my $lump = 4096;
my $offset = 0;
while (1)
{
my $frag = $sth->blob_read(0, $offset, $lump);
last unless defined $frag;
my $ll = length $frag;
last unless $ll;
$blob .= $frag;
$offset += $ll;
}
In contrary the DBD-Pg module does this work by itself, so that the user can
fetch a blob with a single statement:
$blob = $sth->blob_read($lobj_id, 0, 0);
Nevertheless existing scripts should work, just by defining the offset and len
parameters.
Please keep in mind, that the blob_read method provided by the DBI module as
well as its implementation in the DBD-Pg module might change.
---------------------------------------------------------------------------
Edmund Mergl <E.Mergl@bawue.de> August 22, 1997
---------------------------------------------------------------------------
DBD-Pg-0.73/blobs/test.pl 100755 620 144 2065 6535145703 13534 0 ustar mergl users #!/usr/local/bin/perl
#---------------------------------------------------------
#
# $Id: test.pl,v 1.5 1998/03/03 21:04:58 mergl Exp $
#
#---------------------------------------------------------
use DBI;
$dbmain = 'template1';
$dbname = 'pgperltest';
$dbuser = '';
$dbpass = '';
$cwd = `pwd`;
chop $cwd;
$lobject = $cwd . '/README';
my $dbh = DBI->connect("dbi:Pg:dbname=$dbmain", $dbuser, $dbpass);
$dbh->do( "CREATE DATABASE $dbname" );
$dbh->disconnect;
$dbh = DBI->connect("dbi:Pg:dbname=$dbname", $dbuser, $dbpass);
$dbh->do("CREATE TABLE lobject ( id int4, loid oid )");
$dbh->do("INSERT INTO lobject (id, loid) VALUES (1, lo_import('$lobject') )");
$sth = $dbh->prepare("SELECT loid FROM lobject WHERE id = 1");
$sth->execute;
($lobj_id) = $sth->fetchrow_array;
$blob = $sth->blob_read($lobj_id, 200, 80);
print $blob, "\n";
$blob = $sth->blob_read($lobj_id, 0, 0);
print $blob, "\n";
$sth->finish;
$dbh->disconnect;
$dbh = DBI->connect("dbi:Pg:dbname=$dbmain", $dbuser, $dbpass);
$dbh->do( "DROP DATABASE $dbname" );
$dbh->disconnect;
# end of test.pl
DBD-Pg-0.73/Makefile.PL 100644 620 144 3003 6535145703 13057 0 ustar mergl users #---------------------------------------------------------
#
# $Id: Makefile.PL,v 1.14 1998/06/03 03:59:43 mergl Exp $
#
# Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
# Portions Copyright (c) 1997,1998 Edmund Mergl
#
#---------------------------------------------------------
use ExtUtils::MakeMaker;
use Config;
use strict;
use DBI 0.91;
use DBI::DBD;
print "\nConfiguring Pg\n";
print "Remember to actually read the README file !\n";
die "\nYou didn't read the README file !\n" unless ($] >= 5.002);
if (! $ENV{POSTGRES_HOME}) {
print "\$POSTGRES_HOME not defined. Searching for PostgreSQL...\n";
foreach(qw(/usr/local/pgsql /usr/lib/pgsql /usr/pgsql /home/pgsql /opt/pgsql /usr/local/postgres /usr/lib/postgres /usr/postgres /home/postgres /opt/postgres /usr/local/postgresql /usr/lib/postgresql /usr/postgresql /home/postgresql /opt/postgresql)) {
if (-d "$_/lib") {
$ENV{POSTGRES_HOME} = $_;
last;
}
}
}
if (-d "$ENV{POSTGRES_HOME}/lib") {
print "Found PostgreSQL in $ENV{POSTGRES_HOME}\n";
} else {
die "Unable to find PostgreSQL\n";
}
my %opts = (
NAME => 'DBD::Pg',
VERSION_FROM => 'Pg.pm',
INC => "-I$ENV{POSTGRES_HOME}/include -I/usr/local/include/pgsql -I/usr/include/pgsql -I$Config{installarchlib}/DBI -I$Config{installsitearch}/auto/DBI",
OBJECT => "Pg\$(OBJ_EXT) dbdimp\$(OBJ_EXT)",
LIBS => ["-L$ENV{POSTGRES_HOME}/lib -lpq"],
);
WriteMakefile(%opts);
exit(0);
# end of Makefile.PL
DBD-Pg-0.73/Pg.h 100644 620 144 1242 6535145703 11627 0 ustar mergl users /*---------------------------------------------------------
*
* $Id: Pg.h,v 1.13 1998/04/20 20:05:59 mergl Exp $
*
* Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
* Portions Copyright (c) 1997,1998 Edmund Mergl
*
*---------------------------------------------------------
*/
#include "libpq-fe.h"
#ifdef NEVER
#include<sys/stat.h>
#include "libpq/libpq-fs.h"
#endif
#define INV_READ 0x00040000
#define NEED_DBIXS_VERSION 9
#include <DBIXS.h> /* installed by the DBI module */
#include "dbdimp.h" /* read in our implementation details */
#include <dbd_xsh.h> /* installed by the DBI module */
int dbd_db_ping(SV *dbh);
/* end of Pg.h */
DBD-Pg-0.73/Pg.pm 100644 620 144 23567 6535145703 12052 0 ustar mergl users #---------------------------------------------------------
#
# $Id: Pg.pm,v 1.22 1998/06/03 04:06:16 mergl Exp $
#
# Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
# Portions Copyright (c) 1997,1998 Edmund Mergl
#
#---------------------------------------------------------
require 5.002;
{
package DBD::Pg;
use DBI ();
use DynaLoader ();
@ISA = qw(DynaLoader);
$VERSION = '0.73';
require_version DBI 0.91;
bootstrap DBD::Pg $VERSION;
$err = 0; # holds error code for DBI::err
$errstr = ""; # holds error string for DBI::errstr
$drh = undef; # holds driver handle once initialized
sub driver{
return $drh if $drh;
my($class, $attr) = @_;
$class .= "::dr";
# not a 'my' since we use it above to prevent multiple drivers
($drh) = DBI::_new_drh($class, {
'Name' => 'Pg',
'Version' => $VERSION,
'Err' => \$DBD::Pg::err,
'Errstr' => \$DBD::Pg::errstr,
'Attribution' => 'PostgreSQL DBD by Edmund Mergl',
});
$drh;
}
1;
}
{ package DBD::Pg::dr; # ====== DRIVER ======
use strict;
sub errstr {
return $DBD::Pg::errstr;
}
sub connect {
my($drh, $dbname, $user, $auth)= @_;
# create a 'blank' dbh
my($this) = DBI::_new_dbh($drh, {
'Name' => $dbname,
'User' => $user,
});
# Connect to the database..
DBD::Pg::db::_login($this, $dbname, $user, $auth)
or return undef;
$this;
}
}
{ package DBD::Pg::db; # ====== DATABASE ======
use strict;
sub quote {
my $self = shift;
my $str = shift;
return "NULL" unless defined $str;
$str =~ s/\\/\\\\/g;
$str=~s/'/''/g;
"'$str'";
}
sub errstr {
return $DBD::Pg::errstr;
}
sub ping {
my($dbh) = @_;
local $dbh->{RaiseError} = 0 if $dbh->{RaiseErrror};
DBD::Pg::db::_ping($dbh);
}
sub do {
my($dbh, $statement, @attribs) = @_;
DBD::Pg::db::_do($dbh, $statement, @attribs);
}
sub prepare {
my($dbh, $statement, @attribs)= @_;
# create a 'blank' sth
my $sth = DBI::_new_sth($dbh, {
'Statement' => $statement,
});
DBD::Pg::st::_prepare($sth, $statement, @attribs)
or return undef;
$sth;
}
sub tables {
my($dbh) = @_;
my $sth = $dbh->prepare("
select c.relname
from pg_class c, pg_user u
where ( c.relkind = 'r' or c.relkind = 'i' or c.relkind = 'S' )
and c.relname !~ '^pg_'
and c.relname !~ '^xin[vx][0-9]+'
and c.relowner = u.usesysid
ORDER BY c.relname
");
$sth->execute or return undef;
$sth;
}
sub attributes {
my($dbh,$table) = @_;
my $sth = $dbh->prepare("
select a.attnum, a.attname, t.typname, a.attlen
from pg_class c, pg_attribute a, pg_type t
where c.relname = '$table'
and a.attnum > 0
and a.attrelid = c.oid
and a.atttypid = t.oid
ORDER BY attnum
");
$sth->execute or return undef;
$sth;
}
}
{ package DBD::Pg::st; # ====== STATEMENT ======
use strict;
sub errstr {
return $DBD::Pg::errstr;
}
}
1;
__END__
=head1 NAME
DBD::Pg - PostgreSQL database driver for the DBI module
=head1 SYNOPSIS
use DBI;
$dbh = DBI->connect("dbi:Pg:dbname=$dbname", $user, $passwd);
# See the DBI module documentation for full details
=head1 DESCRIPTION
DBD::Pg is a Perl module which works with the DBI module to provide
access to PostgreSQL databases.
=head1 CONNECTING TO POSTGRESQL
To connect to a database you can say:
$dbh = DBI->connect('dbi:Pg:dbname=dbname;host=host;port=port', 'username', 'password');
The first parameter specifies the driver, the database and
the optional host and port. The second and third parameter
specify the username and password. Note that for these two
parameters DBI distinguishes between empty and undefined.
If these parameters are undefined DBI substitutes the values
of the DBI_USER and DBI_PASS environment variables. The
connect method returns a database handle which can be used for
subsequent database interactions. Please refer to the pg_passwd
man-page for the different types of authorization.
This module also supports the ping-method, which can be used
to check the validity of a database-handle.
=head1 SIMPLE STATEMENTS
Given a database connection, you can execute an arbitrary
statement using:
$dbh->do($stmt);
The statement must not be a SELECT statement (except SELECT...INTO TABLE).
=head1 PREPARING AND EXECUTING STATEMENTS
You can prepare a statement for multiple uses, and you can do this for
SELECT statements which return data as well as for statements which return
no data. You create a statement handle using:
$sth = $dbh->prepare($stmt);
Once the statement is prepared, you can execute it:
$rv = $sth->execute;
$rv is the number of selected / affected rows. You can retrieve the values
in the following way:
while ($ary_ref = $sth->fetch) {
}
Another possibility is to bind the fields of a select statement to
perl variables. Whenever a row is fetched from the database the
corresponding perl variables will be automatically updated:
$sth->bind_columns(undef, @list_of_refs_to_vars_to_bind);
while ($sth->fetch) {
}
When you have fetched as many rows as required, you close the statement
handle using:
$sth->finish;
This frees the statement, but it does not free the related data structures.
This is done when you destroy (undef) the statement handle:
undef $sth;
=head1 DISCONNECTING FROM A DATABASE
You can disconnect from the database:
$dbh->disconnect;
Note that this does not destroy the database handle. You
need to do an explicit 'undef $dbh' to destroy the handle.
=head1 DYNAMIC ATTRIBUTES
The following attributes are supported:
$DBI::err # error status
$DBI::errstr # error message
$DBI::rows # row count
=head1 DATABASE HANDLE ATTRIBUTES
This module implements it's own quote method. In addition to the
DBI method it doubles also the backslash, because PostgreSQL treats
a backslash as an escape character.
=head1 STATEMENT HANDLE ATTRIBUTES
For statement handles of a select statement you can
discover what the returned column names, types, sizes are:
@name = @{$sth->{'NAME'}}; # Column names
@type = @{$sth->{'TYPE'}}; # Data types
@size = @{$sth->{'SIZE'}}; # Numeric size
There is also support for two PostgreSQL-specific attributes:
$oid_status = $sth->{'pg_oid_status'}; # oid of last insert
$cmd_status = $sth->{'pg_cmd_status'}; # type of last command
=head1 TRANSACTIONS
The transaction behavior is now controlled with the attribute AutoCommit.
For a complete definition of AutoCommit please refer to the DBI documentation.
According to the DBI specification the default for AutoCommit is TRUE.
In this mode, any change to the database becomes valid immediately. Any
'begin', 'commit' or 'rollback' statement will be rejected.
If AutoCommit is switched-off, immediately a transaction will be started by
issuing a 'begin' statement. Any 'commit' or 'rollback' will start a new
transaction. A disconnect will issue a 'rollback' statement.
In case your scripts do not use transactions, no changes are necessary.
If your scripts make use of transactions, you have to adapt them to the
AutoCommit feature. In most cases it is be sufficient, to remove the
'begin' statements and to switch-off the AutoCommit mode.
=head1 Meta-Information
The driver supports two simple methods to get meta-information about
the available tables and their attributes:
$dbh->tables;
$dbh->DBD::Pg::db::attributes($table);
Because the second one is not (yet) supported by DBI you have to use the
complete name including the package. The first method returns all tables
which are owned by the current user. The second method returns for the
given table a unique number, the name, the type, and the length of every
attribute.
=head1 DATA TYPE bool
The current implementation of PostgreSQL returns 't' for true and 'f' for
false. From the perl point of view a rather unfortunate choice. The DBD-Pg
module translates the result for the data-type bool in a perl-ish like manner:
'f' -> '0' and 't' -> '1'. This way the application does not have to check
the database-specific returned values for the data-type bool, because perl
treats '0' as false and '1' as true. If you make use of the data-type bool
you have to adapt your scripts !
Starting with version 6.3 PostgreSQL will consider 1 and '1' as input for
the boolean data-type as true. In older versions everything except 't' is
considerd as false.
=head1 BLOBS
Support for blob_read is provided. For further
information and examples please read the files
in the blobs subdirectory.
In addition you can use the two registered built-in
functions lo_import() and lo_export(). See the
L<large_objects> for further information and
examples.
=head1 KNOWN RESTRICTIONS
=item *
PostgreSQL does not has the concept of preparing
a statement. Here the prepare method just stores
the statement.
=item *
Although PostgreSQL has a cursor concept, it has not
been used in the current implementation. Cursors in
PostgreSQL can only be used inside a transaction block.
Because transactions in PostgreSQL can not be nested,
this would have implied the restriction, not to use
any nested SELECT statements. Hence the execute method
fetches all data at once into data structures located
in the frontend application. This has to be considered
when selecting large amounts of data !
=item *
$DBI::state is not supported.
=item *
Some statement handle attributes are not supported.
=head1 SEE ALSO
L<DBI>
=head1 AUTHORS
=item *
DBI and DBD-Oracle by Tim Bunce (Tim.Bunce@ig.co.uk)
=item *
DBD-Pg by Edmund Mergl (E.Mergl@bawue.de)
Major parts of this package have been copied from DBI and DBD-Oracle.
=head1 COPYRIGHT
The DBD::Pg module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 ACKNOWLEDGMENTS
See also L<DBI/ACKNOWLEDGMENTS>.
=cut
DBD-Pg-0.73/Pg.xs 100644 620 144 27002 6535145703 12054 0 ustar mergl users /*---------------------------------------------------------
*
* $Id: Pg.xs,v 1.15 1998/02/21 16:34:20 mergl Exp $
*
* Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
* Portions Copyright (c) 1997,1998 Edmund Mergl
*
*---------------------------------------------------------
*/
#include "Pg.h"
DBISTATE_DECLARE;
MODULE = DBD::Pg PACKAGE = DBD::Pg
REQUIRE: 1.929
PROTOTYPES: DISABLE
BOOT:
items = 0; /* avoid 'unused variable' warning */
DBISTATE_INIT;
/* XXX this interface will change: */
DBI_IMP_SIZE("DBD::Pg::dr::imp_data_size", sizeof(imp_drh_t));
DBI_IMP_SIZE("DBD::Pg::db::imp_data_size", sizeof(imp_dbh_t));
DBI_IMP_SIZE("DBD::Pg::st::imp_data_size", sizeof(imp_sth_t));
dbd_init(DBIS);
# ------------------------------------------------------------
# driver level interface
# ------------------------------------------------------------
MODULE = DBD::Pg PACKAGE = DBD::Pg::dr
# disconnect_all renamed and ALIAS'd to avoid length clash on VMS :-(
void
discon_all_(drh)
SV * drh
ALIAS:
disconnect_all = 1
CODE:
D_imp_drh(drh);
ST(0) = dbd_discon_all(drh, imp_drh) ? &sv_yes : &sv_no;
# ------------------------------------------------------------
# database level interface
# ------------------------------------------------------------
MODULE = DBD::Pg PACKAGE = DBD::Pg::db
void
_login(dbh, dbname, uid, pwd)
SV * dbh
char * dbname
char * uid
char * pwd
CODE:
D_imp_dbh(dbh);
ST(0) = dbd_db_login(dbh, imp_dbh, dbname, uid, pwd) ? &sv_yes : &sv_no;
int
_ping(dbh)
SV * dbh
CODE:
int retval;
retval = dbd_db_ping(dbh);
if (retval == 0) {
XST_mUNDEF(0);
}
else {
XST_mIV(0, retval);
}
int
_do(dbh, statement, attribs=Nullsv)
SV * dbh
char * statement
SV * attribs
CODE:
{
D_imp_dbh(dbh);
int retval;
DBD_ATTRIBS_CHECK("_do", dbh, attribs);
if (!strncasecmp(statement, "begin", 5) ||
!strncasecmp(statement, "end", 4) ||
!strncasecmp(statement, "commit", 6) ||
!strncasecmp(statement, "abort", 5) ||
!strncasecmp(statement, "rollback", 8) ) {
warn("please use DBI functions for transaction handling");
retval = -2;
} else {
retval = dbd_db_do(dbh, statement);
}
if (retval == 0) { /* ok with no rows affected */
XST_mPV(0, "0E0"); /* (true but zero) */
}
else if (retval < -1) { /* -1 == unknown number of rows */
XST_mUNDEF(0); /* <= -2 means error */
}
else {
XST_mIV(0, retval); /* typically 1, rowcount or -1 */
}
}
void
commit(dbh)
SV * dbh
CODE:
D_imp_dbh(dbh);
if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) {
warn("commit ineffective with AutoCommit");
ST(0) = &sv_no;
} else {
ST(0) = dbd_db_commit(dbh, imp_dbh) ? &sv_yes : &sv_no;
}
void
rollback(dbh)
SV * dbh
CODE:
D_imp_dbh(dbh);
if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) {
warn("rollback ineffective with AutoCommit");
ST(0) = &sv_no;
} else {
ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &sv_yes : &sv_no;
}
void
disconnect(dbh)
SV * dbh
CODE:
D_imp_dbh(dbh);
if ( !DBIc_ACTIVE(imp_dbh) ) {
XSRETURN_YES;
}
/* Check for disconnect() being called whilst refs to cursors */
/* still exists. This possibly needs some more thought. */
if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !dirty) {
warn("disconnect(%s) invalidates %d active cursor(s)",
SvPV(dbh,na), (int)DBIc_ACTIVE_KIDS(imp_dbh));
}
ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &sv_yes : &sv_no;
void
STORE(dbh, keysv, valuesv)
SV * dbh
SV * keysv
SV * valuesv
CODE:
D_imp_dbh(dbh);
ST(0) = &sv_yes;
if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv)) {
if (!DBIS->set_attr(dbh, keysv, valuesv)) {
ST(0) = &sv_no;
}
}
void
FETCH(dbh, keysv)
SV * dbh
SV * keysv
CODE:
D_imp_dbh(dbh);
SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv);
if (!valuesv) {
valuesv = DBIS->get_attr(dbh, keysv);
}
ST(0) = valuesv; /* dbd_db_FETCH_attrib did sv_2mortal */
void
DESTROY(dbh)
SV * dbh
PPCODE:
D_imp_dbh(dbh);
ST(0) = &sv_yes;
if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */
if (DBIc_WARN(imp_dbh) && !dirty && dbis->debug >= 2) {
warn("Database handle %s DESTROY ignored - never set up", SvPV(dbh,na));
}
}
else {
if (DBIc_IADESTROY(imp_dbh)) { /* want's ineffective destroy */
DBIc_ACTIVE_off(imp_dbh);
}
if (DBIc_ACTIVE(imp_dbh)) {
static int auto_rollback = -1;
if (DBIc_WARN(imp_dbh) && (!dirty || dbis->debug >= 3)) {
warn("Database handle destroyed without explicit disconnect");
}
/* The application has not explicitly disconnected. That's bad. */
/* To ensure integrity we *must* issue a rollback. This will be */
/* harmless if the application has issued a commit. If it hasn't */
/* then it'll ensure integrity. Consider a Ctrl-C killing perl */
/* between two statements that must be executed as a transaction. */
/* Perl will call DESTROY on the dbh and, if we don't rollback, */
/* the server will automatically commit! Bham! Corrupt database! */
if (auto_rollback == -1) { /* need to determine behaviour */
/* DBD_ORACLE_AUTO_ROLLBACK is offered as a _temporary_ sop to */
/* those who can't fix their code in a short timescale. */
char *p = getenv("DBD_ORACLE_AUTO_ROLLBACK");
auto_rollback = (p) ? atoi(p) : 1;
}
if (auto_rollback) {
dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */
}
dbd_db_disconnect(dbh, imp_dbh);
}
dbd_db_destroy(dbh, imp_dbh);
}
# -- end of DBD::~DRIVER~::db
# ------------------------------------------------------------
# statement interface
# ------------------------------------------------------------
MODULE = DBD::Pg PACKAGE = DBD::Pg::st
void
_prepare(sth, statement, attribs=Nullsv)
SV * sth
char * statement
SV * attribs
CODE:
{
D_imp_sth(sth);
D_imp_dbh_from_sth;
DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
if (!strncasecmp(statement, "begin", 5) ||
!strncasecmp(statement, "end", 4) ||
!strncasecmp(statement, "commit", 6) ||
!strncasecmp(statement, "abort", 5) ||
!strncasecmp(statement, "rollback", 8) ) {
warn("please use DBI functions for transaction handling");
ST(0) = &sv_no;
} else {
ST(0) = dbd_st_prepare(sth, imp_sth, statement, attribs) ? &sv_yes : &sv_no;
}
}
void
rows(sth)
SV * sth
CODE:
D_imp_sth(sth);
XST_mIV(0, dbd_st_rows(sth, imp_sth));
void
bind_param(sth, param, value, attribs=Nullsv)
SV * sth
SV * param
SV * value
SV * attribs
CODE:
{
IV sql_type = 0;
D_imp_sth(sth);
if (attribs) {
if (SvIOK(attribs)) {
sql_type = SvIV(attribs);
attribs = Nullsv;
}
else {
SV **svp;
DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
}
}
ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0) ? &sv_yes : &sv_no;
}
void
bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv)
SV * sth
SV * param
SV * value_ref
IV maxlen
SV * attribs
CODE:
{
IV sql_type = 0;
D_imp_sth(sth);
if (!SvROK(value_ref) || SvTYPE(SvRV(value_ref)) > SVt_PVMG) {
croak("bind_param_inout needs a reference to a scalar value");
}
if (SvREADONLY(SvRV(value_ref))) {
croak(no_modify);
}
if (attribs) {
if (SvIOK(attribs)) {
sql_type = SvIV(attribs);
attribs = Nullsv;
}
else {
SV **svp;
DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
}
}
ST(0) = dbd_bind_ph(sth, imp_sth, param, SvRV(value_ref), sql_type, attribs, TRUE, maxlen) ? &sv_yes : &sv_no;
}
void
execute(sth, ...)
SV * sth
CODE:
D_imp_sth(sth);
int retval;
if (items > 1) {
/* Handle binding supplied values to placeholders */
int i, error = 0;
SV *idx;
imp_sth->all_params_len = 0; /* used for malloc of statement string in case we have placeholders */
if (items-1 != DBIc_NUM_PARAMS(imp_sth)) {
croak("execute called with %ld bind variables, %d needed", items-1, DBIc_NUM_PARAMS(imp_sth));
XSRETURN_UNDEF;
}
idx = sv_2mortal(newSViv(0));
for(i=1; i < items ; ++i) {
sv_setiv(idx, i);
if (!dbd_bind_ph(sth, imp_sth, idx, ST(i), 0, Nullsv, FALSE, 0)) {
++error;
}
}
if (error) {
XSRETURN_UNDEF; /* dbd_bind_ph already registered error */
}
}
retval = dbd_st_execute(sth, imp_sth);
/* remember that dbd_st_execute must return <= -2 for error */
if (retval == 0) { /* ok with no rows affected */
XST_mPV(0, "0E0"); /* (true but zero) */
}
else if (retval < -1) { /* -1 == unknown number of rows */
XST_mUNDEF(0); /* <= -2 means error */
}
else {
XST_mIV(0, retval); /* typically 1, rowcount or -1 */
}
void
fetchrow_arrayref(sth)
SV * sth
ALIAS:
fetch = 1
CODE:
D_imp_sth(sth);
AV *av = dbd_st_fetch(sth, imp_sth);
ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &sv_undef;
void
fetchrow_array(sth)
SV * sth
ALIAS:
fetchrow = 1
PPCODE:
D_imp_sth(sth);
AV *av;
av = dbd_st_fetch(sth, imp_sth);
if (av) {
int num_fields = AvFILL(av)+1;
int i;
EXTEND(sp, num_fields);
for(i=0; i < num_fields; ++i) {
PUSHs(AvARRAY(av)[i]);
}
}
void
finish(sth)
SV * sth
CODE:
D_imp_sth(sth);
D_imp_dbh_from_sth;
if (!DBIc_ACTIVE(imp_dbh)) {
/* Either an explicit disconnect() or global destruction */
/* has disconnected us from the database. Finish is meaningless */
/* XXX warn */
XSRETURN_YES;
}
if (!DBIc_ACTIVE(imp_sth)) {
/* No active statement to finish */
XSRETURN_YES;
}
ST(0) = dbd_st_finish(sth, imp_sth) ? &sv_yes : &sv_no;
void
blob_read(sth, field, offset, len, destrv=Nullsv, destoffset=0)
SV * sth
int field
long offset
long len
SV * destrv
long destoffset
CODE:
{
D_imp_sth(sth);
if (!destrv) {
destrv = sv_2mortal(newRV(sv_2mortal(newSV(0))));
}
if (dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset)) {
ST(0) = SvRV(destrv);
}
else ST(0) = &sv_undef;
}
void
STORE(sth, keysv, valuesv)
SV * sth
SV * keysv
SV * valuesv
CODE:
D_imp_sth(sth);
ST(0) = &sv_yes;
if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv)) {
if (!DBIS->set_attr(sth, keysv, valuesv)) {
ST(0) = &sv_no;
}
}
# FETCH renamed and ALIAS'd to avoid case clash on VMS :-(
void
FETCH_attrib(sth, keysv)
SV * sth
SV * keysv
ALIAS:
FETCH = 1
CODE:
D_imp_sth(sth);
SV *valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv);
if (!valuesv) {
valuesv = DBIS->get_attr(sth, keysv);
}
ST(0) = valuesv; /* dbd_st_FETCH_attrib did sv_2mortal */
void
DESTROY(sth)
SV * sth
PPCODE:
D_imp_sth(sth);
ST(0) = &sv_yes;
if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */
if (DBIc_WARN(imp_sth) && !dirty && dbis->debug >= 2) {
warn("Statement handle %s DESTROY ignored - never set up", SvPV(sth,na));
}
}
else {
if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy */
DBIc_ACTIVE_off(imp_sth);
}
if (DBIc_ACTIVE(imp_sth)) {
dbd_st_finish(sth, imp_sth);
}
dbd_st_destroy(sth, imp_sth);
}
# end of Pg.xs
DBD-Pg-0.73/README 100644 620 144 7775 6535145703 12011 0 ustar mergl users #---------------------------------------------------------
#
# $Id: README,v 1.20 1998/06/03 03:59:44 mergl Exp $
#
# Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
# Portions Copyright (c) 1997,1998 Edmund Mergl
#
#---------------------------------------------------------
DESCRIPTION:
------------
This is version 0.73 of DBD-Pg.
DBD-Pg is a PostgreSQL interface for Perl 5 using DBI.
For further information about DBI look at:
http://www.fugue.com/dbi/
COPYRIGHT:
----------
You may distribute under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl README file.
IF YOU HAVE PROBLEMS:
---------------------
Please send comments and bug-reports to <E.Mergl@bawue.de>
Please include the output of perl -v,
and perl -V,
the version of PostgreSQL,
the version of DBD-Pg,
and the version of DBI
in your bug-report.
REQUIREMENTS:
-------------
- build, test and install Perl 5 (at least 5.002)
- build, test and install the DBI module (at least 0.91)
- build, test and install PostgreSQL (at least 6.3)
PLATFORMS:
----------
This release of DBD-Pg has been developed using Linux 2.0 with
dynamic loading for the perl extensions. Let me know, if there
are any problems with other platforms.
INSTALLATION:
-------------
The Makefile checks the environment variable POSTGRES_HOME as well
some standard locations, to find the root directory of your Postgres
installation.
1. perl Makefile.PL
2. make
3. make test
4. make install
( 1. to 3. as normal user, not as root ! )
TESTING:
--------
Run 'make test'.
Note, that the user running this script must have been created with
the access rights to create databases *AND* users ! Do not run this
script as root !
If testing fails with the message 'login failed', please check if access
to the database template1 as well as pgperltest is not protected in pg_hba.conf.
If you are using the shared library libpq.so check if your dynamic loader
finds libpq.so. With Linux the command /sbin/ldconfig -v should tell you,
where it finds libpq.so. If ldconfig does not find libpq.so, either add an
appropriate entry to /etc/ld.so.conf and re-run ldconfig or add the path to
the environment variable LD_LIBRARY_PATH.
A typical error message resulting from not finding libpq.so is:
install_driver(Pg) failed: Can't load './blib/arch/auto/DBD/Pg/Pg.so'
for module DBD::Pg: File not found at
Some linux distributions have an incomplete perl installation.
If you have compile errors like "XS_VERSION_BOOTCHECK undeclared", make a
'find .../lib/perl5 -name XSUB.h -print'
If this file is not present, you need to recompile and reinstall perl.
SGI users: if you get segmentation faults make sure, you use the malloc which
comes with perl when compiling perl (the default is not to).
"David R. Noble" <drnoble@engsci.sandia.gov>
HP users: if you get error messages like:
can't open shared library: .../lib/libpq.sl
No such file or directory
when running the test script, try to replace the
'shared' option in the LDDFLAGS with 'archive'.
Dan Lauterbach <danla@dimensional.com>
FreeBSD users: if you get during make test the error message:
'DBD driver has not implemented the AutoCommit attribute'
recompile the DBI module and the DBD-Pg module and disable
optimization. This error message is due to the broken
optimization in gcc-2.7.2.1.
Sun Users: if you get compile errors like:
/usr/include/string.h:57: parse error before `]'
then you need to remove from pgsql/include/libpq-fe.h
the define for strerror, which clashes with the definition
in the standard include file.
---------------------------------------------------------------------------
Edmund Mergl <E.Mergl@bawue.de> June 03, 1998
---------------------------------------------------------------------------
DBD-Pg-0.73/dbdimp.c 100644 620 144 72145 6535145703 12545 0 ustar mergl users /*---------------------------------------------------------
*
* $Id: dbdimp.c,v 1.19 1998/04/20 20:06:00 mergl Exp $
*
* Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
* Portions Copyright (c) 1997,1998 Edmund Mergl
*
*---------------------------------------------------------
*/
#include "Pg.h"
#define BUFSIZE 1024
DBISTATE_DECLARE;
static void dbd_preparse (imp_sth_t *imp_sth, char *statement);
static int _dbd_rebind_ph (SV *sth, imp_sth_t *imp_sth, phs_t *phs);
static SV *dbd_pad_empty;
void
dbd_init(dbistate)
dbistate_t *dbistate;
{
DBIS = dbistate;
if (getenv("DBD_PAD_EMPTY"))
sv_setiv(dbd_pad_empty, atoi(getenv("DBD_PAD_EMPTY")));
}
void
dbd_error(h, error_num, error_msg)
SV * h;
int error_num;
char *error_msg;
{
D_imp_xxh(h);
sv_setiv(DBIc_ERR(imp_xxh), (IV)error_num); /* set err early */
sv_setpv(DBIc_ERRSTR(imp_xxh), (char*)error_msg);
DBIh_EVENT2(h, ERROR_event, DBIc_ERR(imp_xxh), DBIc_ERRSTR(imp_xxh));
if (dbis->debug >= 2) { fprintf(DBILOGFP, "%s error %d recorded: %s\n", error_msg, error_num, SvPV(DBIc_ERRSTR(imp_xxh),na)); }
}
/* ================================================================== */
int
dbd_discon_all(drh, imp_drh)
SV *drh;
imp_drh_t *imp_drh;
{
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_discon_all\n"); }
return FALSE;
}
int
dbd_db_login(dbh, imp_dbh, dbname, uid, pwd)
SV *dbh;
imp_dbh_t *imp_dbh;
char *dbname;
char *uid;
char *pwd;
{
char *conn_str;
char *src;
char *dest;
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_login\n"); }
/* build connect string */
/* DBD-Pg syntax: 'dbname=dbname;host=host;port=port' */
/* pgsql syntax: 'dbname=dbname host=host port=port user=uid authtype=password password=pwd' */
conn_str = (char *)malloc(strlen(dbname) + strlen(uid) + strlen(pwd) + 34 + 1);
if (! conn_str) {
return 0;
}
src = dbname;
dest = conn_str;
while (*src) {
if (*src != ';') {
*dest++ = *src++;
continue;
}
*dest++ = ' ';
src++;
}
*dest = '\0';
if (strlen(uid)) {
strcat(conn_str, " user=");
strcat(conn_str, uid);
}
if (strlen(uid) && strlen(pwd)) {
strcat(conn_str, " authtype=password password=");
strcat(conn_str, pwd);
}
if (dbis->debug >= 2) { fprintf(DBILOGFP, "dbd_db_login: conn_str = >%s<\n", conn_str); }
/* make a connection to the database */
imp_dbh->conn = PQconnectdb(conn_str);
free(conn_str);
/* check to see that the backend connection was successfully made */
if (PQstatus(imp_dbh->conn) != CONNECTION_OK) {
dbd_error(dbh, PQstatus(imp_dbh->conn), PQerrorMessage(imp_dbh->conn));
return 0;
}
imp_dbh->init_auto = 1; /* initialize AutoCommit */
DBIc_IMPSET_on(imp_dbh); /* imp_dbh set up now */
DBIc_ACTIVE_on(imp_dbh); /* call disconnect before freeing */
return 1;
}
int
dbd_db_ping(dbh)
SV *dbh;
{
D_imp_dbh(dbh);
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_ping\n"); }
if (imp_dbh->conn->status != CONNECTION_OK) {
dbd_error(dbh, imp_dbh->conn->status, "dbd_db_ping: no connection to the backend\n");
return 0;
}
if (1 == pqPuts("Q ", imp_dbh->conn->Pfout, imp_dbh->conn->Pfdebug)) {
dbd_error(dbh, imp_dbh->conn->status, "dbd_db_ping: sending query to the backend failed\n");
imp_dbh->conn->status = CONNECTION_BAD;
return 0;
}
if ('I' != pqGetc(imp_dbh->conn->Pfin, imp_dbh->conn->Pfdebug) || '\0' != pqGetc(imp_dbh->conn->Pfin, imp_dbh->conn->Pfdebug)) {
dbd_error(dbh, imp_dbh->conn->status, "dbd_db_ping: backend closed the channel before responding\n");
imp_dbh->conn->status = CONNECTION_BAD;
return 0;
}
return 1;
}
int
dbd_db_do(dbh, statement)
SV * dbh;
char *statement;
{
D_imp_dbh(dbh);
PGresult* result = 0;
ExecStatusType status;
char *cmdStatus;
char *cmdTuples;
int ret = -2;
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_do: statement = >%s<\n", statement); }
/* execute command */
result = PQexec(imp_dbh->conn, statement);
status = result ? PQresultStatus(result) : -1;
cmdStatus = result ? (char *)PQcmdStatus(result) : NULL;
cmdTuples = result ? (char *)PQcmdTuples(result) : NULL;
PQclear(result);
/* check also for PGRES_TUPLES_OK in case of 'SELECT INTO TABLE' */
if (status != PGRES_COMMAND_OK && status != PGRES_TUPLES_OK) {
dbd_error(dbh, status, PQerrorMessage(imp_dbh->conn));
return -2;
}
if (! strncmp(cmdStatus, "DELETE", 6) || ! strncmp(cmdStatus, "INSERT", 6) || ! strncmp(cmdStatus, "UPDATE", 6)) {
ret = atoi(cmdTuples);
} else {
ret = -1;
}
return ret;
}
int
dbd_db_commit(dbh, imp_dbh)
SV *dbh;
imp_dbh_t *imp_dbh;
{
PGresult* result = 0;
ExecStatusType status;
int retval = 1;
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_commit\n"); }
/* no commit if AutoCommit = on */
if (DBIc_has(imp_dbh, DBIcf_AutoCommit) != FALSE) {
return 0;
}
/* execute commit */
result = PQexec(imp_dbh->conn, "commit");
status = result ? PQresultStatus(result) : -1;
PQclear(result);
if (status != PGRES_COMMAND_OK) {
dbd_error(dbh, status, "commit failed\n");
return 0;
}
if (DBIc_has(imp_dbh, DBIcf_AutoCommit) == FALSE) {
result = PQexec(imp_dbh->conn, "begin");
status = result ? PQresultStatus(result) : -1;
PQclear(result);
if (status != PGRES_COMMAND_OK) {
dbd_error(dbh, status, "begin failed\n");
return 0;
}
}
return retval;
}
int
dbd_db_rollback(dbh, imp_dbh)
SV *dbh;
imp_dbh_t *imp_dbh;
{
PGresult* result = 0;
ExecStatusType status;
int retval = 1;
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_rollback\n"); }
/* no rollback if AutoCommit = on */
if (DBIc_has(imp_dbh, DBIcf_AutoCommit) != FALSE) {
return 0;
}
/* execute rollback */
result = PQexec(imp_dbh->conn, "rollback");
status = result ? PQresultStatus(result) : -1;
PQclear(result);
if (status != PGRES_COMMAND_OK) {
dbd_error(dbh, status, "rollback failed\n");
return 0;
}
if (DBIc_has(imp_dbh, DBIcf_AutoCommit) == FALSE) {
result = PQexec(imp_dbh->conn, "begin");
status = result ? PQresultStatus(result) : -1;
PQclear(result);
if (status != PGRES_COMMAND_OK) {
dbd_error(dbh, status, "begin failed\n");
return 0;
}
}
return retval;
}
int
dbd_db_disconnect(dbh, imp_dbh)
SV *dbh;
imp_dbh_t *imp_dbh;
{
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_disconnect\n"); }
/* We assume that disconnect will always work */
/* since most errors imply already disconnected. */
DBIc_ACTIVE_off(imp_dbh);
/* rollback if AutoCommit = off */
if (DBIc_has(imp_dbh, DBIcf_AutoCommit) == FALSE) {
PGresult* result = 0;
ExecStatusType status;
result = PQexec(imp_dbh->conn, "rollback");
status = result ? PQresultStatus(result) : -1;
PQclear(result);
if (status != PGRES_COMMAND_OK) {
dbd_error(dbh, status, "rollback failed\n");
return 0;
}
if (dbis->debug >= 2) { fprintf(DBILOGFP, "dbd_db_disconnect: AutoCommit=off -> rollback\n"); }
}
PQfinish(imp_dbh->conn);
/* We don't free imp_dbh since a reference still exists */
/* The DESTROY method is the only one to 'free' memory. */
/* Note that statement objects may still exists for this dbh! */
return 1;
}
void
dbd_db_destroy(dbh, imp_dbh)
SV *dbh;
imp_dbh_t *imp_dbh;
{
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_destroy\n"); }
if (DBIc_ACTIVE(imp_dbh)) {
dbd_db_disconnect(dbh, imp_dbh);
}
/* Nothing in imp_dbh to be freed */
DBIc_IMPSET_off(imp_dbh);
}
int
dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv)
SV *dbh;
imp_dbh_t *imp_dbh;
SV *keysv;
SV *valuesv;
{
STRLEN kl;
char *key = SvPV(keysv,kl);
int newval = SvTRUE(valuesv);
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_STORE\n"); }
if (kl==10 && strEQ(key, "AutoCommit")) {
int oldval = DBIc_has(imp_dbh, DBIcf_AutoCommit);
DBIc_set(imp_dbh, DBIcf_AutoCommit, newval);
if (oldval == FALSE && newval != FALSE && imp_dbh->init_auto) {
/* do nothing, fall through */
if (dbis->debug >= 2) { fprintf(DBILOGFP, "dbd_db_STORE: initialize AutoCommit to on\n"); }
} else if (oldval == FALSE && newval != FALSE) {
/* commit any outstanding changes */
PGresult* result = 0;
ExecStatusType status;
result = PQexec(imp_dbh->conn, "commit");
status = result ? PQresultStatus(result) : -1;
PQclear(result);
if (status != PGRES_COMMAND_OK) {
dbd_error(dbh, status, "commit failed\n");
return 0;
}
if (dbis->debug >= 2) { fprintf(DBILOGFP, "dbd_db_STORE: switch AutoCommit to on: commit\n"); }
} else if ((oldval != FALSE && newval == FALSE) || (oldval == FALSE && newval == FALSE && imp_dbh->init_auto)) {
/* start new transaction */
PGresult* result = 0;
ExecStatusType status;
result = PQexec(imp_dbh->conn, "begin");
status = result ? PQresultStatus(result) : -1;
PQclear(result);
if (status != PGRES_COMMAND_OK) {
dbd_error(dbh, status, "begin failed\n");
return 0;
}
if (dbis->debug >= 2) { fprintf(DBILOGFP, "dbd_db_STORE: switch AutoCommit to off: begin\n"); }
}
imp_dbh->init_auto = 0;
return 1;
} else {
return 0;
}
}
SV *
dbd_db_FETCH_attrib(dbh, imp_dbh, keysv)
SV *dbh;
imp_dbh_t *imp_dbh;
SV *keysv;
{
STRLEN kl;
char *key = SvPV(keysv,kl);
SV *retsv = Nullsv;
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_FETCH\n"); }
if (kl==10 && strEQ(key, "AutoCommit")) {
retsv = newSViv((IV)DBIc_is(imp_dbh, DBIcf_AutoCommit));
}
return sv_2mortal(retsv);
}
/* ================================================================== */
int
dbd_st_prepare(sth, imp_sth, statement, attribs)
SV *sth;
imp_sth_t *imp_sth;
char *statement;
SV *attribs;
{
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_prepare: statement = >%s<\n", statement); }
/* scan statement for '?', ':1' and/or ':foo' style placeholders */
dbd_preparse(imp_sth, statement);
/* initialize new statement handle */
imp_sth->result = 0;
imp_sth->cur_tuple = 0;
DBIc_IMPSET_on(imp_sth);
return 1;
}
static void
dbd_preparse(imp_sth, statement)
imp_sth_t *imp_sth;
char *statement;
{
bool in_literal = FALSE;
char *src, *start, *dest;
phs_t phs_tpl;
SV *phs_sv;
int idx=0, style=0, laststyle=0;
STRLEN namelen;
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_preparse: statement = >%s<\n", statement); }
/* allocate room for copy of statement with spare capacity */
/* for editing '?' or ':1' into ':p1' so we can use obndrv. */
imp_sth->statement = (char*)safemalloc(strlen(statement) * 3);
/* initialise phs ready to be cloned per placeholder */
memset(&phs_tpl, 0, sizeof(phs_tpl));
phs_tpl.ftype = 1; /* VARCHAR2 */
src = statement;
dest = imp_sth->statement;
while(*src) {
if (*src == '\'') {
in_literal = ~in_literal;
}
/* check for placeholders but take care of cast operator */
if ((*src != ':' && *src != '?') || (*src == ':' && (*(src-1) == ':' || *(src+1) == ':')) || in_literal) {
*dest++ = *src++;
continue;
}
start = dest; /* save name inc colon */
*dest++ = *src++;
if (*start == '?') { /* X/Open standard */
sprintf(start,":p%d", ++idx); /* '?' -> ':p1' (etc) */
dest = start+strlen(start);
style = 3;
} else if (isDIGIT(*src)) { /* ':1' */
idx = atoi(src);
*dest++ = 'p'; /* ':1'->':p1' */
if (idx <= 0)
croak("Placeholder :%d must be a positive number", idx);
while(isDIGIT(*src))
*dest++ = *src++;
style = 1;
} else if (isALNUM(*src)) { /* ':foo' */
while(isALNUM(*src)) /* includes '_' */
*dest++ = *src++;
style = 2;
} else { /* perhaps ':=' PL/SQL construct */
continue;
}
*dest = '\0'; /* handy for debugging */
namelen = (dest-start);
if (laststyle && style != laststyle)
croak("Can't mix placeholder styles (%d/%d)",style,laststyle);
laststyle = style;
if (imp_sth->all_params_hv == NULL)
imp_sth->all_params_hv = newHV();
phs_tpl.sv = &sv_undef;
phs_sv = newSVpv((char*)&phs_tpl, sizeof(phs_tpl)+namelen+1);
hv_store(imp_sth->all_params_hv, start, namelen, phs_sv, 0);
strcpy( ((phs_t*)(void*)SvPVX(phs_sv))->name, start);
/* warn("params_hv: '%s'\n", start); */
}
*dest = '\0';
if (imp_sth->all_params_hv) {
DBIc_NUM_PARAMS(imp_sth) = (int)HvKEYS(imp_sth->all_params_hv);
if (dbis->debug >= 2)
fprintf(DBILOGFP, " dbd_preparse scanned %d distinct placeholders\n",
(int)DBIc_NUM_PARAMS(imp_sth));
}
}
int
dbd_st_rows(sth, imp_sth)
SV *sth;
imp_sth_t *imp_sth;
{
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_rows\n"); }
return imp_sth->rows;
}
int
dbd_st_execute(sth, imp_sth) /* <= -2:error, >=0:ok row count, (-1=unknown count) */
SV *sth;
imp_sth_t *imp_sth;
{
D_imp_dbh_from_sth;
ExecStatusType status = -1;
char *cmdStatus;
char *cmdTuples;
char *statement;
int ret = -2;
int num_fields;
int i;
bool in_literal = FALSE;
char *src;
char *dest;
char *val;
char namebuf[30];
phs_t *phs;
SV **svp;
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_execute\n"); }
/*
here we get the statement from the statement handle where
it has been stored when creating a blank sth during prepare
svp = hv_fetch((HV *)SvRV(sth), "Statement", 9, FALSE);
statement = SvPV(*svp, na);
*/
statement = imp_sth->statement;
if (! statement) {
/* are we prepared ? */
dbd_error(sth, -1, "statement not prepared\n");
return -2;
}
/* do we have input parameters ? */
if ((int)DBIc_NUM_PARAMS(imp_sth) > 0) {
statement = (char*)safemalloc(strlen(imp_sth->statement) + imp_sth->all_params_len);
dest = statement;
src = imp_sth->statement;
/* scan statement for '?', ':1' and/or ':foo' style placeholders */
while(*src) {
if (*src == '\'') {
in_literal = ~in_literal;
}
if (*src != ':' || in_literal) {
*dest++ = *src++;
continue;
}
i = 0;
namebuf[i++] = *src++; /* ':' */
namebuf[i++] = *src++; /* 'p' */
while (isDIGIT(*src)) {
namebuf[i++] = *src++;
}
namebuf[i] = '\0';
svp = hv_fetch(imp_sth->all_params_hv, namebuf, i, 0);
if (svp == NULL) {
dbd_error(sth, -1, "parameter unknown\n");
return -2;
}
phs = (phs_t*)(void*)SvPVX(*svp);
val = neatsvpv(phs->sv, 0);
while (*val) {
*dest++ = *val++;
}
}
*dest = '\0';
}
if (dbis->debug >= 2) { fprintf(DBILOGFP, "dbd_st_execute: statement = >%s<\n", statement); }
/* clear old result (if any) */
if (imp_sth->result) {
PQclear(imp_sth->result);
}
/* execute statement */
imp_sth->result = PQexec(imp_dbh->conn, statement);
/* free statement string in case of input parameters */
if ((int)DBIc_NUM_PARAMS(imp_sth) > 0) {
Safefree(statement);
}
/* check status */
status = imp_sth->result ? PQresultStatus(imp_sth->result) : -1;
cmdStatus = imp_sth->result ? (char *)PQcmdStatus(imp_sth->result) : "";
cmdTuples = imp_sth->result ? (char *)PQcmdTuples(imp_sth->result) : "";
if (PGRES_TUPLES_OK == status) {
/* select statement */
num_fields = PQnfields(imp_sth->result);
imp_sth->is_bool = (char *)malloc(num_fields);
if (! imp_sth->is_bool) {
return -2;
}
for(i = 0; i < num_fields; ++i) { /* store the columns with datatype = bool */
if (16 == PQftype(imp_sth->result, i)) {
imp_sth->is_bool[i] = '1';
} else {
imp_sth->is_bool[i] = '0';
}
}
imp_sth->cur_tuple = 0;
DBIc_NUM_FIELDS(imp_sth) = num_fields;
DBIc_ACTIVE_on(imp_sth);
ret = PQntuples(imp_sth->result);
} else if (PGRES_COMMAND_OK == status) {
/* non-select statement */
if (! strncmp(cmdStatus, "DELETE", 6) || ! strncmp(cmdStatus, "INSERT", 6) || ! strncmp(cmdStatus, "UPDATE", 6)) {
ret = atoi(cmdTuples);
} else {
ret = -1;
}
} else {
dbd_error(sth, status, PQerrorMessage(imp_dbh->conn));
ret = -2;
}
/* store the number of affected rows */
imp_sth->rows = ret;
return ret;
}
AV *
dbd_st_fetch(sth, imp_sth)
SV * sth;
imp_sth_t *imp_sth;
{
int num_fields;
int i;
AV *av;
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_fetch\n"); }
/* Check that execute() was executed sucessfully */
if ( !DBIc_ACTIVE(imp_sth) ) {
dbd_error(sth, 1, "no statement executing\n");
return Nullav;
}
if ( imp_sth->cur_tuple == PQntuples(imp_sth->result) ) {
imp_sth->cur_tuple = 0;
return Nullav; /* we reached the last tuple */
}
av = DBIS->get_fbav(imp_sth);
num_fields = AvFILL(av)+1;
for(i = 0; i < num_fields; ++i) {
SV *sv = AvARRAY(av)[i];
if (PQgetisnull(imp_sth->result, imp_sth->cur_tuple, i)) {
sv_setsv(sv, &sv_undef);
} else {
char *val = (char*)PQgetvalue(imp_sth->result, imp_sth->cur_tuple, i);
if ('1' == imp_sth->is_bool[i]) {
*val = (*val == 'f') ? '0' : '1'; /* bool: translate postgres into perl */
}
sv_setpv(sv, val);
}
}
imp_sth->cur_tuple += 1;
return av;
}
int
dbd_st_finish(sth, imp_sth)
SV *sth;
imp_sth_t *imp_sth;
{
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_finish\n"); }
if (DBIc_ACTIVE(imp_sth) && imp_sth->result) {
PQclear(imp_sth->result);
imp_sth->result = 0;
imp_sth->rows = 0;
}
DBIc_ACTIVE_off(imp_sth);
return 1;
}
void
dbd_st_destroy(sth, imp_sth)
SV *sth;
imp_sth_t *imp_sth;
{
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_destroy\n"); }
/* Free off contents of imp_sth */
Safefree(imp_sth->statement);
if (imp_sth->is_bool) {
free(imp_sth->is_bool);
imp_sth->is_bool = 0;
}
if (imp_sth->result) {
PQclear(imp_sth->result);
imp_sth->result = 0;
}
if (imp_sth->out_params_av)
sv_free((SV*)imp_sth->out_params_av);
if (imp_sth->all_params_hv) {
HV *hv = imp_sth->all_params_hv;
SV *sv;
char *key;
I32 retlen;
hv_iterinit(hv);
while( (sv = hv_iternextsv(hv, &key, &retlen)) != NULL ) {
if (sv != &sv_undef) {
phs_t *phs_tpl = (phs_t*)(void*)SvPVX(sv);
sv_free(phs_tpl->sv);
}
}
sv_free((SV*)imp_sth->all_params_hv);
}
DBIc_IMPSET_off(imp_sth); /* let DBI know we've done it */
}
int
dbd_st_blob_read (sth, imp_sth, lobjId, offset, len, destrv, destoffset)
SV *sth;
imp_sth_t *imp_sth;
int lobjId;
long offset;
long len;
SV *destrv;
long destoffset;
{
D_imp_dbh_from_sth;
char err[64];
int ret, lobj_fd, nbytes, nread;
PGresult* result;
ExecStatusType status;
SV *bufsv;
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_blob_read\n"); }
/* safety check */
if (! SvROK(destrv)) {
dbd_error(sth, -1, "dbd_st_blob_read: destrv not a reference");
return 0;
}
bufsv = SvRV(destrv); /* dereference destination */
if (! destoffset) {
sv_setpvn(bufsv, "", 0); /* ensure it's writable string */
}
/* execute begin */
result = PQexec(imp_dbh->conn, "begin");
status = result ? PQresultStatus(result) : -1;
PQclear(result);
if (status != PGRES_COMMAND_OK) {
dbd_error(sth, status, PQerrorMessage(imp_dbh->conn));
return 0;
}
/* open large object */
lobj_fd = lo_open(imp_dbh->conn, lobjId, INV_READ);
if (lobj_fd < 0) {
sprintf(&err[0], "lo_open: can't open large object %d", lobjId);
dbd_error(sth, -1, err);
return 0;
}
/* seek on large object */
if (offset > 0) {
ret = lo_lseek(imp_dbh->conn, lobj_fd, offset, SEEK_SET);
if (ret < 0) {
sprintf(&err[0], "lo_seek: can't seek large object %d", lobjId);
dbd_error(sth, -1, err);
return 0;
}
}
/* read from large object */
nread = 0;
nbytes = 1;
while (nbytes > 0) {
SvGROW(bufsv, destoffset + nread + BUFSIZE + 1); /* SvGROW doesn't do +1 */
nbytes = lo_read(imp_dbh->conn, lobj_fd, ((char*)SvPVX(bufsv)) + destoffset + nread, BUFSIZE);
if (nbytes < 0) {
sprintf(&err[0], "lo_read: can't read from large object %d", lobjId);
dbd_error(sth, -1, err);
return 0;
}
nread += nbytes;
/* break if user wants only a specified chunk */
if (len && nread > len) {
break;
}
}
/* close large object */
ret = lo_close(imp_dbh->conn, lobj_fd);
if (ret < 0) {
sprintf(&err[0], "lo_close: can't close large object %d", lobjId);
dbd_error(sth, -1, err);
return 0;
}
/* execute end */
result = PQexec(imp_dbh->conn, "end");
status = result ? PQresultStatus(result) : -1;
PQclear(result);
if (status != PGRES_COMMAND_OK) {
dbd_error(sth, status, PQerrorMessage(imp_dbh->conn));
return 0;
}
/* terminate string */
if (len && nread > len) {
nread = len;
}
SvCUR_set(bufsv, destoffset + nread);
*SvEND(bufsv) = '\0';
return nread;
}
int
dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv)
SV *sth;
imp_sth_t *imp_sth;
SV *keysv;
SV *valuesv;
{
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_STORE\n"); }
return FALSE;
}
SV *
dbd_st_FETCH_attrib(sth, imp_sth, keysv)
SV *sth;
imp_sth_t *imp_sth;
SV *keysv;
{
STRLEN kl;
char *key = SvPV(keysv,kl);
SV *retsv = Nullsv;
int i;
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_FETCH\n"); }
if (kl==13 && strEQ(key, "NUM_OF_PARAMS")) { /* handled by DBI */
return Nullsv;
}
if (! imp_sth->result) {
return Nullsv;
}
if (kl == 4 && strEQ(key, "NAME")) {
AV *av = newAV();
retsv = newRV(sv_2mortal((SV*)av));
for (i = 0; i < DBIc_NUM_FIELDS(imp_sth); i++) {
av_store(av, i, newSVpv(PQfname(imp_sth->result, i),0));
}
} else if ( kl== 4 && strEQ(key, "TYPE")) {
AV *av = newAV();
retsv = newRV(sv_2mortal((SV*)av));
for (i = 0; i < DBIc_NUM_FIELDS(imp_sth); i++) {
av_store(av, i, newSViv(PQftype(imp_sth->result, i)));
}
} else if (kl==4 && strEQ(key, "SIZE")) {
AV *av = newAV();
retsv = newRV(sv_2mortal((SV*)av));
for (i = 0; i < DBIc_NUM_FIELDS(imp_sth); i++) {
av_store(av, i, newSViv(PQfsize(imp_sth->result, i)));
}
} else if (kl==13 && strEQ(key, "pg_oid_status")) {
retsv = newSVpv((char *)PQoidStatus(imp_sth->result), 0);
} else if (kl==13 && strEQ(key, "pg_cmd_status")) {
retsv = newSVpv((char *)PQcmdStatus(imp_sth->result), 0);
} else {
return Nullsv;
}
return sv_2mortal(retsv);
}
static int
_dbd_rebind_ph(sth, imp_sth, phs)
SV *sth;
imp_sth_t *imp_sth;
phs_t *phs;
{
STRLEN value_len;
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_rebind\n"); }
/* for strings, must be a PV first for ptr to be valid? */
/* sv_insert +4 */
/* sv_chop(phs->sv, SvPV(phs->sv,na)+4); XXX */
if (dbis->debug >= 2) {
char *text = neatsvpv(phs->sv,0);
fprintf(DBILOGFP, "bind %s <== %s (size %d/%d/%ld, ptype %ld, otype %d)\n",
phs->name, text, SvCUR(phs->sv),SvLEN(phs->sv),phs->maxlen,
SvTYPE(phs->sv), phs->ftype);
}
/* At the moment we always do sv_setsv() and rebind. */
/* Later we may optimise this so that more often we can */
/* just copy the value & length over and not rebind. */
if (phs->is_inout) { /* XXX */
if (SvREADONLY(phs->sv))
croak(no_modify);
/* phs->sv _is_ the real live variable, it may 'mutate' later */
/* pre-upgrade high to reduce risk of SvPVX realloc/move */
(void)SvUPGRADE(phs->sv, SVt_PVNV);
/* ensure room for result, 28 is magic number (see sv_2pv) */
SvGROW(phs->sv, (phs->maxlen < 28) ? 28 : phs->maxlen+1);
if (imp_sth->dbd_pad_empty)
croak("Can't use dbd_pad_empty with bind_param_inout");
}
else {
/* phs->sv is copy of real variable, upgrade to at least string */
(void)SvUPGRADE(phs->sv, SVt_PV);
}
/* At this point phs->sv must be at least a PV with a valid buffer, */
/* even if it's undef (null) */
/* Here we set phs->progv, phs->indp, and value_len. */
if (SvOK(phs->sv)) {
phs->progv = SvPV(phs->sv, value_len);
phs->indp = 0;
}
else { /* it's null but point to buffer incase it's an out var */
phs->progv = SvPVX(phs->sv);
phs->indp = -1;
value_len = 0;
}
if (imp_sth->dbd_pad_empty && value_len==0) {
sv_setpv(phs->sv, " ");
phs->progv = SvPV(phs->sv, value_len);
}
phs->sv_type = SvTYPE(phs->sv); /* part of mutation check */
phs->alen = value_len + phs->alen_incnull;
phs->maxlen = SvLEN(phs->sv)-1; /* avail buffer space */
imp_sth->all_params_len += phs->alen;
if (dbis->debug >= 3) {
fprintf(DBILOGFP, "bind %s <== '%.100s' (size %d/%ld, indp %d)\n",
phs->name, phs->progv, phs->alen, (long)phs->maxlen, phs->indp);
}
return 1;
}
int
dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, is_inout, maxlen)
SV *sth;
imp_sth_t *imp_sth;
SV *param;
SV *value;
IV sql_type;
SV *attribs;
int is_inout;
IV maxlen;
{
SV **phs_svp;
STRLEN name_len;
char *name;
char namebuf[30];
phs_t *phs;
if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_bind_ph\n"); }
/* check if placeholder was passed as a number */
if (SvNIOK(param) || (SvPOK(param) && isDIGIT(*SvPVX(param)))) {
name = namebuf;
sprintf(name, ":p%d", (int)SvIV(param));
name_len = strlen(name);
}
else { /* use the supplied placeholder name directly */
name = SvPV(param, name_len);
}
if (SvTYPE(value) > SVt_PVMG) /* hook for later array logic */
croak("Can't bind non-scalar value (currently)");
if (dbis->debug >= 2) {
fprintf(DBILOGFP, "bind %s <== %s (attribs: %s)\n", name, neatsvpv(value,0), attribs ? SvPV(attribs,na) : "" );
}
phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0);
if (phs_svp == NULL)
croak("Can't bind unknown placeholder '%s'", name);
phs = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder struct */
if (phs->sv == &sv_undef) { /* first bind for this placeholder */
phs->ftype = 1; /* our default type VARCHAR2 */
phs->maxlen = maxlen; /* 0 if not inout */
phs->is_inout = is_inout;
if (is_inout) {
phs->sv = SvREFCNT_inc(value); /* point to live var */
++imp_sth->has_inout_params;
/* build array of phs's so we can deal with out vars fast */
if (!imp_sth->out_params_av) {
imp_sth->out_params_av = newAV();
}
av_push(imp_sth->out_params_av, SvREFCNT_inc(*phs_svp));
}
}
/* check later rebinds for any changes */
else if (is_inout || phs->is_inout) {
croak("Can't rebind or change param %s in/out mode after first bind", phs->name);
}
else if (maxlen && maxlen != phs->maxlen) {
croak("Can't change param %s maxlen (%ld->%ld) after first bind",
phs->name, phs->maxlen, maxlen);
}
if (!is_inout) { /* normal bind to take a (new) copy of current value */
if (phs->sv == &sv_undef) /* (first time bind) */
phs->sv = newSV(0);
sv_setsv(phs->sv, value);
}
return _dbd_rebind_ph(sth, imp_sth, phs);
}
/* end of dbdimp.c */
DBD-Pg-0.73/dbdimp.h 100644 620 144 4160 6535145703 12522 0 ustar mergl users /*---------------------------------------------------------
*
* $Id: dbdimp.h,v 1.11 1998/02/19 20:28:54 mergl Exp $
*
* Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
* Portions Copyright (c) 1997,1998 Edmund Mergl
*
*---------------------------------------------------------
*/
/* Define drh implementor data structure */
struct imp_drh_st {
dbih_drc_t com; /* MUST be first element in structure */
};
/* Define dbh implementor data structure */
struct imp_dbh_st {
dbih_dbc_t com; /* MUST be first element in structure */
PGconn * conn; /* connection structure */
int init_auto; /* initialize AutoCommit */
};
/* Define sth implementor data structure */
struct imp_sth_st {
dbih_stc_t com; /* MUST be first element in structure */
PGresult* result; /* result structure */
int cur_tuple; /* current tuple */
int rows; /* number of affected rows */
/* Input Details */
char *statement; /* sql (see sth_scan) */
HV *all_params_hv; /* all params, keyed by name */
AV *out_params_av; /* quick access to inout params */
int dbd_pad_empty; /* convert ""->" " when binding */
int all_params_len; /* length-sum of all params */
/* (In/)Out Parameter Details */
bool has_inout_params;
/* needed by conversion of datatype bool */
char *is_bool;
};
#define sword signed int
#define sb2 signed short
#define ub2 unsigned short
typedef struct phs_st phs_t; /* scalar placeholder */
struct phs_st { /* scalar placeholder EXPERIMENTAL */
sword ftype; /* external OCI field type */
SV *sv; /* the scalar holding the value */
int sv_type; /* original sv type at time of bind */
bool is_inout;
IV maxlen; /* max possible len (=allocated buffer) */
/* these will become an array */
sb2 indp; /* null indicator */
char *progv;
ub2 arcode;
ub2 alen; /* effective length ( <= maxlen ) */
int alen_incnull; /* 0 or 1 if alen should include null */
char name[1]; /* struct is malloc'd bigger as needed */
};
/* end of dbdimp.h */
DBD-Pg-0.73/test.pl 100755 620 144 14120 6535145703 12446 0 ustar mergl users #!/usr/local/bin/perl
#---------------------------------------------------------
#
# $Id: test.pl,v 1.14 1998/03/03 21:04:53 mergl Exp $
#
# Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
# Portions Copyright (c) 1997,1998 Edmund Mergl
#
#---------------------------------------------------------
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
BEGIN { $| = 1; print "1..26\n"; }
END {print "not ok 1\n" unless $loaded;}
use DBI;
$loaded = 1;
print "ok 1\n";
$| = 1;
######################### End of black magic.
# supply userid and password below, if access to
# your databases is protected in pgsql/data/pg_hba.conf.
$dbmain = 'template1';
$dbname = 'pgperltest';
$dbuser = '';
$dbpass = '';
#DBI->trace(2); # make your choice
######################### create test database
$dbh = DBI->connect("dbi:Pg:dbname=$dbmain", $dbuser, $dbpass, {PrintError => 0}) or die $DBI::errstr;
$dbh->do("DROP DATABASE $dbname");
$dbh->do("CREATE DATABASE $dbname");
$dbh->disconnect;
######################### create, insert, update, delete, drop
# connect to database and create table
( $dbh = DBI->connect("dbi:Pg:dbname=$dbname", $dbuser, $dbpass) )
and print "ok 2\n"
or die $DBI::errstr;
( $dbh->do( "CREATE TABLE builtin (
bool_ bool,
char_ char,
char16_ char16,
char12_ char(12),
varchar12_ varchar(12),
text_ text,
date_ date,
int4_ int4,
int4a_ int4[],
float8_ float8,
point_ point,
lseg_ lseg,
box_ box
)" ) )
and print "ok 3\n"
or die $DBI::errstr;
# insert into table with $dbh->do(), and then using placeholders
( 1 == $dbh->do( "INSERT INTO builtin VALUES(
't',
'a',
'Edmund Mergl',
'Edmund Mergl',
'Edmund Mergl',
'Edmund Mergl',
'08-03-1997',
1234,
'{1,2,3}',
1.234,
'(1.0,2.0)',
'((1.0,2.0),(3.0,4.0))',
'((1.0,2.0),(3.0,4.0))'
)" ) )
and print "ok 4\n"
or die $DBI::errstr;
( $sth = $dbh->prepare( "INSERT INTO builtin
( bool_, char_, char16_, char12_, varchar12_, text_, date_, int4_, int4a_, float8_, point_, lseg_, box_ )
VALUES ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )
" ) )
and print "ok 5\n"
or die $DBI::errstr;
( $sth->execute (
'f',
'b',
'Halli Hallo',
'Halli Hallo',
'Halli Hallo',
'Halli Hallo',
'06-01-1995',
5678,
'{5,6,7}',
5.678,
'(4.0,5.0)',
'((4.0,5.0),(6.0,7.0))',
'((4.0,5.0),(6.0,7.0))'
) )
and print "ok 6\n"
or die $DBI::errstr;
( $sth->execute (
'f',
'c',
'Potz Blitz',
'Potz Blitz',
'Potz Blitz',
'Potz Blitz',
'05-10-1957',
1357,
'{1,3,5}',
1.357,
'(2.0,7.0)',
'((2.0,7.0),(8.0,3.0))',
'((2.0,7.0),(8.0,3.0))'
) )
and print "ok 7\n"
or die $DBI::errstr;
# test pgsql-specific stuff
$oid_status = $sth->{'pg_oid_status'};
( $oid_status ne '' )
and print "ok 8\n"
or print "not ok 8: oid_status = >$oid_status<\n";
$cmd_status = $sth->{'pg_cmd_status'};
( $cmd_status =~ /^INSERT/ )
and print "ok 9\n"
or print "not ok 9: cmd_status = >$cmd_status<\n";
( $sth->finish )
and print "ok 10\n"
or die $DBI::errstr;
# select from table using input parameters and test various fetch methods
( $sth = $dbh->prepare( "SELECT * FROM builtin where int4_ < ?" ) )
and print "ok 11\n"
or die $DBI::errstr;
( $sth->bind_param(1, 10000) )
and print "ok 12\n"
or die $DBI::errstr;
( $sth->execute )
and print "ok 13\n"
or die $DBI::errstr;
@row_ary = $sth->fetchrow_array;
( join(" ", @row_ary) eq '1 a Edmund Mergl Edmund Mergl Edmund Mergl Edmund Mergl 08-03-1997 1234 {1,2,3} 1.234 (1,2) [(1,2),(3,4)] (3,4),(1,2)' )
and print "ok 14\n"
or print "not ok 14: row = ", join(" ", @row_ary), "\n";
$ary_ref = $sth->fetchrow_arrayref;
( join(" ", @$ary_ref) eq '0 b Halli Hallo Halli Hallo Halli Hallo Halli Hallo 06-01-1995 5678 {5,6,7} 5.678 (4,5) [(4,5),(6,7)] (6,7),(4,5)' )
and print "ok 15\n"
or print "not ok 15: ary_ref = ", join(" ", @$ary_ref), "\n";
$hash_ref = $sth->fetchrow_hashref;
( join(" ", (($key,$val) = each %$hash_ref)) eq 'char12_ Potz Blitz' )
and print "ok 16\n"
or print "not ok 16: key = $key, val = $val\n";
# test various attributes
@name = @{$sth->{'NAME'}};
( join(" ", @name) eq 'bool_ char_ char16_ char12_ varchar12_ text_ date_ int4_ int4a_ float8_ point_ lseg_ box_' )
and print "ok 17\n"
or print "not ok 17: name = ", join(" ", @name), "\n";
@type = @{$sth->{'TYPE'}};
( join(" ", @type) eq '16 18 20 1042 1043 25 1082 23 1007 701 600 601 603' )
and print "ok 18\n"
or print "not ok 18: type = ", join(" ", @type), "\n";
@size = @{$sth->{'SIZE'}};
( join(" ", @size) eq '1 1 16 -1 -1 -1 4 4 -1 8 16 32 32' )
and print "ok 19\n"
or print "not ok 19: size = ", join(" ", @size), "\n";
print "not " if $sth->rows != 3;
print "ok 20\n";
print "not " if $DBI::rows != 3;
print "ok 21\n";
# test binding of output columns
( $sth->execute )
and print "ok 22\n"
or die $DBI::errstr;
( $sth->bind_columns(undef, \$bool, \$char, \$char16, \$char12, \$vchar12, \$text, \$date, \$int4, \$int4a, \$float8, \$point, \$lseg, \$box) )
and print "ok 23\n"
or die $DBI::errstr;
$sth->fetch;
( "$bool, $char, $char16, $char12, $vchar12, $text, $date, $int4, $int4a, $float8, $point, $lseg, $box" eq
'1, a, Edmund Mergl, Edmund Mergl, Edmund Mergl, Edmund Mergl, 08-03-1997, 1234, {1,2,3}, 1.234, (1,2), [(1,2),(3,4)], (3,4),(1,2)' )
and print "ok 24\n"
or print "not ok 24: $bool, $char, $char16, $text, $date, $int4, $int4a, $float8, $point, $lseg, $box\n";
( $sth->finish )
and print "ok 25\n"
or die $DBI::errstr;
# disconnect
( $dbh->disconnect )
and print "ok 26\n"
or die $DBI::errstr;
######################### disconnect and drop test database
$dbh = DBI->connect("dbi:Pg:dbname=$dbmain", $dbuser, $dbpass) or die $DBI::errstr;
$dbh->do("DROP DATABASE $dbname");
$dbh->disconnect;
print "test sequence finished.\n";
######################### EOF
DBD-Pg-0.73/pg_type/ 40755 620 144 0 6535145703 12463 5 ustar mergl users DBD-Pg-0.73/pg_type/README 100644 620 144 2244 6535145703 13442 0 ustar mergl users #---------------------------------------------------------
#
# $Id: README,v 1.1 1997/09/15 19:14:09 mergl Exp $
#
#---------------------------------------------------------
The pg_type subdirectory contains a utility module to convert the numeric
output of $sth->{'TYPE'} into literal type names. This can be done in two
ways: either using an appropriate select or by looking into the appropriate
include file and providing an array for all types. Because the first method
is quite expensive we choose the second method. The module pg_type.pm
contains only this array and can be used to convert the numeric output from
$sth->{'TYPE'} - which is based on the libpq function PQftype() - into type
names. Because the numeric type OIDs are likely to change with a new version
of PostgreSQL, the script pg_type.pl is provided. It just greps through the
include file and builds pg_type.pm. It should be run whenever a new PostgreSQL
version is installed.
---------------------------------------------------------------------------
Edmund Mergl <E.Mergl@bawue.de> August 15, 1997
---------------------------------------------------------------------------
DBD-Pg-0.73/pg_type/pg_type.pl 100755 620 144 2351 6535145703 14570 0 ustar mergl users #!/usr/local/bin/perl
#---------------------------------------------------------
#
# $Id: pg_type.pl,v 1.1 1997/09/15 19:14:09 mergl Exp $
#
# get all OIDs and names from pgsql/src/include/catalog/pg_type.h
# and write them as array into the module pg_type.pm
#
#---------------------------------------------------------
if (! $ENV{POSTGRES_HOME}) {
foreach(qw(/usr/local/pgsql /usr/pgsql /home/pgsql /opt/pgsql /usr/local/postgres /usr/postgres /home/postgres /opt/postgres)) {
if (-d "$_/src") {
$ENV{POSTGRES_HOME} = $_;
last;
}
}
}
if (! -d "$ENV{POSTGRES_HOME}/src") {
die "Unable to find PostgreSQL\n";
}
$PG_TYPE_H = "$ENV{POSTGRES_HOME}/src/include/catalog/pg_type.h";
open PG_TYPE_H, "<$PG_TYPE_H" || die "can not open $PG_TYPE_H\n";
open PG_TYPE_PM, ">pg_type.pm" || die "can not open pg_type.pm\n";
print PG_TYPE_PM "package DBD::Pg::pg_type;\n\n";
print PG_TYPE_PM "\@pg_type;\n\n";
while (<PG_TYPE_H>) {
if ( /^DATA/ ) {
s/^DATA\(insert\s+OID\s+=\s+//;
s/\(//;
($num, $type, $trash) = split;
next if $type =~ /^pg_/;
print PG_TYPE_PM "\$pg_type[$num] = '$type';\n";
}
}
print PG_TYPE_PM "\n1;\n";
close PG_TYPE_H;
close PG_TYPE_PM;
DBD-Pg-0.73/pg_type/pg_type.pm 100644 620 144 4347 6535145703 14575 0 ustar mergl users package DBD::Pg::pg_type;
@pg_type;
$pg_type[16] = 'bool';
$pg_type[17] = 'bytea';
$pg_type[18] = 'char';
$pg_type[19] = 'name';
$pg_type[20] = 'char16';
$pg_type[21] = 'int2';
$pg_type[22] = 'int28';
$pg_type[23] = 'int4';
$pg_type[24] = 'regproc';
$pg_type[25] = 'text';
$pg_type[26] = 'oid';
$pg_type[27] = 'tid';
$pg_type[28] = 'xid';
$pg_type[29] = 'cid';
$pg_type[30] = 'oid8';
$pg_type[32] = 'SET';
$pg_type[210] = 'smgr';
$pg_type[409] = 'char2';
$pg_type[410] = 'char4';
$pg_type[411] = 'char8';
$pg_type[600] = 'point';
$pg_type[601] = 'lseg';
$pg_type[602] = 'path';
$pg_type[603] = 'box';
$pg_type[604] = 'polygon';
$pg_type[605] = 'filename';
$pg_type[628] = 'line';
$pg_type[629] = '_line';
$pg_type[700] = 'float4';
$pg_type[701] = 'float8';
$pg_type[702] = 'abstime';
$pg_type[703] = 'reltime';
$pg_type[704] = 'tinterval';
$pg_type[705] = 'unknown';
$pg_type[718] = 'circle';
$pg_type[719] = '_circle';
$pg_type[790] = 'money';
$pg_type[791] = '_money';
$pg_type[810] = 'oidint2';
$pg_type[910] = 'oidint4';
$pg_type[911] = 'oidname';
$pg_type[1000] = '_bool';
$pg_type[1001] = '_bytea';
$pg_type[1002] = '_char';
$pg_type[1003] = '_name';
$pg_type[1004] = '_char16';
$pg_type[1005] = '_int2';
$pg_type[1006] = '_int28';
$pg_type[1007] = '_int4';
$pg_type[1008] = '_regproc';
$pg_type[1009] = '_text';
$pg_type[1028] = '_oid';
$pg_type[1010] = '_tid';
$pg_type[1011] = '_xid';
$pg_type[1012] = '_cid';
$pg_type[1013] = '_oid8';
$pg_type[1014] = '_lock';
$pg_type[1015] = '_stub';
$pg_type[1016] = '_ref';
$pg_type[1017] = '_point';
$pg_type[1018] = '_lseg';
$pg_type[1019] = '_path';
$pg_type[1020] = '_box';
$pg_type[1021] = '_float4';
$pg_type[1022] = '_float8';
$pg_type[1023] = '_abstime';
$pg_type[1024] = '_reltime';
$pg_type[1025] = '_tinterval';
$pg_type[1026] = '_filename';
$pg_type[1027] = '_polygon';
$pg_type[1033] = 'aclitem';
$pg_type[1034] = '_aclitem';
$pg_type[1039] = '_char2';
$pg_type[1040] = '_char4';
$pg_type[1041] = '_char8';
$pg_type[1042] = 'bpchar';
$pg_type[1043] = 'varchar';
$pg_type[1082] = 'date';
$pg_type[1083] = 'time';
$pg_type[1182] = '_date';
$pg_type[1183] = '_time';
$pg_type[1184] = 'datetime';
$pg_type[1185] = '_datetime';
$pg_type[1186] = 'timespan';
$pg_type[1187] = '_timespan';
$pg_type[1296] = 'timestamp';
1;
DBD-Pg-0.73/pg_type/test.pl 100755 620 144 2737 6535145703 14110 0 ustar mergl users #!/usr/local/bin/perl
#---------------------------------------------------------
#
# $Id: test.pl,v 1.5 1998/03/03 21:05:02 mergl Exp $
#
#---------------------------------------------------------
use DBI;
use pg_type;
$dbmain = 'template1';
$dbname = 'pgperltest';
$dbuser = '';
$dbpass = '';
my $dbh = DBI->connect("dbi:Pg:dbname=$dbmain", $dbuser, $dbpass);
$dbh->do( "CREATE DATABASE $dbname" );
$dbh->disconnect;
$dbh = DBI->connect("dbi:Pg:dbname=$dbname", $dbuser, $dbpass);
$dbh->do( "CREATE TABLE builtin(
bool_ bool,
char_ char,
char16_ char16,
text_ text,
date_ date,
int4_ int4,
int4a_ int[],
float8_ float8,
point_ point,
lseg_ lseg,
box_ box
)" );
$dbh->do( "INSERT INTO builtin VALUES(
't',
'a',
'Edmund Mergl',
'Edmund Mergl',
'08-03-1997',
1234,
'{1,2,3}',
1.234,
'(1.0,2.0)',
'((1.0,2.0),(3.0,4.0))',
'((1.0,2.0),(3.0,4.0))'
)" );
$sth = $dbh->prepare( "SELECT * FROM builtin" );
$sth->execute;
print "NAME:\n";
@name = @{$sth->{'NAME'}};
foreach $key (@name) {
print "$key ";
}
print "\n";
#################################################
print "TYPE:\n";
@type = @{$sth->{'TYPE'}};
foreach $key (@type) {
print "$DBD::Pg::pg_type::pg_type[$key] ";
}
print "\n";
#################################################
$sth->finish;
$dbh->disconnect;
$dbh = DBI->connect("dbi:Pg:dbname=$dbmain", $dbuser, $dbpass);
$dbh->do( "DROP DATABASE $dbname" );
$dbh->disconnect;
# end of test.pl
