aboutsummaryrefslogtreecommitdiff
path: root/src/interfaces/libpgtcl/pgtclCmds.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/interfaces/libpgtcl/pgtclCmds.c')
-rw-r--r--src/interfaces/libpgtcl/pgtclCmds.c238
1 files changed, 116 insertions, 122 deletions
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 <stdio.h>
#include <stdlib.h>
#include <string.h>
+#include <ctype.h>
#include <tcl.h>
#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(&notifies->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(&notifies->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(&notifies->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;
}
generated by cgit v1.2.3 (git 2.25.1) at 2025-05-31 11:43:38 +0000