diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c index 06e7acd..68d6c77 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 *** 187,203 **** 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, --- 193,212 ---- 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 *** 206,211 **** --- 215,222 ---- 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 *** 225,231 **** 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); /* --- 236,243 ---- 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) *** 288,293 **** --- 300,365 ---- } #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 * in *** 422,427 **** --- 494,501 ---- 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) *** 611,618 **** } static Datum ! pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted) { Datum retval; FunctionCallInfo save_fcinfo; --- 685,696 ---- } + /********************************************************************** + * 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 **** --- 710,722 ---- */ 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; --- 740,750 ---- * 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 --- 757,779 ---- 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; --- 788,794 ---- * 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 **** --- 796,802 ---- 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); } } --- 807,816 ---- 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; --- 821,827 ---- * 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); } --- 829,836 ---- 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. --- 839,856 ---- } 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 **** --- 858,869 ---- 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 **** --- 881,952 ---- 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; --- 965,971 ---- * 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; --- 973,981 ---- 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 --- 995,1078 ---- 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; } --- 1080,1113 ---- */ 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; } --- 1116,1141 ---- } 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. --- 1144,1172 ---- /* 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. *************** throw_tcl_error(Tcl_Interp * interp, con *** 1151,1156 **** --- 1328,1378 ---- 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 **** --- 1452,1458 ---- 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 **** --- 1490,1506 ---- /* 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 **** --- 1513,1525 ---- ************************************************************/ 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 **** --- 1547,1554 ---- (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); --- 1561,1569 ---- } } ! 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 **** --- 1635,1644 ---- /************************************************************ * 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); *************** pltcl_returnnull(ClientData cdata, Tcl_I *** 1751,1756 **** --- 1992,2085 ---- 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_ *** 2162,2168 **** free(qdesc->arginfuncs); free(qdesc->argtypioparams); free(qdesc); - /* ckfree((char *) args); */ return TCL_ERROR; } --- 2491,2496 ---- *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2177,2184 **** 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; --- 2505,2510 ---- *************** pltcl_set_tuple_values(Tcl_Interp * inte *** 2516,2522 **** **********************************************************************/ static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc, ! Tcl_DString * retval) { int i; char *outputstr; --- 2842,2848 ---- **********************************************************************/ static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc, ! Tcl_Obj * retobj) { int i; char *outputstr; *************** pltcl_build_tuple_argument(HeapTuple tup *** 2567,2575 **** if (!isnull && OidIsValid(typoutput)) { outputstr = OidOutputFunctionCall(typoutput, attr); ! Tcl_DStringAppendElement(retval, attname); UTF_BEGIN; ! Tcl_DStringAppendElement(retval, UTF_E2U(outputstr)); UTF_END; pfree(outputstr); } --- 2893,2902 ---- 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); }