Skip to content

P
Postgres FD Implementation
Commit 28782206 authored by Tom Lane's avatar Tom Lane
Browse files
Options

Convert PL/Tcl to use Tcl's "object" interfaces. 

The original implementation of Tcl was all strings, but they improved
performance significantly by introducing typed "objects" (integers,
lists, code, etc).  It's past time we made use of that; that happened
in Tcl 8.0 which was released in 1997.

This patch also modernizes some of the error-reporting code, which may
cause small changes in the spelling of complaints about bad calls to
PL/Tcl-provided commands.

Jim Nasby and Karl Lehenbauer, reviewed by Victor Wagner
parent 3b8d7215
Show whitespace changes
Inline Side-by-side
Showing with 329 additions and 336 deletions
src/pl/tcl/pltcl.c
View file @ 28782206
......@@ -47,9 +47,9 @@
((TCL_MAJOR_VERSION > maj) || \
(TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
/* In Tcl >= 8.0, really not supposed to touch interp->result directly */
/* Insist on Tcl >= 8.0 */
#if !HAVE_TCL_VERSION(8,0)
#define Tcl_GetStringResult(interp) ((interp)->result)
#error PostgreSQL only supports Tcl 8.0 or later.
#endif
/* define our text domain for translations */
......@@ -212,33 +212,32 @@ static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid,
bool pltrusted);
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
int objc, Tcl_Obj *const objv[]);
static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
int objc, Tcl_Obj *const objv[]);
static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
int objc, Tcl_Obj *const objv[]);
static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
int objc, Tcl_Obj *const objv[]);
static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
int objc, Tcl_Obj *const objv[]);
static int pltcl_process_SPI_result(Tcl_Interp *interp,
CONST84 char *arrayname,
CONST84 char *loop_body,
Tcl_Obj *loop_body,
int spi_rc,
SPITupleTable *tuptable,
int ntuples);
static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
int objc, Tcl_Obj *const objv[]);
static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
int objc, Tcl_Obj *const objv[]);
static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
int objc, Tcl_Obj *const objv[]);
static void pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc);
static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
Tcl_DString *retval);
static Tcl_Obj *pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc);
/*
......@@ -425,22 +424,22 @@ pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted)
/************************************************************
* Install the commands for SPI support in the interpreter
************************************************************/
Tcl_CreateCommand(interp, "elog",
Tcl_CreateObjCommand(interp, "elog",
pltcl_elog, NULL, NULL);
Tcl_CreateCommand(interp, "quote",
Tcl_CreateObjCommand(interp, "quote",
pltcl_quote, NULL, NULL);
Tcl_CreateCommand(interp, "argisnull",
Tcl_CreateObjCommand(interp, "argisnull",
pltcl_argisnull, NULL, NULL);
Tcl_CreateCommand(interp, "return_null",
Tcl_CreateObjCommand(interp, "return_null",
pltcl_returnnull, NULL, NULL);
Tcl_CreateCommand(interp, "spi_exec",
Tcl_CreateObjCommand(interp, "spi_exec",
pltcl_SPI_execute, NULL, NULL);
Tcl_CreateCommand(interp, "spi_prepare",
Tcl_CreateObjCommand(interp, "spi_prepare",
pltcl_SPI_prepare, NULL, NULL);
Tcl_CreateCommand(interp, "spi_execp",
Tcl_CreateObjCommand(interp, "spi_execp",
pltcl_SPI_execute_plan, NULL, NULL);
Tcl_CreateCommand(interp, "spi_lastoid",
Tcl_CreateObjCommand(interp, "spi_lastoid",
pltcl_SPI_lastoid, NULL, NULL);
/************************************************************
......@@ -561,6 +560,8 @@ pltcl_init_load_unknown(Tcl_Interp *interp)
* There is a module named unknown. Reassemble the
* source from the modsrc attributes and evaluate
* it in the Tcl interpreter
*
* leave this code as DString - it's only executed once per session
************************************************************/
fno = SPI_fnumber(SPI_tuptable->tupdesc, "modsrc");
......@@ -578,7 +579,9 @@ pltcl_init_load_unknown(Tcl_Interp *interp)
pfree(part);
}
}
tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&unknown_src));
tcl_rc = Tcl_EvalEx(interp, Tcl_DStringValue(&unknown_src),
Tcl_DStringLength(&unknown_src),
TCL_EVAL_GLOBAL);
Tcl_DStringFree(&unknown_src);
SPI_freetuptable(SPI_tuptable);
......@@ -685,8 +688,7 @@ pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
Tcl_DString tcl_cmd;
Tcl_DString list_tmp;
Tcl_Obj *tcl_cmd;
int i;
int tcl_rc;
Datum retval;
......@@ -707,9 +709,12 @@ pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
* 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->internal_proname);
tcl_cmd = Tcl_NewObj();
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj(prodesc->internal_proname, -1));
/* We hold a refcount on tcl_cmd just to be sure it stays around */
Tcl_IncrRefCount(tcl_cmd);
/************************************************************
* Add all call arguments to the command
......@@ -724,7 +729,7 @@ pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
* For tuple values, add a list for 'array set ...'
**************************************************/
if (fcinfo->argnull[i])
Tcl_DStringAppendElement(&tcl_cmd, "");
Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
else
{
HeapTupleHeader td;
......@@ -732,6 +737,7 @@ pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
int32 tupTypmod;
TupleDesc tupdesc;
HeapTupleData tmptup;
Tcl_Obj *list_tmp;
td = DatumGetHeapTupleHeader(fcinfo->arg[i]);
/* Extract rowtype info and find a tupdesc */
......@@ -742,10 +748,9 @@ pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
tmptup.t_data = td;
Tcl_DStringSetLength(&list_tmp, 0);
pltcl_build_tuple_argument(&tmptup, tupdesc, &list_tmp);
Tcl_DStringAppendElement(&tcl_cmd,
Tcl_DStringValue(&list_tmp));
list_tmp = pltcl_build_tuple_argument(&tmptup, tupdesc);
Tcl_ListObjAppendElement(NULL, tcl_cmd, list_tmp);
ReleaseTupleDesc(tupdesc);
}
}
......@@ -756,7 +761,7 @@ pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
* of their external representation
**************************************************/
if (fcinfo->argnull[i])
Tcl_DStringAppendElement(&tcl_cmd, "");
Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
else
{
char *tmp;
......@@ -764,7 +769,8 @@ pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
tmp = OutputFunctionCall(&prodesc->arg_out_func[i],
fcinfo->arg[i]);
UTF_BEGIN;
Tcl_DStringAppendElement(&tcl_cmd, UTF_E2U(tmp));
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj(UTF_E2U(tmp), -1));
UTF_END;
pfree(tmp);
}
......@@ -773,20 +779,21 @@ pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
}
PG_CATCH();
{
Tcl_DStringFree(&tcl_cmd);
Tcl_DStringFree(&list_tmp);
/* Release refcount to free tcl_cmd */
Tcl_DecrRefCount(tcl_cmd);
PG_RE_THROW();
}
PG_END_TRY();
Tcl_DStringFree(&list_tmp);
/************************************************************
* Call the Tcl function
*
* We assume no PG error can be thrown directly from this call.
************************************************************/
tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
Tcl_DStringFree(&tcl_cmd);
tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
/* Release refcount to free tcl_cmd (and all subsidiary objects) */
Tcl_DecrRefCount(tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
......@@ -837,9 +844,9 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
char *stroid;
TupleDesc tupdesc;
volatile HeapTuple rettup;
Tcl_DString tcl_cmd;
Tcl_DString tcl_trigtup;
Tcl_DString tcl_newtup;
Tcl_Obj *tcl_cmd;
Tcl_Obj *tcl_trigtup;
Tcl_Obj *tcl_newtup;
int tcl_rc;
int i;
int *modattrs;
......@@ -869,65 +876,74 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
* Create the tcl command to call the internal
* proc in the interpreter
************************************************************/
Tcl_DStringInit(&tcl_cmd);
Tcl_DStringInit(&tcl_trigtup);
Tcl_DStringInit(&tcl_newtup);
tcl_cmd = Tcl_NewObj();
Tcl_IncrRefCount(tcl_cmd);
PG_TRY();
{
/* The procedure name */
Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj(prodesc->internal_proname, -1));
/* The trigger name for argument TG_name */
Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgname);
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj(trigdata->tg_trigger->tgname, -1));
/* The oid of the trigger relation for argument TG_relid */
/* Consider not converting to a string for more performance? */
stroid = DatumGetCString(DirectFunctionCall1(oidout,
ObjectIdGetDatum(trigdata->tg_relation->rd_id)));
Tcl_DStringAppendElement(&tcl_cmd, stroid);
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj(stroid, -1));
pfree(stroid);
/* The name of the table the trigger is acting on: TG_table_name */
stroid = SPI_getrelname(trigdata->tg_relation);
Tcl_DStringAppendElement(&tcl_cmd, stroid);
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj(stroid, -1));
pfree(stroid);
/* The schema of the table the trigger is acting on: TG_table_schema */
stroid = SPI_getnspname(trigdata->tg_relation);
Tcl_DStringAppendElement(&tcl_cmd, stroid);
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj(stroid, -1));
pfree(stroid);
/* A list of attribute names for argument TG_relatts */
Tcl_DStringAppendElement(&tcl_trigtup, "");
tcl_trigtup = Tcl_NewObj();
Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
for (i = 0; i < tupdesc->natts; i++)
{
if (tupdesc->attrs[i]->attisdropped)
Tcl_DStringAppendElement(&tcl_trigtup, "");
Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
else
Tcl_DStringAppendElement(&tcl_trigtup,
NameStr(tupdesc->attrs[i]->attname));
Tcl_ListObjAppendElement(NULL, tcl_trigtup,
Tcl_NewStringObj(NameStr(tupdesc->attrs[i]->attname), -1));
}
Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
Tcl_DStringFree(&tcl_trigtup);
Tcl_DStringInit(&tcl_trigtup);
Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
/* The when part of the event for TG_when */
if (TRIGGER_FIRED_BEFORE(trigdata->tg_event))
Tcl_DStringAppendElement(&tcl_cmd, "BEFORE");
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj("BEFORE", -1));
else if (TRIGGER_FIRED_AFTER(trigdata->tg_event))
Tcl_DStringAppendElement(&tcl_cmd, "AFTER");
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj("AFTER", -1));
else if (TRIGGER_FIRED_INSTEAD(trigdata->tg_event))
Tcl_DStringAppendElement(&tcl_cmd, "INSTEAD OF");
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj("INSTEAD OF", -1));
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");
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj("ROW", -1));
/* Build the data list for the trigtuple */
pltcl_build_tuple_argument(trigdata->tg_trigtuple,
tupdesc, &tcl_trigtup);
tcl_trigtup = pltcl_build_tuple_argument(trigdata->tg_trigtuple,
tupdesc);
/*
* Now the command part of the event for TG_op and data for NEW
......@@ -935,31 +951,34 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
*/
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
{
Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj("INSERT", -1));
Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
Tcl_DStringAppendElement(&tcl_cmd, "");
Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
rettup = trigdata->tg_trigtuple;
}
else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
{
Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj("DELETE", -1));
Tcl_DStringAppendElement(&tcl_cmd, "");
Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
rettup = trigdata->tg_trigtuple;
}
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
{
Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj("UPDATE", -1));
pltcl_build_tuple_argument(trigdata->tg_newtuple,
tupdesc, &tcl_newtup);
tcl_newtup = pltcl_build_tuple_argument(trigdata->tg_newtuple,
tupdesc);
Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_newtup));
Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_newtup);
Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
rettup = trigdata->tg_newtuple;
}
......@@ -968,21 +987,26 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
}
else if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event))
{
Tcl_DStringAppendElement(&tcl_cmd, "STATEMENT");
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj("STATEMENT", -1));
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj("INSERT", -1));
else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj("DELETE", -1));
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj("UPDATE", -1));
else if (TRIGGER_FIRED_BY_TRUNCATE(trigdata->tg_event))
Tcl_DStringAppendElement(&tcl_cmd, "TRUNCATE");
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj("TRUNCATE", -1));
else
elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
Tcl_DStringAppendElement(&tcl_cmd, "");
Tcl_DStringAppendElement(&tcl_cmd, "");
Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
rettup = (HeapTuple) NULL;
}
......@@ -991,27 +1015,26 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
/* 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]);
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj(trigdata->tg_trigger->tgargs[i], -1));
}
PG_CATCH();
{
Tcl_DStringFree(&tcl_cmd);
Tcl_DStringFree(&tcl_trigtup);
Tcl_DStringFree(&tcl_newtup);
Tcl_DecrRefCount(tcl_cmd);
PG_RE_THROW();
}
PG_END_TRY();
Tcl_DStringFree(&tcl_trigtup);
Tcl_DStringFree(&tcl_newtup);
/************************************************************
* Call the Tcl function
*
* We assume no PG error can be thrown directly from this call.
************************************************************/
tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
Tcl_DStringFree(&tcl_cmd);
tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
/* Release refcount to free tcl_cmd (and all subsidiary objects) */
Tcl_DecrRefCount(tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
......@@ -1073,7 +1096,6 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
CONST84 char *ret_name = ret_values[i];
CONST84 char *ret_value = ret_values[i + 1];
int attnum;
HeapTuple typeTup;
Oid typinput;
Oid typioparam;
FmgrInfo finfo;
......@@ -1109,20 +1131,14 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
* Lookup the attribute type in the syscache
* for the input function
************************************************************/
typeTup = SearchSysCache1(TYPEOID,
ObjectIdGetDatum(tupdesc->attrs[attnum - 1]->atttypid));
if (!HeapTupleIsValid(typeTup))
elog(ERROR, "cache lookup failed for type %u",
tupdesc->attrs[attnum - 1]->atttypid);
typinput = ((Form_pg_type) GETSTRUCT(typeTup))->typinput;
typioparam = getTypeIOParam(typeTup);
ReleaseSysCache(typeTup);
getTypeInputInfo(tupdesc->attrs[attnum - 1]->atttypid,
&typinput, &typioparam);
fmgr_info(typinput, &finfo);
/************************************************************
* Set the attribute to NOT NULL and convert the contents
************************************************************/
modnulls[attnum - 1] = ' ';
fmgr_info(typinput, &finfo);
UTF_BEGIN;
modvalues[attnum - 1] = InputFunctionCall(&finfo,
(char *) UTF_U2E(ret_value),
......@@ -1140,7 +1156,6 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
if (rettup == NULL)
elog(ERROR, "SPI_modifytuple() failed - RC = %d", SPI_result);
}
PG_CATCH();
{
......@@ -1162,7 +1177,7 @@ pltcl_event_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
EventTriggerData *tdata = (EventTriggerData *) fcinfo->context;
Tcl_DString tcl_cmd;
Tcl_Obj *tcl_cmd;
int tcl_rc;
/* Connect to SPI manager */
......@@ -1178,13 +1193,19 @@ pltcl_event_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
interp = prodesc->interp_desc->interp;
/* Create the tcl command and call the internal proc */
Tcl_DStringInit(&tcl_cmd);
Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
Tcl_DStringAppendElement(&tcl_cmd, tdata->event);
Tcl_DStringAppendElement(&tcl_cmd, tdata->tag);
tcl_cmd = Tcl_NewObj();
Tcl_IncrRefCount(tcl_cmd);
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj(prodesc->internal_proname, -1));
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj(tdata->event, -1));
Tcl_ListObjAppendElement(NULL, tcl_cmd,
Tcl_NewStringObj(tdata->tag, -1));
tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
Tcl_DStringFree(&tcl_cmd);
/* Release refcount to free tcl_cmd (and all subsidiary objects) */
Tcl_DecrRefCount(tcl_cmd);
/* Check for errors reported by Tcl. */
if (tcl_rc != TCL_OK)
......@@ -1482,6 +1503,10 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
/************************************************************
* Create the tcl command to define the internal
* procedure
*
* leave this code as DString - it's a text processing function
* that only gets invoked when the tcl function is invoked
* for the first time
************************************************************/
Tcl_DStringInit(&proc_internal_def);
Tcl_DStringInit(&proc_internal_body);
......@@ -1550,8 +1575,10 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
/************************************************************
* Create the procedure in the interpreter
************************************************************/
tcl_rc = Tcl_GlobalEval(interp,
Tcl_DStringValue(&proc_internal_def));
tcl_rc = Tcl_EvalEx(interp,
Tcl_DStringValue(&proc_internal_def),
Tcl_DStringLength(&proc_internal_def),
TCL_EVAL_GLOBAL);
Tcl_DStringFree(&proc_internal_def);
if (tcl_rc != TCL_OK)
{
......@@ -1587,37 +1614,33 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
**********************************************************************/
static int
pltcl_elog(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
int objc, Tcl_Obj *const objv[])
{
volatile int level;
MemoryContext oldcontext;
int priIndex;
if (argc != 3)
static CONST84 char *logpriorities[] = {
"DEBUG", "LOG", "INFO", "NOTICE",
"WARNING", "ERROR", "FATAL", (char *) NULL
};
static CONST84 int loglevels[] = {
DEBUG2, LOG, INFO, NOTICE,
WARNING, ERROR, FATAL
};
if (objc != 3)
{
Tcl_SetResult(interp, "syntax error - 'elog level msg'", TCL_STATIC);
Tcl_WrongNumArgs(interp, 1, objv, "level msg");
return TCL_ERROR;
}
if (strcmp(argv[1], "DEBUG") == 0)
level = DEBUG2;
else if (strcmp(argv[1], "LOG") == 0)
level = LOG;
else if (strcmp(argv[1], "INFO") == 0)
level = INFO;
else if (strcmp(argv[1], "NOTICE") == 0)
level = NOTICE;
else if (strcmp(argv[1], "WARNING") == 0)
level = WARNING;
else if (strcmp(argv[1], "ERROR") == 0)
level = ERROR;
else if (strcmp(argv[1], "FATAL") == 0)
level = FATAL;
else
{
Tcl_AppendResult(interp, "Unknown elog level '", argv[1],
"'", NULL);
if (Tcl_GetIndexFromObj(interp, objv[1], logpriorities, "priority",
TCL_EXACT, &priIndex) != TCL_OK)
return TCL_ERROR;
}
level = loglevels[priIndex];
if (level == ERROR)
{
......@@ -1626,7 +1649,7 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
* eventually get converted to a PG error when we reach the call
* handler.
*/
Tcl_SetResult(interp, (char *) argv[2], TCL_VOLATILE);
Tcl_SetObjResult(interp, objv[2]);
return TCL_ERROR;
}
......@@ -1645,7 +1668,7 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
UTF_BEGIN;
ereport(level,
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
errmsg("%s", UTF_U2E(argv[2]))));
errmsg("%s", UTF_U2E(Tcl_GetString(objv[2])))));
UTF_END;
}
PG_CATCH();
......@@ -1659,7 +1682,7 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
/* Pass the error message to Tcl */
UTF_BEGIN;
Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1));
UTF_END;
FreeErrorData(edata);
......@@ -1677,18 +1700,19 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
**********************************************************************/
static int
pltcl_quote(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
int objc, Tcl_Obj *const objv[])
{
char *tmp;
const char *cp1;
char *cp2;
int length;
/************************************************************
* Check call syntax
************************************************************/
if (argc != 2)
if (objc != 2)
{
Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_STATIC);
Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
......@@ -1696,8 +1720,8 @@ pltcl_quote(ClientData cdata, Tcl_Interp *interp,
* Allocate space for the maximum the string can
* grow to and initialize pointers
************************************************************/
tmp = palloc(strlen(argv[1]) * 2 + 1);
cp1 = argv[1];
cp1 = Tcl_GetStringFromObj(objv[1], &length);
tmp = palloc(length * 2 + 1);
cp2 = tmp;
/************************************************************
......@@ -1719,7 +1743,7 @@ pltcl_quote(ClientData cdata, Tcl_Interp *interp,
* Terminate the string and set it as result
************************************************************/
*cp2 = '\0';
Tcl_SetResult(interp, tmp, TCL_VOLATILE);
Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1));
pfree(tmp);
return TCL_OK;
}
......@@ -1730,7 +1754,7 @@ pltcl_quote(ClientData cdata, Tcl_Interp *interp,
**********************************************************************/
static int
pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
int objc, Tcl_Obj *const objv[])
{
int argno;
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
......@@ -1738,10 +1762,9 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
/************************************************************
* Check call syntax
************************************************************/
if (argc != 2)
if (objc != 2)
{
Tcl_SetResult(interp, "syntax error - 'argisnull argno'",
TCL_STATIC);
Tcl_WrongNumArgs(interp, 1, objv, "argno");
return TCL_ERROR;
}
......@@ -1750,15 +1773,15 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
************************************************************/
if (fcinfo == NULL)
{
Tcl_SetResult(interp, "argisnull cannot be used in triggers",
TCL_STATIC);
Tcl_SetObjResult(interp,
Tcl_NewStringObj("argisnull cannot be used in triggers", -1));
return TCL_ERROR;
}
/************************************************************
* Get the argument number
************************************************************/
if (Tcl_GetInt(interp, argv[1], &argno) != TCL_OK)
if (Tcl_GetIntFromObj(interp, objv[1], &argno) != TCL_OK)
return TCL_ERROR;
/************************************************************
......@@ -1767,37 +1790,34 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
argno--;
if (argno < 0 || argno >= fcinfo->nargs)
{
Tcl_SetResult(interp, "argno out of range", TCL_STATIC);
Tcl_SetObjResult(interp,
Tcl_NewStringObj("argno out of range", -1));
return TCL_ERROR;
}
/************************************************************
* Get the requested NULL state
************************************************************/
if (PG_ARGISNULL(argno))
Tcl_SetResult(interp, "1", TCL_STATIC);
else
Tcl_SetResult(interp, "0", TCL_STATIC);
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(PG_ARGISNULL(argno)));
return TCL_OK;
}
/**********************************************************************
* pltcl_returnnull() - Cause a NULL return from a function
* pltcl_returnnull() - Cause a NULL return from the current function
**********************************************************************/
static int
pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
int objc, Tcl_Obj *const objv[])
{
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
/************************************************************
* Check call syntax
************************************************************/
if (argc != 1)
if (objc != 1)
{
Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_STATIC);
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
......@@ -1806,8 +1826,8 @@ pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
************************************************************/
if (fcinfo == NULL)
{
Tcl_SetResult(interp, "return_null cannot be used in triggers",
TCL_STATIC);
Tcl_SetObjResult(interp,
Tcl_NewStringObj("return_null cannot be used in triggers", -1));
return TCL_ERROR;
}
......@@ -1906,68 +1926,74 @@ pltcl_subtrans_abort(Tcl_Interp *interp,
**********************************************************************/
static int
pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
int objc, Tcl_Obj *const objv[])
{
int my_rc;
int spi_rc;
int query_idx;
int i;
int optIndex;
int count = 0;
CONST84 char *volatile arrayname = NULL;
CONST84 char *volatile loop_body = NULL;
Tcl_Obj *volatile loop_body = NULL;
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
char *usage = "syntax error - 'SPI_exec "
"?-count n? "
"?-array name? query ?loop body?";
enum options
{
OPT_ARRAY, OPT_COUNT
};
static CONST84 char *options[] = {
"-array", "-count", (char *) NULL
};
/************************************************************
* Check the call syntax and get the options
************************************************************/
if (argc < 2)
if (objc < 2)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
Tcl_WrongNumArgs(interp, 1, objv,
"?-count n? ?-array name? query ?loop body?");
return TCL_ERROR;
}
i = 1;
while (i < argc)
{
if (strcmp(argv[i], "-array") == 0)
while (i < objc)
{
if (++i >= argc)
if (Tcl_GetIndexFromObj(interp, objv[i], options, "option",
TCL_EXACT, &optIndex) != TCL_OK)
break;
if (++i >= objc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
Tcl_SetObjResult(interp,
Tcl_NewStringObj("missing argument to -count or -array", -1));
return TCL_ERROR;
}
arrayname = argv[i++];
continue;
}
if (strcmp(argv[i], "-count") == 0)
{
if (++i >= argc)
switch ((enum options) optIndex)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
return TCL_ERROR;
continue;
}
case OPT_ARRAY:
arrayname = Tcl_GetString(objv[i++]);
break;
case OPT_COUNT:
if (Tcl_GetIntFromObj(interp, objv[i++], &count) != TCL_OK)
return TCL_ERROR;
break;
}
}
query_idx = i;
if (query_idx >= argc || query_idx + 2 < argc)
if (query_idx >= objc || query_idx + 2 < objc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
Tcl_WrongNumArgs(interp, query_idx - 1, objv, "query ?loop body?");
return TCL_ERROR;
}
if (query_idx + 1 < argc)
loop_body = argv[query_idx + 1];
if (query_idx + 1 < objc)
loop_body = objv[query_idx + 1];
/************************************************************
* Execute the query inside a sub-transaction, so we can cope with
......@@ -1979,7 +2005,7 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
PG_TRY();
{
UTF_BEGIN;
spi_rc = SPI_execute(UTF_U2E(argv[query_idx]),
spi_rc = SPI_execute(UTF_U2E(Tcl_GetString(objv[query_idx])),
pltcl_current_prodesc->fn_readonly, count);
UTF_END;
......@@ -2010,13 +2036,12 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
static int
pltcl_process_SPI_result(Tcl_Interp *interp,
CONST84 char *arrayname,
CONST84 char *loop_body,
Tcl_Obj *loop_body,
int spi_rc,
SPITupleTable *tuptable,
int ntuples)
{
int my_rc = TCL_OK;
char buf[64];
int i;
int loop_rc;
HeapTuple *tuples;
......@@ -2028,15 +2053,14 @@ pltcl_process_SPI_result(Tcl_Interp *interp,
case SPI_OK_INSERT:
case SPI_OK_DELETE:
case SPI_OK_UPDATE:
snprintf(buf, sizeof(buf), "%d", ntuples);
Tcl_SetResult(interp, buf, TCL_VOLATILE);
Tcl_SetObjResult(interp, Tcl_NewIntObj(ntuples));
break;
case SPI_OK_UTILITY:
case SPI_OK_REWRITTEN:
if (tuptable == NULL)
{
Tcl_SetResult(interp, "0", TCL_STATIC);
Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
break;
}
/* FALL THRU for utility returning tuples */
......@@ -2073,7 +2097,7 @@ pltcl_process_SPI_result(Tcl_Interp *interp,
pltcl_set_tuple_values(interp, arrayname, i,
tuples[i], tupdesc);
loop_rc = Tcl_Eval(interp, loop_body);
loop_rc = Tcl_EvalObjEx(interp, loop_body, 0);
if (loop_rc == TCL_OK)
continue;
......@@ -2093,8 +2117,7 @@ pltcl_process_SPI_result(Tcl_Interp *interp,
if (my_rc == TCL_OK)
{
snprintf(buf, sizeof(buf), "%d", ntuples);
Tcl_SetResult(interp, buf, TCL_VOLATILE);
Tcl_SetObjResult(interp, Tcl_NewIntObj(ntuples));
}
break;
......@@ -2121,11 +2144,11 @@ pltcl_process_SPI_result(Tcl_Interp *interp,
**********************************************************************/
static int
pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
int objc, Tcl_Obj *const objv[])
{
volatile MemoryContext plan_cxt = NULL;
int nargs;
CONST84 char **args;
Tcl_Obj **argsObj;
pltcl_query_desc *qdesc;
int i;
Tcl_HashEntry *hashent;
......@@ -2137,17 +2160,16 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
/************************************************************
* Check the call syntax
************************************************************/
if (argc != 3)
if (objc != 3)
{
Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'",
TCL_STATIC);
Tcl_WrongNumArgs(interp, 1, objv, "query argtypes");
return TCL_ERROR;
}
/************************************************************
* Split the argument type list
************************************************************/
if (Tcl_SplitList(interp, argv[2], &nargs, &args) != TCL_OK)
if (Tcl_ListObjGetElements(interp, objv[2], &nargs, &argsObj) != TCL_OK)
return TCL_ERROR;
/************************************************************
......@@ -2192,7 +2214,7 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
typIOParam;
int32 typmod;
parseTypeString(args[i], &typId, &typmod, false);
parseTypeString(Tcl_GetString(argsObj[i]), &typId, &typmod, false);
getTypeInputInfo(typId, &typInput, &typIOParam);
......@@ -2205,7 +2227,7 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
* Prepare the plan and check for errors
************************************************************/
UTF_BEGIN;
qdesc->plan = SPI_prepare(UTF_U2E(argv[1]), nargs, qdesc->argtypes);
qdesc->plan = SPI_prepare(UTF_U2E(Tcl_GetString(objv[1])), nargs, qdesc->argtypes);
UTF_END;
if (qdesc->plan == NULL)
......@@ -2225,7 +2247,6 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
pltcl_subtrans_abort(interp, oldcontext, oldowner);
MemoryContextDelete(plan_cxt);
ckfree((char *) args);
return TCL_ERROR;
}
......@@ -2240,10 +2261,8 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
Tcl_SetHashValue(hashent, (ClientData) qdesc);
ckfree((char *) args);
/* qname is ASCII, so no need for encoding conversion */
Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE);
Tcl_SetObjResult(interp, Tcl_NewStringObj(qdesc->qname, -1));
return TCL_OK;
}
......@@ -2253,85 +2272,85 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
**********************************************************************/
static int
pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
int objc, Tcl_Obj *const objv[])
{
int my_rc;
int spi_rc;
int i;
int j;
int optIndex;
Tcl_HashEntry *hashent;
pltcl_query_desc *qdesc;
const char *nulls = NULL;
CONST84 char *arrayname = NULL;
CONST84 char *loop_body = NULL;
Tcl_Obj *loop_body = NULL;
int count = 0;
int callnargs;
CONST84 char **callargs = NULL;
int callObjc;
Tcl_Obj **callObjv = NULL;
Datum *argvalues;
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
Tcl_HashTable *query_hash;
char *usage = "syntax error - 'SPI_execp "
"?-nulls string? ?-count n? "
"?-array name? query ?args? ?loop body?";
enum options
{
OPT_ARRAY, OPT_COUNT, OPT_NULLS
};
static CONST84 char *options[] = {
"-array", "-count", "-nulls", (char *) NULL
};
/************************************************************
* Get the options and check syntax
************************************************************/
i = 1;
while (i < argc)
{
if (strcmp(argv[i], "-array") == 0)
while (i < objc)
{
if (++i >= argc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
arrayname = argv[i++];
continue;
}
if (strcmp(argv[i], "-nulls") == 0)
{
if (++i >= argc)
if (Tcl_GetIndexFromObj(interp, objv[i], options, "option",
TCL_EXACT, &optIndex) != TCL_OK)
break;
if (++i >= objc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
Tcl_SetObjResult(interp,
Tcl_NewStringObj("missing argument to -array, -count or -nulls", -1));
return TCL_ERROR;
}
nulls = argv[i++];
continue;
}
if (strcmp(argv[i], "-count") == 0)
{
if (++i >= argc)
switch ((enum options) optIndex)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
case OPT_ARRAY:
arrayname = Tcl_GetString(objv[i++]);
break;
case OPT_COUNT:
if (Tcl_GetIntFromObj(interp, objv[i++], &count) != TCL_OK)
return TCL_ERROR;
continue;
}
break;
case OPT_NULLS:
nulls = Tcl_GetString(objv[i++]);
break;
}
}
/************************************************************
* Get the prepared plan descriptor by its key
************************************************************/
if (i >= argc)
if (i >= objc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
Tcl_SetObjResult(interp,
Tcl_NewStringObj("missing argument to -count or -array", -1));
return TCL_ERROR;
}
query_hash = &pltcl_current_prodesc->interp_desc->query_hash;
hashent = Tcl_FindHashEntry(query_hash, argv[i]);
hashent = Tcl_FindHashEntry(query_hash, Tcl_GetString(objv[i]));
if (hashent == NULL)
{
Tcl_AppendResult(interp, "invalid queryid '", argv[i], "'", NULL);
Tcl_AppendResult(interp, "invalid queryid '", Tcl_GetString(objv[i]), "'", NULL);
return TCL_ERROR;
}
qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent);
......@@ -2344,9 +2363,10 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
{
if (strlen(nulls) != qdesc->nargs)
{
Tcl_SetResult(interp,
Tcl_SetObjResult(interp,
Tcl_NewStringObj(
"length of nulls string doesn't match number of arguments",
TCL_STATIC);
-1));
return TCL_ERROR;
}
}
......@@ -2357,44 +2377,47 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
************************************************************/
if (qdesc->nargs > 0)
{
if (i >= argc)
if (i >= objc)
{
Tcl_SetResult(interp, "missing argument list", TCL_STATIC);
Tcl_SetObjResult(interp,
Tcl_NewStringObj(
"argument list length doesn't match number of arguments for query"
,-1));
return TCL_ERROR;
}
/************************************************************
* Split the argument values
************************************************************/
if (Tcl_SplitList(interp, argv[i++], &callnargs, &callargs) != TCL_OK)
if (Tcl_ListObjGetElements(interp, objv[i++], &callObjc, &callObjv) != TCL_OK)
return TCL_ERROR;
/************************************************************
* Check that the number of arguments matches
************************************************************/
if (callnargs != qdesc->nargs)
if (callObjc != qdesc->nargs)
{
Tcl_SetResult(interp,
"argument list length doesn't match number of arguments for query",
TCL_STATIC);
ckfree((char *) callargs);
Tcl_SetObjResult(interp,
Tcl_NewStringObj(
"argument list length doesn't match number of arguments for query"
,-1));
return TCL_ERROR;
}
}
else
callnargs = 0;
callObjc = 0;
/************************************************************
* Get loop body if present
************************************************************/
if (i < argc)
loop_body = argv[i++];
if (i < objc)
loop_body = objv[i++];
if (i != argc)
if (i != objc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
if (callargs)
ckfree((char *) callargs);
Tcl_WrongNumArgs(interp, 1, objv,
"?-count n? ?-array name? ?-nulls string? "
"query ?args? ?loop body?");
return TCL_ERROR;
}
......@@ -2411,9 +2434,9 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
* Setup the value array for SPI_execute_plan() using
* the type specific input functions
************************************************************/
argvalues = (Datum *) palloc(callnargs * sizeof(Datum));
argvalues = (Datum *) palloc(callObjc * sizeof(Datum));
for (j = 0; j < callnargs; j++)
for (j = 0; j < callObjc; j++)
{
if (nulls && nulls[j] == 'n')
{
......@@ -2426,7 +2449,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
{
UTF_BEGIN;
argvalues[j] = InputFunctionCall(&qdesc->arginfuncs[j],
(char *) UTF_U2E(callargs[j]),
(char *) UTF_U2E(Tcl_GetString(callObjv[j])),
qdesc->argtypioparams[j],
-1);
UTF_END;
......@@ -2451,17 +2474,10 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
PG_CATCH();
{
pltcl_subtrans_abort(interp, oldcontext, oldowner);
if (callargs)
ckfree((char *) callargs);
return TCL_ERROR;
}
PG_END_TRY();
if (callargs)
ckfree((char *) callargs);
return my_rc;
}
......@@ -2472,12 +2488,9 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
**********************************************************************/
static int
pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
int objc, Tcl_Obj *const objv[])
{
char buf[64];
snprintf(buf, sizeof(buf), "%u", SPI_lastoid);
Tcl_SetResult(interp, buf, TCL_VOLATILE);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(SPI_lastoid));
return TCL_OK;
}
......@@ -2492,14 +2505,11 @@ pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
{
int i;
char *outputstr;
char buf[64];
Datum attr;
bool isnull;
CONST84 char *attname;
HeapTuple typeTup;
Oid typoutput;
bool typisvarlena;
CONST84 char **arrptr;
CONST84 char **nameptr;
CONST84 char *nullname = NULL;
......@@ -2517,8 +2527,7 @@ pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
{
arrptr = &arrayname;
nameptr = &attname;
snprintf(buf, sizeof(buf), "%d", tupno);
Tcl_SetVar2(interp, arrayname, ".tupno", buf, 0);
Tcl_SetVar2Ex(interp, arrayname, ".tupno", Tcl_NewIntObj(tupno), 0);
}
for (i = 0; i < tupdesc->natts; i++)
......@@ -2537,19 +2546,6 @@ pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
************************************************************/
attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
/************************************************************
* Lookup the attribute type in the syscache
* for the output function
************************************************************/
typeTup = SearchSysCache1(TYPEOID,
ObjectIdGetDatum(tupdesc->attrs[i]->atttypid));
if (!HeapTupleIsValid(typeTup))
elog(ERROR, "cache lookup failed for type %u",
tupdesc->attrs[i]->atttypid);
typoutput = ((Form_pg_type) GETSTRUCT(typeTup))->typoutput;
ReleaseSysCache(typeTup);
/************************************************************
* If there is a value, set the variable
* If not, unset it
......@@ -2558,11 +2554,14 @@ pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
* crash if they don't expect them - need something
* smarter here.
************************************************************/
if (!isnull && OidIsValid(typoutput))
if (!isnull)
{
getTypeOutputInfo(tupdesc->attrs[i]->atttypid,
&typoutput, &typisvarlena);
outputstr = OidOutputFunctionCall(typoutput, attr);
UTF_BEGIN;
Tcl_SetVar2(interp, *arrptr, *nameptr, UTF_E2U(outputstr), 0);
Tcl_SetVar2Ex(interp, *arrptr, *nameptr,
Tcl_NewStringObj(UTF_E2U(outputstr), -1), 0);
UTF_END;
pfree(outputstr);
}
......@@ -2573,21 +2572,20 @@ pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
/**********************************************************************
* pltcl_build_tuple_argument() - Build a string usable for 'array set'
* pltcl_build_tuple_argument() - Build a list object usable for 'array set'
* from all attributes of a given tuple
**********************************************************************/
static void
pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
Tcl_DString *retval)
static Tcl_Obj *
pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
{
Tcl_Obj *retobj = Tcl_NewObj();
int i;
char *outputstr;
Datum attr;
bool isnull;
char *attname;
HeapTuple typeTup;
Oid typoutput;
bool typisvarlena;
for (i = 0; i < tupdesc->natts; i++)
{
......@@ -2605,19 +2603,6 @@ pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
************************************************************/
attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
/************************************************************
* Lookup the attribute type in the syscache
* for the output function
************************************************************/
typeTup = SearchSysCache1(TYPEOID,
ObjectIdGetDatum(tupdesc->attrs[i]->atttypid));
if (!HeapTupleIsValid(typeTup))
elog(ERROR, "cache lookup failed for type %u",
tupdesc->attrs[i]->atttypid);
typoutput = ((Form_pg_type) GETSTRUCT(typeTup))->typoutput;
ReleaseSysCache(typeTup);
/************************************************************
* If there is a value, append the attribute name and the
* value to the list
......@@ -2626,14 +2611,22 @@ pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
* crash if they don't expect them - need something
* smarter here.
************************************************************/
if (!isnull && OidIsValid(typoutput))
if (!isnull)
{
getTypeOutputInfo(tupdesc->attrs[i]->atttypid,
&typoutput, &typisvarlena);
outputstr = OidOutputFunctionCall(typoutput, attr);
Tcl_DStringAppendElement(retval, attname);
UTF_BEGIN;
Tcl_DStringAppendElement(retval, UTF_E2U(outputstr));
Tcl_ListObjAppendElement(NULL, retobj,
Tcl_NewStringObj(UTF_E2U(attname), -1));
UTF_END;
UTF_BEGIN;
Tcl_ListObjAppendElement(NULL, retobj,
Tcl_NewStringObj(UTF_E2U(outputstr), -1));
UTF_END;
pfree(outputstr);
}
}
return retobj;
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment