pgtclcmds.c

关系型数据库 Postgresql 6.5.2

	else if (strcmp(modeWord, "INV_WRITE") == 0)
		mode = INV_WRITE;
	else
	{
		Tcl_AppendResult(interp,
						 "invalid mode argument to Pg_lo_creat\nmode argument must be some OR'd combination of INV_READ, and INV_WRITE",
						 0);
		return TCL_ERROR;
	}

	while ((modeWord = strtok((char *) NULL, "|")) != NULL)
	{
		if (strcmp(modeWord, "INV_READ") == 0)
			mode |= INV_READ;
		else if (strcmp(modeWord, "INV_WRITE") == 0)
			mode |= INV_WRITE;
		else
		{
			Tcl_AppendResult(interp,
							 "invalid mode argument to Pg_lo_creat\nmode argument must be some OR'd combination of INV_READ, INV_WRITE",
							 0);
			return TCL_ERROR;
		}
	}
	sprintf(interp->result, "%d", lo_creat(conn, mode));
	return TCL_OK;
}

/***********************************
Pg_lo_tell
	returns the current seek location of the large object

 syntax:
   pg_lo_tell conn fd

***********************************/
int
Pg_lo_tell(ClientData cData, Tcl_Interp *interp, int argc, char *argv[])
{
	PGconn	   *conn;
	int			fd;

	if (argc != 3)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_lo_tell conn fd", 0);
		return TCL_ERROR;
	}

	conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;

	fd = atoi(argv[2]);

	sprintf(interp->result, "%d", lo_tell(conn, fd));
	return TCL_OK;

}

/***********************************
Pg_lo_unlink
	unlink a file based on lobject id

 syntax:
   pg_lo_unlink conn lobjId


***********************************/
int
Pg_lo_unlink(ClientData cData, Tcl_Interp *interp, int argc, char *argv[])
{
	PGconn	   *conn;
	int			lobjId;
	int			retval;

	if (argc != 3)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_lo_tell conn fd", 0);
		return TCL_ERROR;
	}

	conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;

	lobjId = atoi(argv[2]);

	retval = lo_unlink(conn, lobjId);
	if (retval == -1)
	{
		sprintf(interp->result, "Pg_lo_unlink of '%d' failed", lobjId);
		return TCL_ERROR;
	}

	sprintf(interp->result, "%d", retval);
	return TCL_OK;
}

/***********************************
Pg_lo_import
	import a Unix file into an (inversion) large objct
 returns the oid of that object upon success
 returns InvalidOid upon failure

 syntax:
   pg_lo_import conn filename

***********************************/

int
Pg_lo_import(ClientData cData, Tcl_Interp *interp, int argc, char *argv[])
{
	PGconn	   *conn;
	char	   *filename;
	Oid			lobjId;

	if (argc != 3)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_lo_import conn filename", 0);
		return TCL_ERROR;
	}

	conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;

	filename = argv[2];

	lobjId = lo_import(conn, filename);
	if (lobjId == InvalidOid)
	{
		sprintf(interp->result, "Pg_lo_import of '%s' failed", filename);
		return TCL_ERROR;
	}
	sprintf(interp->result, "%u", lobjId);
	return TCL_OK;
}

/***********************************
Pg_lo_export
	export an Inversion large object to a Unix file

 syntax:
   pg_lo_export conn lobjId filename

***********************************/

int
Pg_lo_export(ClientData cData, Tcl_Interp *interp, int argc, char *argv[])
{
	PGconn	   *conn;
	char	   *filename;
	Oid			lobjId;
	int			retval;

	if (argc != 4)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_lo_export conn lobjId filename", 0);
		return TCL_ERROR;
	}

	conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;

	lobjId = atoi(argv[2]);
	filename = argv[3];

	retval = lo_export(conn, lobjId, filename);
	if (retval == -1)
	{
		sprintf(interp->result, "Pg_lo_export %u %s failed", lobjId, filename);
		return TCL_ERROR;
	}
	return TCL_OK;
}

/**********************************
 * pg_select
 send a select query string to the backend connection

 syntax:
 pg_select connection query var proc

 The query must be a select statement
 The var is used in the proc as an array
 The proc is run once for each row found

 Originally I was also going to update changes but that has turned out
 to be not so simple.  Instead, the caller should get the OID of any
 table they want to update and update it themself in the loop.	I may
 try to write a simplified table lookup and update function to make
 that task a little easier.

 The return is either TCL_OK, TCL_ERROR or TCL_RETURN and interp->result
 may contain more information.
 **********************************/

int
Pg_select(ClientData cData, Tcl_Interp *interp, int argc, char **argv)
{
	Pg_ConnectionId *connid;
	PGconn	   *conn;
	PGresult   *result;
	int			r,
				retval;
	size_t		tupno,
				column,
				ncols;
	Tcl_DString headers;
	char		buffer[2048];
	struct info_s
	{
		char	   *cname;
		int			change;
	}		   *info;

	if (argc != 5)
	{
		Tcl_AppendResult(interp, "Wrong # of arguments\n",
						 "pg_select connection queryString var proc", 0);
		return TCL_ERROR;
	}

	conn = PgGetConnectionId(interp, argv[1], &connid);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;

	if ((result = PQexec(conn, argv[2])) == 0)
	{
		/* error occurred sending the query */
		Tcl_SetResult(interp, PQerrorMessage(conn), TCL_VOLATILE);
		return TCL_ERROR;
	}

	/* Transfer any notify events from libpq to Tcl event queue. */
	PgNotifyTransferEvents(connid);

	if (PQresultStatus(result) != PGRES_TUPLES_OK)
	{
		/* query failed, or it wasn't SELECT */
		Tcl_SetResult(interp, (char *) PQresultErrorMessage(result),
					  TCL_VOLATILE);
		PQclear(result);
		return TCL_ERROR;
	}

	if ((info = (struct info_s *) ckalloc(sizeof(*info) * (ncols = PQnfields(result)))) == NULL)
	{
		Tcl_AppendResult(interp, "Not enough memory", 0);
		PQclear(result);
		return TCL_ERROR;
	}

	Tcl_DStringInit(&headers);

	for (column = 0; column < ncols; column++)
	{
		info[column].cname = PQfname(result, column);
		info[column].change = 0;
		Tcl_DStringAppendElement(&headers, info[column].cname);
	}

	Tcl_SetVar2(interp, argv[3], ".headers", Tcl_DStringValue(&headers), 0);
	Tcl_DStringFree(&headers);
	sprintf(buffer, "%d", ncols);
	Tcl_SetVar2(interp, argv[3], ".numcols", buffer, 0);

	retval = TCL_OK;

	for (tupno = 0; tupno < PQntuples(result); tupno++)
	{
		sprintf(buffer, "%d", tupno);
		Tcl_SetVar2(interp, argv[3], ".tupno", buffer, 0);

		for (column = 0; column < ncols; column++)
			Tcl_SetVar2(interp, argv[3], info[column].cname,
#ifdef TCL_ARRAYS
						tcl_value(PQgetvalue(result, tupno, column)),
#else
						PQgetvalue(result, tupno, column),
#endif
						0);

		Tcl_SetVar2(interp, argv[3], ".command", "update", 0);

		if ((r = Tcl_Eval(interp, argv[4])) != TCL_OK && r != TCL_CONTINUE)
		{
			if (r == TCL_BREAK)
				break;			/* exit loop, but return TCL_OK */

			if (r == TCL_ERROR)
			{
				char		msg[60];

				sprintf(msg, "\n    (\"pg_select\" body line %d)",
						interp->errorLine);
				Tcl_AddErrorInfo(interp, msg);
			}

			retval = r;
			break;
		}
	}

	ckfree((void *) info);
	Tcl_UnsetVar(interp, argv[3], 0);
	PQclear(result);
	return retval;
}

/*
 * Test whether any callbacks are registered on this connection for
 * the given relation name.  NB: supplied name must be case-folded already.
 */

static int
Pg_have_listener(Pg_ConnectionId *connid, const char *relname)
{
	Pg_TclNotifies *notifies;
	Tcl_HashEntry *entry;

	for (notifies = connid->notify_list;
		 notifies != NULL;
		 notifies = notifies->next)
	{
		Tcl_Interp *interp = notifies->interp;

		if (interp == NULL)
			continue;			/* ignore deleted interpreter */

		entry = Tcl_FindHashEntry(&notifies->notify_hash, (char *) relname);
		if (entry == NULL)
			continue;			/* no pg_listen in this interpreter */

		return TRUE;			/* OK, there is a listener */
	}

	return FALSE;				/* Found no listener */
}

/***********************************
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[])
{
	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;
	}

	/*
	 * Get the command arguments. Note that the relation name will be
	 * copied by Tcl_CreateHashEntry while the callback string must be
	 * allocated by us.
	 */
	conn = PgGetConnectionId(interp, argv[1], &connid);
	if (conn == (PGconn *) NULL)
		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(&notifies->notify_hash, TCL_STRING_KEYS);
		notifies->next = connid->notify_list;
		connid->notify_list = notifies;
		Tcl_CallWhenDeleted(interp, PgNotifyInterpDelete,
							(ClientData) notifies);
	}

	if (callback)
	{

		/*
		 * Create or update a callback for a relation
		 */
		int			alreadyHadListener = Pg_have_listener(connid, caserelname);

		entry = Tcl_CreateHashEntry(&notifies->notify_hash, caserelname, &new);
		/* If update, free the old callback string */
		if (!new)
			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);

		/*
		 * Send a LISTEN command if this is the first listener.
		 */
		if (!alreadyHadListener)
		{
			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 (PQresultStatus(result) != PGRES_COMMAND_OK)
			{
				/* Error occurred during the execution of command */
				PQclear(result);
				Tcl_DeleteHashEntry(entry);
				ckfree(callback);
				ckfree(caserelname);
				Tcl_SetResult(interp, PQerrorMessage(conn), TCL_VOLATILE);
				return TCL_ERROR;
			}
			PQclear(result);
		}
	}
	else
	{

		/*
		 * Remove a callback for a relation
		 */
		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);

		/*
		 * Send an UNLISTEN command if that was the last listener. Note:
		 * we don't attempt to turn off the notify mechanism if no LISTENs
		 * remain active; not worth the trouble.
		 */
		if (!Pg_have_listener(connid, caserelname))
		{
			char	   *cmd = (char *)
			ckalloc((unsigned) (strlen(origrelname) + 10));

			sprintf(cmd, "UNLISTEN %s", origrelname);
			result = PQexec(conn, cmd);
			ckfree(cmd);
			/* Transfer any notify events from libpq to Tcl event queue. */
			PgNotifyTransferEvents(connid);
			if (PQresultStatus(result) != PGRES_COMMAND_OK)
			{
				/* Error occurred during the execution of command */
				PQclear(result);
				ckfree(caserelname);
				Tcl_SetResult(interp, PQerrorMessage(conn), TCL_VOLATILE);
				return TCL_ERROR;
			}
			PQclear(result);
		}
	}

	ckfree(caserelname);
	return TCL_OK;
}