diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c index 1efdb2d..4737a5b 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") *************** typedef struct pltcl_proc_desc *** 112,123 **** --- 108,129 ---- 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; *************** static void pltcl_init_interp(pltcl_inte *** 188,204 **** 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 objc, Tcl_Obj * const objv[]); static int pltcl_quote(ClientData cdata, Tcl_Interp *interp, --- 194,213 ---- 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, *************** static int pltcl_argisnull(ClientData cd *** 207,212 **** --- 216,223 ---- 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_SPI_lastoid(ClientData *** 226,232 **** 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); /* --- 237,244 ---- 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_WaitForEvent(Tcl_Time *timePtr) *** 289,294 **** --- 301,366 ---- } #endif /* HAVE_TCL_VERSION(8,4) */ + 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 *************** pltcl_init_interp(pltcl_interp_desc *int *** 423,428 **** --- 495,502 ---- 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); *************** pltclu_call_handler(PG_FUNCTION_ARGS) *** 612,619 **** } static Datum ! pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted) { Datum retval; FunctionCallInfo save_fcinfo; --- 686,697 ---- } + /********************************************************************** + * 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 *** 633,643 **** --- 711,723 ---- */ 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 *** 661,667 **** * 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; --- 741,747 ---- * 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; *************** 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_cmd = Tcl_NewObj(); ! Tcl_ListObjAppendElement (NULL, tcl_cmd, ! Tcl_NewStringObj(prodesc->internal_proname, -1)); /************************************************************ * Add all call arguments to the command --- 758,780 ---- 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_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj()); else { HeapTupleHeader td; --- 789,795 ---- * 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 *** 736,742 **** * of their external representation **************************************************/ if (fcinfo->argnull[i]) ! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj()); else { char *tmp; --- 822,828 ---- * 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 *** 745,751 **** fcinfo->arg[i]); UTF_BEGIN; Tcl_ListObjAppendElement(NULL, tcl_cmd, ! Tcl_NewStringObj(UTF_E2U(tmp), -1)); UTF_END; pfree(tmp); } --- 831,837 ---- 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 *** 765,772 **** * 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. --- 851,857 ---- * 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 *** 774,779 **** --- 859,870 ---- 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 *** 791,796 **** --- 882,953 ---- 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 *** 809,815 **** * 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; --- 966,972 ---- * 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, *** 839,849 **** 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 --- 996,1006 ---- 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 *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 855,884 **** { /* 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 */ --- 1012,1041 ---- { /* 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 */ *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 886,918 **** 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, --- 1043,1075 ---- 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, *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 925,931 **** 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()); --- 1082,1088 ---- 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()); *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 935,941 **** 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); --- 1092,1098 ---- 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); *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 945,951 **** 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); --- 1102,1108 ---- 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); *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 961,980 **** 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); --- 1118,1137 ---- 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); *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 988,1000 **** /* 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(); --- 1145,1157 ---- /* 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(); *************** pltcl_trigger_handler(PG_FUNCTION_ARGS, *** 1007,1015 **** * 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); /************************************************************ --- 1164,1172 ---- * 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); /************************************************************ *************** throw_tcl_error(Tcl_Interp *interp, cons *** 1172,1177 **** --- 1329,1379 ---- 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 *** 1251,1256 **** --- 1453,1459 ---- 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 *** 1288,1293 **** --- 1491,1507 ---- /* 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 *** 1300,1305 **** --- 1514,1526 ---- ************************************************************/ 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 *** 1327,1332 **** --- 1548,1555 ---- (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 *** 1339,1353 **** } } ! 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); --- 1562,1570 ---- } } ! 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); *************** pltcl_returnnull(ClientData cdata, Tcl_I *** 1776,1781 **** --- 1993,2086 ---- 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_SPI_prepare(ClientData cdata, Tcl_ *** 2187,2193 **** free(qdesc->arginfuncs); free(qdesc->argtypioparams); free(qdesc); - /* ckfree((char *) args); */ return TCL_ERROR; } --- 2492,2497 ---- *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2202,2209 **** 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; --- 2506,2511 ---- *************** pltcl_set_tuple_values(Tcl_Interp *inter *** 2541,2547 **** **********************************************************************/ static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc, ! Tcl_Obj *retobj) { int i; char *outputstr; --- 2843,2849 ---- **********************************************************************/ static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc, ! Tcl_Obj * retobj) { int i; char *outputstr; *************** pltcl_build_tuple_argument(HeapTuple tup *** 2592,2599 **** 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; --- 2894,2901 ---- 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;