summaryrefslogtreecommitdiff
path: root/install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.c
diff options
context:
space:
mode:
Diffstat (limited to 'install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.c')
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.c2024
1 files changed, 0 insertions, 2024 deletions
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.c b/install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.c
deleted file mode 100644
index 55f4ee7..0000000
--- a/install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.c
+++ /dev/null
@@ -1,2024 +0,0 @@
-/*
- $Id: dbdimp.c,v 1.1 2004-04-29 09:21:28 ivan Exp $
-
- Copyright (c) 1997,1998,1999,2000 Edmund Mergl
- Copyright (c) 2002 Jeffrey W. Baker
- Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
-
- You may distribute under the terms of either the GNU General Public
- License or the Artistic License, as specified in the Perl README file.
-
-*/
-
-
-/*
- hard-coded OIDs: (here we need the postgresql types)
- pg_sql_type() 1042 (bpchar), 1043 (varchar)
- ddb_st_fetch() 1042 (bpchar), 16 (bool)
- ddb_preparse() 1043 (varchar)
- pgtype_bind_ok()
-*/
-
-#include "Pg.h"
-
-/* XXX DBI should provide a better version of this */
-#define IS_DBI_HANDLE(h) (SvROK(h) && SvTYPE(SvRV(h)) == SVt_PVHV && SvRMAGICAL(SvRV(h)) && (SvMAGIC(SvRV(h)))->mg_type == 'P')
-
-DBISTATE_DECLARE;
-
-/* hard-coded array delimiter */
-static char* array_delimiter = ",";
-
-static void dbd_preparse (imp_sth_t *imp_sth, char *statement);
-
-
-void
-dbd_init (dbistate)
- dbistate_t *dbistate;
-{
- DBIS = dbistate;
-}
-
-
-int
-dbd_discon_all (drh, imp_drh)
- SV *drh;
- imp_drh_t *imp_drh;
-{
- dTHR;
-
- if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_discon_all\n"); }
-
- /* The disconnect_all concept is flawed and needs more work */
- if (!dirty && !SvTRUE(perl_get_sv("DBI::PERL_ENDING",0))) {
- sv_setiv(DBIc_ERR(imp_drh), (IV)1);
- sv_setpv(DBIc_ERRSTR(imp_drh),
- (char*)"disconnect_all not implemented");
- DBIh_EVENT2(drh, ERROR_event,
- DBIc_ERR(imp_drh), DBIc_ERRSTR(imp_drh));
- return FALSE;
- }
- if (perl_destruct_level) {
- perl_destruct_level = 0;
- }
- return FALSE;
-}
-
-
-/* Database specific error handling. */
-
-void
-pg_error (h, error_num, error_msg)
- SV *h;
- int error_num;
- char *error_msg;
-{
- D_imp_xxh(h);
- char *err, *src, *dst;
- int len = strlen(error_msg);
-
- err = (char *)malloc(len + 1);
- if (!err) {
- return;
- }
- src = error_msg;
- dst = err;
-
- /* copy error message without trailing newlines */
- while (*src != '\0' && *src != '\n') {
- *dst++ = *src++;
- }
- *dst = '\0';
-
- sv_setiv(DBIc_ERR(imp_xxh), (IV)error_num); /* set err early */
- sv_setpv(DBIc_ERRSTR(imp_xxh), (char*)err);
- DBIh_EVENT2(h, ERROR_event, DBIc_ERR(imp_xxh), DBIc_ERRSTR(imp_xxh));
- if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "%s error %d recorded: %s\n", err, error_num, SvPV(DBIc_ERRSTR(imp_xxh),na)); }
- free(err);
-}
-
-static int
-pgtype_bind_ok (dbtype)
- int dbtype;
-{
- /* basically we support types that can be returned as strings */
- switch(dbtype) {
- case 16: /* bool */
- case 17: /* bytea */
- case 18: /* char */
- case 20: /* int8 */
- case 21: /* int2 */
- case 23: /* int4 */
- case 25: /* text */
- case 26: /* oid */
- case 700: /* float4 */
- case 701: /* float8 */
- case 702: /* abstime */
- case 703: /* reltime */
- case 704: /* tinterval */
- case 1042: /* bpchar */
- case 1043: /* varchar */
- case 1082: /* date */
- case 1083: /* time */
- case 1184: /* datetime */
- case 1186: /* timespan */
- case 1296: /* timestamp */
- return 1;
- }
- return 0;
-}
-
-
-/* ================================================================== */
-
-int
-pg_db_login (dbh, imp_dbh, dbname, uid, pwd)
- SV *dbh;
- imp_dbh_t *imp_dbh;
- char *dbname;
- char *uid;
- char *pwd;
-{
- dTHR;
-
- char *conn_str;
- char *src;
- char *dest;
-
- if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "pg_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 password=pwd' */
-
- conn_str = (char *)malloc(strlen(dbname) + strlen(uid) + strlen(pwd) + 16 + 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, " password=");
- strcat(conn_str, pwd);
- }
-
- if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "pg_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) {
- pg_error(dbh, PQstatus(imp_dbh->conn), PQerrorMessage(imp_dbh->conn));
- PQfinish(imp_dbh->conn);
- return 0;
- }
-
- imp_dbh->init_commit = 1; /* initialize AutoCommit */
- imp_dbh->pg_auto_escape = 1; /* initialize pg_auto_escape */
- imp_dbh->pg_bool_tf = 0; /* initialize pg_bool_tf */
-
- DBIc_IMPSET_on(imp_dbh); /* imp_dbh set up now */
- DBIc_ACTIVE_on(imp_dbh); /* call disconnect before freeing */
- return 1;
-}
-
-
-int
-dbd_db_getfd (dbh, imp_dbh)
- SV *dbh;
- imp_dbh_t *imp_dbh;
-{
- char id;
- SV* retsv;
-
- if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_getfd\n"); }
-
- return PQsocket(imp_dbh->conn);
-}
-
-SV *
-dbd_db_pg_notifies (dbh, imp_dbh)
- SV *dbh;
- imp_dbh_t *imp_dbh;
-{
- char id;
- PGnotify* notify;
- AV* ret;
- SV* retsv;
-
- if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_pg_notifies\n"); }
-
- PQconsumeInput(imp_dbh->conn);
-
- notify = PQnotifies(imp_dbh->conn);
-
- if (!notify) return &sv_undef;
-
- ret=newAV();
-
- av_push(ret, newSVpv(notify->relname,0) );
- av_push(ret, newSViv(notify->be_pid) );
-
- /* Should free notify memory with PQfreemem() */
-
- retsv = newRV(sv_2mortal((SV*)ret));
-
- return retsv;
-}
-
-int
-dbd_db_ping (dbh)
- SV *dbh;
-{
- char id;
- D_imp_dbh(dbh);
- PGresult* result;
- ExecStatusType status;
-
- if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_ping\n"); }
-
- if (NULL != imp_dbh->conn) {
- result = PQexec(imp_dbh->conn, " ");
- status = result ? PQresultStatus(result) : -1;
- PQclear(result);
-
- if (PGRES_EMPTY_QUERY != status) {
- return 0;
- }
-
- return 1;
- }
-
- return 0;
-}
-
-
-int
-dbd_db_commit (dbh, imp_dbh)
- SV *dbh;
- imp_dbh_t *imp_dbh;
-{
- if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_commit\n"); }
-
- /* no commit if AutoCommit = on */
- if (DBIc_has(imp_dbh, DBIcf_AutoCommit) != FALSE) {
- return 0;
- }
-
- if (NULL != imp_dbh->conn) {
- PGresult* result = 0;
- ExecStatusType commitstatus, beginstatus;
-
- /* execute commit */
- result = PQexec(imp_dbh->conn, "commit");
- commitstatus = result ? PQresultStatus(result) : -1;
- PQclear(result);
-
- /* check result */
- if (commitstatus != PGRES_COMMAND_OK) {
- /* Only put the error message in DBH->errstr */
- pg_error(dbh, commitstatus, PQerrorMessage(imp_dbh->conn));
- }
-
- /* start new transaction. AutoCommit must be FALSE, ref. 20 lines up */
- result = PQexec(imp_dbh->conn, "begin");
- beginstatus = result ? PQresultStatus(result) : -1;
- PQclear(result);
- if (beginstatus != PGRES_COMMAND_OK) {
- /* Maybe add some loud barf here? Raising some very high error? */
- pg_error(dbh, beginstatus, "begin failed\n");
- return 0;
- }
-
- /* if the initial COMMIT failed, return 0 now */
- if (commitstatus != PGRES_COMMAND_OK) {
- return 0;
- }
-
- return 1;
- }
-
- return 0;
-}
-
-
-int
-dbd_db_rollback (dbh, imp_dbh)
- SV *dbh;
- imp_dbh_t *imp_dbh;
-{
- if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_rollback\n"); }
-
- /* no rollback if AutoCommit = on */
- if (DBIc_has(imp_dbh, DBIcf_AutoCommit) != FALSE) {
- return 0;
- }
-
- if (NULL != imp_dbh->conn) {
- PGresult* result = 0;
- ExecStatusType status;
-
- /* execute rollback */
- result = PQexec(imp_dbh->conn, "rollback");
- status = result ? PQresultStatus(result) : -1;
- PQclear(result);
-
- /* check result */
- if (status != PGRES_COMMAND_OK) {
- pg_error(dbh, status, "rollback failed\n");
- return 0;
- }
-
- /* start new transaction. AutoCommit must be FALSE, ref. 20 lines up */
- result = PQexec(imp_dbh->conn, "begin");
- status = result ? PQresultStatus(result) : -1;
- PQclear(result);
- if (status != PGRES_COMMAND_OK) {
- pg_error(dbh, status, "begin failed\n");
- return 0;
- }
-
- return 1;
- }
-
- return 0;
-}
-
-
-int
-dbd_db_disconnect (dbh, imp_dbh)
- SV *dbh;
- imp_dbh_t *imp_dbh;
-{
- dTHR;
-
- if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_disconnect\n"); }
-
- /* We assume that disconnect will always work */
- /* since most errors imply already disconnected. */
- DBIc_ACTIVE_off(imp_dbh);
-
- if (NULL != imp_dbh->conn) {
- /* 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) {
- pg_error(dbh, status, "rollback failed\n");
- return 0;
- }
- if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "dbd_db_disconnect: AutoCommit=off -> rollback\n"); }
- }
-
- PQfinish(imp_dbh->conn);
-
- imp_dbh->conn = NULL;
- }
-
- /* 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) { PerlIO_printf(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) { PerlIO_printf(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_commit) {
- /* do nothing, fall through */
- if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "dbd_db_STORE: initialize AutoCommit to on\n"); }
- } else if (oldval == FALSE && newval != FALSE) {
- if (NULL != imp_dbh->conn) {
- /* 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) {
- pg_error(dbh, status, "commit failed\n");
- return 0;
- }
- }
- if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "dbd_db_STORE: switch AutoCommit to on: commit\n"); }
- } else if ((oldval != FALSE && newval == FALSE) || (oldval == FALSE && newval == FALSE && imp_dbh->init_commit)) {
- if (NULL != imp_dbh->conn) {
- /* 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) {
- pg_error(dbh, status, "begin failed\n");
- return 0;
- }
- }
- if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "dbd_db_STORE: switch AutoCommit to off: begin\n"); }
- }
- /* only needed once */
- imp_dbh->init_commit = 0;
- return 1;
- } else if (kl==14 && strEQ(key, "pg_auto_escape")) {
- imp_dbh->pg_auto_escape = newval;
- } else if (kl==10 && strEQ(key, "pg_bool_tf")) {
- imp_dbh->pg_bool_tf = newval;
-#ifdef SvUTF8_off
- } else if (kl==14 && strEQ(key, "pg_enable_utf8")) {
- imp_dbh->pg_enable_utf8 = newval;
-#endif
- } 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) { PerlIO_printf(DBILOGFP, "dbd_db_FETCH\n"); }
-
- if (kl==10 && strEQ(key, "AutoCommit")) {
- retsv = boolSV(DBIc_has(imp_dbh, DBIcf_AutoCommit));
- } else if (kl==14 && strEQ(key, "pg_auto_escape")) {
- retsv = newSViv((IV)imp_dbh->pg_auto_escape);
- } else if (kl==10 && strEQ(key, "pg_bool_tf")) {
- retsv = newSViv((IV)imp_dbh->pg_bool_tf);
-#ifdef SvUTF8_off
- } else if (kl==14 && strEQ(key, "pg_enable_utf8")) {
- retsv = newSViv((IV)imp_dbh->pg_enable_utf8);
-#endif
- } else if (kl==11 && strEQ(key, "pg_INV_READ")) {
- retsv = newSViv((IV)INV_READ);
- } else if (kl==12 && strEQ(key, "pg_INV_WRITE")) {
- retsv = newSViv((IV)INV_WRITE);
- }
-
- if (!retsv) {
- return Nullsv;
- }
- if (retsv == &sv_yes || retsv == &sv_no) {
- return retsv; /* no need to mortalize yes or no */
- }
- return sv_2mortal(retsv);
-}
-
-
-/* driver specific functins */
-
-
-int
-pg_db_lo_open (dbh, lobjId, mode)
- SV *dbh;
- unsigned int lobjId;
- int mode;
-{
- D_imp_dbh(dbh);
- return lo_open(imp_dbh->conn, lobjId, mode);
-}
-
-
-int
-pg_db_lo_close (dbh, fd)
- SV *dbh;
- int fd;
-{
- D_imp_dbh(dbh);
- return lo_close(imp_dbh->conn, fd);
-}
-
-
-int
-pg_db_lo_read (dbh, fd, buf, len)
- SV *dbh;
- int fd;
- char *buf;
- int len;
-{
- D_imp_dbh(dbh);
- return lo_read(imp_dbh->conn, fd, buf, len);
-}
-
-
-int
-pg_db_lo_write (dbh, fd, buf, len)
- SV *dbh;
- int fd;
- char *buf;
- int len;
-{
- D_imp_dbh(dbh);
- return lo_write(imp_dbh->conn, fd, buf, len);
-}
-
-
-int
-pg_db_lo_lseek (dbh, fd, offset, whence)
- SV *dbh;
- int fd;
- int offset;
- int whence;
-{
- D_imp_dbh(dbh);
- return lo_lseek(imp_dbh->conn, fd, offset, whence);
-}
-
-
-unsigned int
-pg_db_lo_creat (dbh, mode)
- SV *dbh;
- int mode;
-{
- D_imp_dbh(dbh);
- return lo_creat(imp_dbh->conn, mode);
-}
-
-
-int
-pg_db_lo_tell (dbh, fd)
- SV *dbh;
- int fd;
-{
- D_imp_dbh(dbh);
- return lo_tell(imp_dbh->conn, fd);
-}
-
-
-int
-pg_db_lo_unlink (dbh, lobjId)
- SV *dbh;
- unsigned int lobjId;
-{
- D_imp_dbh(dbh);
- return lo_unlink(imp_dbh->conn, lobjId);
-}
-
-
-unsigned int
-pg_db_lo_import (dbh, filename)
- SV *dbh;
- char *filename;
-{
- D_imp_dbh(dbh);
- return lo_import(imp_dbh->conn, filename);
-}
-
-
-int
-pg_db_lo_export (dbh, lobjId, filename)
- SV *dbh;
- unsigned int lobjId;
- char *filename;
-{
- D_imp_dbh(dbh);
- return lo_export(imp_dbh->conn, lobjId, filename);
-}
-
-
-int
-pg_db_putline (dbh, buffer)
- SV *dbh;
- char *buffer;
-{
- D_imp_dbh(dbh);
- return PQputline(imp_dbh->conn, buffer);
-}
-
-
-int
-pg_db_getline (dbh, buffer, length)
- SV *dbh;
- char *buffer;
- int length;
-{
- D_imp_dbh(dbh);
- return PQgetline(imp_dbh->conn, buffer, length);
-}
-
-
-int
-pg_db_endcopy (dbh)
- SV *dbh;
-{
- D_imp_dbh(dbh);
- return PQendcopy(imp_dbh->conn);
-}
-
-
-/* ================================================================== */
-
-
-int
-dbd_st_prepare (sth, imp_sth, statement, attribs)
- SV *sth;
- imp_sth_t *imp_sth;
- char *statement;
- SV *attribs;
-{
- if (dbis->debug >= 1) { PerlIO_printf(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 in_comment = '\0';
- char *src, *start, *dest;
- phs_t phs_tpl;
- SV *phs_sv;
- int idx=0;
- char *style="", *laststyle=Nullch;
- STRLEN namelen;
-
- if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_preparse: statement = >%s<\n", statement); }
-
- /* allocate room for copy of statement with spare capacity */
- /* for editing '?' or ':1' into ':p1'. */
- /* */
- /* Note: the calculated length used here for the safemalloc */
- /* isn't related in any way to the actual worst case length */
- /* of the translated statement, but allowing for 3 times */
- /* the length of the original statement should be safe... */
- imp_sth->statement = (char*)safemalloc(strlen(statement) * 3 + 1);
-
- /* initialise phs ready to be cloned per placeholder */
- memset(&phs_tpl, 0, sizeof(phs_tpl));
- phs_tpl.ftype = 1043; /* VARCHAR */
-
- src = statement;
- dest = imp_sth->statement;
- while(*src) {
-
- if (in_comment) {
- /* SQL-style and C++-style */
- if ((in_comment == '-' || in_comment == '/') && *src == '\n') {
- in_comment = '\0';
- }
- /* C-style */
- else if (in_comment == '*' && *src == '*' && *(src+1) == '/') {
- *dest++ = *src++; /* avoids asterisk-slash-asterisk issues */
- in_comment = '\0';
- }
- *dest++ = *src++;
- continue;
- }
-
- if (in_literal) {
- /* check if literal ends but keep quotes in literal */
- if (*src == in_literal) {
- int bs=0;
- char *str;
- str = src-1;
- while (*(str-bs) == '\\')
- bs++;
- if (!(bs & 1))
- in_literal = 0;
- }
- *dest++ = *src++;
- continue;
- }
-
- /* Look for comments: SQL-style or C++-style or C-style */
- if ((*src == '-' && *(src+1) == '-') ||
- (*src == '/' && *(src+1) == '/') ||
- (*src == '/' && *(src+1) == '*'))
- {
- in_comment = *(src+1);
- /* We know *src & the next char are to be copied, so do */
- /* it. In the case of C-style comments, it happens to */
- /* help us avoid slash-asterisk-slash oddities. */
- *dest++ = *src++;
- *dest++ = *src++;
- continue;
- }
-
- /* check if no placeholders */
- if (*src != ':' && *src != '?') {
- if (*src == '\'' || *src == '"') {
- in_literal = *src;
- }
- *dest++ = *src++;
- continue;
- }
-
- /* check for cast operator */
- if (*src == ':' && (*(src-1) == ':' || *(src+1) == ':')) {
- *dest++ = *src++;
- continue;
- }
-
- /* only here for : or ? outside of a comment or literal and no cast */
-
- 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 = "?";
-
- } else if (isDIGIT(*src)) { /* ':1' */
- idx = atoi(src);
- *dest++ = 'p'; /* ':1'->':p1' */
- if (idx <= 0) {
- croak("Placeholder :%d invalid, placeholders must be >= 1", idx);
- }
- while(isDIGIT(*src)) {
- *dest++ = *src++;
- }
- style = ":1";
-
- } else if (isALNUM(*src)) { /* ':foo' */
- while(isALNUM(*src)) { /* includes '_' */
- *dest++ = *src++;
- }
- style = ":foo";
- } else { /* perhaps ':=' PL/SQL construct */
- continue;
- }
- *dest = '\0'; /* handy for debugging */
- namelen = (dest-start);
- if (laststyle && style != laststyle) {
- croak("Can't mix placeholder styles (%s/%s)",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);
- }
- *dest = '\0';
- if (imp_sth->all_params_hv) {
- DBIc_NUM_PARAMS(imp_sth) = (int)HvKEYS(imp_sth->all_params_hv);
- if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, " dbd_preparse scanned %d distinct placeholders\n", (int)DBIc_NUM_PARAMS(imp_sth)); }
- }
-}
-
-
-/* if it LOOKS like a string, this function will determine whether the type needs to be surrounded in single quotes */
-static int pg_sql_needquote (sql_type)
- int sql_type;
-{
- if (sql_type > 1000 || sql_type == 17 || sql_type == 25 ) {
- return 1;
- }
- return 0;
-}
-
-
-
-static int
-pg_sql_type (imp_sth, name, sql_type)
- imp_sth_t *imp_sth;
- char *name;
- int sql_type;
-{
- switch (sql_type) {
- case SQL_CHAR:
- return 1042; /* bpchar */
- case SQL_NUMERIC:
- return 700; /* float4 */
- case SQL_DECIMAL:
- return 700; /* float4 */
- case SQL_INTEGER:
- return 23; /* int4 */
- case SQL_SMALLINT:
- return 21; /* int2 */
- case SQL_FLOAT:
- return 700; /* float4 */
- case SQL_REAL:
- return 701; /* float8 */
- case SQL_DOUBLE:
- return 20; /* int8 */
- case SQL_VARCHAR:
- return 1043; /* varchar */
- case SQL_BINARY:
- return 17; /* bytea */
- default:
- if (DBIc_WARN(imp_sth) && imp_sth && name) {
- warn("SQL type %d for '%s' is not fully supported, bound as VARCHAR instead",
- sql_type, name);
- }
- return pg_sql_type(imp_sth, name, SQL_VARCHAR);
- }
-}
-
-static int
-sql_pg_type (imp_sth, name, sql_type)
- imp_sth_t *imp_sth;
- char *name;
- int sql_type;
-{
- if (dbis->debug >= 1) {
- PerlIO_printf(DBILOGFP, "sql_pg_type name '%s' type '%d'\n", name, sql_type );
- }
-
- switch (sql_type) {
- case 17: /* bytea */
- return SQL_BINARY;
- case 20: /* int8 */
- return SQL_DOUBLE;
- case 21: /* int2 */
- return SQL_SMALLINT;
- case 23: /* int4 */
- return SQL_INTEGER;
- case 700: /* float4 */
- return SQL_NUMERIC;
- case 701: /* float8 */
- return SQL_REAL;
- case 1042: /* bpchar */
- return SQL_CHAR;
- case 1043: /* varchar */
- return SQL_VARCHAR;
- case 1082: /* date */
- return SQL_DATE;
- case 1083: /* time */
- return SQL_TIME;
- case 1296: /* date */
- return SQL_TIMESTAMP;
-
- default:
- return sql_type;
- }
-}
-
-
-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) { PerlIO_printf(DBILOGFP, "dbd_st_rebind\n"); }
-
- /* convert to a string ASAP */
- if (!SvPOK(phs->sv) && SvOK(phs->sv)) {
- sv_2pv(phs->sv, &na);
- }
-
- if (dbis->debug >= 2) {
- char *val = neatsvpv(phs->sv,0);
- PerlIO_printf(DBILOGFP, " bind %s <== %.1000s (", phs->name, val);
- if (SvOK(phs->sv)) {
- PerlIO_printf(DBILOGFP, "size %ld/%ld/%ld, ", (long)SvCUR(phs->sv),(long)SvLEN(phs->sv),phs->maxlen);
- } else {
- PerlIO_printf(DBILOGFP, "NULL, ");
- }
- PerlIO_printf(DBILOGFP, "ptype %d, otype %d%s)\n", (int)SvTYPE(phs->sv), phs->ftype, (phs->is_inout) ? ", inout" : "");
- }
-
- /* 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);
- }
- 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 in case it's an out var */
- phs->progv = SvPVX(phs->sv);
- phs->indp = -1;
- value_len = 0;
- }
- phs->sv_type = SvTYPE(phs->sv); /* part of mutation check */
- phs->maxlen = SvLEN(phs->sv)-1; /* avail buffer space */
- if (phs->maxlen < 0) { /* can happen with nulls */
- phs->maxlen = 0;
- }
-
- phs->alen = value_len + phs->alen_incnull;
-
- imp_sth->all_params_len += SvOK(phs->sv) ? phs->alen : 4; /* NULL */
-
- if (dbis->debug >= 3) {
- PerlIO_printf(DBILOGFP, " bind %s <== '%.*s' (size %ld/%ld, otype %d, indp %d)\n",
- phs->name,
- (int)(phs->alen>SvIV(DBIS->neatsvpvlen) ? SvIV(DBIS->neatsvpvlen) : phs->alen),
- (phs->progv) ? phs->progv : "",
- (long)phs->alen, (long)phs->maxlen, phs->ftype, phs->indp);
- }
-
- return 1;
-}
-
-
-void dereference(value)
-SV** value;
-{
- AV* buf;
- SV* val;
- char *src;
- int is_ref;
- STRLEN len;
-
- if (SvTYPE(SvRV(*value)) != SVt_PVAV)
- croak("Not an array reference (%s)", neatsvpv(*value,0));
-
- buf = (AV *) SvRV(*value);
- sv_setpv(*value, "{");
- while ( SvOK(val = av_shift(buf)) ) {
- is_ref = SvROK(val);
- if (is_ref)
- dereference(&val);
- else
- sv_catpv(*value, "\"");
- /* Quote */
- src = SvPV(val, len);
- while (len--) {
- if (!is_ref && *src == '\"')
- sv_catpv(*value, "\\");
- sv_catpvn(*value, src++, 1);
- }
- /* End of quote */
- if (!is_ref)
- sv_catpv(*value, "\"");
- if (av_len(buf) > -1)
- sv_catpv(*value, array_delimiter);
- }
- sv_catpv(*value, "}");
- av_clear(buf);
-}
-
-int
-dbd_bind_ph (sth, imp_sth, ph_namesv, newvalue, sql_type, attribs, is_inout, maxlen)
- SV *sth;
- imp_sth_t *imp_sth;
- SV *ph_namesv;
- SV *newvalue;
- 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) { PerlIO_printf(DBILOGFP, "dbd_bind_ph\n"); }
-
- /* check if placeholder was passed as a number */
-
- if (SvGMAGICAL(ph_namesv)) { /* eg if from tainted expression */
- mg_get(ph_namesv);
- }
- if (!SvNIOKp(ph_namesv)) {
- name = SvPV(ph_namesv, name_len);
- }
- if (SvNIOKp(ph_namesv) || (name && isDIGIT(name[0]))) {
- sprintf(namebuf, ":p%d", (int)SvIV(ph_namesv));
- name = namebuf;
- name_len = strlen(name);
- }
- assert(name != Nullch);
-
- if (SvTYPE(newvalue) > SVt_PVLV) { /* hook for later array logic */
- croak("Can't bind a non-scalar value (%s)", neatsvpv(newvalue,0));
- }
- if (SvROK(newvalue) && !IS_DBI_HANDLE(newvalue)) {
- /* dbi handle allowed for cursor variables */
- dereference(&newvalue);
- }
- if (SvTYPE(newvalue) == SVt_PVLV && is_inout) { /* may allow later */
- croak("Can't bind ``lvalue'' mode scalar as inout parameter (currently)");
- }
-
- if (dbis->debug >= 2) {
- PerlIO_printf(DBILOGFP, " bind %s <== %s (type %ld", name, neatsvpv(newvalue,0), (long)sql_type);
- if (is_inout) {
- PerlIO_printf(DBILOGFP, ", inout 0x%lx, maxlen %ld", (long)newvalue, (long)maxlen);
- }
- if (attribs) {
- PerlIO_printf(DBILOGFP, ", attribs: %s", neatsvpv(attribs,0));
- }
- PerlIO_printf(DBILOGFP, ")\n");
- }
-
- phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0);
- if (phs_svp == NULL) {
- croak("Can't bind unknown placeholder '%s' (%s)", name, neatsvpv(ph_namesv,0));
- }
- phs = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder struct */
-
- if (phs->sv == &sv_undef) { /* first bind for this placeholder */
- phs->ftype = 1043; /* our default type VARCHAR */
- phs->is_inout = is_inout;
- if (is_inout) {
- /* phs->sv assigned in the code below */
- ++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));
- }
-
- if (attribs) { /* only look for pg_type on first bind of var */
- SV **svp;
- /* Setup / Clear attributes as defined by attribs. */
- /* XXX If attribs is EMPTY then reset attribs to default? */
- if ( (svp = hv_fetch((HV*)SvRV(attribs), "pg_type", 7, 0)) != NULL) {
- int pg_type = SvIV(*svp);
- if (!pgtype_bind_ok(pg_type)) {
- croak("Can't bind %s, pg_type %d not supported by DBD::Pg", phs->name, pg_type);
- }
- if (sql_type) {
- croak("Can't specify both TYPE (%d) and pg_type (%d) for %s", sql_type, pg_type, phs->name);
- }
- phs->ftype = pg_type;
- }
- }
- if (sql_type) {
- /* SQL_BINARY (-2) is deprecated. */
- if (sql_type == -2 && DBIc_WARN(imp_sth)) {
- warn("Use of SQL type SQL_BINARY (%d) is deprecated. Use { pg_type => DBD::Pg::PG_BYTEA } instead.", sql_type);
- }
- phs->ftype = pg_sql_type(imp_sth, phs->name, sql_type);
- }
- } /* was first bind for this placeholder */
-
- /* 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 (%d => %d)", phs->name, phs->is_inout , is_inout);
- }
- else if (sql_type && phs->ftype != pg_sql_type(imp_sth, phs->name, sql_type)) {
- croak("Can't change TYPE of param %s to %d after initial bind", phs->name, sql_type);
- }
-
- phs->maxlen = maxlen; /* 0 if not inout */
-
- 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, newvalue);
- } else if (newvalue != phs->sv) {
- if (phs->sv) {
- SvREFCNT_dec(phs->sv);
- }
- phs->sv = SvREFCNT_inc(newvalue); /* point to live var */
- }
-
- return dbd_rebind_ph(sth, imp_sth, phs);
-}
-
-
-int
-dbd_st_execute (sth, imp_sth) /* <= -2:error, >=0:ok row count, (-1=unknown count) */
- SV *sth;
- imp_sth_t *imp_sth;
-{
- dTHR;
-
- D_imp_dbh_from_sth;
- ExecStatusType status = -1;
- char *cmdStatus;
- char *cmdTuples;
- char *statement;
- int ret = -2;
- int num_fields;
- int i;
- STRLEN len;
- bool in_literal = FALSE;
- char in_comment = '\0';
- char *src;
- char *dest;
- char *val;
- char namebuf[30];
- phs_t *phs;
- SV **svp;
-
- if (dbis->debug >= 1) { PerlIO_printf(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);
- */
-
- if (NULL == imp_dbh->conn) {
- pg_error(sth, -1, "execute on disconnected handle");
- return -2;
- }
-
- statement = imp_sth->statement;
- if (! statement) {
- /* are we prepared ? */
- pg_error(sth, -1, "statement not prepared\n");
- return -2;
- }
-
- /* do we have input parameters ? */
- if ((int)DBIc_NUM_PARAMS(imp_sth) > 0) {
- /*
- we have to allocate some additional memory for possible escaping
- quotes and backslashes:
- max_len = length of statement
- + total length of all params allowing for worst case all
- characters binary-escaped (\\xxx)
- + null terminator
- Note: parameters look like :p1 at this point, so there's no
- need to explicitly allow for surrounding quotes because '' is
- shorter than :p1
- */
- int max_len = strlen(imp_sth->statement) + imp_sth->all_params_len * 5 + 1;
- statement = (char*)safemalloc( max_len );
- dest = statement;
- src = imp_sth->statement;
- /* scan statement for ':p1' style placeholders */
- while(*src) {
-
- if (in_comment) {
- /* SQL-style and C++-style */
- if ((in_comment == '-' || in_comment == '/') && *src == '\n') {
- in_comment = '\0';
- }
- /* C-style */
- else if (in_comment == '*' && *src == '*' && *(src+1) == '/') {
- *dest++ = *src++; /* avoids asterisk-slash-asterisk issues */
- in_comment = '\0';
- }
- *dest++ = *src++;
- continue;
- }
-
- if (in_literal) {
- /* check if literal ends but keep quotes in literal */
- if (*src == in_literal) {
- int bs=0;
- char *str;
- str = src-1;
- while (*(str-bs) == '\\')
- bs++;
- if (!(bs & 1))
- in_literal = 0;
- }
- *dest++ = *src++;
- continue;
- }
-
- /* Look for comments: SQL-style or C++-style or C-style */
- if ((*src == '-' && *(src+1) == '-') ||
- (*src == '/' && *(src+1) == '/') ||
- (*src == '/' && *(src+1) == '*'))
- {
- in_comment = *(src+1);
- /* We know *src & the next char are to be copied, so do */
- /* it. In the case of C-style comments, it happens to */
- /* help us avoid slash-asterisk-slash oddities. */
- *dest++ = *src++;
- *dest++ = *src++;
- continue;
- }
-
- /* check if no placeholders */
- if (*src != ':' && *src != '?') {
- if (*src == '\'' || *src == '"') {
- in_literal = *src;
- }
- *dest++ = *src++;
- continue;
- }
-
- /* check for cast operator */
- if (*src == ':' && (*(src-1) == ':' || *(src+1) == ':')) {
- *dest++ = *src++;
- continue;
- }
-
-
- i = 0;
- namebuf[i++] = *src++; /* ':' */
- namebuf[i++] = *src++; /* 'p' */
-
- while (isDIGIT(*src) && i < (sizeof(namebuf)-1) ) {
- namebuf[i++] = *src++;
- }
- if ( i == (sizeof(namebuf) - 1)) {
- pg_error(sth, -1, "namebuf buffer overrun\n");
- return -2;
- }
- namebuf[i] = '\0';
- svp = hv_fetch(imp_sth->all_params_hv, namebuf, i, 0);
- if (svp == NULL) {
- pg_error(sth, -1, "parameter unknown\n");
- return -2;
- }
- /* get attribute */
- phs = (phs_t*)(void*)SvPVX(*svp);
- /* replace undef with NULL */
- if(!SvOK(phs->sv)) {
- val = "NULL";
- len = 4;
- } else {
- val = SvPV(phs->sv, len);
- }
- /* quote string attribute */
- if(!SvNIOK(phs->sv) && SvOK(phs->sv) && pg_sql_needquote(phs->ftype)) { /* avoid quoting NULL, tpf: bind_param as numeric */
- *dest++ = '\'';
- }
- while (len--) {
- if (imp_dbh->pg_auto_escape) {
- /* if the parameter was bound as PG_BYTEA, escape nonprintables */
- if (phs->ftype == 17 && !isPRINT(*val)) { /* escape null character */
- dest+=snprintf(dest, (statement + max_len) - dest, "\\\\%03o", *((unsigned char *)val));
- if (dest > statement + max_len) {
- pg_error(sth, -1, "statement buffer overrun\n");
- return -2;
- }
- val++;
- continue; /* do not copy the null */
- }
- /* escape quote */
- if (*val == '\'') {
- *dest++ = '\'';
- }
- /* escape backslash */
- if (*val == '\\') {
- if (phs->ftype == 17) { /* four backslashes. really. */
- *dest++ = '\\';
- *dest++ = '\\';
- *dest++ = '\\';
- } else {
- *dest++ = '\\';
- }
- }
- }
- /* copy attribute to statement */
- *dest++ = *val++;
- }
- /* quote string attribute */
- if(!SvNIOK(phs->sv) && SvOK(phs->sv) && pg_sql_needquote(phs->ftype)) { /* avoid quoting NULL, tpf: bind_param as numeric */
- *dest++ = '\'';
- }
- }
- *dest = '\0';
- }
-
- if (dbis->debug >= 2) { PerlIO_printf(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->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 if (PGRES_COPY_OUT == status || PGRES_COPY_IN == status) {
- /* Copy Out/In data transfer in progress */
- ret = -1;
- } else {
- pg_error(sth, status, PQerrorMessage(imp_dbh->conn));
- ret = -2;
- }
-
- /* store the number of affected rows */
- imp_sth->rows = ret;
-
- return ret;
-}
-
-
-int
-is_high_bit_set(val)
- char *val;
-{
- while (*val++)
- if (*val & 0x80) return 1;
- return 0;
-}
-
-AV *
-dbd_st_fetch (sth, imp_sth)
- SV *sth;
- imp_sth_t *imp_sth;
-{
- D_imp_dbh_from_sth;
- int num_fields;
- int i;
- AV *av;
-
- if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_fetch\n"); }
-
- /* Check that execute() was executed sucessfully */
- if ( !DBIc_ACTIVE(imp_sth) ) {
- pg_error(sth, 1, "no statement executing\n");
-
- return Nullav;
- }
-
- if ( imp_sth->cur_tuple == PQntuples(imp_sth->result) ) {
- imp_sth->cur_tuple = 0;
- DBIc_ACTIVE_off(imp_sth);
- 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);
- int val_len = strlen(val);
- int type = PQftype(imp_sth->result, i); /* hopefully these hard coded values will not change */
- if (16 == type && ! imp_dbh->pg_bool_tf) {
- *val = (*val == 'f') ? '0' : '1'; /* bool: translate postgres into perl */
- }
- if (17 == type) { /* decode \001 -> chr(1), etc, in-place */
- char *p = val; /* points to next available pos */
- char *s = val; /* points to current scanning pos */
- int c1,c2,c3;
- while (*s) {
- if (*s == '\\') {
- if (*(s+1) == '\\') { /* double backslash */
- *p++ = '\\';
- s += 2;
- continue;
- }
- else if ( isdigit(c1=(*(s+1))) &&
- isdigit(c2=(*(s+2))) &&
- isdigit(c3=(*(s+3))) ) {
- *p++ = (c1 - '0') * 64 + (c2 - '0') * 8 + (c3 - '0');
- s += 4;
- continue;
- }
- }
- *p++ = *s++;
- }
- val_len = (p - val);
- }
- else if (1042 == type && DBIc_has(imp_sth,DBIcf_ChopBlanks)) {
- char *str = val;
- while((val_len > 0) && (str[val_len-1] == ' ')) {
- val_len--;
- }
- val[val_len] = '\0';
- }
- sv_setpvn(sv, val, val_len);
-#ifdef SvUTF8_off
- if (imp_dbh->pg_enable_utf8) {
- SvUTF8_off(sv);
- /* XXX Is this all the character data types? */
- if (18 == type || 25 == type || 1042 ==type || 1043 == type) {
- if (is_high_bit_set(val) && is_utf8_string(val, val_len))
- SvUTF8_on(sv);
- }
- }
-#endif
- }
- }
-
- imp_sth->cur_tuple += 1;
-
- return av;
-}
-
-
-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;
- int ret, lobj_fd, nbytes, nread;
- PGresult* result;
- ExecStatusType status;
- SV *bufsv;
- char *tmp;
-
- if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_blob_read\n"); }
- /* safety check */
- if (lobjId <= 0) {
- pg_error(sth, -1, "dbd_st_blob_read: lobjId <= 0");
- return 0;
- }
- if (offset < 0) {
- pg_error(sth, -1, "dbd_st_blob_read: offset < 0");
- return 0;
- }
- if (len < 0) {
- pg_error(sth, -1, "dbd_st_blob_read: len < 0");
- return 0;
- }
- if (! SvROK(destrv)) {
- pg_error(sth, -1, "dbd_st_blob_read: destrv not a reference");
- return 0;
- }
- if (destoffset < 0) {
- pg_error(sth, -1, "dbd_st_blob_read: destoffset < 0");
- return 0;
- }
-
- /* dereference destination and ensure it's writable string */
- bufsv = SvRV(destrv);
- if (! destoffset) {
- sv_setpvn(bufsv, "", 0);
- }
-
- /* execute begin
- result = PQexec(imp_dbh->conn, "begin");
- status = result ? PQresultStatus(result) : -1;
- PQclear(result);
- if (status != PGRES_COMMAND_OK) {
- pg_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) {
- pg_error(sth, -1, PQerrorMessage(imp_dbh->conn));
- return 0;
- }
-
- /* seek on large object */
- if (offset > 0) {
- ret = lo_lseek(imp_dbh->conn, lobj_fd, offset, SEEK_SET);
- if (ret < 0) {
- pg_error(sth, -1, PQerrorMessage(imp_dbh->conn));
- return 0;
- }
- }
-
- /* read from large object */
- nread = 0;
- SvGROW(bufsv, destoffset + nread + BUFSIZ + 1);
- tmp = (SvPVX(bufsv)) + destoffset + nread;
- while ((nbytes = lo_read(imp_dbh->conn, lobj_fd, tmp, BUFSIZ)) > 0) {
- nread += nbytes;
- /* break if user wants only a specified chunk */
- if (len > 0 && nread > len) {
- nread = len;
- break;
- }
- SvGROW(bufsv, destoffset + nread + BUFSIZ + 1);
- tmp = (SvPVX(bufsv)) + destoffset + nread;
- }
-
- /* terminate string */
- SvCUR_set(bufsv, destoffset + nread);
- *SvEND(bufsv) = '\0';
-
- /* close large object */
- ret = lo_close(imp_dbh->conn, lobj_fd);
- if (ret < 0) {
- pg_error(sth, -1, PQerrorMessage(imp_dbh->conn));
- return 0;
- }
-
- /* execute end
- result = PQexec(imp_dbh->conn, "end");
- status = result ? PQresultStatus(result) : -1;
- PQclear(result);
- if (status != PGRES_COMMAND_OK) {
- pg_error(sth, status, PQerrorMessage(imp_dbh->conn));
- return 0;
- }
- */
-
- return nread;
-}
-
-
-int
-dbd_st_rows (sth, imp_sth)
- SV *sth;
- imp_sth_t *imp_sth;
-{
- if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_rows\n"); }
-
- return imp_sth->rows;
-}
-
-
-int
-dbd_st_finish (sth, imp_sth)
- SV *sth;
- imp_sth_t *imp_sth;
-{
- dTHR;
-
- if (dbis->debug >= 1) { PerlIO_printf(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) { PerlIO_printf(DBILOGFP, "dbd_st_destroy\n"); }
-
- /* Free off contents of imp_sth */
-
- Safefree(imp_sth->statement);
- 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_STORE_attrib (sth, imp_sth, keysv, valuesv)
- SV *sth;
- imp_sth_t *imp_sth;
- SV *keysv;
- SV *valuesv;
-{
- if (dbis->debug >= 1) { PerlIO_printf(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);
- int i, sz;
- SV *retsv = Nullsv;
-
- if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_FETCH\n"); }
-
- if (! imp_sth->result) {
- return Nullsv;
- }
-
- i = DBIc_NUM_FIELDS(imp_sth);
-
- if (kl == 4 && strEQ(key, "NAME")) {
- AV *av = newAV();
- retsv = newRV(sv_2mortal((SV*)av));
- while(--i >= 0) {
- av_store(av, i, newSVpv(PQfname(imp_sth->result, i),0));
- }
- } else if ( kl== 4 && strEQ(key, "TYPE")) {
- /* Need to convert the Pg type to ANSI/SQL type. */
- AV *av = newAV();
- retsv = newRV(sv_2mortal((SV*)av));
- while(--i >= 0) {
- av_store(av, i, newSViv(sql_pg_type( imp_sth,
- PQfname(imp_sth->result, i),
- PQftype(imp_sth->result, i))));
- }
- } else if (kl==9 && strEQ(key, "PRECISION")) {
- AV *av = newAV();
- retsv = newRV(sv_2mortal((SV*)av));
- while(--i >= 0) {
- sz = PQfsize(imp_sth->result, i);
- av_store(av, i, sz > 0 ? newSViv(sz) : &sv_undef);
- }
- } else if (kl==5 && strEQ(key, "SCALE")) {
- AV *av = newAV();
- retsv = newRV(sv_2mortal((SV*)av));
- while(--i >= 0) {
- av_store(av, i, &sv_undef);
- }
- } else if (kl==8 && strEQ(key, "NULLABLE")) {
- AV *av = newAV();
- retsv = newRV(sv_2mortal((SV*)av));
- while(--i >= 0) {
- av_store(av, i, newSViv(2));
- }
- } else if (kl==10 && strEQ(key, "CursorName")) {
- retsv = &sv_undef;
- } else if (kl==11 && strEQ(key, "RowsInCache")) {
- retsv = &sv_undef;
- } else if (kl==7 && strEQ(key, "pg_size")) {
- AV *av = newAV();
- retsv = newRV(sv_2mortal((SV*)av));
- while(--i >= 0) {
- av_store(av, i, newSViv(PQfsize(imp_sth->result, i)));
- }
- } else if (kl==7 && strEQ(key, "pg_type")) {
- AV *av = newAV();
- char *type_nam;
- retsv = newRV(sv_2mortal((SV*)av));
- while(--i >= 0) {
- switch (PQftype(imp_sth->result, i)) {
- case 16:
- type_nam = "bool";
- break;
- case 17:
- type_nam = "bytea";
- break;
- case 18:
- type_nam = "char";
- break;
- case 19:
- type_nam = "name";
- break;
- case 20:
- type_nam = "int8";
- break;
- case 21:
- type_nam = "int2";
- break;
- case 22:
- type_nam = "int28";
- break;
- case 23:
- type_nam = "int4";
- break;
- case 24:
- type_nam = "regproc";
- break;
- case 25:
- type_nam = "text";
- break;
- case 26:
- type_nam = "oid";
- break;
- case 27:
- type_nam = "tid";
- break;
- case 28:
- type_nam = "xid";
- break;
- case 29:
- type_nam = "cid";
- break;
- case 30:
- type_nam = "oid8";
- break;
- case 32:
- type_nam = "SET";
- break;
- case 210:
- type_nam = "smgr";
- break;
- case 600:
- type_nam = "point";
- break;
- case 601:
- type_nam = "lseg";
- break;
- case 602:
- type_nam = "path";
- break;
- case 603:
- type_nam = "box";
- break;
- case 604:
- type_nam = "polygon";
- break;
- case 605:
- type_nam = "filename";
- break;
- case 628:
- type_nam = "line";
- break;
- case 629:
- type_nam = "_line";
- break;
- case 700:
- type_nam = "float4";
- break;
- case 701:
- type_nam = "float8";
- break;
- case 702:
- type_nam = "abstime";
- break;
- case 703:
- type_nam = "reltime";
- break;
- case 704:
- type_nam = "tinterval";
- break;
- case 705:
- type_nam = "unknown";
- break;
- case 718:
- type_nam = "circle";
- break;
- case 719:
- type_nam = "_circle";
- break;
- case 790:
- type_nam = "money";
- break;
- case 791:
- type_nam = "_money";
- break;
- case 810:
- type_nam = "oidint2";
- break;
- case 910:
- type_nam = "oidint4";
- break;
- case 911:
- type_nam = "oidname";
- break;
- case 1000:
- type_nam = "_bool";
- break;
- case 1001:
- type_nam = "_bytea";
- break;
- case 1002:
- type_nam = "_char";
- break;
- case 1003:
- type_nam = "_name";
- break;
- case 1005:
- type_nam = "_int2";
- break;
- case 1006:
- type_nam = "_int28";
- break;
- case 1007:
- type_nam = "_int4";
- break;
- case 1008:
- type_nam = "_regproc";
- break;
- case 1009:
- type_nam = "_text";
- break;
- case 1028:
- type_nam = "_oid";
- break;
- case 1010:
- type_nam = "_tid";
- break;
- case 1011:
- type_nam = "_xid";
- break;
- case 1012:
- type_nam = "_cid";
- break;
- case 1013:
- type_nam = "_oid8";
- break;
- case 1014:
- type_nam = "_lock";
- break;
- case 1015:
- type_nam = "_stub";
- break;
- case 1016:
- type_nam = "_ref";
- break;
- case 1017:
- type_nam = "_point";
- break;
- case 1018:
- type_nam = "_lseg";
- break;
- case 1019:
- type_nam = "_path";
- break;
- case 1020:
- type_nam = "_box";
- break;
- case 1021:
- type_nam = "_float4";
- break;
- case 1022:
- type_nam = "_float8";
- break;
- case 1023:
- type_nam = "_abstime";
- break;
- case 1024:
- type_nam = "_reltime";
- break;
- case 1025:
- type_nam = "_tinterval";
- break;
- case 1026:
- type_nam = "_filename";
- break;
- case 1027:
- type_nam = "_polygon";
- break;
- case 1033:
- type_nam = "aclitem";
- break;
- case 1034:
- type_nam = "_aclitem";
- break;
- case 1042:
- type_nam = "bpchar";
- break;
- case 1043:
- type_nam = "varchar";
- break;
- case 1082:
- type_nam = "date";
- break;
- case 1083:
- type_nam = "time";
- break;
- case 1182:
- type_nam = "_date";
- break;
- case 1183:
- type_nam = "_time";
- break;
- case 1184:
- type_nam = "datetime";
- break;
- case 1185:
- type_nam = "_datetime";
- break;
- case 1186:
- type_nam = "timespan";
- break;
- case 1187:
- type_nam = "_timespan";
- break;
- case 1231:
- type_nam = "_numeric";
- break;
- case 1296:
- type_nam = "timestamp";
- break;
- case 1700:
- type_nam = "numeric";
- break;
-
- default:
- type_nam = "unknown";
-
- }
- av_store(av, i, newSVpv(type_nam, 0));
- }
- } 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);
-}
-
-
-/* end of dbdimp.c */
generated by cgit v1.1 at 2024-06-23 09:51:42 +0000