From 579f8f09faee5b30f5c8e0b98c5c8e43719769a3 Mon Sep 17 00:00:00 2001 From: Jan Wieck Date: Mon, 27 Nov 2000 13:29:32 +0000 Subject: [PATCH] Added pg_execute command behaving like spi_exec of PL/Tcl Made pg_lo_read and pg_lo_write binary data safe when libpgtcl is compiled against Tcl version 8.0 or higher. Jan --- src/interfaces/libpgtcl/pgtcl.c | 19 +- src/interfaces/libpgtcl/pgtclCmds.c | 380 +++++++++++++++++++++++++++- src/interfaces/libpgtcl/pgtclCmds.h | 22 +- 3 files changed, 418 insertions(+), 3 deletions(-) diff --git a/src/interfaces/libpgtcl/pgtcl.c b/src/interfaces/libpgtcl/pgtcl.c index e7e37ce46b..a7e3d852d4 100644 --- a/src/interfaces/libpgtcl/pgtcl.c +++ b/src/interfaces/libpgtcl/pgtcl.c @@ -10,7 +10,7 @@ * * * IDENTIFICATION - * $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtcl.c,v 1.17 2000/01/26 05:58:43 momjian Exp $ + * $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtcl.c,v 1.18 2000/11/27 13:29:32 wieck Exp $ * *------------------------------------------------------------------------- */ @@ -70,6 +70,11 @@ Pgtcl_Init(Tcl_Interp *interp) Pg_result, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand(interp, + "pg_execute", + Pg_execute, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand(interp, "pg_lo_open", Pg_lo_open, @@ -80,6 +85,17 @@ Pgtcl_Init(Tcl_Interp *interp) Pg_lo_close, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); +#ifdef PGTCL_USE_TCLOBJ + Tcl_CreateObjCommand(interp, + "pg_lo_read", + Pg_lo_read, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, + "pg_lo_write", + Pg_lo_write, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); +#else Tcl_CreateCommand(interp, "pg_lo_read", Pg_lo_read, @@ -89,6 +105,7 @@ Pgtcl_Init(Tcl_Interp *interp) "pg_lo_write", Pg_lo_write, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); +#endif Tcl_CreateCommand(interp, "pg_lo_lseek", diff --git a/src/interfaces/libpgtcl/pgtclCmds.c b/src/interfaces/libpgtcl/pgtclCmds.c index fb0341b857..9ac6c8a78d 100644 --- a/src/interfaces/libpgtcl/pgtclCmds.c +++ b/src/interfaces/libpgtcl/pgtclCmds.c @@ -8,7 +8,7 @@ * * * IDENTIFICATION - * $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtclCmds.c,v 1.49 2000/04/12 17:17:11 momjian Exp $ + * $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtclCmds.c,v 1.50 2000/11/27 13:29:32 wieck Exp $ * *------------------------------------------------------------------------- */ @@ -20,11 +20,19 @@ #include "pgtclId.h" #include "libpq/libpq-fs.h" /* large-object interface */ +/* + * Local function forward declarations + */ +static int execute_put_values(Tcl_Interp *interp, char *array_varname, + PGresult *result, int tupno); + + #ifdef TCL_ARRAYS #define ISOCTAL(c) (((c) >= '0') && ((c) <= '7')) #define DIGIT(c) ((c) - '0') + /* * translate_escape() * @@ -772,6 +780,274 @@ Pg_result_errReturn: } + +/********************************** + * pg_execute + send a query string to the backend connection and process the result + + syntax: + pg_execute ?-array name? ?-oid varname? connection query ?loop_body? + + the return result is the number of tuples processed. If the query + returns tuples (i.e. a SELECT statement), the result is placed into + variables + **********************************/ + +int +Pg_execute(ClientData cData, Tcl_Interp *interp, int argc, char *argv[]) +{ + Pg_ConnectionId *connid; + PGconn *conn; + PGresult *result; + int i; + int tupno; + int ntup; + int loop_rc; + char *oid_varname = NULL; + char *array_varname = NULL; + char buf[64]; + + char *usage = "Wrong # of arguments\n" + "pg_execute ?-array arrayname? ?-oid varname? " + "connection queryString ?loop_body?"; + + /* + * First we parse the options + */ + i = 1; + while (i < argc) + { + if (argv[i][0] != '-') + break; + + if (strcmp(argv[i], "-array") == 0) + { + /* + * The rows should appear in an array vs. to single variables + */ + i++; + if (i == argc) + { + Tcl_SetResult(interp, usage, TCL_VOLATILE); + return TCL_ERROR; + } + array_varname = argv[i++]; + continue; + } + + if (strcmp(argv[i], "-oid") == 0) + { + /* + * We should place PQoidValue() somewhere + */ + i++; + if (i == argc) + { + Tcl_SetResult(interp, usage, TCL_VOLATILE); + return TCL_ERROR; + } + oid_varname = argv[i++]; + continue; + } + + Tcl_AppendResult(interp, "Unknown option '", argv[i], "'", NULL); + return TCL_ERROR; + } + + /* + * Check that after option parsing at least 'connection' and 'query' + * are left + */ + if (argc - i < 2) + { + Tcl_SetResult(interp, usage, TCL_VOLATILE); + return TCL_ERROR; + } + + /* + * Get the connection and make sure no COPY command is pending + */ + conn = PgGetConnectionId(interp, argv[i++], &connid); + if (conn == (PGconn *) NULL) + return TCL_ERROR; + + if (connid->res_copyStatus != RES_COPY_NONE) + { + Tcl_SetResult(interp, "Attempt to query while COPY in progress", TCL_STATIC); + return TCL_ERROR; + } + + /* + * Execute the query + */ + result = PQexec(conn, argv[i++]); + + /* + * Transfer any notify events from libpq to Tcl event queue. + */ + PgNotifyTransferEvents(connid); + + /* + * Check for errors + */ + if (result == NULL) + { + Tcl_SetResult(interp, PQerrorMessage(conn), TCL_VOLATILE); + return TCL_ERROR; + } + + /* + * Set the oid variable to the returned oid of an INSERT statement + * if requested (or an empty string if it wasn't an INSERT) + */ + if (oid_varname != NULL) + { + if (Tcl_SetVar(interp, oid_varname, + PQoidStatus(result), TCL_LEAVE_ERR_MSG) != TCL_OK) + { + PQclear(result); + return TCL_ERROR; + } + } + + /* + * Decide how to go on based on the result status + */ + switch (PQresultStatus(result)) + { + case PGRES_TUPLES_OK: + /* fall through if we have tuples */ + break; + + case PGRES_EMPTY_QUERY: + case PGRES_COMMAND_OK: + case PGRES_COPY_IN: + case PGRES_COPY_OUT: + /* tell the number of affected tuples for non-SELECT queries */ + Tcl_SetResult(interp, PQcmdTuples(result), TCL_VOLATILE); + PQclear(result); + return TCL_OK; + + default: + /* anything else must be an error */ + Tcl_ResetResult(interp); + Tcl_AppendElement(interp, PQresStatus(PQresultStatus(result))); + Tcl_AppendElement(interp, PQresultErrorMessage(result)); + PQclear(result); + return TCL_ERROR; + } + + /* + * We reach here only for queries that returned tuples + */ + if (i == argc) { + /* + * We don't have a loop body. If we have at least one + * result row, we set all the variables to the first one + * and return. + */ + if (PQntuples(result) > 0) + { + if (execute_put_values(interp, array_varname, result, 0) != TCL_OK) + { + PQclear(result); + return TCL_ERROR; + } + } + + sprintf(buf, "%d", PQntuples(result)); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + PQclear(result); + return TCL_OK; + } + + /* + * We have a loop body. For each row in the result set put the + * values into the Tcl variables and execute the body. + */ + ntup = PQntuples(result); + for (tupno = 0; tupno < ntup; tupno++) + { + if (execute_put_values(interp, array_varname, result, tupno) != TCL_OK) + { + PQclear(result); + return TCL_ERROR; + } + + loop_rc = Tcl_Eval(interp, argv[i]); + + /* The returncode of the loop body controls the loop execution */ + if (loop_rc == TCL_OK || loop_rc == TCL_CONTINUE) + /* OK or CONTINUE means start next loop invocation */ + continue; + if (loop_rc == TCL_RETURN) + { + /* RETURN means hand up the given interpreter result */ + PQclear(result); + return TCL_RETURN; + } + if (loop_rc == TCL_BREAK) + /* BREAK means leave the loop */ + break; + + PQclear(result); + return TCL_ERROR; + } + + /* + * At the end of the loop we put the number of rows we + * got into the interpreter result and clear the result set. + */ + sprintf(buf, "%d", ntup); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + PQclear(result); + return TCL_OK; +} + + +/********************************** + * execute_put_values + + Put the values of one tuple into Tcl variables named like the + column names, or into an array indexed by the column names. + **********************************/ +static int +execute_put_values(Tcl_Interp *interp, char *array_varname, + PGresult *result, int tupno) +{ + int i; + int n; + char *fname; + char *value; + + /* + * For each column get the column name and value + * and put it into a Tcl variable (either scalar or + * array item) + */ + n = PQnfields(result); + for (i = 0; i < n; i++) + { + fname = PQfname(result, i); + value = PQgetvalue(result, tupno, i); + + if (array_varname != NULL) + { + if (Tcl_SetVar2(interp, array_varname, fname, value, + TCL_LEAVE_ERR_MSG) == NULL) + return TCL_ERROR; + } + else + { + if (Tcl_SetVar(interp, fname, value, TCL_LEAVE_ERR_MSG) == NULL) + return TCL_ERROR; + } + } + + return TCL_OK; +} + + /********************************** * pg_lo_open open a large object @@ -885,6 +1161,61 @@ Pg_lo_close(ClientData cData, Tcl_Interp *interp, int argc, char *argv[]) bufVar is the name of a variable in which to store the contents of the read **********************/ +#ifdef PGTCL_USE_TCLOBJ +int +Pg_lo_read(ClientData cData, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]) +{ + PGconn *conn; + int fd; + int nbytes = 0; + char *buf; + Tcl_Obj *bufVar; + Tcl_Obj *bufObj; + int len; + int rc = TCL_OK; + + if (objc != 5) + { + Tcl_AppendResult(interp, "Wrong # of arguments\n", + " pg_lo_read conn fd bufVar len", 0); + return TCL_ERROR; + } + + conn = PgGetConnectionId(interp, Tcl_GetStringFromObj(objv[1], NULL), + (Pg_ConnectionId **) NULL); + if (conn == (PGconn *) NULL) + return TCL_ERROR; + + if (Tcl_GetIntFromObj(interp, objv[2], &fd) != TCL_OK) + return TCL_ERROR; + + bufVar = objv[3]; + + if (Tcl_GetIntFromObj(interp, objv[4], &len) != TCL_OK) + return TCL_ERROR; + + if (len <= 0) + { + Tcl_SetObjResult(interp, Tcl_NewIntObj(nbytes)); + return TCL_OK; + } + buf = ckalloc(len + 1); + + nbytes = lo_read(conn, fd, buf, len); + bufObj = Tcl_NewStringObj(buf, nbytes); + + if (Tcl_ObjSetVar2(interp, bufVar, NULL, bufObj, + TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1) == NULL) + rc = TCL_ERROR; + else + Tcl_SetObjResult(interp, Tcl_NewIntObj(nbytes)); + + ckfree(buf); + return rc; + +} +#else int Pg_lo_read(ClientData cData, Tcl_Interp *interp, int argc, char *argv[]) { @@ -927,6 +1258,7 @@ Pg_lo_read(ClientData cData, Tcl_Interp *interp, int argc, char *argv[]) return TCL_OK; } +#endif /*********************************** Pg_lo_write @@ -936,6 +1268,51 @@ Pg_lo_write pg_lo_write conn fd buf len ***********************************/ +#ifdef PGTCL_USE_TCLOBJ +int +Pg_lo_write(ClientData cData, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]) +{ + PGconn *conn; + char *buf; + int fd; + int nbytes = 0; + int len; + + if (objc != 5) + { + Tcl_AppendResult(interp, "Wrong # of arguments\n", + "pg_lo_write conn fd buf len", 0); + return TCL_ERROR; + } + + conn = PgGetConnectionId(interp, Tcl_GetStringFromObj(objv[1], NULL), + (Pg_ConnectionId **) NULL); + if (conn == (PGconn *) NULL) + return TCL_ERROR; + + if (Tcl_GetIntFromObj(interp, objv[2], &fd) != TCL_OK) + return TCL_ERROR; + + buf = Tcl_GetStringFromObj(objv[3], &nbytes); + + if (Tcl_GetIntFromObj(interp, objv[4], &len) != TCL_OK) + return TCL_ERROR; + + if (len > nbytes) + len = nbytes; + + if (len <= 0) + { + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + return TCL_OK; + } + + nbytes = lo_write(conn, fd, buf, len); + Tcl_SetObjResult(interp, Tcl_NewIntObj(nbytes)); + return TCL_OK; +} +#else int Pg_lo_write(ClientData cData, Tcl_Interp *interp, int argc, char *argv[]) { @@ -972,6 +1349,7 @@ Pg_lo_write(ClientData cData, Tcl_Interp *interp, int argc, char *argv[]) sprintf(interp->result, "%d", nbytes); return TCL_OK; } +#endif /*********************************** Pg_lo_lseek diff --git a/src/interfaces/libpgtcl/pgtclCmds.h b/src/interfaces/libpgtcl/pgtclCmds.h index 76fff887aa..e5183838d3 100644 --- a/src/interfaces/libpgtcl/pgtclCmds.h +++ b/src/interfaces/libpgtcl/pgtclCmds.h @@ -6,7 +6,7 @@ * Portions Copyright (c) 1996-2000, PostgreSQL, Inc * Portions Copyright (c) 1994, Regents of the University of California * - * $Id: pgtclCmds.h,v 1.18 2000/05/29 21:25:03 momjian Exp $ + * $Id: pgtclCmds.h,v 1.19 2000/11/27 13:29:32 wieck Exp $ * *------------------------------------------------------------------------- */ @@ -20,6 +20,15 @@ #define RES_HARD_MAX 128 #define RES_START 16 +/* + * From Tcl verion 8.0 on we can make large object access binary. + */ +#ifdef TCL_MAJOR_VERSION +# if (TCL_MAJOR_VERSION >= 8) +# define PGTCL_USE_TCLOBJ +# endif +#endif + /* * Each Pg_ConnectionId has a list of Pg_TclNotifies structs, one for each * Tcl interpreter that has executed any pg_listens on the connection. @@ -75,6 +84,8 @@ extern int Pg_disconnect( ClientData cData, Tcl_Interp *interp, int argc, char *argv[]); extern int Pg_exec( ClientData cData, Tcl_Interp *interp, int argc, char *argv[]); +extern int Pg_execute( + ClientData cData, Tcl_Interp *interp, int argc, char *argv[]); extern int Pg_select( ClientData cData, Tcl_Interp *interp, int argc, char *argv[]); extern int Pg_result( @@ -83,10 +94,19 @@ extern int Pg_lo_open( ClientData cData, Tcl_Interp *interp, int argc, char *argv[]); extern int Pg_lo_close( ClientData cData, Tcl_Interp *interp, int argc, char *argv[]); +#ifdef PGTCL_USE_TCLOBJ +extern int Pg_lo_read( + ClientData cData, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +extern int Pg_lo_write( + ClientData cData, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +#else extern int Pg_lo_read( ClientData cData, Tcl_Interp *interp, int argc, char *argv[]); extern int Pg_lo_write( ClientData cData, Tcl_Interp *interp, int argc, char *argv[]); +#endif extern int Pg_lo_lseek( ClientData cData, Tcl_Interp *interp, int argc, char *argv[]); extern int Pg_lo_creat( -- GitLab