diff --git a/doc/src/sgml/libpgtcl.sgml b/doc/src/sgml/libpgtcl.sgml index 331ad1a9d3a..82c267a4563 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 a90c0c7c490..af6f4d74af7 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 b7eae9d6b78..5b3d5e91d54 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; } + /* + * 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 { + /* Downcase it */ + char *rels = origrelname; + char *reld = caserelname; + while (*rels) { + *reld++ = tolower(*rels++); + } + *reld = '\0'; + } + + if ((argc > 3) && *argv[3]) { + callback = (char *) ckalloc((unsigned) (strlen(argv[3]) + 1)); + strcpy(callback, argv[3]); + } + + /* 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->next = connid->notify_list; + connid->notify_list = notifies; + Tcl_CallWhenDeleted(interp, PgNotifyInterpDelete, + (ClientData) notifies); + } + /* - * Set or update a callback for a relation; + * 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); - } else { - /* Free the old callback string */ - ckfree((char *) Tcl_GetHashValue(entry)); - } - /* Store the new callback command */ - Tcl_SetHashValue(entry, 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); } /* * Remove a callback for a relation. There is no way to - * un-listen a relation, simply remove the callback from + * un-listen a relation, so we 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); + 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 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; - - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args, should be \"", - argv[0], " connection\"", 0); - return TCL_ERROR; - } - - /* - * Get the connection argument. - */ - 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; - } - PQclear(result); - - /* - * Loop while there are pending notifies. - */ - 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); - } - - /* - * 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 f0f8513da44..052a1a0a6f2 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 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(¬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 648531fdc7f..815b11db345 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