pltcl.c

来自「关系型数据库 Postgresql 6.5.2」· C语言 代码 · 共 2,057 行 · 第 1/5 页

		 * prefix procedure body with
		 * upvar #0 <internal_procname> GD
		 * and with appropriate setting of NEW, OLD,
		 * and the arguments as numerical variables.
		 ************************************************************/
		Tcl_DStringAppend(&proc_internal_body, "upvar #0 ", -1);
		Tcl_DStringAppend(&proc_internal_body, internal_proname, -1);
		Tcl_DStringAppend(&proc_internal_body, " GD\n", -1);

		Tcl_DStringAppend(&proc_internal_body,
						  "array set NEW $__PLTcl_Tup_NEW\n", -1);
		Tcl_DStringAppend(&proc_internal_body,
						  "array set OLD $__PLTcl_Tup_OLD\n", -1);

		Tcl_DStringAppend(&proc_internal_body,
						  "set i 0\n"
						  "set v 0\n"
						  "foreach v $args {\n"
						  "  incr i\n"
						  "  set $i $v\n"
						  "}\n"
						  "unset i v\n\n", -1);

		proc_source = textout(&(procStruct->prosrc));
		Tcl_DStringAppend(&proc_internal_body, proc_source, -1);
		pfree(proc_source);
		Tcl_DStringAppendElement(&proc_internal_def,
								 Tcl_DStringValue(&proc_internal_body));
		Tcl_DStringFree(&proc_internal_body);

		/************************************************************
		 * Create the procedure in the safe interpreter
		 ************************************************************/
		tcl_rc = Tcl_GlobalEval(pltcl_safe_interp,
								Tcl_DStringValue(&proc_internal_def));
		Tcl_DStringFree(&proc_internal_def);
		if (tcl_rc != TCL_OK)
		{
			free(prodesc->proname);
			free(prodesc);
			elog(ERROR, "pltcl: cannot create internal procedure %s - %s",
				 internal_proname, pltcl_safe_interp->result);
		}

		/************************************************************
		 * Add the proc description block to the hashtable
		 ************************************************************/
		hashent = Tcl_CreateHashEntry(pltcl_proc_hash,
									  prodesc->proname, &hashnew);
		Tcl_SetHashValue(hashent, (ClientData) prodesc);
	}
	else
	{
		/************************************************************
		 * Found the proc description block in the hashtable
		 ************************************************************/
		prodesc = (pltcl_proc_desc *) Tcl_GetHashValue(hashent);
	}

	tupdesc = trigdata->tg_relation->rd_att;

	/************************************************************
	 * Create the tcl command to call the internal
	 * proc in the safe 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, internal_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 = oidout(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++)
		Tcl_DStringAppendElement(&tcl_trigtup, tupdesc->attrs[i]->attname.data);
	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
		Tcl_DStringAppendElement(&tcl_cmd, "UNKNOWN");

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

	/* 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
	{
		Tcl_DStringAppendElement(&tcl_cmd, "UNKNOWN");

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

		rettup = trigdata->tg_trigtuple;
	}

	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(pltcl_safe_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;
			elog(ERROR, "pltcl: %s", pltcl_safe_interp->result);
		}
		if (--pltcl_call_level == 0)
			pltcl_restart_in_progress = 0;
		siglongjmp(Warn_restart, 1);
	}

	switch (tcl_rc)
	{
		case TCL_OK:
			break;

		default:
			elog(ERROR, "pltcl: unsupported TCL return code %d", tcl_rc);
	}

	/************************************************************
	 * The return value from the procedure might be one of
	 * the magic strings OK or SKIP or a list from array get
	 ************************************************************/
	if (SPI_finish() != SPI_OK_FINISH)
		elog(ERROR, "pltcl: SPI_finish() failed");

	if (strcmp(pltcl_safe_interp->result, "OK") == 0)
		return rettup;
	if (strcmp(pltcl_safe_interp->result, "SKIP") == 0)
	{
		return (HeapTuple) NULL;;
	}

	/************************************************************
	 * Convert the result value from the safe interpreter
	 * and setup structures for SPI_modifytuple();
	 ************************************************************/
	if (Tcl_SplitList(pltcl_safe_interp, pltcl_safe_interp->result,
					  &ret_numvals, &ret_values) != TCL_OK)
	{
		elog(NOTICE, "pltcl: cannot split return value from trigger");
		elog(ERROR, "pltcl: %s", pltcl_safe_interp->result);
	}

	if (ret_numvals % 2 != 0)
	{
		ckfree(ret_values);
		elog(ERROR, "pltcl: invalid return list from trigger - must have even # of elements");
	}

	modattrs = (int *) palloc(tupdesc->natts * sizeof(int));
	modvalues = (Datum *) palloc(tupdesc->natts * sizeof(Datum));
	for (i = 0; i < tupdesc->natts; i++)
	{
		modattrs[i] = i + 1;
		modvalues[i] = (Datum) NULL;
	}

	modnulls = palloc(tupdesc->natts + 1);
	memset(modnulls, 'n', tupdesc->natts);
	modnulls[tupdesc->natts] = '\0';

	/************************************************************
	 * Care for possible elog(ERROR)'s below
	 ************************************************************/
	if (sigsetjmp(Warn_restart, 1) != 0)
	{
		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
		ckfree(ret_values);
		pltcl_restart_in_progress = 1;
		if (--pltcl_call_level == 0)
			pltcl_restart_in_progress = 0;
		siglongjmp(Warn_restart, 1);
	}

	i = 0;
	while (i < ret_numvals)
	{
		int			attnum;
		HeapTuple	typeTup;
		Oid			typinput;
		Oid			typelem;
		FmgrInfo	finfo;

		/************************************************************
		 * Ignore pseudo elements with a dot name
		 ************************************************************/
		if (*(ret_values[i]) == '.')
		{
			i += 2;
			continue;
		}

		/************************************************************
		 * Get the attribute number
		 ************************************************************/
		attnum = SPI_fnumber(tupdesc, ret_values[i++]);
		if (attnum == SPI_ERROR_NOATTRIBUTE)
			elog(ERROR, "pltcl: invalid attribute '%s'", ret_values[--i]);

		/************************************************************
		 * Lookup the attribute type in the syscache
		 * for the input function
		 ************************************************************/
		typeTup = SearchSysCacheTuple(TYPOID,
				  ObjectIdGetDatum(tupdesc->attrs[attnum - 1]->atttypid),
									  0, 0, 0);
		if (!HeapTupleIsValid(typeTup))
		{
			elog(ERROR, "pltcl: Cache lookup for attribute '%s' type %ld failed",
				 ret_values[--i],
				 ObjectIdGetDatum(tupdesc->attrs[attnum - 1]->atttypid));
		}
		typinput = (Oid) (((Form_pg_type) GETSTRUCT(typeTup))->typinput);
		typelem = (Oid) (((Form_pg_type) GETSTRUCT(typeTup))->typelem);

		/************************************************************
		 * Set the attribute to NOT NULL and convert the contents
		 ************************************************************/
		modnulls[attnum - 1] = ' ';
		fmgr_info(typinput, &finfo);
		modvalues[attnum - 1] = (Datum) (*fmgr_faddr(&finfo))
			(ret_values[i++],
			 typelem,
			 (!VARLENA_FIXED_SIZE(tupdesc->attrs[attnum - 1]))
			 ? tupdesc->attrs[attnum - 1]->attlen
			 : tupdesc->attrs[attnum - 1]->atttypmod
			);
	}


	rettup = SPI_modifytuple(trigdata->tg_relation, rettup, tupdesc->natts,
							 modattrs, modvalues, modnulls);

	pfree(modattrs);
	pfree(modvalues);
	pfree(modnulls);

	if (rettup == NULL)
		elog(ERROR, "pltcl: SPI_modifytuple() failed - RC = %d\n", SPI_result);

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

	return rettup;
}


/**********************************************************************
 * pltcl_elog()		- elog() support for PLTcl
 **********************************************************************/
static int
pltcl_elog(ClientData cdata, Tcl_Interp *interp,
		   int argc, char *argv[])
{
	int			level;
	sigjmp_buf	save_restart;

	/************************************************************
	 * Suppress messages during the restart process
	 ************************************************************/
	if (pltcl_restart_in_progress)
		return TCL_ERROR;

	/************************************************************
	 * Catch the restart longjmp and begin a controlled
	 * return though all interpreter levels if it happens
	 ************************************************************/
	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;
		return TCL_ERROR;
	}

	if (argc != 3)
	{
		Tcl_SetResult(interp, "syntax error - 'elog level msg'",
					  TCL_VOLATILE);
		return TCL_ERROR;
	}

	if (strcmp(argv[1], "NOTICE") == 0)
		level = NOTICE;
	else if (strcmp(argv[1], "WARN") == 0)
		level = ERROR;
	else if (strcmp(argv[1], "ERROR") == 0)
		level = ERROR;
	else if (strcmp(argv[1], "FATAL") == 0)
		level = FATAL;
	else if (strcmp(argv[1], "DEBUG") == 0)
		level = DEBUG;
	else if (strcmp(argv[1], "NOIND") == 0)
		level = NOIND;
	else
	{
		Tcl_AppendResult(interp, "Unknown elog level '", argv[1],
						 "'", NULL);
		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
		return TCL_ERROR;
	}

	/************************************************************
	 * Call elog(), restore the original restart address
	 * and return to the caller (if not catched)
	 ************************************************************/
	elog(level, argv[2]);
	memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
	return TCL_OK;
}


/**********************************************************************
 * pltcl_quote()	- quote literal strings that are to
 *			  be used in SPI_exec query strings
 **********************************************************************/
static int