The attached patch modifies libpgtcl per previous discussion: the

pg_notifies statement is eliminated, and callbacks defined by
pg_listen are instead invoked automatically from the Tcl idle loop
whenever a NOTIFY message is received.

I have done only cursory testing, so there may be problems still
lurking (particularly on non-Unix machines?).  But it seems to
work.

Patch is against today's cvs sources.  Note that this will not work
with the 6.3.2 release since it depends on the new libpq.

The diffs are a bit large so I've gzipped them.  A patch to update
libpgtcl.sgml is included too.

			regards, tom lane

1 files changed, 267 insertions, 16 deletions

diff --git a/src/interfaces/libpgtcl/pgtclId.c b/src/interfaces/libpgtcl/pgtclId.c
index b3985f73216..4ed8f58d57f 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(&notifies->notify_hash, &hsearch);
+	     entry != NULL;
+	     entry = Tcl_NextHashEntry(&hsearch)) {
+	    ckfree((char*) Tcl_GetHashValue(entry));
+	}
+	Tcl_DeleteHashTable(&notifies->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(&notifies->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);
+}