pg_on_connection_loss command for libpgtcl. Patch from
authorTom Lane
Mon, 2 Sep 2002 21:51:47 +0000 (21:51 +0000)
committerTom Lane
Mon, 2 Sep 2002 21:51:47 +0000 (21:51 +0000)
Gerhard Hintermayer, revised and documented by Tom Lane.

This patch also fixes a 'must fix' bug: libpgtcl's LISTEN/NOTIFY
support was broken by the recent changes to the PGnotify structure.
Guess that change wasn't quite so safe as we thought.

doc/src/sgml/libpgtcl.sgml
src/interfaces/libpgtcl/pgtcl.c
src/interfaces/libpgtcl/pgtclCmds.c
src/interfaces/libpgtcl/pgtclCmds.h
src/interfaces/libpgtcl/pgtclId.c
src/interfaces/libpgtcl/pgtclId.h

index 3bebbc327f8de132b13dacbf4705e81c477d48d6..c42f0988108cdf0e50e053e9138cf9e61044a36b 100644 (file)
     pg_listen
     establish a callback for NOTIFY messages
   
+  
+    pg_on_connection_loss
+    establish a callback for unexpected connection loss
+  
 
   
     pg_lo_creat
@@ -1245,7 +1249,7 @@ pg_listen dbHandle 
   callbackCommand
 
 
-If present and not empty, provides the command string to execute
+If present, provides the command string to execute
 when a matching notification arrives.
 
 
@@ -1312,6 +1316,105 @@ invoke the SQL NOTIFY statement using pg_exec.
 
 
 
+
+
+pg_on_connection_loss
+PGTCL - Asynchronous Notify
+
+
+pg_on_connection_loss
+
+set or change a callback for unexpected connection loss
+
+
+ID="IX-PGTCL-PGON_CONNECTION_LOSS-1">pgtclconnection loss
+connection loss
+
+
+
+2002-09-02
+
+
+pg_on_connection_loss dbHandle callbackCommand
+
+
+
+
+2002-09-02
+
+Inputs</div> <div class="diff add">+
+
+
+
+  dbHandle
+
+
+Specifies a valid database handle.
+
+
+
+
+
+  callbackCommand
+
+
+If present, provides the command string to execute
+when connection loss is detected.
+
+
+
+
+
+
+
+
+2002-09-02
+
+Outputs</div> <div class="diff add">+
+
+
+
+  None
+
+
+
+
+
+
+
+
+
+
+
+
+2002-09-02
+
+Description</div> <div class="diff add">+
+pg_on_connection_loss creates, changes, or cancels
+a request to execute a callback command if an unexpected loss of connection
+to the database occurs.
+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.
+
+
+
+The callback 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 update or vwait to cause
+the idle loop to be entered.
+
+
+
+
+
+
+
 
 
 pg_lo_creat
index a415d63be65a4c89e5d7a46a0c7a5ffe18b6b5f0..e0f64958fe965096276368166fc959fc70be8a2c 100644 (file)
@@ -10,7 +10,7 @@
  *
  *
  * IDENTIFICATION
- *   $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtcl.c,v 1.25 2002/06/20 20:29:53 momjian Exp $
+ *   $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtcl.c,v 1.26 2002/09/02 21:51:47 tgl Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -151,8 +151,13 @@ Pgtcl_Init(Tcl_Interp *interp)
                      "pg_listen",
                      Pg_listen,
                      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+   
+   Tcl_CreateCommand(interp,
+                     "pg_on_connection_loss",
+                     Pg_on_connection_loss,
+                     (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
 
-   Tcl_PkgProvide(interp, "Pgtcl", "1.3");
+   Tcl_PkgProvide(interp, "Pgtcl", "1.4");
 
    return TCL_OK;
 }
index 901bcbfd32935156bf4fbed902eb37c1d0124d2d..ca754688564f58bb7bbadcd7a3112d2e861df445 100644 (file)
@@ -8,7 +8,7 @@
  *
  *
  * IDENTIFICATION
- *   $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtclCmds.c,v 1.65 2002/09/02 06:11:43 momjian Exp $
+ *   $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtclCmds.c,v 1.66 2002/09/02 21:51:47 tgl Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -1876,6 +1876,7 @@ Pg_listen(ClientData cData, Tcl_Interp *interp, int argc, char *argv[])
        notifies = (Pg_TclNotifies *) ckalloc(sizeof(Pg_TclNotifies));
        notifies->interp = interp;
        Tcl_InitHashTable(¬ifies->notify_hash, TCL_STRING_KEYS);
+       notifies->conn_loss_cmd = NULL;
        notifies->next = connid->notify_list;
        connid->notify_list = notifies;
        Tcl_CallWhenDeleted(interp, PgNotifyInterpDelete,
@@ -1970,3 +1971,84 @@ Pg_listen(ClientData cData, Tcl_Interp *interp, int argc, char *argv[])
    ckfree(caserelname);
    return TCL_OK;
 }
+
+/***********************************
+Pg_on_connection_loss
+   create or remove a callback request for unexpected connection loss
+
+ syntax:
+   pg_on_connection_loss conn ?callbackcommand?
+
+   With a third arg, creates or changes the callback command for
+   connection loss; 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_on_connection_loss(ClientData cData, Tcl_Interp *interp, int argc, char *argv[])
+{
+   char       *callback = NULL;
+   Pg_TclNotifies *notifies;
+   Pg_ConnectionId *connid;
+   PGconn     *conn;
+
+   if (argc < 2 || argc > 3)
+   {
+       Tcl_AppendResult(interp, "wrong # args, should be \"",
+                        argv[0], " connection ?callback?\"", 0);
+       return TCL_ERROR;
+   }
+
+   /*
+    * Get the command arguments.
+    */
+   conn = PgGetConnectionId(interp, argv[1], &connid);
+   if (conn == (PGconn *) NULL)
+       return TCL_ERROR;
+
+   if ((argc > 2) && *argv[2])
+   {
+       callback = (char *) ckalloc((unsigned) (strlen(argv[2]) + 1));
+       strcpy(callback, argv[2]);
+   }
+
+   /* Find or make a Pg_TclNotifies struct for this interp and connection */
+
+   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->conn_loss_cmd = NULL;
+       notifies->next = connid->notify_list;
+       connid->notify_list = notifies;
+       Tcl_CallWhenDeleted(interp, PgNotifyInterpDelete,
+                           (ClientData) notifies);
+   }
+
+   /* Store new callback setting */
+
+   if (notifies->conn_loss_cmd)
+       ckfree((void *) notifies->conn_loss_cmd);
+   notifies->conn_loss_cmd = callback;
+
+   if (callback)
+   {
+       /*
+        * Start the notify event source if it isn't already running.
+        * The notify source will cause Tcl to watch read-ready on the
+        * connection socket, so that we find out quickly if the connection
+        * drops.
+        */
+       PgStartNotifyEventSource(connid);
+   }
+
+   return TCL_OK;
+}
index 3b2988d9d00d2eff033821cdcd64ad23d8131394..97b19da7f4c68a9bfc9fe8c1b2a0cda8b3f16749 100644 (file)
@@ -6,7 +6,7 @@
  * Portions Copyright (c) 1996-2002, PostgreSQL Global Development Group
  * Portions Copyright (c) 1994, Regents of the University of California
  *
- * $Id: pgtclCmds.h,v 1.26 2002/06/20 20:29:53 momjian Exp $
+ * $Id: pgtclCmds.h,v 1.27 2002/09/02 21:51:47 tgl Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -21,7 +21,7 @@
 #define RES_START 16
 
 /*
- * From Tcl verion 8.0 on we can make large object access binary.
+ * From Tcl version 8.0 on we can make large object access binary.
  */
 #ifdef TCL_MAJOR_VERSION
 #if (TCL_MAJOR_VERSION >= 8)
@@ -36,6 +36,9 @@
  * 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.)
+ *
+ * We use the same approach for pg_on_connection_loss callbacks, but they
+ * are not kept in a hashtable since there's no name associated.
  */
 
 typedef struct Pg_TclNotifies_s
@@ -48,6 +51,8 @@ typedef struct Pg_TclNotifies_s
     * got round to deleting the Pg_TclNotifies structure.
     */
    Tcl_HashTable notify_hash;  /* Active pg_listen requests */
+
+   char       *conn_loss_cmd;  /* pg_on_connection_loss cmd, or NULL */
 }  Pg_TclNotifies;
 
 typedef struct Pg_ConnectionId_s
@@ -128,5 +133,7 @@ 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_on_connection_loss(
+           ClientData cData, Tcl_Interp *interp, int argc, char *argv[]);
 
 #endif   /* PGTCLCMDS_H */
index 3a3bee63fd8979666804a6293a9188ac4112c220..f8b0d5c55bf70d9fd4dcb6f2517b6d40b2b0a1c0 100644 (file)
@@ -13,7 +13,7 @@
  * Portions Copyright (c) 1994, Regents of the University of California
  *
  * IDENTIFICATION
- *   $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtclId.c,v 1.32 2002/08/18 01:39:43 momjian Exp $
+ *   $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtclId.c,v 1.33 2002/09/02 21:51:47 tgl Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -268,6 +268,8 @@ PgDelConnectionId(DRIVER_DEL_PROTO)
             entry = Tcl_NextHashEntry(&hsearch))
            ckfree((char *) Tcl_GetHashValue(entry));
        Tcl_DeleteHashTable(¬ifies->notify_hash);
+       if (notifies->conn_loss_cmd)
+           ckfree((void *) notifies->conn_loss_cmd);
        Tcl_DontCallWhenDeleted(notifies->interp, PgNotifyInterpDelete,
                                (ClientData) notifies);
        ckfree((void *) notifies);
@@ -275,9 +277,9 @@ PgDelConnectionId(DRIVER_DEL_PROTO)
 
    /*
     * Turn off the Tcl event source for this connection, and delete any
-    * pending notify events.
+    * pending notify and connection-loss events.
     */
-   PgStopNotifyEventSource(connid);
+   PgStopNotifyEventSource(connid, true);
 
    /* Close the libpq connection too */
    PQfinish(connid->conn);
@@ -495,7 +497,8 @@ error_out:
 typedef struct
 {
    Tcl_Event   header;         /* Standard Tcl event info */
-   PGnotify    info;           /* Notify name from SQL server */
+   PGnotify   *notify;         /* Notify event from libpq, or NULL */
+   /* We use a NULL notify pointer to denote a connection-loss event */
    Pg_ConnectionId *connid;    /* Connection for server */
 }  NotifyEvent;
 
@@ -506,7 +509,6 @@ Pg_Notify_EventProc(Tcl_Event *evPtr, int flags)
 {
    NotifyEvent *event = (NotifyEvent *) evPtr;
    Pg_TclNotifies *notifies;
-   Tcl_HashEntry *entry;
    char       *callback;
    char       *svcallback;
 
@@ -516,7 +518,11 @@ Pg_Notify_EventProc(Tcl_Event *evPtr, int flags)
 
    /* If connection's been closed, just forget the whole thing. */
    if (event->connid == NULL)
+   {
+       if (event->notify)
+           PQfreeNotify(event->notify);
        return 1;
+   }
 
    /*
     * Preserve/Release to ensure the connection struct doesn't disappear
@@ -541,17 +547,29 @@ Pg_Notify_EventProc(Tcl_Event *evPtr, int flags)
        /*
         * 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 (event->notify)
+       {
+           /* Ordinary NOTIFY event */
+           Tcl_HashEntry *entry;
+
+           entry = Tcl_FindHashEntry(¬ifies->notify_hash,
+                                     event->notify->relname);
+           if (entry == NULL)
+               continue;       /* no pg_listen in this interpreter */
+           callback = (char *) Tcl_GetHashValue(entry);
+       }
+       else
+       {
+           /* Connection-loss event */
+           callback = notifies->conn_loss_cmd;
+       }
+
        if (callback == NULL)
-           continue;           /* safety check -- shouldn't happen */
+           continue;           /* nothing to do for this interpreter */
 
        /*
         * We have to copy the callback string in case the user executes a
-        * new pg_listen during the callback.
+        * new pg_listen or pg_on_connection_loss during the callback.
         */
        svcallback = (char *) ckalloc((unsigned) (strlen(callback) + 1));
        strcpy(svcallback, callback);
@@ -562,7 +580,10 @@ Pg_Notify_EventProc(Tcl_Event *evPtr, int flags)
        Tcl_Preserve((ClientData) interp);
        if (Tcl_GlobalEval(interp, svcallback) != TCL_OK)
        {
-           Tcl_AddErrorInfo(interp, "\n    (\"pg_listen\" script)");
+           if (event->notify)
+               Tcl_AddErrorInfo(interp, "\n    (\"pg_listen\" script)");
+           else
+               Tcl_AddErrorInfo(interp, "\n    (\"pg_on_connection_loss\" script)");
            Tcl_BackgroundError(interp);
        }
        Tcl_Release((ClientData) interp);
@@ -578,6 +599,9 @@ Pg_Notify_EventProc(Tcl_Event *evPtr, int flags)
 
    Tcl_Release((ClientData) event->connid);
 
+   if (event->notify)
+       PQfreeNotify(event->notify);
+
    return 1;
 }
 
@@ -598,20 +622,45 @@ PgNotifyTransferEvents(Pg_ConnectionId * connid)
        NotifyEvent *event = (NotifyEvent *) ckalloc(sizeof(NotifyEvent));
 
        event->header.proc = Pg_Notify_EventProc;
-       event->info = *notify;
+       event->notify = notify;
        event->connid = connid;
        Tcl_QueueEvent((Tcl_Event *) event, TCL_QUEUE_TAIL);
-       PQfreeNotify(notify);
    }
 
    /*
     * This is also a good place to check for unexpected closure of the
     * connection (ie, backend crash), in which case we must shut down the
     * notify event source to keep Tcl from trying to select() on the now-
-    * closed socket descriptor.
+    * closed socket descriptor.  But don't kill on-connection-loss events;
+    * in fact, register one.
     */
    if (PQsocket(connid->conn) < 0)
-       PgStopNotifyEventSource(connid);
+       PgConnLossTransferEvents(connid);
+}
+
+/*
+ * Handle a connection-loss event
+ */
+void
+PgConnLossTransferEvents(Pg_ConnectionId * connid)
+{
+   if (connid->notifier_running)
+   {
+       /* Put the on-connection-loss event in the Tcl queue */
+       NotifyEvent *event = (NotifyEvent *) ckalloc(sizeof(NotifyEvent));
+
+       event->header.proc = Pg_Notify_EventProc;
+       event->notify = NULL;
+       event->connid = connid;
+       Tcl_QueueEvent((Tcl_Event *) event, TCL_QUEUE_TAIL);
+   }
+
+   /*
+    * Shut down the notify event source to keep Tcl from trying to select()
+    * on the now-closed socket descriptor.  And zap any unprocessed notify
+    * events ... but not, of course, the connection-loss event.
+    */
+   PgStopNotifyEventSource(connid, false);
 }
 
 /*
@@ -633,7 +682,7 @@ PgNotifyInterpDelete(ClientData clientData, Tcl_Interp *interp)
 }
 
 /*
- * Comparison routine for detecting events to be removed by Tcl_DeleteEvents.
+ * Comparison routines for detecting events to be removed by Tcl_DeleteEvents.
  * NB: In (at least) Tcl versions 7.6 through 8.0.3, there is a serious
  * bug in Tcl_DeleteEvents: if there are multiple events on the queue and
  * you tell it to delete the last one, the event list pointers get corrupted,
@@ -649,6 +698,22 @@ NotifyEventDeleteProc(Tcl_Event *evPtr, ClientData clientData)
 {
    Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
 
+   if (evPtr->proc == Pg_Notify_EventProc)
+   {
+       NotifyEvent *event = (NotifyEvent *) evPtr;
+
+       if (event->connid == connid && event->notify != NULL)
+           event->connid = NULL;
+   }
+   return 0;
+}
+
+/* This version deletes on-connection-loss events too */
+static int
+AllNotifyEventDeleteProc(Tcl_Event *evPtr, ClientData clientData)
+{
+   Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
+
    if (evPtr->proc == Pg_Notify_EventProc)
    {
        NotifyEvent *event = (NotifyEvent *) evPtr;
@@ -675,10 +740,19 @@ Pg_Notify_FileHandler(ClientData clientData, int mask)
     * it internally to libpq; but it will clear the read-ready
     * condition).
     */
-   PQconsumeInput(connid->conn);
-
-   /* Transfer notify events from libpq to Tcl event queue. */
-   PgNotifyTransferEvents(connid);
+   if (PQconsumeInput(connid->conn))
+   {
+       /* Transfer notify events from libpq to Tcl event queue. */
+       PgNotifyTransferEvents(connid);
+   }
+   else
+   {
+       /*
+        * If there is no input but we have read-ready,
+        * assume this means we lost the connection.
+        */
+       PgConnLossTransferEvents(connid);
+   }
 }
 
 
@@ -686,8 +760,8 @@ Pg_Notify_FileHandler(ClientData clientData, int mask)
  * 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.
+ * or pg_on_connection_loss has been executed on the connection.  Currently,
+ * once started the notifier is run until the connection is closed.
  *
  * FIXME: if PQreset is executed on the underlying PGconn, the active
  * socket number could change. How and when should we test for this
@@ -724,7 +798,7 @@ PgStartNotifyEventSource(Pg_ConnectionId * connid)
 }
 
 void
-PgStopNotifyEventSource(Pg_ConnectionId * connid)
+PgStopNotifyEventSource(Pg_ConnectionId * connid, bool allevents)
 {
    /* Remove the event source */
    if (connid->notifier_running)
@@ -742,6 +816,9 @@ PgStopNotifyEventSource(Pg_ConnectionId * connid)
        connid->notifier_running = 0;
    }
 
-   /* Kill any queued Tcl events that reference this channel */
-   Tcl_DeleteEvents(NotifyEventDeleteProc, (ClientData) connid);
+   /* Kill queued Tcl events that reference this channel */
+   if (allevents)
+       Tcl_DeleteEvents(AllNotifyEventDeleteProc, (ClientData) connid);
+   else
+       Tcl_DeleteEvents(NotifyEventDeleteProc, (ClientData) connid);
 }
index ac99b9c6e00a8619fcb0d5d00bc9cf95904caef4..4f5558561bfb17c6b73adfaa33c5292156aa34fb 100644 (file)
@@ -10,7 +10,7 @@
  * Portions Copyright (c) 1996-2002, PostgreSQL Global Development Group
  * Portions Copyright (c) 1994, Regents of the University of California
  *
- * $Id: pgtclId.h,v 1.20 2002/08/18 01:39:43 momjian Exp $
+ * $Id: pgtclId.h,v 1.21 2002/09/02 21:51:47 tgl Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -44,8 +44,9 @@ 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 PgStopNotifyEventSource(Pg_ConnectionId * connid, bool allevents);
 extern void PgNotifyTransferEvents(Pg_ConnectionId * connid);
+extern void PgConnLossTransferEvents(Pg_ConnectionId * connid);
 extern void PgNotifyInterpDelete(ClientData clientData, Tcl_Interp *interp);
 
 /* GetFileProc is needed in Tcl 7.6 *only* ... it went away again in 8.0 */