((TCL_MAJOR_VERSION > maj) || \
(TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
-/* In Tcl >= 8.0, really not supposed to touch interp->result directly */
+/* Insist on Tcl >= 8.0 */
#if !HAVE_TCL_VERSION(8,0)
-#define Tcl_GetStringResult(interp) ((interp)->result)
+#error PostgreSQL only supports Tcl 8.0 or later.
#endif
/* define our text domain for translations */
bool pltrusted);
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
- int argc, CONST84 char *argv[]);
+ int objc, Tcl_Obj *const objv[]);
static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
- int argc, CONST84 char *argv[]);
+ int objc, Tcl_Obj *const objv[]);
static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
- int argc, CONST84 char *argv[]);
+ int objc, Tcl_Obj *const objv[]);
static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
- int argc, CONST84 char *argv[]);
+ int objc, Tcl_Obj *const objv[]);
static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
- int argc, CONST84 char *argv[]);
+ int objc, Tcl_Obj *const objv[]);
static int pltcl_process_SPI_result(Tcl_Interp *interp,
CONST84 char *arrayname,
- CONST84 char *loop_body,
+ Tcl_Obj *loop_body,
int spi_rc,
SPITupleTable *tuptable,
int ntuples);
static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
- int argc, CONST84 char *argv[]);
+ int objc, Tcl_Obj *const objv[]);
static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
- int argc, CONST84 char *argv[]);
+ int objc, Tcl_Obj *const objv[]);
static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
- int argc, CONST84 char *argv[]);
+ int objc, Tcl_Obj *const objv[]);
static void pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc);
-static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
- Tcl_DString *retval);
+static Tcl_Obj *pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc);
/*
/************************************************************
* 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
* There is a module named unknown. Reassemble the
* source from the modsrc attributes and evaluate
* it in the Tcl interpreter
+ *
+ * leave this code as DString - it's only executed once per session
************************************************************/
fno = SPI_fnumber(SPI_tuptable->tupdesc, "modsrc");
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);
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
- Tcl_DString tcl_cmd;
- Tcl_DString list_tmp;
+ Tcl_Obj *tcl_cmd;
int i;
int tcl_rc;
Datum retval;
* Create the tcl command to call the internal
* proc in the Tcl interpreter
************************************************************/
- Tcl_DStringInit(&tcl_cmd);
- Tcl_DStringInit(&list_tmp);
- Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
+ tcl_cmd = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj(prodesc->internal_proname, -1));
+
+ /* We hold a refcount on tcl_cmd just to be sure it stays around */
+ Tcl_IncrRefCount(tcl_cmd);
/************************************************************
* Add all call arguments to the command
* 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;
int32 tupTypmod;
TupleDesc tupdesc;
HeapTupleData tmptup;
+ Tcl_Obj *list_tmp;
td = DatumGetHeapTupleHeader(fcinfo->arg[i]);
/* Extract rowtype info and find a tupdesc */
tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
tmptup.t_data = td;
- Tcl_DStringSetLength(&list_tmp, 0);
- pltcl_build_tuple_argument(&tmptup, tupdesc, &list_tmp);
- Tcl_DStringAppendElement(&tcl_cmd,
- Tcl_DStringValue(&list_tmp));
+ list_tmp = pltcl_build_tuple_argument(&tmptup, tupdesc);
+ Tcl_ListObjAppendElement(NULL, tcl_cmd, list_tmp);
+
ReleaseTupleDesc(tupdesc);
}
}
* of their external representation
**************************************************/
if (fcinfo->argnull[i])
- Tcl_DStringAppendElement(&tcl_cmd, "");
+ Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
else
{
char *tmp;
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);
}
}
PG_CATCH();
{
- Tcl_DStringFree(&tcl_cmd);
- Tcl_DStringFree(&list_tmp);
+ /* Release refcount to free tcl_cmd */
+ Tcl_DecrRefCount(tcl_cmd);
PG_RE_THROW();
}
PG_END_TRY();
- Tcl_DStringFree(&list_tmp);
/************************************************************
* Call the Tcl function
*
* We assume no PG error can be thrown directly from this call.
************************************************************/
- tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
- Tcl_DStringFree(&tcl_cmd);
+ tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
+
+ /* Release refcount to free tcl_cmd (and all subsidiary objects) */
+ Tcl_DecrRefCount(tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
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;
* Create the tcl command to call the internal
* proc in the interpreter
************************************************************/
- Tcl_DStringInit(&tcl_cmd);
- Tcl_DStringInit(&tcl_trigtup);
- Tcl_DStringInit(&tcl_newtup);
+ tcl_cmd = Tcl_NewObj();
+ Tcl_IncrRefCount(tcl_cmd);
+
PG_TRY();
{
/* The procedure name */
- Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj(prodesc->internal_proname, -1));
/* The trigger name for argument TG_name */
- Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgname);
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj(trigdata->tg_trigger->tgname, -1));
/* The oid of the trigger relation for argument TG_relid */
+ /* Consider not converting to a string for more performance? */
stroid = DatumGetCString(DirectFunctionCall1(oidout,
ObjectIdGetDatum(trigdata->tg_relation->rd_id)));
- Tcl_DStringAppendElement(&tcl_cmd, stroid);
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj(stroid, -1));
pfree(stroid);
/* The name of the table the trigger is acting on: TG_table_name */
stroid = SPI_getrelname(trigdata->tg_relation);
- Tcl_DStringAppendElement(&tcl_cmd, stroid);
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj(stroid, -1));
pfree(stroid);
/* The schema of the table the trigger is acting on: TG_table_schema */
stroid = SPI_getnspname(trigdata->tg_relation);
- Tcl_DStringAppendElement(&tcl_cmd, stroid);
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj(stroid, -1));
pfree(stroid);
/* A list of attribute names for argument TG_relatts */
- Tcl_DStringAppendElement(&tcl_trigtup, "");
+ tcl_trigtup = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
for (i = 0; i < tupdesc->natts; i++)
{
if (tupdesc->attrs[i]->attisdropped)
- Tcl_DStringAppendElement(&tcl_trigtup, "");
+ Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
else
- Tcl_DStringAppendElement(&tcl_trigtup,
- NameStr(tupdesc->attrs[i]->attname));
+ Tcl_ListObjAppendElement(NULL, tcl_trigtup,
+ Tcl_NewStringObj(NameStr(tupdesc->attrs[i]->attname), -1));
}
- Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
- Tcl_DStringFree(&tcl_trigtup);
- Tcl_DStringInit(&tcl_trigtup);
+ Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
/* The when part of the event for TG_when */
if (TRIGGER_FIRED_BEFORE(trigdata->tg_event))
- Tcl_DStringAppendElement(&tcl_cmd, "BEFORE");
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj("BEFORE", -1));
else if (TRIGGER_FIRED_AFTER(trigdata->tg_event))
- Tcl_DStringAppendElement(&tcl_cmd, "AFTER");
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj("AFTER", -1));
else if (TRIGGER_FIRED_INSTEAD(trigdata->tg_event))
- Tcl_DStringAppendElement(&tcl_cmd, "INSTEAD OF");
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj("INSTEAD OF", -1));
else
elog(ERROR, "unrecognized WHEN tg_event: %u", trigdata->tg_event);
/* The level part of the event for TG_level */
if (TRIGGER_FIRED_FOR_ROW(trigdata->tg_event))
{
- Tcl_DStringAppendElement(&tcl_cmd, "ROW");
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj("ROW", -1));
/* Build the data list for the trigtuple */
- pltcl_build_tuple_argument(trigdata->tg_trigtuple,
- tupdesc, &tcl_trigtup);
+ tcl_trigtup = pltcl_build_tuple_argument(trigdata->tg_trigtuple,
+ tupdesc);
/*
* Now the command part of the event for TG_op and data for NEW
*/
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
{
- Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj("INSERT", -1));
- Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
- Tcl_DStringAppendElement(&tcl_cmd, "");
+ Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
+ Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
rettup = trigdata->tg_trigtuple;
}
else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
{
- Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj("DELETE", -1));
- Tcl_DStringAppendElement(&tcl_cmd, "");
- Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
+ Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
+ Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
rettup = trigdata->tg_trigtuple;
}
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
{
- Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj("UPDATE", -1));
- pltcl_build_tuple_argument(trigdata->tg_newtuple,
- tupdesc, &tcl_newtup);
+ tcl_newtup = pltcl_build_tuple_argument(trigdata->tg_newtuple,
+ tupdesc);
- Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_newtup));
- Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
+ Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_newtup);
+ Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
rettup = trigdata->tg_newtuple;
}
}
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;
}
/* Finally append the arguments from CREATE TRIGGER */
for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
- Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgargs[i]);
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj(trigdata->tg_trigger->tgargs[i], -1));
}
PG_CATCH();
{
- Tcl_DStringFree(&tcl_cmd);
- Tcl_DStringFree(&tcl_trigtup);
- Tcl_DStringFree(&tcl_newtup);
+ Tcl_DecrRefCount(tcl_cmd);
PG_RE_THROW();
}
PG_END_TRY();
- Tcl_DStringFree(&tcl_trigtup);
- Tcl_DStringFree(&tcl_newtup);
/************************************************************
* Call the Tcl function
*
* We assume no PG error can be thrown directly from this call.
************************************************************/
- tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
- Tcl_DStringFree(&tcl_cmd);
+ tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
+
+ /* Release refcount to free tcl_cmd (and all subsidiary objects) */
+ Tcl_DecrRefCount(tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
CONST84 char *ret_name = ret_values[i];
CONST84 char *ret_value = ret_values[i + 1];
int attnum;
- HeapTuple typeTup;
Oid typinput;
Oid typioparam;
FmgrInfo finfo;
* Lookup the attribute type in the syscache
* for the input function
************************************************************/
- typeTup = SearchSysCache1(TYPEOID,
- ObjectIdGetDatum(tupdesc->attrs[attnum - 1]->atttypid));
- if (!HeapTupleIsValid(typeTup))
- elog(ERROR, "cache lookup failed for type %u",
- tupdesc->attrs[attnum - 1]->atttypid);
- typinput = ((Form_pg_type) GETSTRUCT(typeTup))->typinput;
- typioparam = getTypeIOParam(typeTup);
- ReleaseSysCache(typeTup);
+ getTypeInputInfo(tupdesc->attrs[attnum - 1]->atttypid,
+ &typinput, &typioparam);
+ fmgr_info(typinput, &finfo);
/************************************************************
* Set the attribute to NOT NULL and convert the contents
************************************************************/
modnulls[attnum - 1] = ' ';
- fmgr_info(typinput, &finfo);
UTF_BEGIN;
modvalues[attnum - 1] = InputFunctionCall(&finfo,
(char *) UTF_U2E(ret_value),
if (rettup == NULL)
elog(ERROR, "SPI_modifytuple() failed - RC = %d", SPI_result);
-
}
PG_CATCH();
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
EventTriggerData *tdata = (EventTriggerData *) fcinfo->context;
- Tcl_DString tcl_cmd;
+ Tcl_Obj *tcl_cmd;
int tcl_rc;
/* Connect to SPI manager */
interp = prodesc->interp_desc->interp;
/* Create the tcl command and call the internal proc */
- Tcl_DStringInit(&tcl_cmd);
- Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
- Tcl_DStringAppendElement(&tcl_cmd, tdata->event);
- Tcl_DStringAppendElement(&tcl_cmd, tdata->tag);
+ tcl_cmd = Tcl_NewObj();
+ Tcl_IncrRefCount(tcl_cmd);
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj(prodesc->internal_proname, -1));
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj(tdata->event, -1));
+ Tcl_ListObjAppendElement(NULL, tcl_cmd,
+ Tcl_NewStringObj(tdata->tag, -1));
+
+ tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
- tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
- Tcl_DStringFree(&tcl_cmd);
+ /* Release refcount to free tcl_cmd (and all subsidiary objects) */
+ Tcl_DecrRefCount(tcl_cmd);
/* Check for errors reported by Tcl. */
if (tcl_rc != TCL_OK)
/************************************************************
* Create the tcl command to define the internal
* procedure
+ *
+ * leave this code as DString - it's a text processing function
+ * that only gets invoked when the tcl function is invoked
+ * for the first time
************************************************************/
Tcl_DStringInit(&proc_internal_def);
Tcl_DStringInit(&proc_internal_body);
/************************************************************
* 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)
{
**********************************************************************/
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;
+
+ 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;
}
- if (strcmp(argv[1], "DEBUG") == 0)
- level = DEBUG2;
- else if (strcmp(argv[1], "LOG") == 0)
- level = LOG;
- else if (strcmp(argv[1], "INFO") == 0)
- level = INFO;
- else if (strcmp(argv[1], "NOTICE") == 0)
- level = NOTICE;
- else if (strcmp(argv[1], "WARNING") == 0)
- level = WARNING;
- else if (strcmp(argv[1], "ERROR") == 0)
- level = ERROR;
- else if (strcmp(argv[1], "FATAL") == 0)
- level = FATAL;
- else
- {
- Tcl_AppendResult(interp, "Unknown elog level '", argv[1],
- "'", NULL);
+ if (Tcl_GetIndexFromObj(interp, objv[1], logpriorities, "priority",
+ TCL_EXACT, &priIndex) != TCL_OK)
return TCL_ERROR;
- }
+
+ level = loglevels[priIndex];
if (level == ERROR)
{
* 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;
}
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();
/* 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);
**********************************************************************/
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;
}
* 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;
/************************************************************
* 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;
}
**********************************************************************/
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;
/************************************************************
* 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;
}
************************************************************/
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;
/************************************************************
argno--;
if (argno < 0 || argno >= fcinfo->nargs)
{
- Tcl_SetResult(interp, "argno out of range", TCL_STATIC);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("argno out of range", -1));
return TCL_ERROR;
}
/************************************************************
* Get the requested NULL state
************************************************************/
- if (PG_ARGISNULL(argno))
- Tcl_SetResult(interp, "1", TCL_STATIC);
- else
- Tcl_SetResult(interp, "0", TCL_STATIC);
-
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(PG_ARGISNULL(argno)));
return TCL_OK;
}
/**********************************************************************
- * pltcl_returnnull() - Cause a NULL return from a function
+ * pltcl_returnnull() - Cause a NULL return from the current function
**********************************************************************/
static int
pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
- int argc, CONST84 char *argv[])
+ int objc, Tcl_Obj *const objv[])
{
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
/************************************************************
* Check call syntax
************************************************************/
- if (argc != 1)
+ if (objc != 1)
{
- Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_STATIC);
+ Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
************************************************************/
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;
}
**********************************************************************/
static int
pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
- int argc, CONST84 char *argv[])
+ int objc, Tcl_Obj *const objv[])
{
int my_rc;
int spi_rc;
int query_idx;
int i;
+ int optIndex;
int count = 0;
CONST84 char *volatile arrayname = NULL;
- CONST84 char *volatile loop_body = NULL;
+ Tcl_Obj *volatile loop_body = NULL;
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
- char *usage = "syntax error - 'SPI_exec "
- "?-count n? "
- "?-array name? query ?loop body?";
+ enum options
+ {
+ OPT_ARRAY, OPT_COUNT
+ };
+
+ static CONST84 char *options[] = {
+ "-array", "-count", (char *) NULL
+ };
/************************************************************
* Check the call syntax and get the options
************************************************************/
- if (argc < 2)
+ if (objc < 2)
{
- Tcl_SetResult(interp, usage, TCL_STATIC);
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-count n? ?-array name? query ?loop body?");
return TCL_ERROR;
}
i = 1;
- while (i < argc)
+ 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_SetResult(interp, usage, TCL_STATIC);
- return TCL_ERROR;
- }
- arrayname = argv[i++];
- continue;
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("missing argument to -count or -array", -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;
- 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
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;
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;
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 */
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;
if (my_rc == TCL_OK)
{
- snprintf(buf, sizeof(buf), "%d", ntuples);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(ntuples));
}
break;
**********************************************************************/
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;
/************************************************************
* 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;
/************************************************************
typIOParam;
int32 typmod;
- parseTypeString(args[i], &typId, &typmod, false);
+ parseTypeString(Tcl_GetString(argsObj[i]), &typId, &typmod, false);
getTypeInputInfo(typId, &typInput, &typIOParam);
* 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)
pltcl_subtrans_abort(interp, oldcontext, oldowner);
MemoryContextDelete(plan_cxt);
- ckfree((char *) args);
return TCL_ERROR;
}
hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
Tcl_SetHashValue(hashent, (ClientData) qdesc);
- ckfree((char *) args);
-
/* qname is ASCII, so no need for encoding conversion */
- Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(qdesc->qname, -1));
return TCL_OK;
}
**********************************************************************/
static int
pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
- int argc, CONST84 char *argv[])
+ int objc, Tcl_Obj *const objv[])
{
int my_rc;
int spi_rc;
int i;
int j;
+ int optIndex;
Tcl_HashEntry *hashent;
pltcl_query_desc *qdesc;
const char *nulls = NULL;
CONST84 char *arrayname = NULL;
- CONST84 char *loop_body = NULL;
+ Tcl_Obj *loop_body = NULL;
int count = 0;
- int callnargs;
- CONST84 char **callargs = NULL;
+ int callObjc;
+ Tcl_Obj **callObjv = NULL;
Datum *argvalues;
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
Tcl_HashTable *query_hash;
- char *usage = "syntax error - 'SPI_execp "
- "?-nulls string? ?-count n? "
- "?-array name? query ?args? ?loop body?";
+ enum options
+ {
+ OPT_ARRAY, OPT_COUNT, OPT_NULLS
+ };
+
+ static CONST84 char *options[] = {
+ "-array", "-count", "-nulls", (char *) NULL
+ };
/************************************************************
* Get the options and check syntax
************************************************************/
i = 1;
- while (i < argc)
+ while (i < objc)
{
- if (strcmp(argv[i], "-array") == 0)
- {
- if (++i >= argc)
- {
- Tcl_SetResult(interp, usage, TCL_STATIC);
- return TCL_ERROR;
- }
- arrayname = argv[i++];
- continue;
- }
- if (strcmp(argv[i], "-nulls") == 0)
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option",
+ TCL_EXACT, &optIndex) != TCL_OK)
+ break;
+
+ 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;
- 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
************************************************************/
- 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);
{
if (strlen(nulls) != qdesc->nargs)
{
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(
"length of nulls string doesn't match number of arguments",
- TCL_STATIC);
+ -1));
return TCL_ERROR;
}
}
************************************************************/
if (qdesc->nargs > 0)
{
- if (i >= argc)
+ if (i >= objc)
{
- Tcl_SetResult(interp, "missing argument list", TCL_STATIC);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(
+ "argument list length doesn't match number of arguments for query"
+ ,-1));
return TCL_ERROR;
}
/************************************************************
* Split the argument values
************************************************************/
- if (Tcl_SplitList(interp, argv[i++], &callnargs, &callargs) != TCL_OK)
+ if (Tcl_ListObjGetElements(interp, objv[i++], &callObjc, &callObjv) != TCL_OK)
return TCL_ERROR;
/************************************************************
* Check that the number of arguments matches
************************************************************/
- if (callnargs != qdesc->nargs)
+ if (callObjc != qdesc->nargs)
{
- Tcl_SetResult(interp,
- "argument list length doesn't match number of arguments for query",
- TCL_STATIC);
- ckfree((char *) callargs);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(
+ "argument list length doesn't match number of arguments for query"
+ ,-1));
return TCL_ERROR;
}
}
else
- callnargs = 0;
+ callObjc = 0;
/************************************************************
* Get loop body if present
************************************************************/
- if (i < argc)
- loop_body = argv[i++];
+ if (i < objc)
+ loop_body = objv[i++];
- if (i != argc)
+ if (i != objc)
{
- Tcl_SetResult(interp, usage, TCL_STATIC);
- if (callargs)
- ckfree((char *) callargs);
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-count n? ?-array name? ?-nulls string? "
+ "query ?args? ?loop body?");
return TCL_ERROR;
}
* 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')
{
{
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;
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;
}
**********************************************************************/
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;
}
{
int i;
char *outputstr;
- char buf[64];
Datum attr;
bool isnull;
-
CONST84 char *attname;
- HeapTuple typeTup;
Oid typoutput;
-
+ bool typisvarlena;
CONST84 char **arrptr;
CONST84 char **nameptr;
CONST84 char *nullname = NULL;
{
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++)
************************************************************/
attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
- /************************************************************
- * Lookup the attribute type in the syscache
- * for the output function
- ************************************************************/
- typeTup = SearchSysCache1(TYPEOID,
- ObjectIdGetDatum(tupdesc->attrs[i]->atttypid));
- if (!HeapTupleIsValid(typeTup))
- elog(ERROR, "cache lookup failed for type %u",
- tupdesc->attrs[i]->atttypid);
-
- typoutput = ((Form_pg_type) GETSTRUCT(typeTup))->typoutput;
- ReleaseSysCache(typeTup);
-
/************************************************************
* If there is a value, set the variable
* If not, unset it
* crash if they don't expect them - need something
* smarter here.
************************************************************/
- if (!isnull && OidIsValid(typoutput))
+ if (!isnull)
{
+ getTypeOutputInfo(tupdesc->attrs[i]->atttypid,
+ &typoutput, &typisvarlena);
outputstr = OidOutputFunctionCall(typoutput, attr);
UTF_BEGIN;
- Tcl_SetVar2(interp, *arrptr, *nameptr, UTF_E2U(outputstr), 0);
+ Tcl_SetVar2Ex(interp, *arrptr, *nameptr,
+ Tcl_NewStringObj(UTF_E2U(outputstr), -1), 0);
UTF_END;
pfree(outputstr);
}
/**********************************************************************
- * pltcl_build_tuple_argument() - Build a string usable for 'array set'
+ * pltcl_build_tuple_argument() - Build a list object usable for 'array set'
* from all attributes of a given tuple
**********************************************************************/
-static void
-pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
- Tcl_DString *retval)
+static Tcl_Obj *
+pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
{
+ Tcl_Obj *retobj = Tcl_NewObj();
int i;
char *outputstr;
Datum attr;
bool isnull;
-
char *attname;
- HeapTuple typeTup;
Oid typoutput;
+ bool typisvarlena;
for (i = 0; i < tupdesc->natts; i++)
{
************************************************************/
attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
- /************************************************************
- * Lookup the attribute type in the syscache
- * for the output function
- ************************************************************/
- typeTup = SearchSysCache1(TYPEOID,
- ObjectIdGetDatum(tupdesc->attrs[i]->atttypid));
- if (!HeapTupleIsValid(typeTup))
- elog(ERROR, "cache lookup failed for type %u",
- tupdesc->attrs[i]->atttypid);
-
- typoutput = ((Form_pg_type) GETSTRUCT(typeTup))->typoutput;
- ReleaseSysCache(typeTup);
-
/************************************************************
* If there is a value, append the attribute name and the
* value to the list
* crash if they don't expect them - need something
* smarter here.
************************************************************/
- if (!isnull && OidIsValid(typoutput))
+ if (!isnull)
{
+ getTypeOutputInfo(tupdesc->attrs[i]->atttypid,
+ &typoutput, &typisvarlena);
outputstr = OidOutputFunctionCall(typoutput, attr);
- Tcl_DStringAppendElement(retval, attname);
UTF_BEGIN;
- Tcl_DStringAppendElement(retval, UTF_E2U(outputstr));
+ Tcl_ListObjAppendElement(NULL, retobj,
+ Tcl_NewStringObj(UTF_E2U(attname), -1));
+ UTF_END;
+ UTF_BEGIN;
+ Tcl_ListObjAppendElement(NULL, retobj,
+ Tcl_NewStringObj(UTF_E2U(outputstr), -1));
UTF_END;
pfree(outputstr);
}
}
+
+ return retobj;
}