diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c index 6e8c5c0..da5cf27 100644 *** a/src/pl/tcl/pltcl.c --- b/src/pl/tcl/pltcl.c *************** *** 33,49 **** #include "utils/memutils.h" #include "utils/syscache.h" #include "utils/typcache.h" #define HAVE_TCL_VERSION(maj,min) \ ((TCL_MAJOR_VERSION > maj) || \ (TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min)) - /* In Tcl >= 8.0, really not supposed to touch interp->result directly */ - #if !HAVE_TCL_VERSION(8,0) - #define Tcl_GetStringResult(interp) ((interp)->result) - #endif - /* define our text domain for translations */ #undef TEXTDOMAIN #define TEXTDOMAIN PG_TEXTDOMAIN("pltcl") --- 33,45 ---- #include "utils/memutils.h" #include "utils/syscache.h" #include "utils/typcache.h" + #include "funcapi.h" #define HAVE_TCL_VERSION(maj,min) \ ((TCL_MAJOR_VERSION > maj) || \ (TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min)) /* define our text domain for translations */ #undef TEXTDOMAIN #define TEXTDOMAIN PG_TEXTDOMAIN("pltcl") *************** PG_MODULE_MAGIC; *** 95,104 **** **********************************************************************/ typedef struct pltcl_interp_desc { ! Oid user_id; /* Hash key (must be first!) */ ! Tcl_Interp *interp; /* The interpreter */ ! Tcl_HashTable query_hash; /* pltcl_query_desc structs */ ! } pltcl_interp_desc; /********************************************************************** --- 91,100 ---- **********************************************************************/ typedef struct pltcl_interp_desc { ! Oid user_id; /* Hash key (must be first!) */ ! Tcl_Interp *interp; /* The interpreter */ ! Tcl_HashTable query_hash; /* pltcl_query_desc structs */ ! } pltcl_interp_desc; /********************************************************************** *************** typedef struct pltcl_proc_desc *** 112,124 **** ItemPointerData fn_tid; bool fn_readonly; bool lanpltrusted; pltcl_interp_desc *interp_desc; FmgrInfo result_in_func; Oid result_typioparam; int nargs; FmgrInfo arg_out_func[FUNC_MAX_ARGS]; bool arg_is_rowtype[FUNC_MAX_ARGS]; ! } pltcl_proc_desc; /********************************************************************** --- 108,130 ---- ItemPointerData fn_tid; bool fn_readonly; bool lanpltrusted; + bool fn_retistuple; /* true, if function returns tuple */ + bool fn_retisset; /* true, if function returns a set */ pltcl_interp_desc *interp_desc; FmgrInfo result_in_func; Oid result_typioparam; int nargs; FmgrInfo arg_out_func[FUNC_MAX_ARGS]; bool arg_is_rowtype[FUNC_MAX_ARGS]; ! ! TupleDesc ret_tupdesc; ! Tuplestorestate *tuple_store; /* SRFs accumulate result here */ ! AttInMetadata *attinmeta; ! int natts; ! MemoryContext tuple_store_cxt; ! ResourceOwner tuple_store_owner; ! ReturnSetInfo *rsi; ! } pltcl_proc_desc; /********************************************************************** *************** typedef struct pltcl_query_desc *** 132,138 **** Oid *argtypes; FmgrInfo *arginfuncs; Oid *argtypioparams; ! } pltcl_query_desc; /********************************************************************** --- 138,144 ---- Oid *argtypes; FmgrInfo *arginfuncs; Oid *argtypioparams; ! } pltcl_query_desc; /********************************************************************** *************** typedef struct pltcl_query_desc *** 148,167 **** **********************************************************************/ typedef struct pltcl_proc_key { ! Oid proc_id; /* Function OID */ /* * is_trigger is really a bool, but declare as Oid to ensure this struct * contains no padding */ ! Oid is_trigger; /* is it a trigger function? */ ! Oid user_id; /* User calling the function, or 0 */ ! } pltcl_proc_key; typedef struct pltcl_proc_ptr { ! pltcl_proc_key proc_key; /* Hash key (must be first!) */ pltcl_proc_desc *proc_ptr; ! } pltcl_proc_ptr; /********************************************************************** --- 154,173 ---- **********************************************************************/ typedef struct pltcl_proc_key { ! Oid proc_id; /* Function OID */ /* * is_trigger is really a bool, but declare as Oid to ensure this struct * contains no padding */ ! Oid is_trigger; /* is it a trigger function? */ ! Oid user_id; /* User calling the function, or 0 */ ! } pltcl_proc_key; typedef struct pltcl_proc_ptr { ! pltcl_proc_key proc_key; /* Hash key (must be first!) */ pltcl_proc_desc *proc_ptr; ! } pltcl_proc_ptr; /********************************************************************** *************** Datum pltcl_call_handler(PG_FUNCTION_AR *** 183,231 **** Datum pltclu_call_handler(PG_FUNCTION_ARGS); void _PG_init(void); ! static void pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted); static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted); ! static void pltcl_init_load_unknown(Tcl_Interp *interp); ! static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted); ! static Datum pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted); ! static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted); ! static void throw_tcl_error(Tcl_Interp *interp, const char *proname); 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[]); ! 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); /* --- 189,243 ---- Datum pltclu_call_handler(PG_FUNCTION_ARGS); void _PG_init(void); ! static void pltcl_init_interp(pltcl_interp_desc * interp_desc, bool pltrusted); static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted); ! static void pltcl_init_load_unknown(Tcl_Interp * interp); ! static Datum pltcl_handler(FunctionCallInfo fcinfo, bool pltrusted); ! static Datum pltcl_func_handler(FunctionCallInfo fcinfo, bool pltrusted); ! static HeapTuple pltcl_trigger_handler(FunctionCallInfo fcinfo, bool pltrusted); ! static void throw_tcl_error(Tcl_Interp * interp, const char *proname); static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid, ! bool pltrusted); ! static void ! pltcl_pg_returnnext(Tcl_Interp * interp, int rowObjc, Tcl_Obj ** rowObjv); ! 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_returnnext(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); ! static void pltcl_init_tuple_store(pltcl_proc_desc * prodesc); /* *************** pltcl_FinalizeNotifier(ClientData client *** 256,262 **** } static void ! pltcl_SetTimer(Tcl_Time *timePtr) { } --- 268,274 ---- } static void ! pltcl_SetTimer(Tcl_Time * timePtr) { } *************** pltcl_AlertNotifier(ClientData clientDat *** 267,273 **** static void pltcl_CreateFileHandler(int fd, int mask, ! Tcl_FileProc *proc, ClientData clientData) { } --- 279,285 ---- static void pltcl_CreateFileHandler(int fd, int mask, ! Tcl_FileProc * proc, ClientData clientData) { } *************** pltcl_ServiceModeHook(int mode) *** 282,293 **** } static int ! pltcl_WaitForEvent(Tcl_Time *timePtr) { return 0; } #endif /* HAVE_TCL_VERSION(8,4) */ /* * This routine is a crock, and so is everyplace that calls it. The problem --- 294,414 ---- } static int ! pltcl_WaitForEvent(Tcl_Time * timePtr) { return 0; } #endif /* HAVE_TCL_VERSION(8,4) */ + #if 0 + static Tcl_Obj * + tclobj_from_bool(Datum d) + { + return Tcl_NewBooleanObj(DatumGetBool(d)); + } + + static Tcl_Obj * + tclobj_from_float4(Datum d) + { + return Tcl_NewDoubleObj(DatumGetFloat4(d)); + } + + static Tcl_Obj * + tclobj_from_float8(Datum d) + { + return Tcl_NewDoubleObj(DatumGetFloat8(d)); + } + + static Tcl_Obj * + tclobj_from_int16(Datum d) + { + return Tcl_NewIntObj(DatumGetInt16(d)); + } + + + static Tcl_Obj * + tclobj_from_int32(Datum d) + { + return Tcl_NewIntObj(DatumGetInt32(d)); + } + + static Tcl_Obj * + tclobj_from_int64(Datum d) + { + return Tcl_NewWideIntObj(DatumGetInt64(d)); + } + + static Tcl_Obj * + tclobj_from_bytea(Datum d) + { + text *txt = DatumGetByteaP(d); + char *str = VARDATA(txt); + size_t size = VARSIZE(txt) - VARHDRSZ; + + return Tcl_NewByteArrayObj(str, size); + } + #endif + + static HeapTuple + pltcl_build_tuple_result(Tcl_Interp * interp, Tcl_Obj ** kvObjv, int kvObjc, pltcl_proc_desc * prodesc) + { + HeapTuple tup; + char **values; + int i; + + values = (char **) palloc0(prodesc->natts * sizeof(char *)); + + for (i = 0; i < kvObjc; i += 2) + { + char *fieldName = Tcl_GetString(kvObjv[i]); + int attn = SPI_fnumber(prodesc->ret_tupdesc, fieldName); + + if (attn <= 0 || prodesc->ret_tupdesc->attrs[attn - 1]->attisdropped) + ereport(ERROR, + (errcode(ERRCODE_UNDEFINED_COLUMN), + errmsg("Tcl list contains nonexistent column \"%s\"", + fieldName))); + + UTF_BEGIN; + values[attn - 1] = UTF_E2U(Tcl_GetString(kvObjv[i + 1])); + UTF_END; + } + + tup = BuildTupleFromCStrings(prodesc->attinmeta, values); + pfree(values); + return tup; + } + + /********************************************************************** + * pltcl_reset_state() - reset function's runtime state + * + * This is called on function and trigger entry + * (pltcl_func_handler and pltcl_trigger_handler) to clear + * any previous results. + * + * rsi is present if it's a function but not if it's a trigger. + **********************************************************************/ + static void + pltcl_reset_state(pltcl_proc_desc * prodesc, ReturnSetInfo * rsi) + { + prodesc->ret_tupdesc = NULL; + prodesc->tuple_store = NULL; + prodesc->attinmeta = NULL; + prodesc->natts = 0; + + if (rsi) + { + prodesc->tuple_store_cxt = rsi->econtext->ecxt_per_query_memory; + prodesc->tuple_store_owner = CurrentResourceOwner; + } + else + { + prodesc->tuple_store_cxt = NULL; + prodesc->tuple_store_owner = NULL; + } + + prodesc->rsi = rsi; + } /* * This routine is a crock, and so is everyplace that calls it. The problem *************** _PG_init(void) *** 390,396 **** * pltcl_init_interp() - initialize a new Tcl interpreter **********************************************************************/ static void ! pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted) { Tcl_Interp *interp; char interpname[32]; --- 511,517 ---- * pltcl_init_interp() - initialize a new Tcl interpreter **********************************************************************/ static void ! pltcl_init_interp(pltcl_interp_desc * interp_desc, bool pltrusted) { Tcl_Interp *interp; char interpname[32]; *************** pltcl_init_interp(pltcl_interp_desc *int *** 414,436 **** /************************************************************ * 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 --- 535,559 ---- /************************************************************ * 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, "return_next", ! pltcl_returnnext, 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_fetch_interp(bool pltrusted) *** 471,477 **** * table pltcl_modules (if it exists) **********************************************************************/ static void ! pltcl_init_load_unknown(Tcl_Interp *interp) { Relation pmrel; char *pmrelname, --- 594,600 ---- * table pltcl_modules (if it exists) **********************************************************************/ static void ! pltcl_init_load_unknown(Tcl_Interp * interp) { Relation pmrel; char *pmrelname, *************** pltclu_call_handler(PG_FUNCTION_ARGS) *** 611,618 **** } static Datum ! pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted) { Datum retval; FunctionCallInfo save_fcinfo; --- 734,745 ---- } + /********************************************************************** + * pltcl_handler() - Handler for function and trigger calls, for + * both trusted and untrusted interpreters. + **********************************************************************/ static Datum ! pltcl_handler(FunctionCallInfo fcinfo, bool pltrusted) { Datum retval; FunctionCallInfo save_fcinfo; *************** pltcl_handler(PG_FUNCTION_ARGS, bool plt *** 632,642 **** --- 759,771 ---- */ if (CALLED_AS_TRIGGER(fcinfo)) { + /* invoke the trigger handler */ pltcl_current_fcinfo = NULL; retval = PointerGetDatum(pltcl_trigger_handler(fcinfo, pltrusted)); } else { + /* invoke the function handler */ pltcl_current_fcinfo = fcinfo; retval = pltcl_func_handler(fcinfo, pltrusted); } *************** pltcl_handler(PG_FUNCTION_ARGS, bool plt *** 660,671 **** * pltcl_func_handler() - Handler for regular function calls **********************************************************************/ static Datum ! pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted) { pltcl_proc_desc *prodesc; Tcl_Interp *volatile interp; ! Tcl_DString tcl_cmd; ! Tcl_DString list_tmp; int i; int tcl_rc; Datum retval; --- 789,799 ---- * pltcl_func_handler() - Handler for regular function calls **********************************************************************/ static Datum ! pltcl_func_handler(FunctionCallInfo fcinfo, bool pltrusted) { 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 *** 678,694 **** prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid, pltrusted); pltcl_current_prodesc = prodesc; - interp = prodesc->interp_desc->interp; /************************************************************ * 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 --- 806,828 ---- prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid, pltrusted); + /* + * globally store current proc description, this can be redone using + * clientdata-type structures and eventually allow threading or something + */ pltcl_current_prodesc = prodesc; interp = prodesc->interp_desc->interp; + /* reset essential function runtime to a known state */ + pltcl_reset_state(prodesc, (ReturnSetInfo *) fcinfo->resultinfo); + /************************************************************ * 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 *** 703,709 **** * For tuple values, add a list for 'array set ...' **************************************************/ if (fcinfo->argnull[i]) ! Tcl_DStringAppendElement(&tcl_cmd, ""); else { HeapTupleHeader td; --- 837,843 ---- * 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 *** 711,716 **** --- 845,851 ---- 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 *** 721,730 **** 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); } } --- 856,865 ---- 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 *** 735,741 **** * of their external representation **************************************************/ if (fcinfo->argnull[i]) ! Tcl_DStringAppendElement(&tcl_cmd, ""); else { char *tmp; --- 870,876 ---- * 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 *** 743,749 **** tmp = OutputFunctionCall(&prodesc->arg_out_func[i], fcinfo->arg[i]); UTF_BEGIN; ! Tcl_DStringAppendElement(&tcl_cmd, UTF_E2U(tmp)); UTF_END; pfree(tmp); } --- 878,885 ---- 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 *** 752,771 **** } 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. --- 888,905 ---- } 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)); /************************************************************ * Check for errors reported by Tcl. *************** pltcl_func_handler(PG_FUNCTION_ARGS, boo *** 773,778 **** --- 907,918 ---- if (tcl_rc != TCL_OK) throw_tcl_error(interp, prodesc->user_proname); + /* + * Don't get rid of tcl_cmd until after throwing the error because with + * tcl objects it can be referenced from the error handler + */ + Tcl_DecrRefCount(tcl_cmd); + /************************************************************ * Disconnect from SPI manager and then create the return * value datum (if the input function does a palloc for it *************** pltcl_func_handler(PG_FUNCTION_ARGS, boo *** 790,795 **** --- 930,1001 ---- NULL, prodesc->result_typioparam, -1); + else if (prodesc->fn_retisset) + { + ReturnSetInfo *rsi = prodesc->rsi; + + if (!rsi || !IsA(rsi, ReturnSetInfo) || + (rsi->allowedModes & SFRM_Materialize) == 0) + ereport(ERROR, + (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), + errmsg("set-valued function called in context that cannot accept a set"))); + + rsi->returnMode = SFRM_Materialize; + + /* If we produced any tuples, send back the result */ + if (prodesc->tuple_store) + { + rsi->setResult = prodesc->tuple_store; + if (prodesc->ret_tupdesc) + { + MemoryContext oldcxt; + + oldcxt = MemoryContextSwitchTo(prodesc->tuple_store_cxt); + rsi->setDesc = CreateTupleDescCopy(prodesc->ret_tupdesc); + MemoryContextSwitchTo(oldcxt); + } + } + retval = (Datum) 0; + fcinfo->isnull = true; + } + else if (prodesc->fn_retistuple) + { + TupleDesc td; + HeapTuple tup; + Tcl_Obj *resultObj; + Tcl_Obj **resultObjv; + int resultObjc; + + if (get_call_result_type(fcinfo, NULL, &td) != TYPEFUNC_COMPOSITE) + { + ereport(ERROR, + (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), + errmsg("function returning record called in context " + "that cannot accept type record"))); + } + + resultObj = Tcl_GetObjResult(interp); + if (Tcl_ListObjGetElements (interp, resultObj, &resultObjc, &resultObjv) == TCL_ERROR) + { + return TCL_ERROR; + } + + if (resultObjc & 1) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("list must have even number of elements", -1)); + return TCL_ERROR; + } + + Assert(!prodesc->ret_tupdesc); + Assert(!prodesc->attinmeta); + prodesc->ret_tupdesc = td; + prodesc->natts = td->natts; + prodesc->attinmeta = TupleDescGetAttInMetadata(prodesc->ret_tupdesc); + + tup = pltcl_build_tuple_result(interp, resultObjv, resultObjc, prodesc); + retval = HeapTupleGetDatum(tup); + } else { UTF_BEGIN; *************** pltcl_func_handler(PG_FUNCTION_ARGS, boo *** 808,814 **** * pltcl_trigger_handler() - Handler for trigger calls **********************************************************************/ static HeapTuple ! pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted) { pltcl_proc_desc *prodesc; Tcl_Interp *volatile interp; --- 1014,1020 ---- * pltcl_trigger_handler() - Handler for trigger calls **********************************************************************/ static HeapTuple ! pltcl_trigger_handler(FunctionCallInfo fcinfo, bool pltrusted) { pltcl_proc_desc *prodesc; Tcl_Interp *volatile interp; *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 816,824 **** 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; --- 1022,1030 ---- 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, *** 838,911 **** pltrusted); pltcl_current_prodesc = prodesc; - interp = prodesc->interp_desc->interp; - tupdesc = trigdata->tg_relation->rd_att; /************************************************************ * 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 --- 1044,1127 ---- pltrusted); pltcl_current_prodesc = prodesc; interp = prodesc->interp_desc->interp; tupdesc = trigdata->tg_relation->rd_att; + pltcl_reset_state(prodesc, NULL); + /************************************************************ * 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, *** 913,943 **** */ 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; } --- 1129,1162 ---- */ 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, *** 946,966 **** } 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; } --- 1165,1190 ---- } 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, *** 969,995 **** /* 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. --- 1193,1221 ---- /* 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. *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 1126,1132 **** * throw_tcl_error - ereport an error returned from the Tcl interpreter **********************************************************************/ static void ! throw_tcl_error(Tcl_Interp *interp, const char *proname) { /* * Caution is needed here because Tcl_GetVar could overwrite the --- 1352,1358 ---- * throw_tcl_error - ereport an error returned from the Tcl interpreter **********************************************************************/ static void ! throw_tcl_error(Tcl_Interp * interp, const char *proname) { /* * Caution is needed here because Tcl_GetVar could overwrite the *************** throw_tcl_error(Tcl_Interp *interp, cons *** 1151,1156 **** --- 1377,1427 ---- UTF_END; } + static void + pltcl_init_tuple_store(pltcl_proc_desc * prodesc) + { + ReturnSetInfo *rsi = prodesc->rsi; + MemoryContext oldcxt; + ResourceOwner oldowner; + + /* + * Check caller can handle a set result in the way we want + */ + if (!rsi || !IsA(rsi, ReturnSetInfo) || + (rsi->allowedModes & SFRM_Materialize) == 0 || + rsi->expectedDesc == NULL) + ereport(ERROR, + (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), + errmsg("set-valued function called in context that cannot accept a set"))); + + Assert(!prodesc->tuple_store); + Assert(!prodesc->attinmeta); + + /* + * Switch to the right memory context and resource owner for storing the + * tuplestore for return set. If we're within a subtransaction opened for + * an exception-block, for example, we must still create the tuplestore in + * the resource owner that was active when this function was entered, and + * not in the subtransaction resource owner. + */ + prodesc->ret_tupdesc = rsi->expectedDesc; + prodesc->natts = prodesc->ret_tupdesc->natts; + + oldcxt = MemoryContextSwitchTo(prodesc->tuple_store_cxt); + oldowner = CurrentResourceOwner; + CurrentResourceOwner = prodesc->tuple_store_owner; + + prodesc->tuple_store = + tuplestore_begin_heap(rsi->allowedModes & SFRM_Materialize_Random, + false, work_mem); + + prodesc->attinmeta = TupleDescGetAttInMetadata(prodesc->ret_tupdesc); + + CurrentResourceOwner = oldowner; + MemoryContextSwitchTo(oldcxt); + + } + /********************************************************************** * compile_pltcl_function - compile (or hopefully just look up) function *************** compile_pltcl_function(Oid fn_oid, Oid t *** 1230,1235 **** --- 1501,1507 ---- Tcl_Interp *interp; int i; int tcl_rc; + FunctionCallInfo fcinfo = pltcl_current_fcinfo; /************************************************************ * Build our internal proc name from the function's Oid. Append *************** compile_pltcl_function(Oid fn_oid, Oid t *** 1267,1272 **** --- 1539,1555 ---- /* And whether it is trusted */ prodesc->lanpltrusted = pltrusted; + /* not necessary since MemSet 0 above */ + prodesc->fn_retistuple = false; + prodesc->fn_retisset = false; + prodesc->tuple_store_cxt = NULL; + prodesc->tuple_store_owner = NULL; + prodesc->tuple_store = NULL; + prodesc->ret_tupdesc = NULL; + prodesc->attinmeta = NULL; + prodesc->natts = 0; + + /************************************************************ * Identify the interpreter to use for the function ************************************************************/ *************** compile_pltcl_function(Oid fn_oid, Oid t *** 1279,1284 **** --- 1562,1574 ---- ************************************************************/ if (!is_trigger) { + prodesc->rsi = (ReturnSetInfo *) fcinfo->resultinfo; + if (prodesc->rsi) + { + prodesc->tuple_store_cxt = prodesc->rsi->econtext->ecxt_per_query_memory; + prodesc->tuple_store_owner = CurrentResourceOwner; + } + typeTup = SearchSysCache1(TYPEOID, ObjectIdGetDatum(procStruct->prorettype)); *************** compile_pltcl_function(Oid fn_oid, Oid t *** 1306,1311 **** --- 1596,1603 ---- (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), errmsg("trigger functions can only be called as triggers"))); } + else if (procStruct->prorettype == RECORDOID) + ; else { free(prodesc->user_proname); *************** compile_pltcl_function(Oid fn_oid, Oid t *** 1318,1332 **** } } ! if (typeStruct->typtype == TYPTYPE_COMPOSITE) ! { ! free(prodesc->user_proname); ! free(prodesc->internal_proname); ! free(prodesc); ! ereport(ERROR, ! (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), ! errmsg("PL/Tcl functions cannot return composite types"))); ! } perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func)); prodesc->result_typioparam = getTypeIOParam(typeTup); --- 1610,1618 ---- } } ! prodesc->fn_retisset = procStruct->proretset; ! prodesc->fn_retistuple = (procStruct->prorettype == RECORDOID || ! typeStruct->typtype == TYPTYPE_COMPOSITE); perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func)); prodesc->result_typioparam = getTypeIOParam(typeTup); *************** compile_pltcl_function(Oid fn_oid, Oid t *** 1398,1403 **** --- 1684,1693 ---- /************************************************************ * 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 *** 1495,1533 **** * pltcl_elog() - elog() support for PLTcl **********************************************************************/ 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) { /* --- 1785,1851 ---- * pltcl_elog() - elog() support for PLTcl **********************************************************************/ 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 *** 1535,1541 **** * eventually get converted to a PG error when we reach the call * handler. */ ! Tcl_SetResult(interp, (char *) argv[2], TCL_VOLATILE); return TCL_ERROR; } --- 1853,1859 ---- * 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 *** 1552,1558 **** PG_TRY(); { UTF_BEGIN; ! elog(level, "%s", UTF_U2E(argv[2])); UTF_END; } PG_CATCH(); --- 1870,1876 ---- PG_TRY(); { UTF_BEGIN; ! elog(level, "%s", UTF_U2E(Tcl_GetString(objv[2]))); UTF_END; } PG_CATCH(); *************** pltcl_elog(ClientData cdata, Tcl_Interp *** 1566,1572 **** /* Pass the error message to Tcl */ UTF_BEGIN; ! Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE); UTF_END; FreeErrorData(edata); --- 1884,1890 ---- /* 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 *** 1583,1590 **** * be used in SPI_execute query strings **********************************************************************/ static int ! pltcl_quote(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]) { char *tmp; const char *cp1; --- 1901,1908 ---- * be used in SPI_execute query strings **********************************************************************/ 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 *** 1593,1601 **** /************************************************************ * Check call syntax ************************************************************/ ! if (argc != 2) { ! Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_STATIC); return TCL_ERROR; } --- 1911,1919 ---- /************************************************************ * Check call syntax ************************************************************/ ! if (objc != 2) { ! Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } *************** pltcl_quote(ClientData cdata, Tcl_Interp *** 1603,1610 **** * 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; /************************************************************ --- 1921,1928 ---- * 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 *** 1626,1632 **** * Terminate the string and set it as result ************************************************************/ *cp2 = '\0'; ! Tcl_SetResult(interp, tmp, TCL_VOLATILE); pfree(tmp); return TCL_OK; } --- 1944,1950 ---- * 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 *** 1636,1643 **** * pltcl_argisnull() - determine if a specific argument is NULL **********************************************************************/ static int ! pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, ! int argc, CONST84 char *argv[]) { int argno; FunctionCallInfo fcinfo = pltcl_current_fcinfo; --- 1954,1961 ---- * pltcl_argisnull() - determine if a specific argument is NULL **********************************************************************/ 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 *** 1645,1654 **** /************************************************************ * Check call syntax ************************************************************/ ! if (argc != 2) { ! Tcl_SetResult(interp, "syntax error - 'argisnull argno'", ! TCL_STATIC); return TCL_ERROR; } --- 1963,1971 ---- /************************************************************ * Check call syntax ************************************************************/ ! if (objc != 2) { ! Tcl_WrongNumArgs(interp, 1, objv, "argno"); return TCL_ERROR; } *************** pltcl_argisnull(ClientData cdata, Tcl_In *** 1657,1671 **** ************************************************************/ 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; /************************************************************ --- 1974,1988 ---- ************************************************************/ 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 *** 1674,1691 **** 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; } --- 1991,2005 ---- 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 *** 1694,1710 **** * pltcl_returnnull() - Cause a NULL return from a function **********************************************************************/ 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; } --- 2008,2024 ---- * pltcl_returnnull() - Cause a NULL return from a function **********************************************************************/ 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 *** 1713,1720 **** ************************************************************/ if (fcinfo == NULL) { ! Tcl_SetResult(interp, "return_null cannot be used in triggers", ! TCL_STATIC); return TCL_ERROR; } --- 2027,2034 ---- ************************************************************/ if (fcinfo == NULL) { ! Tcl_SetObjResult(interp, ! Tcl_NewStringObj("return_null cannot be used in triggers", -1)); return TCL_ERROR; } *************** pltcl_returnnull(ClientData cdata, Tcl_I *** 1727,1732 **** --- 2041,2134 ---- return TCL_RETURN; } + /********************************************************************** + * pltcl_pg_returnnext() - Queue a row of Tcl key-value pairs into the + * function's tuple_store + **********************************************************************/ + static void + pltcl_pg_returnnext(Tcl_Interp * interp, int rowObjc, Tcl_Obj ** rowObjv) + { + pltcl_proc_desc *prodesc = pltcl_current_prodesc; + + if (!prodesc->fn_retisset) + ereport(ERROR, + (errcode(ERRCODE_SYNTAX_ERROR), + errmsg("cannot use return_next in a non-SETOF function"))); + + if (prodesc->tuple_store == NULL) + pltcl_init_tuple_store(prodesc); + + if (prodesc->fn_retistuple) + { + HeapTuple tuple; + + tuple = pltcl_build_tuple_result(interp, rowObjv, rowObjc, prodesc); + tuplestore_puttuple(prodesc->tuple_store, tuple); + } + else + { + ereport(ERROR, + (errcode(ERRCODE_SYNTAX_ERROR), + errmsg("unprepared for non-retistuple state at this point"))); + } + } + + /********************************************************************** + * pltcl_returnnext() - Tcl-callable command take a list of key-value + * pairs and store in the tuple_store + * for sending as a result when the + * function is complete. + **********************************************************************/ + static int + pltcl_returnnext(ClientData cdata, Tcl_Interp * interp, + int objc, Tcl_Obj * const objv[]) + { + FunctionCallInfo fcinfo = pltcl_current_fcinfo; + Tcl_Obj **rowObjv; + int rowObjc; + pltcl_proc_desc *prodesc = pltcl_current_prodesc; + + /************************************************************ + * Check call syntax + ************************************************************/ + if (objc != 2) + { + Tcl_WrongNumArgs(interp, 1, objv, "list"); + return TCL_ERROR; + } + + /************************************************************ + * Check that we're called as a normal function + ************************************************************/ + if (fcinfo == NULL) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("return_next cannot be used in triggers", -1)); + return TCL_ERROR; + } + + if (!prodesc->fn_retisset) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("cannot use return_next in a non-SETOF function", -1)); + return TCL_ERROR; + } + + if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR) + { + return TCL_ERROR; + } + + if (rowObjc & 1) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("list must have even number of elements", -1)); + return TCL_ERROR; + } + + pltcl_pg_returnnext(interp, rowObjc, rowObjv); + return TCL_OK; + } /*---------- * Support for running SPI operations inside subtransactions *************** pltcl_subtrans_commit(MemoryContext oldc *** 1777,1783 **** } static void ! pltcl_subtrans_abort(Tcl_Interp *interp, MemoryContext oldcontext, ResourceOwner oldowner) { ErrorData *edata; --- 2179,2185 ---- } static void ! pltcl_subtrans_abort(Tcl_Interp * interp, MemoryContext oldcontext, ResourceOwner oldowner) { ErrorData *edata; *************** pltcl_subtrans_abort(Tcl_Interp *interp, *** 1812,1830 **** * for the Tcl interpreter **********************************************************************/ 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?"; --- 2214,2242 ---- * for the Tcl interpreter **********************************************************************/ 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_ *** 1832,1880 **** /************************************************************ * 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 --- 2244,2296 ---- /************************************************************ * 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_ *** 1886,1892 **** PG_TRY(); { UTF_BEGIN; ! spi_rc = SPI_execute(UTF_U2E(argv[query_idx]), pltcl_current_prodesc->fn_readonly, count); UTF_END; --- 2302,2308 ---- 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_ *** 1915,1929 **** * Shared code between pltcl_SPI_execute and pltcl_SPI_execute_plan */ 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; --- 2331,2344 ---- * Shared code between pltcl_SPI_execute and pltcl_SPI_execute_plan */ 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 *** 1935,1949 **** 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 */ --- 2350,2363 ---- 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 *** 1980,1986 **** pltcl_set_tuple_values(interp, arrayname, i, tuples[i], tupdesc); ! loop_rc = Tcl_Eval(interp, loop_body); if (loop_rc == TCL_OK) continue; --- 2394,2400 ---- 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 *** 2000,2007 **** if (my_rc == TCL_OK) { ! snprintf(buf, sizeof(buf), "%d", ntuples); ! Tcl_SetResult(interp, buf, TCL_VOLATILE); } break; --- 2414,2420 ---- if (my_rc == TCL_OK) { ! Tcl_SetObjResult(interp, Tcl_NewIntObj(ntuples)); } break; *************** pltcl_process_SPI_result(Tcl_Interp *int *** 2027,2037 **** * and not save the plan currently. **********************************************************************/ 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; --- 2440,2450 ---- * and not save the plan currently. **********************************************************************/ 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_ *** 2044,2060 **** /************************************************************ * 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; /************************************************************ --- 2457,2472 ---- /************************************************************ * 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_ *** 2088,2094 **** typIOParam; int32 typmod; ! parseTypeString(args[i], &typId, &typmod); getTypeInputInfo(typId, &typInput, &typIOParam); --- 2500,2506 ---- typIOParam; int32 typmod; ! parseTypeString(Tcl_GetString(argsObj[i]), &typId, &typmod); getTypeInputInfo(typId, &typInput, &typIOParam); *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2101,2107 **** * Prepare the plan and check for errors ************************************************************/ UTF_BEGIN; ! plan = SPI_prepare(UTF_U2E(argv[1]), nargs, qdesc->argtypes); UTF_END; if (plan == NULL) --- 2513,2519 ---- * 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_ *** 2128,2134 **** free(qdesc->arginfuncs); free(qdesc->argtypioparams); free(qdesc); - ckfree((char *) args); return TCL_ERROR; } --- 2540,2545 ---- *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2143,2152 **** 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; } --- 2554,2561 ---- hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew); Tcl_SetHashValue(hashent, (ClientData) qdesc); /* 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_ *** 2155,2172 **** * pltcl_SPI_execute_plan() - Execute a prepared plan **********************************************************************/ 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; --- 2564,2582 ---- * pltcl_SPI_execute_plan() - Execute a prepared plan **********************************************************************/ 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, *** 2175,2180 **** --- 2585,2599 ---- 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, *** 2183,2240 **** * 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); --- 2602,2655 ---- * 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, *** 2260,2266 **** ************************************************************/ if (qdesc->nargs > 0) { ! if (i >= argc) { Tcl_SetResult(interp, "missing argument list", TCL_STATIC); return TCL_ERROR; --- 2675,2681 ---- ************************************************************/ if (qdesc->nargs > 0) { ! if (i >= objc) { Tcl_SetResult(interp, "missing argument list", TCL_STATIC); return TCL_ERROR; *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2269,2275 **** /************************************************************ * Split the argument values ************************************************************/ ! if (Tcl_SplitList(interp, argv[i++], &callnargs, &callargs) != TCL_OK) return TCL_ERROR; /************************************************************ --- 2684,2690 ---- /************************************************************ * 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, *** 2290,2299 **** /************************************************************ * Get loop body if present ************************************************************/ ! if (i < argc) ! loop_body = argv[i++]; ! if (i != argc) { Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; --- 2705,2714 ---- /************************************************************ * 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, *** 2373,2385 **** * be used after insert queries **********************************************************************/ 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; } --- 2788,2797 ---- * be used after insert queries **********************************************************************/ 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_SPI_lastoid(ClientData cdata, Tcl_ *** 2389,2400 **** * of a given tuple **********************************************************************/ static void ! pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname, int tupno, HeapTuple tuple, TupleDesc tupdesc) { int i; char *outputstr; - char buf[64]; Datum attr; bool isnull; --- 2801,2811 ---- * of a given tuple **********************************************************************/ static void ! pltcl_set_tuple_values(Tcl_Interp * interp, CONST84 char *arrayname, int tupno, HeapTuple tuple, TupleDesc tupdesc) { int i; char *outputstr; Datum attr; bool isnull; *************** pltcl_set_tuple_values(Tcl_Interp *inter *** 2419,2426 **** { arrptr = &arrayname; nameptr = &attname; ! snprintf(buf, sizeof(buf), "%d", tupno); ! Tcl_SetVar2(interp, arrayname, ".tupno", buf, 0); } for (i = 0; i < tupdesc->natts; i++) --- 2830,2836 ---- { 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 *** 2464,2470 **** { outputstr = OidOutputFunctionCall(typoutput, attr); UTF_BEGIN; ! Tcl_SetVar2(interp, *arrptr, *nameptr, UTF_E2U(outputstr), 0); UTF_END; pfree(outputstr); } --- 2874,2881 ---- { 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 *** 2480,2486 **** **********************************************************************/ static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc, ! Tcl_DString *retval) { int i; char *outputstr; --- 2891,2897 ---- **********************************************************************/ static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc, ! Tcl_Obj * retobj) { int i; char *outputstr; *************** pltcl_build_tuple_argument(HeapTuple tup *** 2531,2539 **** if (!isnull && OidIsValid(typoutput)) { outputstr = OidOutputFunctionCall(typoutput, attr); ! Tcl_DStringAppendElement(retval, attname); UTF_BEGIN; ! Tcl_DStringAppendElement(retval, UTF_E2U(outputstr)); UTF_END; pfree(outputstr); } --- 2942,2951 ---- 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); }