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.
<ENTRY><function>pg_listen</function></ENTRY>
<ENTRY>establish a callback for NOTIFY messages</ENTRY>
</ROW>
+ <ROW>
+ <ENTRY><function>pg_on_connection_loss</function></ENTRY>
+ <ENTRY>establish a callback for unexpected connection loss</ENTRY>
+ </ROW>
<ROW>
<ENTRY><function>pg_lo_creat</function></ENTRY>
<REPLACEABLE CLASS="PARAMETER">callbackCommand</REPLACEABLE>
</TERM>
<LISTITEM>
-<PARA>If present and not empty, provides the command string to execute
+<PARA>If present, provides the command string to execute
when a matching notification arrives.
</PARA>
</LISTITEM>
<!-- ********************************************************** -->
+<REFENTRY ID="PGTCL-PGON_CONNECTION_LOSS">
+<REFMETA>
+<REFENTRYTITLE>pg_on_connection_loss</REFENTRYTITLE>
+<REFMISCINFO>PGTCL - Asynchronous Notify</REFMISCINFO>
+</REFMETA>
+<REFNAMEDIV>
+<REFNAME>pg_on_connection_loss
+</REFNAME>
+<REFPURPOSE>set or change a callback for unexpected connection loss
+</REFPURPOSE>
+<INDEXTERM
+ID="IX-PGTCL-PGON_CONNECTION_LOSS-1"><PRIMARY>pgtcl</PRIMARY><SECONDARY>connection loss</SECONDARY></INDEXTERM>
+<INDEXTERM ID="IX-PGTCL-PGON_CONNECTION_LOSS-2"><PRIMARY>connection loss</PRIMARY></INDEXTERM>
+</REFNAMEDIV>
+<REFSYNOPSISDIV>
+<REFSYNOPSISDIVINFO>
+<DATE>2002-09-02</DATE>
+</REFSYNOPSISDIVINFO>
+<SYNOPSIS>
+pg_on_connection_loss <REPLACEABLE CLASS="PARAMETER">dbHandle</REPLACEABLE> <REPLACEABLE CLASS="PARAMETER">callbackCommand</REPLACEABLE>
+</SYNOPSIS>
+
+<REFSECT2 ID="R2-PGTCL-PGON_CONNECTION_LOSS-1">
+<REFSECT2INFO>
+<DATE>2002-09-02</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">callbackCommand</REPLACEABLE>
+</TERM>
+<LISTITEM>
+<PARA>If present, provides the command string to execute
+when connection loss is detected.
+</PARA>
+</LISTITEM>
+</VARLISTENTRY>
+</VARIABLELIST>
+</REFSECT2>
+
+<REFSECT2 ID="R2-PGTCL-PGON_CONNECTION_LOSS-2">
+<REFSECT2INFO>
+<DATE>2002-09-02</DATE>
+</REFSECT2INFO>
+<TITLE>Outputs
+</TITLE>
+<VARIABLELIST>
+<VARLISTENTRY>
+<TERM>
+ None
+</TERM>
+<LISTITEM>
+<PARA>
+</PARA>
+</LISTITEM>
+</VARLISTENTRY>
+</VARIABLELIST>
+</REFSECT2>
+</REFSYNOPSISDIV>
+
+<REFSECT1 ID="R1-PGTCL-PGON_CONNECTION_LOSS-1">
+<REFSECT1INFO>
+<DATE>2002-09-02</DATE>
+</REFSECT1INFO>
+<TITLE>Description
+</TITLE>
+<PARA><FUNCTION>pg_on_connection_loss</FUNCTION> creates, changes, or cancels
+a request to execute a callback command if an unexpected loss of connection
+to the database occurs.
+With a <parameter>callbackCommand</>
+parameter, the request is established, or the command string of an already
+existing request is replaced. With no <parameter>callbackCommand</>
+parameter, a prior request is canceled.
+</PARA>
+
+<para>
+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 <FUNCTION>update</FUNCTION> or <FUNCTION>vwait</FUNCTION> to cause
+the idle loop to be entered.
+</Para>
+</REFSECT1>
+
+</REFENTRY>
+
+<!-- ********************************************************** -->
+
<REFENTRY ID="PGTCL-PGLOCREAT">
<REFMETA>
<REFENTRYTITLE>pg_lo_creat</REFENTRYTITLE>
*
*
* 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 $
*
*-------------------------------------------------------------------------
*/
"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;
}
*
*
* 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 $
*
*-------------------------------------------------------------------------
*/
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,
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;
+}
* 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 $
*
*-------------------------------------------------------------------------
*/
#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)
* 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
* 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
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 */
* 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 $
*
*-------------------------------------------------------------------------
*/
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);
/*
* 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);
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;
{
NotifyEvent *event = (NotifyEvent *) evPtr;
Pg_TclNotifies *notifies;
- Tcl_HashEntry *entry;
char *callback;
char *svcallback;
/* 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
/*
* 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);
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);
Tcl_Release((ClientData) event->connid);
+ if (event->notify)
+ PQfreeNotify(event->notify);
+
return 1;
}
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);
}
/*
}
/*
- * 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,
{
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;
* 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);
+ }
}
* 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
}
void
-PgStopNotifyEventSource(Pg_ConnectionId * connid)
+PgStopNotifyEventSource(Pg_ConnectionId * connid, bool allevents)
{
/* Remove the event source */
if (connid->notifier_running)
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);
}
* 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 $
*
*-------------------------------------------------------------------------
*/
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 */
projects / postgresql / commitdiff