Well I haven't received any feedback pro or con re my suggested new Tcl

function so I am going to assume that it is such a good idea that no
one sees any point in discussing it.  :-)  I have made two changes -
I have merged this into pgtclCmds.c and I have taken out any code for
updating tuples after the loop body runs.  See comments for discussion
of this.

I have also fixed up the error checking stuff so that break, continue
and syntax errors have the expected result.

Submitted by: D'Arcy Cain

3 files changed, 122 insertions, 3 deletions

diff --git a/src/interfaces/libpgtcl/pgtcl.c b/src/interfaces/libpgtcl/pgtcl.c
index 449107339fe..f3758cd8fb1 100644
--- a/src/interfaces/libpgtcl/pgtcl.c
+++ b/src/interfaces/libpgtcl/pgtcl.c
@@ -9,7 +9,7 @@
  *
  *
  * IDENTIFICATION
- *    $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtcl.c,v 1.1.1.1 1996/07/09 06:22:16 scrappy Exp $
+ *    $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtcl.c,v 1.2 1996/10/07 21:19:06 scrappy Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -45,6 +45,11 @@ Pg_Init (Tcl_Interp *interp)
 		    (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
   
   Tcl_CreateCommand(interp,
+		    "pg_select",
+		    Pg_select,
+		    (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
+  
+  Tcl_CreateCommand(interp,
 		    "pg_result",
 		    Pg_result,
 		    (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
diff --git a/src/interfaces/libpgtcl/pgtclCmds.c b/src/interfaces/libpgtcl/pgtclCmds.c
index 87b926805e5..029a4329f96 100644
--- a/src/interfaces/libpgtcl/pgtclCmds.c
+++ b/src/interfaces/libpgtcl/pgtclCmds.c
@@ -7,7 +7,7 @@
  *
  *
  * IDENTIFICATION
- *    $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtclCmds.c,v 1.3 1996/09/16 05:54:53 scrappy Exp $
+ *    $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtclCmds.c,v 1.4 1996/10/07 21:19:07 scrappy Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -1031,4 +1031,116 @@ Pg_lo_export(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
     return TCL_OK;
 }
 
+/**********************************
+ * pg_select
+ send a select query string to the backend connection
+ 
+ syntax:
+ pg_select connection query var proc
+
+ The query must be a select statement
+ The var is used in the proc as an array
+ The proc is run once for each row found
+
+ Originally I was also going to update changes but that has turned out
+ to be not so simple.  Instead, the caller should get the OID of any
+ table they want to update and update it themself in the loop.  I may
+ try to write a simplified table lookup and update function to make
+ that task a little easier.
+
+ The return is either TCL_OK, TCL_ERROR or TCL_RETURN and interp->result
+ may contain more information.
+ **********************************/
+
+int
+Pg_select(ClientData cData, Tcl_Interp *interp, int argc, char **argv)
+{
+	PGconn *conn;
+   	PGresult *result;
+    int ch_flag, r;
+    size_t tupno, column, ncols;
+	Tcl_DString headers;
+	struct {
+		char    *cname;
+		char    *data;
+		int     change;
+	} *info;
+
+	if (argc != 5)
+	{
+		Tcl_AppendResult(interp, "Wrong # of arguments\n",
+			 "pg_select connection queryString var proc", 0);
+		return TCL_ERROR;
+	}
+
+    if (! PgValidId(argv[1]))
+	{
+		Tcl_AppendResult(interp,
+				"Argument passed in is not a valid connection\n", 0);
+		return TCL_ERROR;
+    }
+  
+    conn = (PGconn*)PgGetId(argv[1]);
+
+	if ((result = PQexec(conn, argv[2])) == 0)
+    {
+		/* error occurred during the query */
+		Tcl_SetResult(interp, conn->errorMessage, TCL_STATIC);
+		return TCL_ERROR;
+    }
+
+	if ((info = malloc(sizeof(*info) * (ncols =  PQnfields(result)))) == NULL)
+	{
+		Tcl_AppendResult(interp, "Not enough memory", 0);
+		return TCL_ERROR;
+	}
+
+	Tcl_DStringInit(&headers);
+
+	for (column = 0; column < ncols; column++)
+	{
+		info[column].cname = PQfname(result, column);
+		info[column].data = malloc(2000);
+		info[column].change = 0;
+		Tcl_DStringAppendElement(&headers, info[column].cname);
+	}
+
+	Tcl_SetVar2(interp, argv[3], ".headers", Tcl_DStringValue(&headers), 0);
+	sprintf(info[0].data, "%d", ncols);
+	Tcl_SetVar2(interp, argv[3], ".numcols", info[0].data, 0);
+
+	for (tupno = 0; tupno < PQntuples(result); tupno++)
+	{
+		sprintf(info[0].data, "%d", tupno);
+		Tcl_SetVar2(interp, argv[3], ".tupno", info[0].data, 0);
+
+		for (column = 0; column < ncols; column++)
+		{
+			strcpy(info[column].data, PQgetvalue(result, tupno, column));
+			Tcl_SetVar2(interp, argv[3], info[column].cname, info[column].data, 0);
+		}
+
+		Tcl_SetVar2(interp, argv[3], ".command", "update", 0);
+
+		if ((r = Tcl_Eval(interp, argv[4])) != TCL_OK && r != TCL_CONTINUE)
+		{
+			if (r == TCL_BREAK)
+				return TCL_OK;
+
+			if (r == TCL_ERROR)
+			{
+				char	msg[60];
+
+				sprintf(msg, "\n    (\"pg_select\" body line %d)",
+								interp->errorLine);
+				Tcl_AddErrorInfo(interp, msg);
+			}
+
+			return r;
+		}
+	}
+
+	Tcl_AppendResult(interp, "", 0);
+	return TCL_OK;
+}
 
diff --git a/src/interfaces/libpgtcl/pgtclCmds.h b/src/interfaces/libpgtcl/pgtclCmds.h
index 244471ebe1b..23664de18f9 100644
--- a/src/interfaces/libpgtcl/pgtclCmds.h
+++ b/src/interfaces/libpgtcl/pgtclCmds.h
@@ -5,7 +5,7 @@
  *
  * Copyright (c) 1994, Regents of the University of California
  *
- * $Id: pgtclCmds.h,v 1.1.1.1 1996/07/09 06:22:16 scrappy Exp $
+ * $Id: pgtclCmds.h,v 1.2 1996/10/07 21:19:09 scrappy Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -24,6 +24,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_select(
+    ClientData cData, Tcl_Interp *interp, int argc, char* argv[]);
 extern int Pg_result(
     ClientData cData, Tcl_Interp *interp, int argc, char* argv[]);
 extern int Pg_lo_open(