diff --git a/src/interfaces/libpgtcl/pgtcl.c b/src/interfaces/libpgtcl/pgtcl.c
index e7e37ce46b4f271bbe1b5b269a914fd674cae34a..a7e3d852d4191ee3c2abcb0efa94d06550212c73 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 fb0341b857d536d7a9724f749b44f60c72b9c4c6..9ac6c8a78d72505d59e05ea0abdd76866cfc7479 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 76fff887aa863c0fa273806dfd596de4a9263242..e5183838d3cab42d4a4795ca7f101330483e16b4 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(