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