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); }