diff --git a/doc/src/sgml/libpgtcl.sgml b/doc/src/sgml/libpgtcl.sgml
index 331ad1a9d3ae4e90d981d3c03c73c0106ee2db5f..82c267a4563f4722cc61a93661169be43db36e0f 100644
--- a/doc/src/sgml/libpgtcl.sgml
+++ b/doc/src/sgml/libpgtcl.sgml
@@ -3,11 +3,8 @@
<Para>
pgtcl is a tcl package for front-end programs to interface with <ProductName>Postgres</ProductName>
-backends. pgtcl does not use the libpq library but communicates to
-the backend directly via the frontend-backend protocol. Thus, it is
-more efficient than previous postgres->tcl bindings which are layered
-on top of libpq. In addition, pgtcl can handle multiple backend
-connections from a single frontend application.
+backends. It makes most of the functionality of libpq available to
+tcl scripts.
</Para>
<Para>
@@ -42,17 +39,25 @@ the standard Unix file system interface.
<ENTRY>pg_disconnect</ENTRY>
<ENTRY>closes a connection</ENTRY>
</ROW>
+ <ROW>
+ <ENTRY>pg_conndefaults</ENTRY>
+ <ENTRY>get connection options and their defaults</ENTRY>
+ </ROW>
<ROW>
<ENTRY>pg_exec</ENTRY>
<ENTRY>send a query to the backend</ENTRY>
</ROW>
+ <ROW>
+ <ENTRY>pg_result</ENTRY>
+ <ENTRY>manipulate the results of a query</ENTRY>
+ </ROW>
<ROW>
<ENTRY>pg_select</ENTRY>
<ENTRY>loop over the result of a select statement</ENTRY>
</ROW>
<ROW>
- <ENTRY>pg_result</ENTRY>
- <ENTRY>manipulate the results of a query</ENTRY>
+ <ENTRY>pg_listen</ENTRY>
+ <ENTRY>establish a callback for NOTIFY messages</ENTRY>
</ROW>
<ROW>
@@ -101,8 +106,7 @@ the standard Unix file system interface.
</Para>
<Para>
-Some commands equivalent to libpq commands are provided for connection
-and query operations.
+These commands are described further on subsequent pages.
</Para>
<Para>
@@ -142,7 +146,7 @@ proc getDBs { {host "localhost"} {port "5432"} } {
</Sect1>
<Sect1>
-<Title>Reference Information</Title>
+<Title>pgtcl Command Reference Information</Title>
<REFENTRY ID="PGTCL-PGCONNECT-1">
<REFMETA>
@@ -235,7 +239,7 @@ pg_connect <REPLACEABLE CLASS="PARAMETER">dbName</REPLACEABLE> <OPTIONAL>-host <
<LISTITEM>
<PARA>
The return result is either an error message or a handle for a database
- connection. Handles start with the prefix "pgp"
+ connection. Handles start with the prefix "pgsql"
</PARA>
</LISTITEM>
</VARLISTENTRY>
@@ -414,7 +418,114 @@ pg_exec <REPLACEABLE CLASS="PARAMETER">dbHandle</REPLACEABLE> <REPLACEABLE CLASS
</TITLE>
<PARA>
<FUNCTION>pg_exec</FUNCTION> submits a query to the <ProductName>Postgres</ProductName> backend and returns a result.
- Handles start with the prefix "pgp".
+
+Query result handles start with the connection handle and add a period
+and a result number.
+</PARA>
+</REFSECT1>
+
+<REFENTRY ID="PGTCL-PGLISTEN-1">
+<REFMETA>
+<REFENTRYTITLE>pg_listen</REFENTRYTITLE>
+<REFMISCINFO>PGTCL - Asynchronous Notify</REFMISCINFO>
+</REFMETA>
+<REFNAMEDIV>
+<REFNAME>pg_listen
+</REFNAME>
+<REFPURPOSE>sets or changes a callback for asynchronous NOTIFY messages
+</REFPURPOSE>
+<INDEXTERM ID="IX-PGTCL-PGLISTEN-1"><PRIMARY>pgtcl</PRIMARY><SECONDARY>notify</SECONDARY></INDEXTERM>
+<INDEXTERM ID="IX-PGTCL-PGLISTEN-2"><PRIMARY>notify</PRIMARY></INDEXTERM>
+</REFNAMEDIV>
+<REFSYNOPSISDIV>
+<REFSYNOPSISDIVINFO>
+<DATE>1998-5-22</DATE>
+</REFSYNOPSISDIVINFO>
+<SYNOPSIS>
+pg_listen <REPLACEABLE CLASS="PARAMETER">dbHandle</REPLACEABLE> <REPLACEABLE CLASS="PARAMETER">notifyName</REPLACEABLE> <REPLACEABLE CLASS="PARAMETER">callbackCommand</REPLACEABLE>
+</SYNOPSIS>
+
+<REFSECT2 ID="R2-PGTCL-PGLISTEN-1">
+<REFSECT2INFO>
+<DATE>1998-5-22</DATE>
+</REFSECT2INFO>
+<TITLE>Inputs
+</TITLE>
+<VARIABLELIST>
+<VARLISTENTRY>
+<TERM>
+ <REPLACEABLE CLASS="PARAMETER">dbHandle</REPLACEABLE>
+</TERM>
+<LISTITEM>
+<PARA>Specifies a valid database handle.
+</PARA>
+</LISTITEM>
+</VARLISTENTRY>
+<VARLISTENTRY>
+<TERM>
+ <REPLACEABLE CLASS="PARAMETER">notifyName</REPLACEABLE>
+</TERM>
+<LISTITEM>
+<PARA>Specifies the notification name to start or stop listening to.
+</PARA>
+</LISTITEM>
+</VARLISTENTRY>
+<VARLISTENTRY>
+<TERM>
+ <REPLACEABLE CLASS="PARAMETER">callbackCommand</REPLACEABLE>
+</TERM>
+<LISTITEM>
+<PARA>If present and not empty, provides the command string to execute
+when a matching notification arrives.
+</PARA>
+</LISTITEM>
+</VARLISTENTRY>
+</VARIABLELIST>
+</REFSECT2>
+
+<REFSECT2 ID="R2-PGTCL-PGLISTEN-2">
+<REFSECT2INFO>
+<DATE>1998-5-22</DATE>
+</REFSECT2INFO>
+<TITLE>Outputs
+</TITLE>
+<VARIABLELIST>
+<VARLISTENTRY>
+<TERM>
+ None
+</TERM>
+<LISTITEM>
+<PARA>
+</PARA>
+</LISTITEM>
+</VARLISTENTRY>
+</VARIABLELIST>
+</REFSECT2>
+</REFSYNOPSISDIV>
+
+<REFSECT1 ID="R1-PGTCL-PGLISTEN-1">
+<REFSECT1INFO>
+<DATE>1998-5-22</DATE>
+</REFSECT1INFO>
+<TITLE>Description
+</TITLE>
+<PARA><FUNCTION>pg_listen</FUNCTION> creates, changes, or cancels a request
+to listen for asynchronous NOTIFY messages from the
+<ProductName>Postgres</ProductName> backend. With a callbackCommand
+parameter, the request is established, or the command string of an already
+existing request is replaced. With no callbackCommand parameter, a prior
+request is canceled.
+</PARA>
+After a <PARA><FUNCTION>pg_listen</FUNCTION> request is established,
+the specified command string is executed whenever a NOTIFY message bearing
+the given name arrives from the backend. This occurs when any
+<ProductName>Postgres</ProductName> client application issues a NOTIFY command
+referencing that name. (Note that the name can be, but does not have to be,
+that of an existing relation in the database.)
+The command string is executed from the Tcl idle loop. That is the normal
+idle state of an application written with Tk. In non-Tk Tcl shells, you can
+execute <FUNCTION>update</FUNCTION> or <FUNCTION>vwait</FUNCTION> to cause
+the idle loop to be entered.
</PARA>
</REFSECT1>
diff --git a/src/interfaces/libpgtcl/pgtcl.c b/src/interfaces/libpgtcl/pgtcl.c
index a90c0c7c4908e759aa360f8b057849df94779014..af6f4d74af70807d37525a3ebeeb7e7316afc3ac 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.10 1998/03/15 08:02:57 scrappy Exp $
+ * $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtcl.c,v 1.11 1998/06/16 04:10:15 momjian Exp $
*
*-------------------------------------------------------------------------
*/
@@ -36,7 +36,7 @@ Pgtcl_Init (Tcl_Interp *interp)
* to guess where it might be by position in the struct. This is needed
* for Tcl7.6 and beyond, which have the getfileproc.
*/
-#if (TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION == 6)
+#if HAVE_TCL_GETFILEPROC
Pg_ConnType.getFileProc = PgGetFileProc;
#endif
@@ -126,12 +126,7 @@ Pgtcl_Init (Tcl_Interp *interp)
Pg_listen,
(ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
- Tcl_CreateCommand(interp,
- "pg_notifies",
- Pg_notifies,
- (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
-
- Tcl_PkgProvide(interp, "Pgtcl", "1.1");
+ Tcl_PkgProvide(interp, "Pgtcl", "1.2");
return TCL_OK;
}
diff --git a/src/interfaces/libpgtcl/pgtclCmds.c b/src/interfaces/libpgtcl/pgtclCmds.c
index b7eae9d6b78513987e0198b11b68acce5821c0d7..5b3d5e91d54d3c8fb8e903dff6232ffcb339975f 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.24 1998/06/15 19:30:17 momjian Exp $
+ * $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtclCmds.c,v 1.25 1998/06/16 04:10:16 momjian Exp $
*
*-------------------------------------------------------------------------
*/
@@ -15,6 +15,7 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
+#include <ctype.h>
#include <tcl.h>
#include "postgres.h"
@@ -415,7 +416,6 @@ Pg_exec(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
conn = PgGetConnectionId(interp, argv[1], &connid);
if (conn == (PGconn *)NULL) {
- Tcl_AppendResult(interp, "First argument is not a valid connection\n", 0);
return TCL_ERROR;
}
@@ -426,6 +426,10 @@ Pg_exec(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
connStatus = conn->status;
result = PQexec(conn, argv[2]);
+
+ /* Transfer any notify events from libpq to Tcl event queue. */
+ PgNotifyTransferEvents(connid);
+
if (result) {
int rId = PgSetResultId(interp, argv[1], result);
if (result->resultStatus == PGRES_COPY_IN ||
@@ -439,9 +443,11 @@ Pg_exec(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
/* error occurred during the query */
Tcl_SetResult(interp, conn->errorMessage, TCL_STATIC);
if (connStatus == CONNECTION_OK) {
+ /* Is this REALLY a good idea? I don't think so! */
PQreset(conn);
if (conn->status == CONNECTION_OK) {
result = PQexec(conn, argv[2]);
+ PgNotifyTransferEvents(connid);
if (result) {
int rId = PgSetResultId(interp, argv[1], result);
if (result->resultStatus == PGRES_COPY_IN ||
@@ -699,7 +705,6 @@ Pg_lo_open(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId**)NULL);
if (conn == (PGconn *)NULL) {
- Tcl_AppendResult(interp, "First argument is not a valid connection\n", 0);
return TCL_ERROR;
}
@@ -766,7 +771,6 @@ Pg_lo_close(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId**)NULL);
if (conn == (PGconn *)NULL) {
- Tcl_AppendResult(interp, "First argument is not a valid connection\n", 0);
return TCL_ERROR;
}
@@ -804,7 +808,6 @@ Pg_lo_read(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId**)NULL);
if (conn == (PGconn *)NULL) {
- Tcl_AppendResult(interp, "First argument is not a valid connection\n", 0);
return TCL_ERROR;
}
@@ -854,7 +857,6 @@ Pg_lo_write(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId**)NULL);
if (conn == (PGconn *)NULL) {
- Tcl_AppendResult(interp, "First argument is not a valid connection\n", 0);
return TCL_ERROR;
}
@@ -900,7 +902,6 @@ Pg_lo_lseek(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId**)NULL);
if (conn == (PGconn *)NULL) {
- Tcl_AppendResult(interp, "First argument is not a valid connection\n", 0);
return TCL_ERROR;
}
@@ -952,7 +953,6 @@ Pg_lo_creat(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId**)NULL);
if (conn == (PGconn *)NULL) {
- Tcl_AppendResult(interp, "First argument is not a valid connection\n", 0);
return TCL_ERROR;
}
@@ -1008,7 +1008,6 @@ Pg_lo_tell(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId**)NULL);
if (conn == (PGconn *)NULL) {
- Tcl_AppendResult(interp, "First argument is not a valid connection\n", 0);
return TCL_ERROR;
}
@@ -1043,7 +1042,6 @@ Pg_lo_unlink(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId**)NULL);
if (conn == (PGconn *)NULL) {
- Tcl_AppendResult(interp, "First argument is not a valid connection\n", 0);
return TCL_ERROR;
}
@@ -1085,7 +1083,6 @@ Pg_lo_import(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId**)NULL);
if (conn == (PGconn *)NULL) {
- Tcl_AppendResult(interp, "First argument is not a valid connection\n", 0);
return TCL_ERROR;
}
@@ -1125,7 +1122,6 @@ Pg_lo_export(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId**)NULL);
if (conn == (PGconn *)NULL) {
- Tcl_AppendResult(interp, "First argument is not a valid connection\n", 0);
return TCL_ERROR;
}
@@ -1164,6 +1160,7 @@ Pg_lo_export(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
int
Pg_select(ClientData cData, Tcl_Interp *interp, int argc, char **argv)
{
+ Pg_ConnectionId *connid;
PGconn *conn;
PGresult *result;
int r;
@@ -1182,7 +1179,7 @@ Pg_select(ClientData cData, Tcl_Interp *interp, int argc, char **argv)
return TCL_ERROR;
}
- conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId**)NULL);
+ conn = PgGetConnectionId(interp, argv[1], &connid);
if (conn == (PGconn *)NULL) {
return TCL_ERROR;
}
@@ -1194,6 +1191,9 @@ Pg_select(ClientData cData, Tcl_Interp *interp, int argc, char **argv)
return TCL_ERROR;
}
+ /* Transfer any notify events from libpq to Tcl event queue. */
+ PgNotifyTransferEvents(connid);
+
if ((info = (struct info_s *)ckalloc(sizeof(*info) * (ncols = PQnfields(result)))) == NULL)
{
Tcl_AppendResult(interp, "Not enough memory", 0);
@@ -1248,145 +1248,139 @@ Pg_select(ClientData cData, Tcl_Interp *interp, int argc, char **argv)
return TCL_OK;
}
+/***********************************
+Pg_listen
+ create or remove a callback request for notifies on a given name
+
+ syntax:
+ pg_listen conn notifyname ?callbackcommand?
+
+ With a fourth arg, creates or changes the callback command for
+ notifies on the given name; without, cancels the callback request.
+
+ Callbacks can occur whenever Tcl is executing its event loop.
+ This is the normal idle loop in Tk; in plain tclsh applications,
+ vwait or update can be used to enter the Tcl event loop.
+***********************************/
int
Pg_listen(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
{
- int new;
- char *relname;
- char *callback = NULL;
+ char *origrelname;
+ char *caserelname;
+ char *callback = NULL;
+ Pg_TclNotifies *notifies;
Tcl_HashEntry *entry;
Pg_ConnectionId *connid;
PGconn *conn;
PGresult *result;
+ int new;
- if ((argc < 3) || (argc > 4)) {
- Tcl_AppendResult(interp, "wrong # args, should be \"",
- argv[0], " connection relname ?callback?\"", 0);
- return TCL_ERROR;
+ if (argc < 3 || argc > 4) {
+ Tcl_AppendResult(interp, "wrong # args, should be \"",
+ argv[0], " connection relname ?callback?\"", 0);
+ return TCL_ERROR;
}
/*
- * Get the command arguments. Note that relname will copied by
- * Tcl_CreateHashEntry while callback must be allocated.
+ * Get the command arguments. Note that the relation name will be copied
+ * by Tcl_CreateHashEntry while the callback string must be allocated.
*/
conn = PgGetConnectionId(interp, argv[1], &connid);
if (conn == (PGconn *)NULL) {
- Tcl_AppendResult(interp, "First argument is not a valid connection\n", 0);
- return TCL_ERROR;
- }
- relname = argv[2];
- if ((argc > 3) && *argv[3]) {
- callback = (char *) ckalloc((unsigned) (strlen(argv[3])+1));
- strcpy(callback, argv[3]);
+ return TCL_ERROR;
}
- /*
- * Set or update a callback for a relation;
- */
- if (callback) {
- entry = Tcl_CreateHashEntry(&(connid->notify_hash), relname, &new);
- if (new) {
- /* New callback, execute a listen command on the relation */
- char *cmd = (char *) ckalloc((unsigned) (strlen(argv[2])+8));
- sprintf(cmd, "LISTEN %s", relname);
- result = PQexec(conn, cmd);
- ckfree(cmd);
- if (!result || (result->resultStatus != PGRES_COMMAND_OK)) {
- /* Error occurred during the execution of command */
- if (result) PQclear(result);
- ckfree(callback);
- Tcl_DeleteHashEntry(entry);
- Tcl_SetResult(interp, conn->errorMessage, TCL_STATIC);
- return TCL_ERROR;
- }
- PQclear(result);
+ /*
+ * LISTEN/NOTIFY do not preserve case unless the relation name is
+ * quoted. We have to do the same thing to ensure that we will find
+ * the desired pg_listen item.
+ */
+ origrelname = argv[2];
+ caserelname = (char *) ckalloc((unsigned) (strlen(origrelname) + 1));
+ if (*origrelname == '"') {
+ /* Copy a quoted string without downcasing */
+ strcpy(caserelname, origrelname + 1);
+ caserelname[strlen(caserelname) - 1] = '\0';
} else {
- /* Free the old callback string */
- ckfree((char *) Tcl_GetHashValue(entry));
+ /* Downcase it */
+ char *rels = origrelname;
+ char *reld = caserelname;
+ while (*rels) {
+ *reld++ = tolower(*rels++);
+ }
+ *reld = '\0';
}
- /* Store the new callback command */
- Tcl_SetHashValue(entry, callback);
- }
- /*
- * Remove a callback for a relation. There is no way to
- * un-listen a relation, simply remove the callback from
- * the notify hash table.
- */
- if (callback == NULL) {
- entry = Tcl_FindHashEntry(&(connid->notify_hash), relname);
- if (entry == NULL) {
- Tcl_AppendResult(interp, "not listening on ", relname, 0);
- return TCL_ERROR;
- }
- ckfree((char *) Tcl_GetHashValue(entry));
- Tcl_DeleteHashEntry(entry);
+ if ((argc > 3) && *argv[3]) {
+ callback = (char *) ckalloc((unsigned) (strlen(argv[3]) + 1));
+ strcpy(callback, argv[3]);
}
- return TCL_OK;
-}
-
-int
-Pg_notifies(ClientData cData, Tcl_Interp *interp, int argc, char* argv[])
-{
- int count;
- char buff[12];
- char *callback;
- Tcl_HashEntry *entry;
- Pg_ConnectionId *connid;
- PGconn *conn;
- PGresult *result;
- PGnotify *notify;
+ /* Find or make a Pg_TclNotifies struct for this interp and connection */
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args, should be \"",
- argv[0], " connection\"", 0);
- return TCL_ERROR;
- }
+ for (notifies = connid->notify_list; notifies; notifies = notifies->next) {
+ if (notifies->interp == interp)
+ break;
+ }
+ if (notifies == NULL) {
+ notifies = (Pg_TclNotifies *) ckalloc(sizeof(Pg_TclNotifies));
+ notifies->interp = interp;
+ Tcl_InitHashTable(¬ifies->notify_hash, TCL_STRING_KEYS);
+ notifies->next = connid->notify_list;
+ connid->notify_list = notifies;
+ Tcl_CallWhenDeleted(interp, PgNotifyInterpDelete,
+ (ClientData) notifies);
+ }
/*
- * Get the connection argument.
+ * Set or update a callback for a relation
*/
- conn = (PGconn*)PgGetConnectionId(interp, argv[1], &connid);
- if (conn == (PGconn *)NULL) {
- Tcl_AppendResult(interp, "First argument is not a valid connection\n", 0);
- return TCL_ERROR;
- }
-
- /* Execute an empty command to retrieve asynchronous notifications */
- result = PQexec(conn, " ");
- if (result == NULL) {
- /* Error occurred during the execution of command */
- Tcl_SetResult(interp, conn->errorMessage, TCL_STATIC);
- return TCL_ERROR;
+ if (callback) {
+ entry = Tcl_CreateHashEntry(¬ifies->notify_hash, caserelname, &new);
+ if (new) {
+ /* New callback, execute a listen command on the relation */
+ char *cmd = (char *) ckalloc((unsigned) (strlen(origrelname)+8));
+ sprintf(cmd, "LISTEN %s", origrelname);
+ result = PQexec(conn, cmd);
+ ckfree(cmd);
+ /* Transfer any notify events from libpq to Tcl event queue. */
+ PgNotifyTransferEvents(connid);
+ if (!result || (result->resultStatus != PGRES_COMMAND_OK)) {
+ /* Error occurred during the execution of command */
+ if (result) PQclear(result);
+ ckfree(callback);
+ ckfree(caserelname);
+ Tcl_DeleteHashEntry(entry);
+ Tcl_SetResult(interp, PQerrorMessage(conn), TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ PQclear(result);
+ } else {
+ /* Update, free the old callback string */
+ ckfree((char *) Tcl_GetHashValue(entry));
+ }
+ /* Store the new callback string */
+ Tcl_SetHashValue(entry, callback);
+ /* Start the notify event source if it isn't already running */
+ PgStartNotifyEventSource(connid);
}
- PQclear(result);
/*
- * Loop while there are pending notifies.
+ * Remove a callback for a relation. There is no way to
+ * un-listen a relation, so we simply remove the callback from
+ * the notify hash table.
*/
- for (count=0; count < 999; count++) {
- /* See if there is a pending notification */
- notify = PQnotifies(conn);
- if (notify == NULL) {
- break;
- }
- entry = Tcl_FindHashEntry(&(connid->notify_hash), notify->relname);
- if (entry != NULL) {
- callback = (char*)Tcl_GetHashValue(entry);
- if (callback) {
- /* This should be a global eval, shouldn't it? */
- Tcl_Eval(interp, callback);
- /* And what if there's an error. Bgerror should be called? */
- }
- }
- free(notify);
+ if (callback == NULL) {
+ entry = Tcl_FindHashEntry(¬ifies->notify_hash, caserelname);
+ if (entry == NULL) {
+ Tcl_AppendResult(interp, "not listening on ", origrelname, 0);
+ ckfree(caserelname);
+ return TCL_ERROR;
+ }
+ ckfree((char *) Tcl_GetHashValue(entry));
+ Tcl_DeleteHashEntry(entry);
}
- /*
- * Return the number of notifications processed.
- */
- sprintf(buff, "%d", count);
- Tcl_SetResult(interp, buff, TCL_VOLATILE);
+ ckfree(caserelname);
return TCL_OK;
}
diff --git a/src/interfaces/libpgtcl/pgtclCmds.h b/src/interfaces/libpgtcl/pgtclCmds.h
index f0f8513da449bdbdb77dc63f9223794ba3e5e4c8..052a1a0a6f267662d604b32cc7ccccfc3ce32d35 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.9 1998/03/15 08:02:59 scrappy Exp $
+ * $Id: pgtclCmds.h,v 1.10 1998/06/16 04:10:17 momjian Exp $
*
*-------------------------------------------------------------------------
*/
@@ -14,13 +14,29 @@
#define PGTCLCMDS_H
#include "tcl.h"
-#include "libpq/pqcomm.h"
#include "libpq-fe.h"
-#include "libpq/libpq-fs.h"
#define RES_HARD_MAX 128
#define RES_START 16
+/*
+ * Each Pg_ConnectionId has a list of Pg_TclNotifies structs, one for each
+ * Tcl interpreter that has executed any pg_listens on the connection.
+ * We need this arrangement to be able to clean up if an interpreter is
+ * deleted while the connection remains open. A free side benefit is that
+ * multiple interpreters can be registered to listen for the same notify
+ * name. (All their callbacks will be called, but in an unspecified order.)
+ */
+
+typedef struct Pg_TclNotifies_s {
+ struct Pg_TclNotifies_s *next; /* list link */
+ Tcl_Interp *interp; /* This Tcl interpreter */
+ /* NB: if interp == NULL, the interpreter is gone but we haven't
+ * yet got round to deleting the Pg_TclNotifies structure.
+ */
+ Tcl_HashTable notify_hash; /* Active pg_listen requests */
+} Pg_TclNotifies;
+
typedef struct Pg_ConnectionId_s {
char id[32];
PGconn *conn;
@@ -31,10 +47,11 @@ typedef struct Pg_ConnectionId_s {
int res_copy; /* Query result with active copy */
int res_copyStatus; /* Copying status */
PGresult **results; /* The results */
-
- Tcl_HashTable notify_hash;
-} Pg_ConnectionId;
+ Pg_TclNotifies *notify_list; /* head of list of notify info */
+ int notifier_running; /* notify event source is live */
+
+} Pg_ConnectionId;
#define RES_COPY_NONE 0
#define RES_COPY_INPROGRESS 1
@@ -78,9 +95,5 @@ extern int Pg_lo_export(
ClientData cData, Tcl_Interp *interp, int argc, char* argv[]);
extern int Pg_listen(
ClientData cData, Tcl_Interp *interp, int argc, char* argv[]);
-extern int Pg_notifies(
- ClientData cData, Tcl_Interp *interp, int argc, char* argv[]);
-
#endif /*PGTCLCMDS_H*/
-
diff --git a/src/interfaces/libpgtcl/pgtclId.c b/src/interfaces/libpgtcl/pgtclId.c
index b3985f732167d4022a022f085c560fe401494052..4ed8f58d57f3b2c694eca18e75cb9fc36282d240 100644
--- a/src/interfaces/libpgtcl/pgtclId.c
+++ b/src/interfaces/libpgtcl/pgtclId.c
@@ -12,7 +12,7 @@
*
*
* IDENTIFICATION
- * $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtclId.c,v 1.10 1998/05/06 23:53:30 momjian Exp $
+ * $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtclId.c,v 1.11 1998/06/16 04:10:17 momjian Exp $
*
*-------------------------------------------------------------------------
*/
@@ -26,7 +26,8 @@
#include "pgtclCmds.h"
#include "pgtclId.h"
-int PgEndCopy(Pg_ConnectionId *connid, int *errorCodePtr)
+
+static int PgEndCopy(Pg_ConnectionId *connid, int *errorCodePtr)
{
connid->res_copyStatus = RES_COPY_NONE;
if (PQendcopy(connid->conn)) {
@@ -147,12 +148,14 @@ int PgOutputProc(DRIVER_OUTPUT_PROTO)
return bufSize;
}
-#if (TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION == 6)
+#if HAVE_TCL_GETFILEPROC
+
Tcl_File
PgGetFileProc(ClientData cData, int direction)
{
return (Tcl_File)NULL;
}
+
#endif
Tcl_ChannelType Pg_ConnType = {
@@ -184,14 +187,18 @@ PgSetConnectionId(Tcl_Interp *interp, PGconn *conn)
connid->res_copy = -1;
connid->res_copyStatus = RES_COPY_NONE;
connid->results = (PGresult**)ckalloc(sizeof(PGresult*) * RES_START);
- for (i = 0; i < RES_START; i++) connid->results[i] = NULL;
- Tcl_InitHashTable(&connid->notify_hash, TCL_STRING_KEYS);
+ for (i = 0; i < RES_START; i++)
+ connid->results[i] = NULL;
+ connid->notify_list = NULL;
+ connid->notifier_running = 0;
sprintf(connid->id, "pgsql%d", PQsocket(conn));
#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION == 5
+ /* Original signature (only seen in Tcl 7.5) */
conn_chan = Tcl_CreateChannel(&Pg_ConnType, connid->id, NULL, NULL, (ClientData)connid);
#else
+ /* Tcl 7.6 and later use this */
conn_chan = Tcl_CreateChannel(&Pg_ConnType, connid->id, (ClientData)connid,
TCL_READABLE | TCL_WRITABLE);
#endif
@@ -214,7 +221,7 @@ PgGetConnectionId(Tcl_Interp *interp, char *id, Pg_ConnectionId **connid_p)
conn_chan = Tcl_GetChannel(interp, id, 0);
if(conn_chan == NULL || Tcl_GetChannelType(conn_chan) != &Pg_ConnType) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, id, " is not a valid postgresql connection\n", 0);
+ Tcl_AppendResult(interp, id, " is not a valid postgresql connection", 0);
return (PGconn *)NULL;
}
@@ -232,9 +239,9 @@ PgGetConnectionId(Tcl_Interp *interp, char *id, Pg_ConnectionId **connid_p)
int PgDelConnectionId(DRIVER_DEL_PROTO)
{
Tcl_HashEntry *entry;
- char *hval;
Tcl_HashSearch hsearch;
Pg_ConnectionId *connid;
+ Pg_TclNotifies *notifies;
int i;
connid = (Pg_ConnectionId *)cData;
@@ -245,17 +252,38 @@ int PgDelConnectionId(DRIVER_DEL_PROTO)
}
ckfree((void*)connid->results);
- for (entry = Tcl_FirstHashEntry(&(connid->notify_hash), &hsearch);
- entry != NULL;
- entry = Tcl_NextHashEntry(&hsearch))
- {
- hval = (char*)Tcl_GetHashValue(entry);
- ckfree(hval);
+ /* Release associated notify info */
+ while ((notifies = connid->notify_list) != NULL) {
+ connid->notify_list = notifies->next;
+ for (entry = Tcl_FirstHashEntry(¬ifies->notify_hash, &hsearch);
+ entry != NULL;
+ entry = Tcl_NextHashEntry(&hsearch)) {
+ ckfree((char*) Tcl_GetHashValue(entry));
+ }
+ Tcl_DeleteHashTable(¬ifies->notify_hash);
+ Tcl_DontCallWhenDeleted(notifies->interp, PgNotifyInterpDelete,
+ (ClientData) notifies);
+ ckfree((void*) notifies);
}
-
- Tcl_DeleteHashTable(&connid->notify_hash);
+
+ /* Turn off the Tcl event source for this connection,
+ * and delete any pending notify events.
+ */
+ PgStopNotifyEventSource(connid);
+
+ /* Close the libpq connection too */
PQfinish(connid->conn);
- ckfree((void*)connid);
+ connid->conn = NULL;
+
+ /*
+ * We must use Tcl_EventuallyFree because we don't want the connid struct
+ * to vanish instantly if Pg_Notify_EventProc is active for it.
+ * (Otherwise, closing the connection from inside a pg_listen callback
+ * could lead to coredump.) Pg_Notify_EventProc can detect that the
+ * connection has been deleted from under it by checking connid->conn.
+ */
+ Tcl_EventuallyFree((ClientData) connid, TCL_DYNAMIC);
+
return 0;
}
@@ -407,3 +435,226 @@ PgGetConnByResultId(Tcl_Interp *interp, char *resid_c)
}
+
+
+/********************************************
+ Notify event source
+
+ These functions allow asynchronous notify messages arriving from
+ the SQL server to be dispatched as Tcl events. See the Tcl
+ Notifier(3) man page for more info.
+
+ The main trick in this code is that we have to cope with status changes
+ between the queueing and the execution of a Tcl event. For example,
+ if the user changes or cancels the pg_listen callback command, we should
+ use the new setting; we do that by not resolving the notify relation
+ name until the last possible moment.
+ We also have to handle closure of the channel or deletion of the interpreter
+ to be used for the callback (note that with multiple interpreters,
+ the channel can outlive the interpreter it was created by!)
+ Upon closure of the channel, we immediately delete any pending events
+ that reference it. But for interpreter deletion, we just set any
+ matching interp pointers in the Pg_TclNotifies list to NULL. The
+ list item stays around until the connection is deleted. (This avoids
+ trouble with walking through a list whose members may get deleted under us.)
+ *******************************************/
+
+typedef struct {
+ Tcl_Event header; /* Standard Tcl event info */
+ PGnotify info; /* Notify name from SQL server */
+ Pg_ConnectionId *connid; /* Connection for server */
+} NotifyEvent;
+
+/* Setup before waiting in event loop */
+
+static void Pg_Notify_SetupProc (ClientData clientData, int flags)
+{
+ Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
+ Tcl_File handle;
+
+ /* We classify SQL notifies as Tcl file events. */
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return;
+ }
+
+ /* Set up to watch for asynchronous data arrival on backend channel */
+ handle = Tcl_GetFile((ClientData) PQsocket(connid->conn), TCL_UNIX_FD);
+ Tcl_WatchFile(handle, TCL_READABLE);
+}
+
+/* Check to see if events have arrived in event loop */
+
+static void Pg_Notify_CheckProc (ClientData clientData, int flags)
+{
+ Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
+ Tcl_File handle;
+
+ /* We classify SQL notifies as Tcl file events. */
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return;
+ }
+
+ /* Consume any data available from the SQL server
+ * (this just buffers it internally to libpq).
+ * We use Tcl_FileReady to avoid a useless kernel call
+ * when no data is available.
+ */
+ handle = Tcl_GetFile((ClientData) PQsocket(connid->conn), TCL_UNIX_FD);
+ if (Tcl_FileReady(handle, TCL_READABLE) != 0) {
+ PQconsumeInput(connid->conn);
+ }
+
+ /* Transfer notify events from libpq to Tcl event queue. */
+ PgNotifyTransferEvents(connid);
+}
+
+/* Dispatch an event that has reached the front of the event queue */
+
+static int Pg_Notify_EventProc (Tcl_Event *evPtr, int flags)
+{
+ NotifyEvent *event = (NotifyEvent *) evPtr;
+ Pg_TclNotifies *notifies;
+ Tcl_HashEntry *entry;
+ char *callback;
+ char *svcallback;
+
+ /* We classify SQL notifies as Tcl file events. */
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return 0;
+ }
+
+ /* Preserve/Release to ensure the connection struct doesn't disappear
+ * underneath us.
+ */
+ Tcl_Preserve((ClientData) event->connid);
+
+ /*
+ * Loop for each interpreter that has ever registered on the connection.
+ * Each one can get a callback.
+ */
+
+ for (notifies = event->connid->notify_list;
+ notifies != NULL;
+ notifies = notifies->next) {
+ Tcl_Interp *interp = notifies->interp;
+ if (interp == NULL)
+ continue; /* ignore deleted interpreter */
+ /*
+ * Find the callback to be executed for this interpreter, if any.
+ */
+ entry = Tcl_FindHashEntry(¬ifies->notify_hash,
+ event->info.relname);
+ if (entry == NULL)
+ continue; /* no pg_listen in this interpreter */
+ callback = (char *) Tcl_GetHashValue(entry);
+ if (callback == NULL)
+ continue; /* safety check -- shouldn't happen */
+ /*
+ * We have to copy the callback string in case the user executes
+ * a new pg_listen during the callback.
+ */
+ svcallback = (char *) ckalloc((unsigned) (strlen(callback) + 1));
+ strcpy(svcallback, callback);
+ /*
+ * Execute the callback.
+ */
+ Tcl_Preserve((ClientData) interp);
+ if (Tcl_GlobalEval(interp, svcallback) != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n (\"pg_listen\" script)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_Release((ClientData) interp);
+ ckfree(svcallback);
+ /*
+ * Check for the possibility that the callback closed the connection.
+ */
+ if (event->connid->conn == NULL)
+ break;
+ }
+
+ Tcl_Release((ClientData) event->connid);
+
+ return 1;
+}
+
+/*
+ * Transfer any notify events available from libpq into the Tcl event queue.
+ * Note that this must be called after each PQexec (to capture notifies
+ * that arrive during command execution) as well as in Pg_Notify_CheckProc
+ * (to capture notifies that arrive when we're idle).
+ */
+
+void PgNotifyTransferEvents (Pg_ConnectionId *connid)
+{
+ PGnotify *notify;
+
+ while ((notify = PQnotifies(connid->conn)) != NULL) {
+ NotifyEvent *event = (NotifyEvent *) ckalloc(sizeof(NotifyEvent));
+ event->header.proc = Pg_Notify_EventProc;
+ event->info = *notify;
+ event->connid = connid;
+ Tcl_QueueEvent((Tcl_Event *) event, TCL_QUEUE_TAIL);
+ free(notify);
+ }
+}
+
+/*
+ * Cleanup code for coping when an interpreter or a channel is deleted.
+ *
+ * PgNotifyInterpDelete is registered as an interpreter deletion callback
+ * for each extant Pg_TclNotifies structure.
+ * NotifyEventDeleteProc is used by PgStopNotifyEventSource to get
+ * rid of pending Tcl events that reference a dying connection.
+ */
+
+void PgNotifyInterpDelete(ClientData clientData, Tcl_Interp *interp)
+{
+ /* Mark the interpreter dead, but don't do anything else yet */
+ Pg_TclNotifies *notifies = (Pg_TclNotifies *) clientData;
+ notifies->interp = NULL;
+}
+
+/* Comparison routine for detecting events to be removed by DeleteEvent */
+static int NotifyEventDeleteProc(Tcl_Event *evPtr, ClientData clientData)
+{
+ NotifyEvent *event;
+ Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
+
+ if (evPtr->proc != Pg_Notify_EventProc) {
+ return 0;
+ }
+ event = (NotifyEvent *) evPtr;
+ if (event->connid != connid) {
+ return 0;
+ }
+ return 1;
+}
+
+/* Start and stop the notify event source for a connection.
+ * We do not bother to run the notifier unless at least one
+ * pg_listen has been executed on the connection. Currently,
+ * once started the notifier is run until the connection is
+ * closed.
+ */
+
+void PgStartNotifyEventSource(Pg_ConnectionId *connid)
+{
+ /* Start the notify event source if it isn't already running */
+ if (! connid->notifier_running) {
+ Tcl_CreateEventSource(Pg_Notify_SetupProc, Pg_Notify_CheckProc,
+ (ClientData) connid);
+ connid->notifier_running = 1;
+ }
+}
+
+void PgStopNotifyEventSource(Pg_ConnectionId *connid)
+{
+ /* Remove the event source */
+ if (connid->notifier_running) {
+ Tcl_DeleteEventSource(Pg_Notify_SetupProc, Pg_Notify_CheckProc,
+ (ClientData) connid);
+ connid->notifier_running = 0;
+ }
+ /* Kill any queued Tcl events that reference this channel */
+ Tcl_DeleteEvents(NotifyEventDeleteProc, (ClientData) connid);
+}
diff --git a/src/interfaces/libpgtcl/pgtclId.h b/src/interfaces/libpgtcl/pgtclId.h
index 648531fdc7fe9dd8fba4248d3056635f04dd89f7..815b11db345cf23fd8ee296887bf5eebf711cf01 100644
--- a/src/interfaces/libpgtcl/pgtclId.h
+++ b/src/interfaces/libpgtcl/pgtclId.h
@@ -8,14 +8,15 @@
*
* Copyright (c) 1994, Regents of the University of California
*
-* $Id: pgtclId.h,v 1.6 1998/03/15 08:03:00 scrappy Exp $
+* $Id: pgtclId.h,v 1.7 1998/06/16 04:10:17 momjian Exp $
*
*-------------------------------------------------------------------------
*/
extern void PgSetConnectionId(Tcl_Interp *interp, PGconn *conn);
-#if (TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION == 5)
+#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION == 5
+/* Only Tcl 7.5 had drivers with this signature */
# define DRIVER_DEL_PROTO ClientData cData, Tcl_Interp *interp, \
Tcl_File inFile, Tcl_File outFile
# define DRIVER_OUTPUT_PROTO ClientData cData, Tcl_File outFile, char *buf, \
@@ -23,6 +24,7 @@ extern void PgSetConnectionId(Tcl_Interp *interp, PGconn *conn);
# define DRIVER_INPUT_PROTO ClientData cData, Tcl_File inFile, char *buf, \
int bufSize, int *errorCodePtr
#else
+/* Tcl 7.6 and beyond use this signature */
# define DRIVER_OUTPUT_PROTO ClientData cData, char *buf, int bufSize, \
int *errorCodePtr
# define DRIVER_INPUT_PROTO ClientData cData, char *buf, int bufSize, \
@@ -39,8 +41,19 @@ extern int PgSetResultId(Tcl_Interp *interp, char *connid, PGresult *res);
extern PGresult *PgGetResultId(Tcl_Interp *interp, char *id);
extern void PgDelResultId(Tcl_Interp *interp, char *id);
extern int PgGetConnByResultId(Tcl_Interp *interp, char *resid);
+extern void PgStartNotifyEventSource(Pg_ConnectionId *connid);
+extern void PgStopNotifyEventSource(Pg_ConnectionId *connid);
+extern void PgNotifyTransferEvents(Pg_ConnectionId *connid);
+extern void PgNotifyInterpDelete(ClientData clientData, Tcl_Interp *interp);
-#if (TCL_MAJOR_VERSION < 8)
+/* GetFileProc is needed in Tcl 7.6 and later */
+#if (TCL_MAJOR_VERSION * 100 + TCL_MINOR_VERSION) >= 706
+#define HAVE_TCL_GETFILEPROC 1
+#else
+#define HAVE_TCL_GETFILEPROC 0
+#endif
+
+#if HAVE_TCL_GETFILEPROC
extern Tcl_File PgGetFileProc(ClientData cData, int direction);
#endif