Currently, pl/tcl is implemented through nothing but string
manipulation. In other words, the C code is effectively creating a giant
string that the tcl interpreter must re-parse every time the function is
executed. Additionally, all arguments are treated as raw strings,
instead of the far more efficient internal tcl object types.
The biggest win comes with how pltcl interfaces with SPI result sets.
Currently, the entire chunk of tcl code that is executed for each result
row must be reparsed and recompiled from scratch. Now, the code is
compiled once and the bytecode is stored.
This work is sponsored by Flight Aware (http://flightaware.com/).
--
Jim Nasby, Data Architect, Blue Treble Consulting, Austin TX
Experts in Analytics, Data Architecture and PostgreSQL
Data in Trouble? Get it in Treble! http://BlueTreble.com
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index dce5d04..fdb6f9e 100644
--- a/src/pl/tcl/pltcl.c
+++ b/src/pl/tcl/pltcl.c
@@ -212,33 +212,33 @@ 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);
+ Tcl_Obj * retobj);
/*
@@ -425,23 +425,23 @@ pltcl_init_interp(pltcl_interp_desc *interp_desc, bool
pltrusted)
/************************************************************
* Install the commands for SPI support in the interpreter
************************************************************/
- Tcl_CreateCommand(interp, "elog",
- pltcl_elog, NULL, NULL);
- Tcl_CreateCommand(interp, "quote",
- pltcl_quote, NULL, NULL);
- Tcl_CreateCommand(interp, "argisnull",
- pltcl_argisnull, NULL, NULL);
- Tcl_CreateCommand(interp, "return_null",
- pltcl_returnnull, NULL, NULL);
-
- Tcl_CreateCommand(interp, "spi_exec",
- pltcl_SPI_execute, NULL, NULL);
- Tcl_CreateCommand(interp, "spi_prepare",
- pltcl_SPI_prepare, NULL, NULL);
- Tcl_CreateCommand(interp, "spi_execp",
- pltcl_SPI_execute_plan, NULL, NULL);
- Tcl_CreateCommand(interp, "spi_lastoid",
- pltcl_SPI_lastoid, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "elog",
+ pltcl_elog, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "quote",
+ pltcl_quote, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "argisnull",
+ pltcl_argisnull, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "return_null",
+ pltcl_returnnull, NULL, NULL);
+
+ Tcl_CreateObjCommand(interp, "spi_exec",
+ pltcl_SPI_execute, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "spi_prepare",
+ pltcl_SPI_prepare, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "spi_execp",
+ pltcl_SPI_execute_plan, NULL,
NULL);
+ Tcl_CreateObjCommand(interp, "spi_lastoid",
+ pltcl_SPI_lastoid, NULL, NULL);
/************************************************************
* Try to load the unknown procedure from pltcl_modules
@@ -578,7 +578,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 +687,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 = Tcl_NewObj();
int i;
int tcl_rc;
Datum retval;
@@ -707,9 +708,9 @@ 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));
/************************************************************
* Add all call arguments to the command
@@ -724,7 +725,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 +733,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 +744,10 @@ 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 = Tcl_NewObj();
+ pltcl_build_tuple_argument(&tmptup,
tupdesc, list_tmp);
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
list_tmp);
+ Tcl_DecrRefCount(list_tmp);
ReleaseTupleDesc(tupdesc);
}
}
@@ -756,7 +758,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 +766,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 +776,19 @@ pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
}
PG_CATCH();
{
- Tcl_DStringFree(&tcl_cmd);
- Tcl_DStringFree(&list_tmp);
+ 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_IncrRefCount(tcl_cmd);
+ tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT |
TCL_EVAL_GLOBAL));
+ Tcl_DecrRefCount(tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
@@ -837,9 +839,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 +871,75 @@ 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_trigtup = Tcl_NewObj();
+ tcl_newtup = Tcl_NewObj();
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 */
+ /* NB don't convert 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_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);
+ /* Tcl_DecrRefCount(tcl_trigtup); */
+ tcl_trigtup = Tcl_NewObj();
/* 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);
+
tupdesc, tcl_trigtup);
/*
* Now the command part of the event for TG_op and data
for NEW
@@ -935,31 +947,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);
+
tupdesc, tcl_newtup);
- 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 +983,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 +1011,29 @@ 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);
+ Tcl_DecrRefCount(tcl_trigtup);
+ Tcl_DecrRefCount(tcl_newtup);
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_IncrRefCount(tcl_cmd);
+ tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT |
TCL_EVAL_GLOBAL));
+ /* Tcl_DecrRefCount(tcl_trigtup); */
+ /* Tcl_DecrRefCount(tcl_newtup); */
+ Tcl_DecrRefCount(tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
@@ -1183,7 +1205,9 @@ pltcl_event_trigger_handler(PG_FUNCTION_ARGS, bool
pltrusted)
Tcl_DStringAppendElement(&tcl_cmd, tdata->event);
Tcl_DStringAppendElement(&tcl_cmd, tdata->tag);
- tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
+ tcl_rc = Tcl_EvalEx(interp, Tcl_DStringValue(&tcl_cmd),
+ Tcl_DStringLength(&tcl_cmd),
+ TCL_EVAL_GLOBAL);
Tcl_DStringFree(&tcl_cmd);
/* Check for errors reported by Tcl. */
@@ -1482,6 +1506,10 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
/************************************************************
* Create the tcl command to define the internal
* procedure
+ *
+ * leave this 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 +1578,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,38 +1617,66 @@ 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)
+ enum logpriority
{
- Tcl_SetResult(interp, "syntax error - 'elog level msg'",
TCL_STATIC);
+ LOG_DEBUG, LOG_LOG, LOG_INFO, LOG_NOTICE,
+ LOG_WARNING, LOG_ERROR, LOG_FATAL
+ };
+
+ static CONST84 char *logpriorities[] = {
+ "DEBUG", "LOG", "INFO", "NOTICE",
+ "WARNING", "ERROR", "FATAL", (char *) NULL
+ };
+
+ if (objc != 3)
+ {
+ 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
+ if (Tcl_GetIndexFromObj(interp, objv[1], logpriorities, "priority",
+ TCL_EXACT, &priIndex)
!= TCL_OK)
{
- Tcl_AppendResult(interp, "Unknown elog level '", argv[1],
- "'", NULL);
return TCL_ERROR;
}
+ switch ((enum logpriority) priIndex)
+ {
+ case LOG_DEBUG:
+ level = DEBUG2;
+ break;
+
+ case LOG_LOG:
+ level = LOG;
+ break;
+
+ case LOG_INFO:
+ level = INFO;
+ break;
+
+ case LOG_NOTICE:
+ level = NOTICE;
+ break;
+
+ case LOG_WARNING:
+ level = WARNING;
+ break;
+
+ case LOG_ERROR:
+ level = ERROR;
+ break;
+
+ case LOG_FATAL:
+ level = FATAL;
+ break;
+ }
+
if (level == ERROR)
{
/*
@@ -1626,7 +1684,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 +1703,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 +1717,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 +1735,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 +1755,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 +1778,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 +1789,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 +1797,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 +1808,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,18 +1825,15 @@ 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;
}
@@ -1788,16 +1843,16 @@ pltcl_argisnull(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[])
{
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 +1861,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,18 +1961,28 @@ 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 *loop_body = NULL;
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
+ enum options
+ {
+ OPT_ARRAY, OPT_COUNT
+ };
+
+ static CONST84 char *options[] = {
+ "-array", "-count", (char *) NULL
+ };
+
char *usage = "syntax error - 'SPI_exec "
"?-count n? "
"?-array name? query ?loop body?";
@@ -1925,49 +1990,53 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
/************************************************************
* Check the call syntax and get the options
************************************************************/
- if (argc < 2)
+ if (objc < 2)
{
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-count n? ?-array name?
query ?loop body?");
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
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)
- {
- Tcl_SetResult(interp, usage, TCL_STATIC);
- return TCL_ERROR;
- }
- arrayname = argv[i++];
- continue;
+ break;
}
- if (strcmp(argv[i], "-count") == 0)
+ if (++i >= objc)
{
- if (++i >= argc)
- {
- Tcl_SetResult(interp, usage, TCL_STATIC);
- return TCL_ERROR;
- }
- if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
- return TCL_ERROR;
- continue;
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("missing argument to -count or
-array", -1));
+ return TCL_ERROR;
}
- break;
+ switch ((enum options) optIndex)
+ {
+ 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 +2048,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 +2079,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 +2096,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 +2140,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 +2160,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 +2187,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 +2203,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 +2257,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 +2270,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 +2290,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 +2304,10 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
Tcl_SetHashValue(hashent, (ClientData) qdesc);
- ckfree((char *) args);
+ /* 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,25 +2317,35 @@ 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;
+ enum options
+ {
+ OPT_ARRAY, OPT_COUNT, OPT_NULLS
+ };
+
+ static CONST84 char *options[] = {
+ "-array", "-count", "-nulls", (char *) NULL
+ };
+
char *usage = "syntax error - 'SPI_execp "
"?-nulls string? ?-count n? "
"?-array name? query ?args? ?loop body?";
@@ -2280,58 +2354,54 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp
*interp,
* Get the options and check syntax
************************************************************/
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)
- {
- Tcl_SetResult(interp, usage, TCL_STATIC);
- return TCL_ERROR;
- }
- arrayname = argv[i++];
- continue;
+ break;
}
- if (strcmp(argv[i], "-nulls") == 0)
+
+ if (++i >= objc)
{
- if (++i >= argc)
- {
- Tcl_SetResult(interp, usage, TCL_STATIC);
- return TCL_ERROR;
- }
- nulls = argv[i++];
- continue;
+ Tcl_SetObjResult(interp,
+
Tcl_NewStringObj("missing argument to -array, -count or -nulls", -1));
+ return TCL_ERROR;
}
- if (strcmp(argv[i], "-count") == 0)
+
+ switch ((enum options) optIndex)
{
- if (++i >= argc)
- {
- 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;
- 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);
@@ -2357,7 +2427,8 @@ 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);
return TCL_ERROR;
@@ -2366,35 +2437,32 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp
*interp,
/************************************************************
* 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);
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);
return TCL_ERROR;
}
@@ -2411,9 +2479,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 +2494,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 +2519,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 +2533,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,7 +2550,6 @@ pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char
*arrayname,
{
int i;
char *outputstr;
- char buf[64];
Datum attr;
bool isnull;
@@ -2517,8 +2574,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++)
@@ -2562,7 +2618,8 @@ pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char
*arrayname,
{
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);
}
@@ -2578,7 +2635,7 @@ pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char
*arrayname,
**********************************************************************/
static void
pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
- Tcl_DString *retval)
+ Tcl_Obj * retobj)
{
int i;
char *outputstr;
@@ -2629,9 +2686,10 @@ pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc
tupdesc,
if (!isnull && OidIsValid(typoutput))
{
outputstr = OidOutputFunctionCall(typoutput, attr);
- Tcl_DStringAppendElement(retval, attname);
+ Tcl_ListObjAppendElement(NULL, retobj,
+
Tcl_NewStringObj(attname, -1));
UTF_BEGIN;
- Tcl_DStringAppendElement(retval, UTF_E2U(outputstr));
+ Tcl_ListObjAppendElement(NULL, retobj,
Tcl_NewStringObj(UTF_E2U(outputstr), -1));
UTF_END;
pfree(outputstr);
}
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
