diff --git a/doc/src/sgml/libpgtcl.sgml b/doc/src/sgml/libpgtcl.sgml index 3bebbc327f8de132b13dacbf4705e81c477d48d6..c42f0988108cdf0e50e053e9138cf9e61044a36b 100644 --- a/doc/src/sgml/libpgtcl.sgml +++ b/doc/src/sgml/libpgtcl.sgml @@ -72,6 +72,10 @@ <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> @@ -1245,7 +1249,7 @@ pg_listen <REPLACEABLE CLASS="PARAMETER">dbHandle</REPLACEABLE> <REPLACEABLE CLA <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> @@ -1312,6 +1316,105 @@ invoke the SQL NOTIFY statement using <FUNCTION>pg_exec</FUNCTION>. <!-- ********************************************************** --> +<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> diff --git a/src/interfaces/libpgtcl/pgtcl.c b/src/interfaces/libpgtcl/pgtcl.c index a415d63be65a4c89e5d7a46a0c7a5ffe18b6b5f0..e0f64958fe965096276368166fc959fc70be8a2c 100644 --- a/src/interfaces/libpgtcl/pgtcl.c +++ b/src/interfaces/libpgtcl/pgtcl.c @@ -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; } diff --git a/src/interfaces/libpgtcl/pgtclCmds.c b/src/interfaces/libpgtcl/pgtclCmds.c index 901bcbfd32935156bf4fbed902eb37c1d0124d2d..ca754688564f58bb7bbadcd7a3112d2e861df445 100644 --- a/src/interfaces/libpgtcl/pgtclCmds.c +++ b/src/interfaces/libpgtcl/pgtclCmds.c @@ -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; +} diff --git a/src/interfaces/libpgtcl/pgtclCmds.h b/src/interfaces/libpgtcl/pgtclCmds.h index 3b2988d9d00d2eff033821cdcd64ad23d8131394..97b19da7f4c68a9bfc9fe8c1b2a0cda8b3f16749 100644 --- a/src/interfaces/libpgtcl/pgtclCmds.h +++ b/src/interfaces/libpgtcl/pgtclCmds.h @@ -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 */ diff --git a/src/interfaces/libpgtcl/pgtclId.c b/src/interfaces/libpgtcl/pgtclId.c index 3a3bee63fd8979666804a6293a9188ac4112c220..f8b0d5c55bf70d9fd4dcb6f2517b6d40b2b0a1c0 100644 --- a/src/interfaces/libpgtcl/pgtclId.c +++ b/src/interfaces/libpgtcl/pgtclId.c @@ -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); } diff --git a/src/interfaces/libpgtcl/pgtclId.h b/src/interfaces/libpgtcl/pgtclId.h index ac99b9c6e00a8619fcb0d5d00bc9cf95904caef4..4f5558561bfb17c6b73adfaa33c5292156aa34fb 100644 --- a/src/interfaces/libpgtcl/pgtclId.h +++ b/src/interfaces/libpgtcl/pgtclId.h @@ -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 */