/* $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 */