diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c index 7b952b2..1efdb2d 100644 *** a/src/pl/tcl/pltcl.c --- b/src/pl/tcl/pltcl.c *************** static pltcl_proc_desc *compile_pltcl_fu *** 200,232 **** bool pltrusted); static int pltcl_elog(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]); static int pltcl_quote(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]); static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]); static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]); static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]); static int pltcl_process_SPI_result(Tcl_Interp *interp, CONST84 char *arrayname, ! CONST84 char *loop_body, int spi_rc, SPITupleTable *tuptable, int ntuples); static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]); static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]); static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]); 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); /* --- 200,232 ---- bool pltrusted); static int pltcl_elog(ClientData cdata, Tcl_Interp *interp, ! int objc, Tcl_Obj * const objv[]); static int pltcl_quote(ClientData cdata, Tcl_Interp *interp, ! int objc, Tcl_Obj * const objv[]); static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, ! int objc, Tcl_Obj * const objv[]); static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, ! int objc, Tcl_Obj * const objv[]); static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, ! int objc, Tcl_Obj * const objv[]); static int pltcl_process_SPI_result(Tcl_Interp *interp, CONST84 char *arrayname, ! Tcl_Obj * loop_body, int spi_rc, SPITupleTable *tuptable, int ntuples); static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp, ! int objc, Tcl_Obj * const objv[]); static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, ! int objc, Tcl_Obj * const objv[]); static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp, ! 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_Obj *retobj); /* *************** pltcl_init_interp(pltcl_interp_desc *int *** 415,437 **** /************************************************************ * 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); /************************************************************ * Try to load the unknown procedure from pltcl_modules --- 415,437 ---- /************************************************************ * Install the commands for SPI support in the interpreter ************************************************************/ ! 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 *************** pltcl_func_handler(PG_FUNCTION_ARGS, boo *** 665,672 **** { pltcl_proc_desc *prodesc; Tcl_Interp *volatile interp; ! Tcl_DString tcl_cmd; ! Tcl_DString list_tmp; int i; int tcl_rc; Datum retval; --- 665,671 ---- { pltcl_proc_desc *prodesc; Tcl_Interp *volatile interp; ! Tcl_Obj *tcl_cmd = Tcl_NewObj(); int i; int tcl_rc; Datum retval; *************** pltcl_func_handler(PG_FUNCTION_ARGS, boo *** 687,695 **** * 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); /************************************************************ * Add all call arguments to the command --- 686,694 ---- * Create the tcl command to call the internal * proc in the Tcl interpreter ************************************************************/ ! tcl_cmd = Tcl_NewObj(); ! Tcl_ListObjAppendElement (NULL, tcl_cmd, ! Tcl_NewStringObj(prodesc->internal_proname, -1)); /************************************************************ * Add all call arguments to the command *************** pltcl_func_handler(PG_FUNCTION_ARGS, boo *** 704,710 **** * For tuple values, add a list for 'array set ...' **************************************************/ if (fcinfo->argnull[i]) ! Tcl_DStringAppendElement(&tcl_cmd, ""); else { HeapTupleHeader td; --- 703,709 ---- * For tuple values, add a list for 'array set ...' **************************************************/ if (fcinfo->argnull[i]) ! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj()); else { HeapTupleHeader td; *************** pltcl_func_handler(PG_FUNCTION_ARGS, boo *** 712,717 **** --- 711,717 ---- int32 tupTypmod; TupleDesc tupdesc; HeapTupleData tmptup; + Tcl_Obj *list_tmp; td = DatumGetHeapTupleHeader(fcinfo->arg[i]); /* Extract rowtype info and find a tupdesc */ *************** pltcl_func_handler(PG_FUNCTION_ARGS, boo *** 722,731 **** 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)); ReleaseTupleDesc(tupdesc); } } --- 722,731 ---- tmptup.t_len = HeapTupleHeaderGetDatumLength(td); tmptup.t_data = td; ! 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); } } *************** pltcl_func_handler(PG_FUNCTION_ARGS, boo *** 736,742 **** * of their external representation **************************************************/ if (fcinfo->argnull[i]) ! Tcl_DStringAppendElement(&tcl_cmd, ""); else { char *tmp; --- 736,742 ---- * of their external representation **************************************************/ if (fcinfo->argnull[i]) ! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj()); else { char *tmp; *************** pltcl_func_handler(PG_FUNCTION_ARGS, boo *** 744,750 **** tmp = OutputFunctionCall(&prodesc->arg_out_func[i], fcinfo->arg[i]); UTF_BEGIN; ! Tcl_DStringAppendElement(&tcl_cmd, UTF_E2U(tmp)); UTF_END; pfree(tmp); } --- 744,751 ---- tmp = OutputFunctionCall(&prodesc->arg_out_func[i], fcinfo->arg[i]); UTF_BEGIN; ! Tcl_ListObjAppendElement(NULL, tcl_cmd, ! Tcl_NewStringObj(UTF_E2U(tmp), -1)); UTF_END; pfree(tmp); } *************** pltcl_func_handler(PG_FUNCTION_ARGS, boo *** 753,772 **** } PG_CATCH(); { ! Tcl_DStringFree(&tcl_cmd); ! Tcl_DStringFree(&list_tmp); 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); /************************************************************ * Check for errors reported by Tcl. --- 754,772 ---- } PG_CATCH(); { ! Tcl_DecrRefCount(tcl_cmd); PG_RE_THROW(); } PG_END_TRY(); /************************************************************ * Call the Tcl function * * We assume no PG error can be thrown directly from this call. ************************************************************/ ! 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. *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 817,825 **** char *stroid; TupleDesc tupdesc; volatile HeapTuple rettup; ! Tcl_DString tcl_cmd; ! Tcl_DString tcl_trigtup; ! Tcl_DString tcl_newtup; int tcl_rc; int i; int *modattrs; --- 817,825 ---- char *stroid; TupleDesc tupdesc; volatile HeapTuple rettup; ! Tcl_Obj *tcl_cmd; ! Tcl_Obj *tcl_trigtup; ! Tcl_Obj *tcl_newtup; int tcl_rc; int i; int *modattrs; *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 848,912 **** * Create the tcl command to call the internal * proc in the interpreter ************************************************************/ ! Tcl_DStringInit(&tcl_cmd); ! Tcl_DStringInit(&tcl_trigtup); ! Tcl_DStringInit(&tcl_newtup); PG_TRY(); { /* The procedure name */ ! Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname); /* The trigger name for argument TG_name */ ! Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgname); /* The oid of the trigger relation for argument TG_relid */ stroid = DatumGetCString(DirectFunctionCall1(oidout, ObjectIdGetDatum(trigdata->tg_relation->rd_id))); ! Tcl_DStringAppendElement(&tcl_cmd, stroid); 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); 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); pfree(stroid); /* A list of attribute names for argument TG_relatts */ ! Tcl_DStringAppendElement(&tcl_trigtup, ""); for (i = 0; i < tupdesc->natts; i++) { if (tupdesc->attrs[i]->attisdropped) ! Tcl_DStringAppendElement(&tcl_trigtup, ""); else ! Tcl_DStringAppendElement(&tcl_trigtup, ! NameStr(tupdesc->attrs[i]->attname)); } ! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup)); ! Tcl_DStringFree(&tcl_trigtup); ! Tcl_DStringInit(&tcl_trigtup); /* The when part of the event for TG_when */ if (TRIGGER_FIRED_BEFORE(trigdata->tg_event)) ! Tcl_DStringAppendElement(&tcl_cmd, "BEFORE"); else if (TRIGGER_FIRED_AFTER(trigdata->tg_event)) ! Tcl_DStringAppendElement(&tcl_cmd, "AFTER"); else if (TRIGGER_FIRED_INSTEAD(trigdata->tg_event)) ! Tcl_DStringAppendElement(&tcl_cmd, "INSTEAD OF"); 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"); /* Build the data list for the trigtuple */ pltcl_build_tuple_argument(trigdata->tg_trigtuple, ! tupdesc, &tcl_trigtup); /* * Now the command part of the event for TG_op and data for NEW --- 848,922 ---- * Create the tcl command to call the internal * proc in the interpreter ************************************************************/ ! tcl_cmd = Tcl_NewObj(); ! tcl_trigtup = Tcl_NewObj(); ! tcl_newtup = Tcl_NewObj(); PG_TRY(); { /* The procedure name */ ! Tcl_ListObjAppendElement(NULL, tcl_cmd, ! Tcl_NewStringObj(prodesc->internal_proname, -1)); /* The trigger name for argument TG_name */ ! 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_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_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_ListObjAppendElement(NULL, tcl_cmd, ! Tcl_NewStringObj(stroid, -1)); pfree(stroid); /* A list of attribute names for argument TG_relatts */ ! Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj()); for (i = 0; i < tupdesc->natts; i++) { if (tupdesc->attrs[i]->attisdropped) ! Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj()); else ! Tcl_ListObjAppendElement(NULL, tcl_trigtup, ! Tcl_NewStringObj(NameStr(tupdesc->attrs[i]->attname), -1)); } ! 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_ListObjAppendElement(NULL, tcl_cmd, ! Tcl_NewStringObj("BEFORE",-1)); else if (TRIGGER_FIRED_AFTER(trigdata->tg_event)) ! Tcl_ListObjAppendElement(NULL, tcl_cmd, ! Tcl_NewStringObj("AFTER",-1)); else if (TRIGGER_FIRED_INSTEAD(trigdata->tg_event)) ! 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_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); /* * Now the command part of the event for TG_op and data for NEW *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 914,944 **** */ if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event)) { ! Tcl_DStringAppendElement(&tcl_cmd, "INSERT"); ! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup)); ! Tcl_DStringAppendElement(&tcl_cmd, ""); rettup = trigdata->tg_trigtuple; } else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event)) { ! Tcl_DStringAppendElement(&tcl_cmd, "DELETE"); ! Tcl_DStringAppendElement(&tcl_cmd, ""); ! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup)); rettup = trigdata->tg_trigtuple; } else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event)) { ! Tcl_DStringAppendElement(&tcl_cmd, "UPDATE"); pltcl_build_tuple_argument(trigdata->tg_newtuple, ! tupdesc, &tcl_newtup); ! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_newtup)); ! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup)); rettup = trigdata->tg_newtuple; } --- 924,957 ---- */ if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event)) { ! Tcl_ListObjAppendElement(NULL, tcl_cmd, ! Tcl_NewStringObj("INSERT",-1)); ! 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_ListObjAppendElement(NULL, tcl_cmd, ! Tcl_NewStringObj("DELETE",-1)); ! 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_ListObjAppendElement(NULL, tcl_cmd, ! Tcl_NewStringObj("UPDATE",-1)); pltcl_build_tuple_argument(trigdata->tg_newtuple, ! tupdesc, tcl_newtup); ! Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_newtup); ! Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup); rettup = trigdata->tg_newtuple; } *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 947,967 **** } else if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event)) { ! Tcl_DStringAppendElement(&tcl_cmd, "STATEMENT"); if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event)) ! Tcl_DStringAppendElement(&tcl_cmd, "INSERT"); else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event)) ! Tcl_DStringAppendElement(&tcl_cmd, "DELETE"); else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event)) ! Tcl_DStringAppendElement(&tcl_cmd, "UPDATE"); else if (TRIGGER_FIRED_BY_TRUNCATE(trigdata->tg_event)) ! Tcl_DStringAppendElement(&tcl_cmd, "TRUNCATE"); else elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event); ! Tcl_DStringAppendElement(&tcl_cmd, ""); ! Tcl_DStringAppendElement(&tcl_cmd, ""); rettup = (HeapTuple) NULL; } --- 960,985 ---- } else if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event)) { ! Tcl_ListObjAppendElement(NULL, tcl_cmd, ! Tcl_NewStringObj("STATEMENT",-1)); if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event)) ! Tcl_ListObjAppendElement(NULL, tcl_cmd, ! Tcl_NewStringObj("INSERT", -1)); else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event)) ! Tcl_ListObjAppendElement(NULL, tcl_cmd, ! Tcl_NewStringObj("DELETE", -1)); else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event)) ! Tcl_ListObjAppendElement(NULL, tcl_cmd, ! Tcl_NewStringObj("UPDATE", -1)); else if (TRIGGER_FIRED_BY_TRUNCATE(trigdata->tg_event)) ! Tcl_ListObjAppendElement(NULL, tcl_cmd, ! Tcl_NewStringObj("TRUNCATE", -1)); else elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event); ! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj()); ! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj()); rettup = (HeapTuple) NULL; } *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 970,996 **** /* 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]); } PG_CATCH(); { ! Tcl_DStringFree(&tcl_cmd); ! Tcl_DStringFree(&tcl_trigtup); ! Tcl_DStringFree(&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); /************************************************************ * Check for errors reported by Tcl. --- 988,1016 ---- /* Finally append the arguments from CREATE TRIGGER */ for (i = 0; i < trigdata->tg_trigger->tgnargs; i++) ! Tcl_ListObjAppendElement (NULL, tcl_cmd, ! Tcl_NewStringObj (trigdata->tg_trigger->tgargs[i], -1)); } PG_CATCH(); { ! Tcl_DecrRefCount(tcl_cmd); ! Tcl_DecrRefCount(tcl_trigtup); ! Tcl_DecrRefCount(tcl_newtup); PG_RE_THROW(); } PG_END_TRY(); /************************************************************ * Call the Tcl function * * We assume no PG error can be thrown directly from this call. ************************************************************/ ! 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. *************** compile_pltcl_function(Oid fn_oid, Oid t *** 1399,1404 **** --- 1419,1428 ---- /************************************************************ * 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); *************** compile_pltcl_function(Oid fn_oid, Oid t *** 1497,1534 **** **********************************************************************/ static int pltcl_elog(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]) { volatile int level; MemoryContext oldcontext; ! if (argc != 3) { ! Tcl_SetResult(interp, "syntax error - 'elog level msg'", TCL_STATIC); 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); return TCL_ERROR; } if (level == ERROR) { /* --- 1521,1586 ---- **********************************************************************/ static int pltcl_elog(ClientData cdata, Tcl_Interp *interp, ! int objc, Tcl_Obj * const objv[]) { volatile int level; MemoryContext oldcontext; + int priIndex; ! enum logpriority { ! 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 (Tcl_GetIndexFromObj(interp, objv[1], logpriorities, "priority", ! TCL_EXACT, &priIndex) != TCL_OK) { 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) { /* *************** pltcl_elog(ClientData cdata, Tcl_Interp *** 1536,1542 **** * eventually get converted to a PG error when we reach the call * handler. */ ! Tcl_SetResult(interp, (char *) argv[2], TCL_VOLATILE); return TCL_ERROR; } --- 1588,1594 ---- * eventually get converted to a PG error when we reach the call * handler. */ ! Tcl_SetObjResult(interp, objv[2]); return TCL_ERROR; } *************** pltcl_elog(ClientData cdata, Tcl_Interp *** 1553,1559 **** PG_TRY(); { UTF_BEGIN; ! elog(level, "%s", UTF_U2E(argv[2])); UTF_END; } PG_CATCH(); --- 1605,1611 ---- PG_TRY(); { UTF_BEGIN; ! elog(level, "%s", UTF_U2E(Tcl_GetString(objv[2]))); UTF_END; } PG_CATCH(); *************** pltcl_elog(ClientData cdata, Tcl_Interp *** 1567,1573 **** /* Pass the error message to Tcl */ UTF_BEGIN; ! Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE); UTF_END; FreeErrorData(edata); --- 1619,1625 ---- /* Pass the error message to Tcl */ UTF_BEGIN; ! Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1)); UTF_END; FreeErrorData(edata); *************** pltcl_elog(ClientData cdata, Tcl_Interp *** 1585,1591 **** **********************************************************************/ static int pltcl_quote(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]) { char *tmp; const char *cp1; --- 1637,1643 ---- **********************************************************************/ static int pltcl_quote(ClientData cdata, Tcl_Interp *interp, ! int objc, Tcl_Obj * const objv[]) { char *tmp; const char *cp1; *************** pltcl_quote(ClientData cdata, Tcl_Interp *** 1594,1602 **** /************************************************************ * Check call syntax ************************************************************/ ! if (argc != 2) { ! Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_STATIC); return TCL_ERROR; } --- 1646,1654 ---- /************************************************************ * Check call syntax ************************************************************/ ! if (objc != 2) { ! Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } *************** pltcl_quote(ClientData cdata, Tcl_Interp *** 1604,1611 **** * Allocate space for the maximum the string can * grow to and initialize pointers ************************************************************/ ! tmp = palloc(strlen(argv[1]) * 2 + 1); ! cp1 = argv[1]; cp2 = tmp; /************************************************************ --- 1656,1663 ---- * Allocate space for the maximum the string can * grow to and initialize pointers ************************************************************/ ! tmp = palloc(strlen(Tcl_GetString(objv[1])) * 2 + 1); ! cp1 = Tcl_GetString(objv[1]); cp2 = tmp; /************************************************************ *************** pltcl_quote(ClientData cdata, Tcl_Interp *** 1627,1633 **** * Terminate the string and set it as result ************************************************************/ *cp2 = '\0'; ! Tcl_SetResult(interp, tmp, TCL_VOLATILE); pfree(tmp); return TCL_OK; } --- 1679,1685 ---- * Terminate the string and set it as result ************************************************************/ *cp2 = '\0'; ! Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1)); pfree(tmp); return TCL_OK; } *************** pltcl_quote(ClientData cdata, Tcl_Interp *** 1638,1644 **** **********************************************************************/ static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]) { int argno; FunctionCallInfo fcinfo = pltcl_current_fcinfo; --- 1690,1696 ---- **********************************************************************/ static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, ! int objc, Tcl_Obj * const objv[]) { int argno; FunctionCallInfo fcinfo = pltcl_current_fcinfo; *************** pltcl_argisnull(ClientData cdata, Tcl_In *** 1646,1655 **** /************************************************************ * Check call syntax ************************************************************/ ! if (argc != 2) { ! Tcl_SetResult(interp, "syntax error - 'argisnull argno'", ! TCL_STATIC); return TCL_ERROR; } --- 1698,1706 ---- /************************************************************ * Check call syntax ************************************************************/ ! if (objc != 2) { ! Tcl_WrongNumArgs(interp, 1, objv, "argno"); return TCL_ERROR; } *************** pltcl_argisnull(ClientData cdata, Tcl_In *** 1658,1672 **** ************************************************************/ if (fcinfo == NULL) { ! Tcl_SetResult(interp, "argisnull cannot be used in triggers", ! TCL_STATIC); return TCL_ERROR; } /************************************************************ * Get the argument number ************************************************************/ ! if (Tcl_GetInt(interp, argv[1], &argno) != TCL_OK) return TCL_ERROR; /************************************************************ --- 1709,1723 ---- ************************************************************/ if (fcinfo == NULL) { ! Tcl_SetObjResult(interp, ! Tcl_NewStringObj("argisnull cannot be used in triggers", -1)); return TCL_ERROR; } /************************************************************ * Get the argument number ************************************************************/ ! if (Tcl_GetIntFromObj(interp, objv[1], &argno) != TCL_OK) return TCL_ERROR; /************************************************************ *************** pltcl_argisnull(ClientData cdata, Tcl_In *** 1675,1692 **** argno--; if (argno < 0 || argno >= fcinfo->nargs) { ! Tcl_SetResult(interp, "argno out of range", TCL_STATIC); 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); ! return TCL_OK; } --- 1726,1740 ---- argno--; if (argno < 0 || argno >= fcinfo->nargs) { ! Tcl_SetObjResult(interp, ! Tcl_NewStringObj("argno out of range", -1)); return TCL_ERROR; } /************************************************************ * Get the requested NULL state ************************************************************/ ! Tcl_SetObjResult(interp, Tcl_NewBooleanObj(PG_ARGISNULL(argno))); return TCL_OK; } *************** pltcl_argisnull(ClientData cdata, Tcl_In *** 1696,1711 **** **********************************************************************/ static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]) { FunctionCallInfo fcinfo = pltcl_current_fcinfo; /************************************************************ * Check call syntax ************************************************************/ ! if (argc != 1) { ! Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_STATIC); return TCL_ERROR; } --- 1744,1759 ---- **********************************************************************/ static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, ! int objc, Tcl_Obj * const objv[]) { FunctionCallInfo fcinfo = pltcl_current_fcinfo; /************************************************************ * Check call syntax ************************************************************/ ! if (objc != 1) { ! Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } *************** pltcl_returnnull(ClientData cdata, Tcl_I *** 1714,1721 **** ************************************************************/ if (fcinfo == NULL) { ! Tcl_SetResult(interp, "return_null cannot be used in triggers", ! TCL_STATIC); return TCL_ERROR; } --- 1762,1769 ---- ************************************************************/ if (fcinfo == NULL) { ! Tcl_SetObjResult(interp, ! Tcl_NewStringObj("return_null cannot be used in triggers", -1)); return TCL_ERROR; } *************** pltcl_subtrans_abort(Tcl_Interp *interp, *** 1814,1831 **** **********************************************************************/ static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]) { int my_rc; int spi_rc; int query_idx; int i; int count = 0; CONST84 char *volatile arrayname = NULL; ! CONST84 char *volatile loop_body = NULL; MemoryContext oldcontext = CurrentMemoryContext; ResourceOwner oldowner = CurrentResourceOwner; char *usage = "syntax error - 'SPI_exec " "?-count n? " "?-array name? query ?loop body?"; --- 1862,1889 ---- **********************************************************************/ static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, ! 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; ! 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?"; *************** pltcl_SPI_execute(ClientData cdata, Tcl_ *** 1833,1881 **** /************************************************************ * Check the call syntax and get the options ************************************************************/ ! if (argc < 2) { Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } i = 1; ! while (i < argc) { ! 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], "-count") == 0) { ! 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; } ! break; } query_idx = i; ! if (query_idx >= argc || query_idx + 2 < argc) { Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } ! if (query_idx + 1 < argc) ! loop_body = argv[query_idx + 1]; /************************************************************ * Execute the query inside a sub-transaction, so we can cope with --- 1891,1943 ---- /************************************************************ * Check the call syntax and get the options ************************************************************/ ! 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 < objc) { ! if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", ! TCL_EXACT, &optIndex) != TCL_OK) { ! return TCL_ERROR; } ! if (++i >= objc) { ! Tcl_SetObjResult(interp, ! Tcl_NewStringObj("missing argument to -count or -array", -1)); ! return TCL_ERROR; } ! 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 >= 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 < objc) ! loop_body = objv[query_idx + 1]; /************************************************************ * Execute the query inside a sub-transaction, so we can cope with *************** pltcl_SPI_execute(ClientData cdata, Tcl_ *** 1887,1893 **** PG_TRY(); { UTF_BEGIN; ! spi_rc = SPI_execute(UTF_U2E(argv[query_idx]), pltcl_current_prodesc->fn_readonly, count); UTF_END; --- 1949,1955 ---- PG_TRY(); { UTF_BEGIN; ! spi_rc = SPI_execute(UTF_U2E(Tcl_GetString(objv[query_idx])), pltcl_current_prodesc->fn_readonly, count); UTF_END; *************** pltcl_SPI_execute(ClientData cdata, Tcl_ *** 1918,1930 **** static int pltcl_process_SPI_result(Tcl_Interp *interp, CONST84 char *arrayname, ! CONST84 char *loop_body, int spi_rc, SPITupleTable *tuptable, int ntuples) { int my_rc = TCL_OK; - char buf[64]; int i; int loop_rc; HeapTuple *tuples; --- 1980,1991 ---- static int pltcl_process_SPI_result(Tcl_Interp *interp, CONST84 char *arrayname, ! Tcl_Obj * loop_body, int spi_rc, SPITupleTable *tuptable, int ntuples) { int my_rc = TCL_OK; int i; int loop_rc; HeapTuple *tuples; *************** pltcl_process_SPI_result(Tcl_Interp *int *** 1936,1950 **** case SPI_OK_INSERT: case SPI_OK_DELETE: case SPI_OK_UPDATE: ! snprintf(buf, sizeof(buf), "%d", ntuples); ! Tcl_SetResult(interp, buf, TCL_VOLATILE); break; case SPI_OK_UTILITY: case SPI_OK_REWRITTEN: if (tuptable == NULL) { ! Tcl_SetResult(interp, "0", TCL_STATIC); break; } /* FALL THRU for utility returning tuples */ --- 1997,2010 ---- case SPI_OK_INSERT: case SPI_OK_DELETE: case SPI_OK_UPDATE: ! Tcl_SetObjResult(interp, Tcl_NewIntObj(ntuples)); break; case SPI_OK_UTILITY: case SPI_OK_REWRITTEN: if (tuptable == NULL) { ! Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); break; } /* FALL THRU for utility returning tuples */ *************** pltcl_process_SPI_result(Tcl_Interp *int *** 1981,1987 **** pltcl_set_tuple_values(interp, arrayname, i, tuples[i], tupdesc); ! loop_rc = Tcl_Eval(interp, loop_body); if (loop_rc == TCL_OK) continue; --- 2041,2047 ---- pltcl_set_tuple_values(interp, arrayname, i, tuples[i], tupdesc); ! loop_rc = Tcl_EvalObjEx(interp, loop_body, 0); if (loop_rc == TCL_OK) continue; *************** pltcl_process_SPI_result(Tcl_Interp *int *** 2001,2008 **** if (my_rc == TCL_OK) { ! snprintf(buf, sizeof(buf), "%d", ntuples); ! Tcl_SetResult(interp, buf, TCL_VOLATILE); } break; --- 2061,2067 ---- if (my_rc == TCL_OK) { ! Tcl_SetObjResult(interp, Tcl_NewIntObj(ntuples)); } break; *************** pltcl_process_SPI_result(Tcl_Interp *int *** 2029,2038 **** **********************************************************************/ static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]) { int nargs; ! CONST84 char **args; pltcl_query_desc *qdesc; void *plan; int i; --- 2088,2097 ---- **********************************************************************/ static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp, ! int objc, Tcl_Obj * const objv[]) { int nargs; ! Tcl_Obj **argsObj; pltcl_query_desc *qdesc; void *plan; int i; *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2045,2061 **** /************************************************************ * Check the call syntax ************************************************************/ ! if (argc != 3) { ! Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'", ! TCL_STATIC); return TCL_ERROR; } /************************************************************ * Split the argument type list ************************************************************/ ! if (Tcl_SplitList(interp, argv[2], &nargs, &args) != TCL_OK) return TCL_ERROR; /************************************************************ --- 2104,2119 ---- /************************************************************ * Check the call syntax ************************************************************/ ! if (objc != 3) { ! Tcl_WrongNumArgs(interp, 1, objv, "query argtypes"); return TCL_ERROR; } /************************************************************ * Split the argument type list ************************************************************/ ! if (Tcl_ListObjGetElements(interp, objv[2], &nargs, &argsObj) != TCL_OK) return TCL_ERROR; /************************************************************ *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2089,2095 **** typIOParam; int32 typmod; ! parseTypeString(args[i], &typId, &typmod); getTypeInputInfo(typId, &typInput, &typIOParam); --- 2147,2153 ---- typIOParam; int32 typmod; ! parseTypeString(Tcl_GetString(argsObj[i]), &typId, &typmod); getTypeInputInfo(typId, &typInput, &typIOParam); *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2102,2108 **** * Prepare the plan and check for errors ************************************************************/ UTF_BEGIN; ! plan = SPI_prepare(UTF_U2E(argv[1]), nargs, qdesc->argtypes); UTF_END; if (plan == NULL) --- 2160,2166 ---- * Prepare the plan and check for errors ************************************************************/ UTF_BEGIN; ! plan = SPI_prepare(UTF_U2E(Tcl_GetString(argsObj[1])), nargs, qdesc->argtypes); UTF_END; if (plan == NULL) *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2129,2135 **** free(qdesc->arginfuncs); free(qdesc->argtypioparams); free(qdesc); ! ckfree((char *) args); return TCL_ERROR; } --- 2187,2193 ---- free(qdesc->arginfuncs); free(qdesc->argtypioparams); free(qdesc); ! /* ckfree((char *) args); */ return TCL_ERROR; } *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2144,2153 **** 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); return TCL_OK; } --- 2202,2211 ---- 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_SetObjResult(interp, Tcl_NewStringObj(qdesc->qname, -1)); return TCL_OK; } *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2157,2173 **** **********************************************************************/ static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]) { int my_rc; int spi_rc; int i; int j; Tcl_HashEntry *hashent; pltcl_query_desc *qdesc; const char *volatile nulls = NULL; CONST84 char *volatile arrayname = NULL; ! CONST84 char *volatile loop_body = NULL; int count = 0; int callnargs; CONST84 char **callargs = NULL; --- 2215,2232 ---- **********************************************************************/ static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, ! 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 *volatile nulls = NULL; CONST84 char *volatile arrayname = NULL; ! Tcl_Obj *loop_body = NULL; int count = 0; int callnargs; CONST84 char **callargs = NULL; *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2176,2181 **** --- 2235,2249 ---- 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?"; *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2184,2241 **** * Get the options and check syntax ************************************************************/ i = 1; ! while (i < argc) { ! 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 (++i >= argc) ! { ! Tcl_SetResult(interp, usage, TCL_STATIC); ! return TCL_ERROR; ! } ! nulls = argv[i++]; ! continue; } ! if (strcmp(argv[i], "-count") == 0) { ! 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; ! } ! break; } /************************************************************ * Get the prepared plan descriptor by its key ************************************************************/ ! if (i >= argc) { ! Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } query_hash = &pltcl_current_prodesc->interp_desc->query_hash; ! hashent = Tcl_FindHashEntry(query_hash, argv[i]); if (hashent == NULL) { ! Tcl_AppendResult(interp, "invalid queryid '", argv[i], "'", NULL); return TCL_ERROR; } qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent); --- 2252,2305 ---- * Get the options and check syntax ************************************************************/ i = 1; ! while (i < objc) { ! if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", ! TCL_EXACT, &optIndex) != TCL_OK) { ! return TCL_ERROR; } ! ! if (++i >= objc) { ! Tcl_SetObjResult(interp, ! Tcl_NewStringObj("missing argument to -count or -array", -1)); ! return TCL_ERROR; } ! ! 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; ! ! case OPT_NULLS: ! nulls = Tcl_GetString(objv[i++]); ! break; ! } } /************************************************************ * Get the prepared plan descriptor by its key ************************************************************/ ! if (i >= objc) { ! 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, Tcl_GetString(objv[i])); if (hashent == NULL) { ! Tcl_AppendResult(interp, "invalid queryid '", Tcl_GetString(objv[i]), "'", NULL); return TCL_ERROR; } qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent); *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2261,2267 **** ************************************************************/ if (qdesc->nargs > 0) { ! if (i >= argc) { Tcl_SetResult(interp, "missing argument list", TCL_STATIC); return TCL_ERROR; --- 2325,2331 ---- ************************************************************/ if (qdesc->nargs > 0) { ! if (i >= objc) { Tcl_SetResult(interp, "missing argument list", TCL_STATIC); return TCL_ERROR; *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2270,2276 **** /************************************************************ * Split the argument values ************************************************************/ ! if (Tcl_SplitList(interp, argv[i++], &callnargs, &callargs) != TCL_OK) return TCL_ERROR; /************************************************************ --- 2334,2340 ---- /************************************************************ * Split the argument values ************************************************************/ ! if (Tcl_SplitList(interp, Tcl_GetString(objv[i++]), &callnargs, &callargs) != TCL_OK) return TCL_ERROR; /************************************************************ *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2291,2300 **** /************************************************************ * Get loop body if present ************************************************************/ ! if (i < argc) ! loop_body = argv[i++]; ! if (i != argc) { Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; --- 2355,2364 ---- /************************************************************ * Get loop body if present ************************************************************/ ! if (i < objc) ! loop_body = objv[i++]; ! if (i != objc) { Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2375,2386 **** **********************************************************************/ static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]) { ! char buf[64]; ! ! snprintf(buf, sizeof(buf), "%u", SPI_lastoid); ! Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } --- 2439,2447 ---- **********************************************************************/ static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp, ! int objc, Tcl_Obj * const objv[]) { ! Tcl_SetObjResult(interp, Tcl_NewWideIntObj(SPI_lastoid)); return TCL_OK; } *************** pltcl_set_tuple_values(Tcl_Interp *inter *** 2395,2401 **** { int i; char *outputstr; - char buf[64]; Datum attr; bool isnull; --- 2456,2461 ---- *************** pltcl_set_tuple_values(Tcl_Interp *inter *** 2420,2427 **** { arrptr = &arrayname; nameptr = &attname; ! snprintf(buf, sizeof(buf), "%d", tupno); ! Tcl_SetVar2(interp, arrayname, ".tupno", buf, 0); } for (i = 0; i < tupdesc->natts; i++) --- 2480,2486 ---- { arrptr = &arrayname; nameptr = &attname; ! Tcl_SetVar2Ex(interp, arrayname, ".tupno", Tcl_NewIntObj(tupno), 0); } for (i = 0; i < tupdesc->natts; i++) *************** pltcl_set_tuple_values(Tcl_Interp *inter *** 2465,2471 **** { outputstr = OidOutputFunctionCall(typoutput, attr); UTF_BEGIN; ! Tcl_SetVar2(interp, *arrptr, *nameptr, UTF_E2U(outputstr), 0); UTF_END; pfree(outputstr); } --- 2524,2531 ---- { outputstr = OidOutputFunctionCall(typoutput, attr); UTF_BEGIN; ! Tcl_SetVar2Ex(interp, *arrptr, *nameptr, ! Tcl_NewStringObj(UTF_E2U(outputstr), -1), 0); UTF_END; pfree(outputstr); } *************** pltcl_set_tuple_values(Tcl_Interp *inter *** 2481,2487 **** **********************************************************************/ static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc, ! Tcl_DString *retval) { int i; char *outputstr; --- 2541,2547 ---- **********************************************************************/ static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc, ! Tcl_Obj *retobj) { int i; char *outputstr; *************** pltcl_build_tuple_argument(HeapTuple tup *** 2532,2540 **** if (!isnull && OidIsValid(typoutput)) { outputstr = OidOutputFunctionCall(typoutput, attr); ! Tcl_DStringAppendElement(retval, attname); UTF_BEGIN; ! Tcl_DStringAppendElement(retval, UTF_E2U(outputstr)); UTF_END; pfree(outputstr); } --- 2592,2601 ---- if (!isnull && OidIsValid(typoutput)) { outputstr = OidOutputFunctionCall(typoutput, attr); ! Tcl_ListObjAppendElement (NULL, retobj, ! Tcl_NewStringObj (attname, -1)); UTF_BEGIN; ! Tcl_ListObjAppendElement(NULL, retobj, Tcl_NewStringObj(UTF_E2U(outputstr), -1)); UTF_END; pfree(outputstr); }