pltcl.c

PostgreSQL7.4.6 for Linux

	 ************************************************************/
	save_fcinfo = pltcl_current_fcinfo;

	if (CALLED_AS_TRIGGER(fcinfo))
	{
		pltcl_current_fcinfo = NULL;
		retval = PointerGetDatum(pltcl_trigger_handler(fcinfo));
	}
	else
	{
		pltcl_current_fcinfo = fcinfo;
		retval = pltcl_func_handler(fcinfo);
	}

	pltcl_current_fcinfo = save_fcinfo;

	pltcl_call_level--;

	return retval;
}


/*
 * Alternate handler for unsafe functions
 */
PG_FUNCTION_INFO_V1(pltclu_call_handler);

/* keep non-static */
Datum
pltclu_call_handler(PG_FUNCTION_ARGS)
{
	return pltcl_call_handler(fcinfo);
}

/**********************************************************************
 * pltcl_func_handler()		- Handler for regular function calls
 **********************************************************************/
static Datum
pltcl_func_handler(PG_FUNCTION_ARGS)
{
	pltcl_proc_desc *prodesc;
	Tcl_Interp *volatile interp;
	Tcl_DString tcl_cmd;
	Tcl_DString list_tmp;
	int			i;
	int			tcl_rc;
	Datum		retval;
	sigjmp_buf	save_restart;

	/* Find or compile the function */
	prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid);

	if (prodesc->lanpltrusted)
		interp = pltcl_safe_interp;
	else
		interp = pltcl_norm_interp;

	/************************************************************
	 * Create the tcl command to call the internal
	 * proc in the Tcl interpreter
	 ************************************************************/
	Tcl_DStringInit(&tcl_cmd);
	Tcl_DStringInit(&list_tmp);
	Tcl_DStringAppendElement(&tcl_cmd, prodesc->proname);

	/************************************************************
	 * Catch elog(ERROR) during build of the Tcl command
	 ************************************************************/
	memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
	if (sigsetjmp(Warn_restart, 1) != 0)
	{
		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
		Tcl_DStringFree(&tcl_cmd);
		Tcl_DStringFree(&list_tmp);
		pltcl_restart_in_progress = 1;
		if (--pltcl_call_level == 0)
			pltcl_restart_in_progress = 0;
		siglongjmp(Warn_restart, 1);
	}

	/************************************************************
	 * Add all call arguments to the command
	 ************************************************************/
	for (i = 0; i < prodesc->nargs; i++)
	{
		if (prodesc->arg_is_rel[i])
		{
			/**************************************************
			 * For tuple values, add a list for 'array set ...'
			 **************************************************/
			TupleTableSlot *slot = (TupleTableSlot *) fcinfo->arg[i];

			Assert(slot != NULL && !fcinfo->argnull[i]);
			Tcl_DStringInit(&list_tmp);
			pltcl_build_tuple_argument(slot->val,
									   slot->ttc_tupleDescriptor,
									   &list_tmp);
			Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&list_tmp));
			Tcl_DStringFree(&list_tmp);
			Tcl_DStringInit(&list_tmp);
		}
		else
		{
			/**************************************************
			 * Single values are added as string element
			 * of their external representation
			 **************************************************/
			if (fcinfo->argnull[i])
				Tcl_DStringAppendElement(&tcl_cmd, "");
			else
			{
				char	   *tmp;

				tmp = DatumGetCString(FunctionCall3(&prodesc->arg_out_func[i],
													fcinfo->arg[i],
							  ObjectIdGetDatum(prodesc->arg_out_elem[i]),
													Int32GetDatum(-1)));
				UTF_BEGIN;
				Tcl_DStringAppendElement(&tcl_cmd, UTF_E2U(tmp));
				UTF_END;
				pfree(tmp);
			}
		}
	}
	Tcl_DStringFree(&list_tmp);
	memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));

	/************************************************************
	 * Call the Tcl function
	 ************************************************************/
	tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
	Tcl_DStringFree(&tcl_cmd);

	/************************************************************
	 * Check the return code from Tcl and handle
	 * our special restart mechanism to get rid
	 * of all nested call levels on transaction
	 * abort.
	 ************************************************************/
	if (tcl_rc != TCL_OK || pltcl_restart_in_progress)
	{
		if (!pltcl_restart_in_progress)
		{
			pltcl_restart_in_progress = 1;
			if (--pltcl_call_level == 0)
				pltcl_restart_in_progress = 0;
			UTF_BEGIN;
			ereport(ERROR,
					(errmsg("pltcl: %s", interp->result),
					 errdetail("%s",
							   UTF_U2E(Tcl_GetVar(interp, "errorInfo",
												  TCL_GLOBAL_ONLY)))));
			UTF_END;
		}
		if (--pltcl_call_level == 0)
			pltcl_restart_in_progress = 0;
		siglongjmp(Warn_restart, 1);
	}

	/************************************************************
	 * Convert the result value from the Tcl interpreter
	 * into its PostgreSQL data format and return it.
	 * Again, the function call could fire an elog and we
	 * have to count for the current interpreter level we are
	 * on. The save_restart from above is still good.
	 ************************************************************/
	if (sigsetjmp(Warn_restart, 1) != 0)
	{
		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
		pltcl_restart_in_progress = 1;
		if (--pltcl_call_level == 0)
			pltcl_restart_in_progress = 0;
		siglongjmp(Warn_restart, 1);
	}

	/************************************************************
	 * Disconnect from SPI manager and then create the return
	 * values datum (if the input function does a palloc for it
	 * this must not be allocated in the SPI memory context
	 * because SPI_finish would free it).  But don't try to call
	 * the result_in_func if we've been told to return a NULL;
	 * the contents of interp->result may not be a valid value of
	 * the result type in that case.
	 ************************************************************/
	if (SPI_finish() != SPI_OK_FINISH)
		elog(ERROR, "SPI_finish() failed");

	if (fcinfo->isnull)
		retval = (Datum) 0;
	else
	{
		UTF_BEGIN;
		retval = FunctionCall3(&prodesc->result_in_func,
							   PointerGetDatum(UTF_U2E(interp->result)),
							   ObjectIdGetDatum(prodesc->result_in_elem),
							   Int32GetDatum(-1));
		UTF_END;
	}

	/************************************************************
	 * Finally we may restore normal error handling.
	 ************************************************************/
	memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));

	return retval;
}


/**********************************************************************
 * pltcl_trigger_handler()	- Handler for trigger calls
 **********************************************************************/
static HeapTuple
pltcl_trigger_handler(PG_FUNCTION_ARGS)
{
	pltcl_proc_desc *prodesc;
	Tcl_Interp *volatile interp;
	TriggerData *trigdata = (TriggerData *) fcinfo->context;
	char	   *stroid;
	TupleDesc	tupdesc;
	volatile HeapTuple rettup;
	Tcl_DString tcl_cmd;
	Tcl_DString tcl_trigtup;
	Tcl_DString tcl_newtup;
	int			tcl_rc;
	int			i;

	int		   *modattrs;
	Datum	   *modvalues;
	char	   *modnulls;

	int			ret_numvals;
	CONST84 char **ret_values;

	sigjmp_buf	save_restart;

	/* Find or compile the function */
	prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid,
									 RelationGetRelid(trigdata->tg_relation));

	if (prodesc->lanpltrusted)
		interp = pltcl_safe_interp;
	else
		interp = pltcl_norm_interp;

	tupdesc = trigdata->tg_relation->rd_att;

	/************************************************************
	 * Create the tcl command to call the internal
	 * proc in the interpreter
	 ************************************************************/
	Tcl_DStringInit(&tcl_cmd);
	Tcl_DStringInit(&tcl_trigtup);
	Tcl_DStringInit(&tcl_newtup);

	/************************************************************
	 * We call external functions below - care for elog(ERROR)
	 ************************************************************/
	memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
	if (sigsetjmp(Warn_restart, 1) != 0)
	{
		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
		Tcl_DStringFree(&tcl_cmd);
		Tcl_DStringFree(&tcl_trigtup);
		Tcl_DStringFree(&tcl_newtup);
		pltcl_restart_in_progress = 1;
		if (--pltcl_call_level == 0)
			pltcl_restart_in_progress = 0;
		siglongjmp(Warn_restart, 1);
	}

	/* The procedure name */
	Tcl_DStringAppendElement(&tcl_cmd, prodesc->proname);

	/* The trigger name for argument TG_name */
	Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgname);

	/* The oid of the trigger relation for argument TG_relid */
	stroid = DatumGetCString(DirectFunctionCall1(oidout,
						ObjectIdGetDatum(trigdata->tg_relation->rd_id)));
	Tcl_DStringAppendElement(&tcl_cmd, stroid);
	pfree(stroid);

	/* A list of attribute names for argument TG_relatts */
	Tcl_DStringAppendElement(&tcl_trigtup, "");
	for (i = 0; i < tupdesc->natts; i++)
	{
		if (tupdesc->attrs[i]->attisdropped)
			Tcl_DStringAppendElement(&tcl_trigtup, "");
		else
			Tcl_DStringAppendElement(&tcl_trigtup,
									 NameStr(tupdesc->attrs[i]->attname));
	}
	Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
	Tcl_DStringFree(&tcl_trigtup);
	Tcl_DStringInit(&tcl_trigtup);

	/* The when part of the event for TG_when */
	if (TRIGGER_FIRED_BEFORE(trigdata->tg_event))
		Tcl_DStringAppendElement(&tcl_cmd, "BEFORE");
	else if (TRIGGER_FIRED_AFTER(trigdata->tg_event))
		Tcl_DStringAppendElement(&tcl_cmd, "AFTER");
	else
		elog(ERROR, "unrecognized WHEN tg_event: %u", trigdata->tg_event);

	/* The level part of the event for TG_level */
	if (TRIGGER_FIRED_FOR_ROW(trigdata->tg_event))
	{
		Tcl_DStringAppendElement(&tcl_cmd, "ROW");

		/* Build the data list for the trigtuple */
		pltcl_build_tuple_argument(trigdata->tg_trigtuple,
								   tupdesc, &tcl_trigtup);

		/*
		 * Now the command part of the event for TG_op and data for NEW
		 * and OLD
		 */
		if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
		{
			Tcl_DStringAppendElement(&tcl_cmd, "INSERT");

			Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
			Tcl_DStringAppendElement(&tcl_cmd, "");

			rettup = trigdata->tg_trigtuple;
		}
		else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
		{
			Tcl_DStringAppendElement(&tcl_cmd, "DELETE");

			Tcl_DStringAppendElement(&tcl_cmd, "");
			Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));

			rettup = trigdata->tg_trigtuple;
		}
		else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
		{
			Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");

			pltcl_build_tuple_argument(trigdata->tg_newtuple,
									   tupdesc, &tcl_newtup);

			Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_newtup));
			Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));

			rettup = trigdata->tg_newtuple;
		}
		else
			elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
	}
	else if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event))
	{
		Tcl_DStringAppendElement(&tcl_cmd, "STATEMENT");

		if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
			Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
		else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
			Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
		else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
			Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
		else
			elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);

		Tcl_DStringAppendElement(&tcl_cmd, "");
		Tcl_DStringAppendElement(&tcl_cmd, "");

		rettup = (HeapTuple) NULL;
	}
	else
		elog(ERROR, "unrecognized LEVEL tg_event: %u", trigdata->tg_event);

	memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
	Tcl_DStringFree(&tcl_trigtup);
	Tcl_DStringFree(&tcl_newtup);

	/************************************************************
	 * Finally append the arguments from CREATE TRIGGER
	 ************************************************************/
	for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
		Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgargs[i]);

	/************************************************************
	 * Call the Tcl function
	 ************************************************************/
	tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
	Tcl_DStringFree(&tcl_cmd);

	/************************************************************
	 * Check the return code from Tcl and handle
	 * our special restart mechanism to get rid
	 * of all nested call levels on transaction
	 * abort.
	 ************************************************************/
	if (tcl_rc == TCL_ERROR || pltcl_restart_in_progress)
	{
		if (!pltcl_restart_in_progress)
		{
			pltcl_restart_in_progress = 1;
			if (--pltcl_call_level == 0)
				pltcl_restart_in_progress = 0;
			UTF_BEGIN;
			ereport(ERROR,
					(errmsg("pltcl: %s", interp->result),
					 errdetail("%s",
							   UTF_U2E(Tcl_GetVar(interp, "errorInfo",
												  TCL_GLOBAL_ONLY)))));
			UTF_END;
		}
		if (--pltcl_call_level == 0)
			pltcl_restart_in_progress = 0;
		siglongjmp(Warn_restart, 1);
	}

	switch (tcl_rc)