pgtclid.c

关系型数据库 Postgresql 6.5.2

		return -1;
	}

	*connid_p = connid;

	return resid;
}


/*
 * Get back the result pointer from the Id
 */
PGresult   *
PgGetResultId(Tcl_Interp *interp, char *id)
{
	Pg_ConnectionId *connid;
	int			resid;

	if (!id)
		return NULL;
	resid = getresid(interp, id, &connid);
	if (resid == -1)
		return NULL;
	return connid->results[resid];
}


/*
 * Remove a result Id from the hash tables
 */
void
PgDelResultId(Tcl_Interp *interp, char *id)
{
	Pg_ConnectionId *connid;
	int			resid;

	resid = getresid(interp, id, &connid);
	if (resid == -1)
		return;
	connid->results[resid] = 0;
}


/*
 * Get the connection Id from the result Id
 */
int
PgGetConnByResultId(Tcl_Interp *interp, char *resid_c)
{
	char	   *mark;
	Tcl_Channel conn_chan;

	if (!(mark = strchr(resid_c, '.')))
		goto error_out;
	*mark = '\0';
	conn_chan = Tcl_GetChannel(interp, resid_c, 0);
	*mark = '.';
	if (conn_chan && Tcl_GetChannelType(conn_chan) == &Pg_ConnType)
	{
		Tcl_SetResult(interp, Tcl_GetChannelName(conn_chan), TCL_VOLATILE);
		return TCL_OK;
	}

error_out:
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, resid_c, " is not a valid connection\n", 0);
	return TCL_ERROR;
}




/*-------------------------------------------
  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 the file event handler
  for it, which has the effect of disabling any file-ready events that might
  be hanging about in the Tcl event queue.	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.)

  Another headache is that Ousterhout keeps changing the Tcl I/O interfaces.
  libpgtcl currently claims to work with Tcl 7.5, 7.6, and 8.0, and each of
  'em is different.  Worse, the Tcl_File type went away in 8.0, which means
  there is no longer any platform-independent way of waiting for file ready.
  So we now have to use a Unix-specific interface.	Grumble.

  In the current design, Pg_Notify_FileHandler is a file handler that
  we establish by calling Tcl_CreateFileHandler().	It gets invoked from
  the Tcl event loop whenever the underlying PGconn's socket is read-ready.
  We suck up any available data (to clear the OS-level read-ready condition)
  and then transfer any available PGnotify events into the Tcl event queue.
  Eventually these events will be dispatched to Pg_Notify_EventProc.  When
  we do an ordinary PQexec, we must also transfer PGnotify events into Tcl's
  event queue, since libpq might have read them when we weren't looking.
  ------------------------------------------*/

typedef struct
{
	Tcl_Event	header;			/* Standard Tcl event info */
	PGnotify	info;			/* Notify name from SQL server */
	Pg_ConnectionId *connid;	/* Connection for server */
} NotifyEvent;

/* Dispatch a NotifyEvent 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;

	/* If connection's been closed, just forget the whole thing. */
	if (event->connid == NULL)
		return 1;

	/*
	 * 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(&notifies->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_FileHandler
 * (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);
	}

	/*
	 * 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.
	 */
	if (PQsocket(connid->conn) < 0)
		PgStopNotifyEventSource(connid);
}

/*
 * 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 cancel
 * pending Tcl NotifyEvents 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 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,
 * with the result that events queued immediately thereafter get lost.
 * Therefore we daren't tell Tcl_DeleteEvents to actually delete anything!
 * We simply use it as a way of scanning the event queue.  Events matching
 * the about-to-be-deleted connid are marked dead by setting their connid
 * fields to NULL.	Then Pg_Notify_EventProc will do nothing when those
 * events are executed.
 */
static int
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->connid = NULL;
	}
	return 0;
}

/*
 * File handler callback: called when Tcl has detected read-ready on socket.
 * The clientData is a pointer to the associated connection.
 * We can ignore the condition mask since we only ever ask about read-ready.
 */

static void
Pg_Notify_FileHandler(ClientData clientData, int mask)
{
	Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;

	/*
	 * Consume any data available from the SQL server (this just buffers
	 * 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);
}


/*
 * 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.
 *
 * FIXME: if PQreset is executed on the underlying PGconn, the active
 * socket number could change.	How and when should we test for this
 * and update the Tcl file handler linkage?  (For that matter, we'd
 * also have to reissue LISTEN commands for active LISTENs, since the
 * new backend won't know about 'em.  I'm leaving this problem for
 * another day.)
 */

void
PgStartNotifyEventSource(Pg_ConnectionId *connid)
{
	/* Start the notify event source if it isn't already running */
	if (!connid->notifier_running)
	{
		int			pqsock = PQsocket(connid->conn);

		if (pqsock >= 0)
		{
#if TCL_MAJOR_VERSION >= 8
			/* In Tcl 8, Tcl_CreateFileHandler takes a socket directly. */
			Tcl_CreateFileHandler(pqsock, TCL_READABLE,
							 Pg_Notify_FileHandler, (ClientData) connid);
#else
			/* In Tcl 7.5 and 7.6, we need to gin up a Tcl_File. */
			Tcl_File	tclfile = Tcl_GetFile((ClientData) pqsock, TCL_UNIX_FD);

			Tcl_CreateFileHandler(tclfile, TCL_READABLE,
							 Pg_Notify_FileHandler, (ClientData) connid);
#endif
			connid->notifier_running = 1;
			connid->notifier_socket = pqsock;
		}
	}
}

void
PgStopNotifyEventSource(Pg_ConnectionId *connid)
{
	/* Remove the event source */
	if (connid->notifier_running)
	{
#if TCL_MAJOR_VERSION >= 8
		/* In Tcl 8, Tcl_DeleteFileHandler takes a socket directly. */
		Tcl_DeleteFileHandler(connid->notifier_socket);
#else
		/* In Tcl 7.5 and 7.6, we need to gin up a Tcl_File. */
		Tcl_File	tclfile = Tcl_GetFile((ClientData) connid->notifier_socket,
										  TCL_UNIX_FD);

		Tcl_DeleteFileHandler(tclfile);
#endif
		connid->notifier_running = 0;
	}

	/* Kill any queued Tcl events that reference this channel */
	Tcl_DeleteEvents(NotifyEventDeleteProc, (ClientData) connid);
}