From 583891833ff102b805a752ded0ad38bb8087dcf9 Mon Sep 17 00:00:00 2001 From: Bruce Momjian Date: Tue, 16 Jun 1998 04:10:17 +0000 Subject: [PATCH] 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 --- doc/src/sgml/libpgtcl.sgml | 135 +++++++++++-- src/interfaces/libpgtcl/pgtcl.c | 11 +- src/interfaces/libpgtcl/pgtclCmds.c | 238 ++++++++++++----------- src/interfaces/libpgtcl/pgtclCmds.h | 33 +++- src/interfaces/libpgtcl/pgtclId.c | 283 ++++++++++++++++++++++++++-- src/interfaces/libpgtcl/pgtclId.h | 19 +- 6 files changed, 548 insertions(+), 171 deletions(-) diff --git a/doc/src/sgml/libpgtcl.sgml b/doc/src/sgml/libpgtcl.sgml index 331ad1a9d3..82c267a456 100644 --- a/doc/src/sgml/libpgtcl.sgml +++ b/doc/src/sgml/libpgtcl.sgml @@ -3,11 +3,8 @@ pgtcl is a tcl package for front-end programs to interface with Postgres -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. @@ -42,17 +39,25 @@ the standard Unix file system interface. pg_disconnect closes a connection + + pg_conndefaults + get connection options and their defaults + pg_exec send a query to the backend + + pg_result + manipulate the results of a query + pg_select loop over the result of a select statement - pg_result - manipulate the results of a query + pg_listen + establish a callback for NOTIFY messages @@ -101,8 +106,7 @@ the standard Unix file system interface. -Some commands equivalent to libpq commands are provided for connection -and query operations. +These commands are described further on subsequent pages. @@ -142,7 +146,7 @@ proc getDBs { {host "localhost"} {port "5432"} } { -Reference Information +pgtcl Command Reference Information @@ -235,7 +239,7 @@ pg_connect dbName -host < 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" @@ -414,7 +418,114 @@ pg_exec dbHandle pg_exec submits a query to the Postgres 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. + + + + + +pg_listen +PGTCL - Asynchronous Notify + + +pg_listen + +sets or changes a callback for asynchronous NOTIFY messages + +pgtclnotify +notify + + + +1998-5-22 + + +pg_listen dbHandle notifyName callbackCommand + + + + +1998-5-22 + +Inputs + + + + + dbHandle + + +Specifies a valid database handle. + + + + + + notifyName + + +Specifies the notification name to start or stop listening to. + + + + + + callbackCommand + + +If present and not empty, provides the command string to execute +when a matching notification arrives. + + + + + + + + +1998-5-22 + +Outputs + + + + + None + + + + + + + + + + + + +1998-5-22 + +Description + +pg_listen creates, changes, or cancels a request +to listen for asynchronous NOTIFY messages from the +Postgres 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. + +After a pg_listen 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 +Postgres 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 update or vwait to cause +the idle loop to be entered. diff --git a/src/interfaces/libpgtcl/pgtcl.c b/src/interfaces/libpgtcl/pgtcl.c index a90c0c7c49..af6f4d74af 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 b7eae9d6b7..5b3d5e91d5 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 #include #include +#include #include #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 f0f8513da4..052a1a0a6f 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 b3985f7321..4ed8f58d57 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 648531fdc7..815b11db34 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 -- 2.40.0