--- pl/plperl/plperl.c.4~ 2005-05-22 11:17:40.213363619 +0530 +++ pl/plperl/plperl.c 2005-05-22 16:25:55.024867551 +0530 @@ -53,6 +53,7 @@ #include "utils/lsyscache.h" #include "utils/memutils.h" #include "utils/typcache.h" +#include "miscadmin.h" /* perl stuff */ #include "EXTERN.h" @@ -413,25 +414,6 @@ } -/* - * Obtain tuple descriptor for a function returning tuple - * - * NB: copy the result if needed for any great length of time - */ -static TupleDesc -get_function_tupdesc(FunctionCallInfo fcinfo) -{ - TupleDesc result; - - if (get_call_result_type(fcinfo, NULL, &result) != TYPEFUNC_COMPOSITE) - ereport(ERROR, - (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), - errmsg("function returning record called in context " - "that cannot accept type record"))); - return result; -} - - /* Set up the new tuple returned from a trigger. */ static HeapTuple @@ -806,6 +788,7 @@ plperl_proc_desc *prodesc; SV *perlret; Datum retval; + ReturnSetInfo *rsi; if (SPI_connect() != SPI_OK_CONNECT) elog(ERROR, "could not connect to SPI manager"); @@ -814,17 +797,7 @@ plperl_current_prodesc = prodesc; - if (!prodesc->fn_retisset) - perlret = plperl_call_perl_func(prodesc, fcinfo); - else if (SRF_IS_FIRSTCALL()) - perlret = plperl_call_perl_func(prodesc, fcinfo); - else - { - /* Get back the SV stashed on initial call */ - FuncCallContext *funcctx = (FuncCallContext *) fcinfo->flinfo->fn_extra; - - perlret = (SV *) funcctx->user_fctx; - } + perlret = plperl_call_perl_func(prodesc, fcinfo); /************************************************************ * Disconnect from SPI manager and then create the return @@ -835,11 +808,11 @@ if (SPI_finish() != SPI_OK_FINISH) elog(ERROR, "SPI_finish() failed"); + rsi = (ReturnSetInfo *)fcinfo->resultinfo; + if (!(perlret && SvOK(perlret) && SvTYPE(perlret) != SVt_NULL)) { /* return NULL if Perl code returned undef */ - ReturnSetInfo *rsi = (ReturnSetInfo *) fcinfo->resultinfo; - if (perlret) SvREFCNT_dec(perlret); if (rsi && IsA(rsi, ReturnSetInfo)) @@ -847,83 +820,27 @@ PG_RETURN_NULL(); } - if (prodesc->fn_retisset && prodesc->fn_retistuple) + if (prodesc->fn_retisset) { - /* set of tuples */ - AV *ret_av; - FuncCallContext *funcctx; - TupleDesc tupdesc; + /* Returns a set of tuples or scalars. */ + int i; + AV *ret_av; + Tuplestorestate *store; + MemoryContext cxt; + TypeFuncClass rettype; + TupleDesc tupdesc; AttInMetadata *attinmeta; - if (!SvOK(perlret) || SvTYPE(perlret) != SVt_RV || - SvTYPE(SvRV(perlret)) != SVt_PVAV) + if (!rsi || !IsA(rsi, ReturnSetInfo) || + (rsi->allowedModes & SFRM_Materialize) == 0 || + rsi->expectedDesc == NULL) { ereport(ERROR, - (errcode(ERRCODE_DATATYPE_MISMATCH), - errmsg("set-returning Perl function must return " - "reference to array"))); - } - - ret_av = (AV *) SvRV(perlret); - - if (SRF_IS_FIRSTCALL()) - { - MemoryContext oldcontext; - - funcctx = SRF_FIRSTCALL_INIT(); - - funcctx->user_fctx = (void *) perlret; - - funcctx->max_calls = av_len(ret_av) + 1; - - /* Cache a copy of the result's tupdesc and attinmeta */ - oldcontext = MemoryContextSwitchTo(funcctx->multi_call_memory_ctx); - tupdesc = get_function_tupdesc(fcinfo); - tupdesc = CreateTupleDescCopy(tupdesc); - funcctx->attinmeta = TupleDescGetAttInMetadata(tupdesc); - MemoryContextSwitchTo(oldcontext); + (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), + errmsg("set-valued function called in context that " + "cannot accept a set"))); } - funcctx = SRF_PERCALL_SETUP(); - attinmeta = funcctx->attinmeta; - tupdesc = attinmeta->tupdesc; - - if (funcctx->call_cntr < funcctx->max_calls) - { - SV **svp; - HV *row_hv; - HeapTuple tuple; - - svp = av_fetch(ret_av, funcctx->call_cntr, FALSE); - Assert(svp != NULL); - - if (!SvOK(*svp) || SvTYPE(*svp) != SVt_RV || - SvTYPE(SvRV(*svp)) != SVt_PVHV) - { - ereport(ERROR, - (errcode(ERRCODE_DATATYPE_MISMATCH), - errmsg("elements of Perl result array must be " - "reference to hash"))); - } - - row_hv = (HV *) SvRV(*svp); - - tuple = plperl_build_tuple_result(row_hv, attinmeta); - retval = HeapTupleGetDatum(tuple); - SRF_RETURN_NEXT(funcctx, retval); - } - else - { - SvREFCNT_dec(perlret); - SRF_RETURN_DONE(funcctx); - } - } - else if (prodesc->fn_retisset) - { - /* set of non-tuples */ - AV *ret_av; - FuncCallContext *funcctx; - if (!SvOK(perlret) || SvTYPE(perlret) != SVt_RV || SvTYPE(SvRV(perlret)) != SVt_PVAV) { @@ -933,56 +850,78 @@ "reference to array"))); } - ret_av = (AV *) SvRV(perlret); + cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory); + store = tuplestore_begin_heap(true, false, work_mem); - if (SRF_IS_FIRSTCALL()) - { - funcctx = SRF_FIRSTCALL_INIT(); + if (prodesc->fn_retistuple) { + rettype = get_call_result_type(fcinfo, NULL, &tupdesc); + attinmeta = TupleDescGetAttInMetadata(tupdesc); + } + else { + tupdesc = rsi->expectedDesc; + attinmeta = 0; + } + tupdesc = CreateTupleDescCopy(tupdesc); + + i = 0; + ret_av = (AV *)SvRV(perlret); + while (i <= av_len(ret_av)) { + SV **svp; + HeapTuple tuple; - funcctx->user_fctx = (void *) perlret; - - funcctx->max_calls = av_len(ret_av) + 1; - } - - funcctx = SRF_PERCALL_SETUP(); - - if (funcctx->call_cntr < funcctx->max_calls) - { - SV **svp; - - svp = av_fetch(ret_av, funcctx->call_cntr, FALSE); + svp = av_fetch(ret_av, i, FALSE); Assert(svp != NULL); - if (SvOK(*svp) && SvTYPE(*svp) != SVt_NULL) - { - char *val = SvPV(*svp, PL_na); - - fcinfo->isnull = false; - retval = FunctionCall3(&prodesc->result_in_func, - PointerGetDatum(val), - ObjectIdGetDatum(prodesc->result_typioparam), - Int32GetDatum(-1)); + if (prodesc->fn_retistuple) { + if (!SvOK(*svp) || SvTYPE(*svp) != SVt_RV || + SvTYPE(SvRV(*svp)) != SVt_PVHV) + { + ereport(ERROR, + (errcode(ERRCODE_DATATYPE_MISMATCH), + errmsg("elements of Perl result array must be " + "reference to hash"))); + } + tuple = plperl_build_tuple_result((HV *)SvRV(*svp), attinmeta); } - else - { - fcinfo->isnull = true; - retval = (Datum) 0; + else { + Datum ret; + bool isNull = false; + + if (SvOK(*svp) && SvTYPE(*svp) != SVt_NULL) { + char *val = SvPV(*svp, PL_na); + ret = FunctionCall3( + &prodesc->result_in_func, + PointerGetDatum(val), + ObjectIdGetDatum(prodesc->result_typioparam), + Int32GetDatum(-1) + ); + } + else { + ret = (Datum)0; + isNull = true; + } + + tuple = heap_form_tuple(tupdesc, &ret, &isNull); } - SRF_RETURN_NEXT(funcctx, retval); - } - else - { - SvREFCNT_dec(perlret); - SRF_RETURN_DONE(funcctx); + + tuplestore_puttuple(store, tuple); + heap_freetuple(tuple); + i++; } + MemoryContextSwitchTo(cxt); + + rsi->returnMode = SFRM_Materialize; + rsi->setResult = store; + rsi->setDesc = tupdesc; + + retval = (Datum)0; } else if (prodesc->fn_retistuple) { /* singleton perl hash to Datum */ - HV *perlhash; - TupleDesc td; + TupleDesc td; AttInMetadata *attinmeta; - HeapTuple tup; + HeapTuple tup; if (!SvOK(perlret) || SvTYPE(perlret) != SVt_RV || SvTYPE(SvRV(perlret)) != SVt_PVHV) @@ -993,23 +932,27 @@ "must return reference to hash"))); } - perlhash = (HV *) SvRV(perlret); /* * XXX should cache the attinmeta data instead of recomputing */ - td = get_function_tupdesc(fcinfo); - /* td = CreateTupleDescCopy(td); */ - attinmeta = TupleDescGetAttInMetadata(td); - tup = plperl_build_tuple_result(perlhash, attinmeta); + 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"))); + } + + attinmeta = TupleDescGetAttInMetadata(td); + tup = plperl_build_tuple_result((HV *)SvRV(perlret), attinmeta); retval = HeapTupleGetDatum(tup); } else { /* perl string to Datum */ - char *val = SvPV(perlret, PL_na); - + char *val = SvPV(perlret, PL_na); retval = FunctionCall3(&prodesc->result_in_func, CStringGetDatum(val), ObjectIdGetDatum(prodesc->result_typioparam),