pltcl.c

PostgreSQL7.4.6 for Linux

						"pltcl: SPI_exec() failed - SPI_ERROR_OPUNKNOWN",
						  TCL_VOLATILE);
			return TCL_ERROR;

		default:
			snprintf(buf, sizeof(buf), "%d", spi_rc);
			Tcl_AppendResult(interp, "pltcl: SPI_exec() failed - ",
							 "unknown RC ", buf, NULL);
			return TCL_ERROR;
	}

	/************************************************************
	 * Only SELECT queries fall through to here - remember the
	 * tuples we got
	 ************************************************************/

	ntuples = SPI_processed;
	if (ntuples > 0)
	{
		tuples = SPI_tuptable->vals;
		tupdesc = SPI_tuptable->tupdesc;
	}

	/************************************************************
	 * Again prepare for elog(ERROR)
	 ************************************************************/
	if (sigsetjmp(Warn_restart, 1) != 0)
	{
		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
		pltcl_restart_in_progress = 1;
		Tcl_SetResult(interp, "Transaction abort", TCL_VOLATILE);
		return TCL_ERROR;
	}

	/************************************************************
	 * If there is no loop body given, just set the variables
	 * from the first tuple (if any) and return the number of
	 * tuples selected
	 ************************************************************/
	if (argc == query_idx + 1)
	{
		if (ntuples > 0)
			pltcl_set_tuple_values(interp, arrayname, 0, tuples[0], tupdesc);
		snprintf(buf, sizeof(buf), "%d", ntuples);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
		SPI_freetuptable(SPI_tuptable);
		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
		return TCL_OK;
	}

	tuptable = SPI_tuptable;

	/************************************************************
	 * There is a loop body - process all tuples and evaluate
	 * the body on each
	 ************************************************************/
	query_idx++;
	for (i = 0; i < ntuples; i++)
	{
		pltcl_set_tuple_values(interp, arrayname, i, tuples[i], tupdesc);

		loop_rc = Tcl_Eval(interp, argv[query_idx]);

		if (loop_rc == TCL_OK)
			continue;
		if (loop_rc == TCL_CONTINUE)
			continue;
		if (loop_rc == TCL_RETURN)
		{
			SPI_freetuptable(tuptable);
			memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
			return TCL_RETURN;
		}
		if (loop_rc == TCL_BREAK)
			break;
		SPI_freetuptable(tuptable);
		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
		return TCL_ERROR;
	}

	SPI_freetuptable(tuptable);

	/************************************************************
	 * Finally return the number of tuples
	 ************************************************************/
	memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
	snprintf(buf, sizeof(buf), "%d", ntuples);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	return TCL_OK;
}


/**********************************************************************
 * pltcl_SPI_prepare()		- Builtin support for prepared plans
 *				  The Tcl command SPI_prepare
 *				  always saves the plan using
 *				  SPI_saveplan and returns a key for
 *				  access. There is no chance to prepare
 *				  and not save the plan currently.
 **********************************************************************/
static int
pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
				  int argc, CONST84 char *argv[])
{
	int			nargs;
	CONST84 char **args;
	pltcl_query_desc *qdesc;
	void	   *plan;
	int			i;
	HeapTuple	typeTup;
	Tcl_HashEntry *hashent;
	int			hashnew;
	sigjmp_buf	save_restart;
	Tcl_HashTable *query_hash;

	/************************************************************
	 * Don't do anything if we are already in restart mode
	 ************************************************************/
	if (pltcl_restart_in_progress)
		return TCL_ERROR;

	/************************************************************
	 * Check the call syntax
	 ************************************************************/
	if (argc != 3)
	{
		Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'",
					  TCL_VOLATILE);
		return TCL_ERROR;
	}

	/************************************************************
	 * Split the argument type list
	 ************************************************************/
	if (Tcl_SplitList(interp, argv[2], &nargs, &args) != TCL_OK)
		return TCL_ERROR;

	/************************************************************
	 * Allocate the new querydesc structure
	 ************************************************************/
	qdesc = (pltcl_query_desc *) malloc(sizeof(pltcl_query_desc));
	snprintf(qdesc->qname, sizeof(qdesc->qname), "%lx", (long) qdesc);
	qdesc->nargs = nargs;
	qdesc->argtypes = (Oid *) malloc(nargs * sizeof(Oid));
	qdesc->arginfuncs = (FmgrInfo *) malloc(nargs * sizeof(FmgrInfo));
	qdesc->argtypelems = (Oid *) malloc(nargs * sizeof(Oid));

	/************************************************************
	 * Prepare to start a controlled return through all
	 * interpreter levels on transaction abort
	 ************************************************************/
	memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
	if (sigsetjmp(Warn_restart, 1) != 0)
	{
		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
		pltcl_restart_in_progress = 1;
		free(qdesc->argtypes);
		free(qdesc->arginfuncs);
		free(qdesc->argtypelems);
		free(qdesc);
		ckfree((char *) args);
		return TCL_ERROR;
	}

	/************************************************************
	 * Lookup the argument types by name in the system cache
	 * and remember the required information for input conversion
	 ************************************************************/
	for (i = 0; i < nargs; i++)
	{
		char		   *argcopy;
		List		   *names = NIL;
		List		   *lp;
		TypeName	   *typename;

		/************************************************************
		 * Use SplitIdentifierString() on a copy of the type name,
		 * turn the resulting pointer list into a TypeName node
		 * and call typenameType() to get the pg_type tuple.
		 ************************************************************/
		argcopy  = pstrdup(args[i]);
		SplitIdentifierString(argcopy, '.', &names);
		typename = makeNode(TypeName);
		foreach (lp, names)
			typename->names = lappend(typename->names, makeString(lfirst(lp)));

		typeTup = typenameType(typename);
		qdesc->argtypes[i] = HeapTupleGetOid(typeTup);
		perm_fmgr_info(((Form_pg_type) GETSTRUCT(typeTup))->typinput,
					   &(qdesc->arginfuncs[i]));
		qdesc->argtypelems[i] = ((Form_pg_type) GETSTRUCT(typeTup))->typelem;
		ReleaseSysCache(typeTup);

		freeList(typename->names);
		pfree(typename);
		freeList(names);
		pfree(argcopy);
	}

	/************************************************************
	 * Prepare the plan and check for errors
	 ************************************************************/
	UTF_BEGIN;
	plan = SPI_prepare(UTF_U2E(argv[1]), nargs, qdesc->argtypes);
	UTF_END;

	if (plan == NULL)
	{
		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
		elog(ERROR, "SPI_prepare() failed");
	}

	/************************************************************
	 * Save the plan into permanent memory (right now it's in the
	 * SPI procCxt, which will go away at function end).
	 ************************************************************/
	qdesc->plan = SPI_saveplan(plan);
	if (qdesc->plan == NULL)
	{
		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
		elog(ERROR, "SPI_saveplan() failed");
	}
	/* Release the procCxt copy to avoid within-function memory leak */
	SPI_freeplan(plan);

	/************************************************************
	 * Insert a hashtable entry for the plan and return
	 * the key to the caller
	 ************************************************************/
	if (interp == pltcl_norm_interp)
		query_hash = pltcl_norm_query_hash;
	else
		query_hash = pltcl_safe_query_hash;

	memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));

	hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
	Tcl_SetHashValue(hashent, (ClientData) qdesc);

	ckfree((char *) args);

	Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE);
	return TCL_OK;
}


/**********************************************************************
 * pltcl_SPI_execp()		- Execute a prepared plan
 **********************************************************************/
static int
pltcl_SPI_execp(ClientData cdata, Tcl_Interp *interp,
				int argc, CONST84 char *argv[])
{
	int			spi_rc;
	char		buf[64];
	volatile int i;
	int			j;
	int			loop_body;
	Tcl_HashEntry *hashent;
	pltcl_query_desc *qdesc;
	Datum	   *volatile argvalues = NULL;
	const char *volatile nulls = NULL;
	CONST84 char *volatile arrayname = NULL;
	int			count = 0;
	int			callnargs;
	static CONST84 char **callargs = NULL;
	int			loop_rc;
	int			ntuples;
	HeapTuple  *volatile tuples = NULL;
	volatile TupleDesc tupdesc = NULL;
	SPITupleTable *tuptable;
	sigjmp_buf	save_restart;
	Tcl_HashTable *query_hash;

	char	   *usage = "syntax error - 'SPI_execp "
	"?-nulls string? ?-count n? "
	"?-array name? query ?args? ?loop body?";

	/************************************************************
	 * Tidy up from an earlier abort
	 ************************************************************/
	if (callargs != NULL)
	{
		ckfree((char *) callargs);
		callargs = NULL;
	}

	/************************************************************
	 * Don't do anything if we are already in restart mode
	 ************************************************************/
	if (pltcl_restart_in_progress)
		return TCL_ERROR;

	/************************************************************
	 * Get the options and check syntax
	 ************************************************************/
	i = 1;
	while (i < argc)
	{
		if (strcmp(argv[i], "-array") == 0)
		{
			if (++i >= argc)
			{
				Tcl_SetResult(interp, usage, TCL_VOLATILE);
				return TCL_ERROR;
			}
			arrayname = argv[i++];
			continue;
		}
		if (strcmp(argv[i], "-nulls") == 0)
		{
			if (++i >= argc)
			{
				Tcl_SetResult(interp, usage, TCL_VOLATILE);
				return TCL_ERROR;
			}
			nulls = argv[i++];
			continue;
		}
		if (strcmp(argv[i], "-count") == 0)
		{
			if (++i >= argc)
			{
				Tcl_SetResult(interp, usage, TCL_VOLATILE);
				return TCL_ERROR;
			}
			if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
				return TCL_ERROR;
			continue;
		}

		break;
	}

	/************************************************************
	 * Check minimum call arguments
	 ************************************************************/
	if (i >= argc)
	{
		Tcl_SetResult(interp, usage, TCL_VOLATILE);
		return TCL_ERROR;
	}

	/************************************************************
	 * Get the prepared plan descriptor by its key
	 ************************************************************/
	if (interp == pltcl_norm_interp)
		query_hash = pltcl_norm_query_hash;
	else
		query_hash = pltcl_safe_query_hash;

	hashent = Tcl_FindHashEntry(query_hash, argv[i++]);
	if (hashent == NULL)
	{
		Tcl_AppendResult(interp, "invalid queryid '", argv[--i], "'", NULL);
		return TCL_ERROR;
	}
	qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent);

	/************************************************************
	 * If a nulls string is given, check for correct length
	 ************************************************************/
	if (nulls != NULL)
	{
		if (strlen(nulls) != qdesc->nargs)
		{
			Tcl_SetResult(interp,
				   "length of nulls string doesn't match # of arguments",
						  TCL_VOLATILE);
			return TCL_ERROR;
		}
	}

	/************************************************************
	 * If there was a argtype list on preparation, we need
	 * an argument value list now
	 ************************************************************/
	if (qdesc->nargs > 0)
	{
		if (i >= argc)
		{
			Tcl_SetResult(interp, "missing argument list", TCL_VOLATILE);
			return TCL_ERROR;
		}

		/************************************************************
		 * Split the argument values
		 ************************************************************/
		if (Tcl_SplitList(interp, argv[i++], &callnargs, &callargs) != TCL_OK)
			return TCL_ERROR;

		/************************************************************
		 * Check that the # of arguments matches
		 ************************************************************/
		if (callnargs != qdesc->nargs)
		{
			Tcl_SetResult(interp,
			"argument list length doesn't match # of arguments for query",
						  TCL_VOLATILE);
			if (callargs != NULL)
			{
				ckfree((char *) callargs);
				callargs = NULL;
			}
			return TCL_ERROR;
		}

		/************************************************************
		 * Prepare to start a controlled return through all