diff options
Diffstat (limited to 'src/pl/plperl/plperl.c')
| -rw-r--r-- | src/pl/plperl/plperl.c | 643 |
1 files changed, 614 insertions, 29 deletions
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index 7bb2ac34331..7d9cd583af2 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -33,7 +33,7 @@ * ENHANCEMENTS, OR MODIFICATIONS. * * IDENTIFICATION - * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.44 2004/06/06 00:41:28 tgl Exp $ + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.45 2004/07/01 20:50:22 joe Exp $ * **********************************************************************/ @@ -49,6 +49,7 @@ #include "catalog/pg_language.h" #include "catalog/pg_proc.h" #include "catalog/pg_type.h" +#include "funcapi.h" /* need for SRF support */ #include "commands/trigger.h" #include "executor/spi.h" #include "fmgr.h" @@ -78,6 +79,8 @@ typedef struct plperl_proc_desc TransactionId fn_xmin; CommandId fn_cmin; bool lanpltrusted; + bool fn_retistuple; /* true, if function returns tuple */ + Oid ret_oid; /* Oid of returning type */ FmgrInfo result_in_func; Oid result_typioparam; int nargs; @@ -94,6 +97,9 @@ typedef struct plperl_proc_desc static int plperl_firstcall = 1; static PerlInterpreter *plperl_interp = NULL; static HV *plperl_proc_hash = NULL; +AV *g_row_keys = NULL; +AV *g_column_keys = NULL; +int g_attr_num = 0; /********************************************************************** * Forward declarations @@ -106,6 +112,7 @@ void plperl_init(void); static Datum plperl_func_handler(PG_FUNCTION_ARGS); +static Datum plperl_trigger_handler(PG_FUNCTION_ARGS); static plperl_proc_desc *compile_plperl_function(Oid fn_oid, bool is_trigger); static SV *plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc); @@ -205,14 +212,15 @@ plperl_init_interp(void) "", "-e", /* - * no commas between the next 5 please. They are supposed to be + * no commas between the next lines please. They are supposed to be * one string */ - "require Safe; SPI::bootstrap();" - "sub ::mksafefunc { my $x = new Safe; $x->permit_only(':default');$x->permit(':base_math');" - "$x->share(qw[&elog &DEBUG &LOG &INFO &NOTICE &WARNING &ERROR]);" - " return $x->reval(qq[sub { $_[0] }]); }" - "sub ::mkunsafefunc {return eval(qq[ sub { $_[0] } ]); }" + "require Safe; SPI::bootstrap(); use vars qw(%_SHARED);" + "use vars qw($PLContainer); $PLContainer = new Safe('PLPerl');" + "$PLContainer->permit_only(':default');$PLContainer->permit(':base_math');" + "$PLContainer->share(qw[&elog &spi_exec_query &DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %SHARED ]);" + "sub ::mksafefunc { return $PLContainer->reval(qq[sub { $_[0] $_[1]}]); }" + "sub ::mkunsafefunc {return eval(qq[ sub { $_[0] $_[1] } ]); }" }; plperl_interp = perl_alloc(); @@ -230,6 +238,312 @@ plperl_init_interp(void) } +/********************************************************************** + * turn a tuple into a hash expression and add it to a list + **********************************************************************/ +static void +plperl_sv_add_tuple_value(SV * rv, HeapTuple tuple, TupleDesc tupdesc) +{ + int i; + char *value; + char *key; + + sv_catpvf(rv, "{ "); + + for (i = 0; i < tupdesc->natts; i++) + { + key = SPI_fname(tupdesc, i + 1); + value = SPI_getvalue(tuple, tupdesc, i + 1); + if (value) + sv_catpvf(rv, "%s => '%s'", key, value); + else + sv_catpvf(rv, "%s => undef", key); + if (i != tupdesc->natts - 1) + sv_catpvf(rv, ", "); + } + + sv_catpvf(rv, " }"); +} + +/********************************************************************** + * set up arguments for a trigger call + **********************************************************************/ +static SV * +plperl_trigger_build_args(FunctionCallInfo fcinfo) +{ + TriggerData *tdata; + TupleDesc tupdesc; + int i = 0; + SV *rv; + + rv = newSVpv("{ ", 0); + + tdata = (TriggerData *) fcinfo->context; + + tupdesc = tdata->tg_relation->rd_att; + + sv_catpvf(rv, "name => '%s'", tdata->tg_trigger->tgname); + sv_catpvf(rv, ", relid => '%s'", DatumGetCString(DirectFunctionCall1(oidout, ObjectIdGetDatum(tdata->tg_relation->rd_id)))); + + if (TRIGGER_FIRED_BY_INSERT(tdata->tg_event)) + { + sv_catpvf(rv, ", event => 'INSERT'"); + sv_catpvf(rv, ", new =>"); + plperl_sv_add_tuple_value(rv, tdata->tg_trigtuple, tupdesc); + } + else if (TRIGGER_FIRED_BY_DELETE(tdata->tg_event)) + { + sv_catpvf(rv, ", event => 'DELETE'"); + sv_catpvf(rv, ", old => "); + plperl_sv_add_tuple_value(rv, tdata->tg_trigtuple, tupdesc); + } + else if (TRIGGER_FIRED_BY_UPDATE(tdata->tg_event)) + { + sv_catpvf(rv, ", event => 'UPDATE'"); + + sv_catpvf(rv, ", new =>"); + plperl_sv_add_tuple_value(rv, tdata->tg_newtuple, tupdesc); + + sv_catpvf(rv, ", old => "); + plperl_sv_add_tuple_value(rv, tdata->tg_trigtuple, tupdesc); + } + else + sv_catpvf(rv, ", event => 'UNKNOWN'"); + + sv_catpvf(rv, ", argc => %d", tdata->tg_trigger->tgnargs); + + if (tdata->tg_trigger->tgnargs != 0) + { + sv_catpvf(rv, ", args => [ "); + for (i = 0; i < tdata->tg_trigger->tgnargs; i++) + { + sv_catpvf(rv, "%s", tdata->tg_trigger->tgargs[i]); + if (i != tdata->tg_trigger->tgnargs - 1) + sv_catpvf(rv, ", "); + } + sv_catpvf(rv, " ]"); + } + sv_catpvf(rv, ", relname => '%s'", SPI_getrelname(tdata->tg_relation)); + + if (TRIGGER_FIRED_BEFORE(tdata->tg_event)) + sv_catpvf(rv, ", when => 'BEFORE'"); + else if (TRIGGER_FIRED_AFTER(tdata->tg_event)) + sv_catpvf(rv, ", when => 'AFTER'"); + else + sv_catpvf(rv, ", when => 'UNKNOWN'"); + + if (TRIGGER_FIRED_FOR_ROW(tdata->tg_event)) + sv_catpvf(rv, ", level => 'ROW'"); + else if (TRIGGER_FIRED_FOR_STATEMENT(tdata->tg_event)) + sv_catpvf(rv, ", level => 'STATEMENT'"); + else + sv_catpvf(rv, ", level => 'UNKNOWN'"); + + sv_catpvf(rv, " }"); + + rv = perl_eval_pv(SvPV(rv, PL_na), TRUE); + + return rv; +} + + +/********************************************************************** + * check return value from plperl function + **********************************************************************/ +static int +plperl_is_set(SV * sv) +{ + int i = 0; + int len = 0; + int set = 0; + int other = 0; + AV *input_av; + SV **val; + + if (SvTYPE(sv) != SVt_RV) + return 0; + + if (SvTYPE(SvRV(sv)) == SVt_PVHV) + return 0; + + if (SvTYPE(SvRV(sv)) == SVt_PVAV) + { + input_av = (AV *) SvRV(sv); + len = av_len(input_av) + 1; + + for (i = 0; i < len; i++) + { + val = av_fetch(input_av, i, FALSE); + if (SvTYPE(*val) == SVt_RV) + set = 1; + else + other = 1; + } + } + + if (len == 0) + return 1; + if (set && !other) + return 1; + if (!set && other) + return 0; + if (set && other) + elog(ERROR, "plperl: check your return value structure"); + if (!set && !other) + elog(ERROR, "plperl: check your return value structure"); + + return 0; /* for compiler */ +} + +/********************************************************************** + * extract a list of keys from a hash + **********************************************************************/ +static AV * +plperl_get_keys(HV * hv) +{ + AV *ret; + SV **svp; + int key_count; + SV *val; + char *key; + I32 klen; + + key_count = 0; + ret = newAV(); + + hv_iterinit(hv); + while (val = hv_iternextsv(hv, (char **) &key, &klen)) + { + av_store(ret, key_count, eval_pv(key, TRUE)); + key_count++; + } + hv_iterinit(hv); + return ret; +} + +/********************************************************************** + * extract a given key (by index) from a list of keys + **********************************************************************/ +static char * +plperl_get_key(AV * keys, int index) +{ + SV **svp; + int len; + + len = av_len(keys) + 1; + if (index < len) + svp = av_fetch(keys, index, FALSE); + else + return NULL; + return SvPV(*svp, PL_na); +} + +/********************************************************************** + * extract a value for a given key from a hash + * + * return NULL on error or if we got an undef + * + **********************************************************************/ +static char * +plperl_get_elem(HV * hash, char *key) +{ + SV **svp; + + if (hv_exists_ent(hash, eval_pv(key, TRUE), FALSE)) + svp = hv_fetch(hash, key, strlen(key), FALSE); + else + { + elog(ERROR, "plperl: key '%s' not found", key); + return NULL; + } + return SvTYPE(*svp) == SVt_NULL ? NULL : SvPV(*svp, PL_na); +} + +/********************************************************************** + * set up the new tuple returned from a trigger + **********************************************************************/ +static HeapTuple +plperl_modify_tuple(HV * hvTD, TriggerData *tdata, HeapTuple otup, Oid fn_oid) +{ + SV **svp; + HV *hvNew; + AV *plkeys; + char *platt; + char *plval; + HeapTuple rtup; + int natts, + i, + attn, + atti; + int *volatile modattrs = NULL; + Datum *volatile modvalues = NULL; + char *volatile modnulls = NULL; + TupleDesc tupdesc; + HeapTuple typetup; + + tupdesc = tdata->tg_relation->rd_att; + + svp = hv_fetch(hvTD, "new", 3, FALSE); + hvNew = (HV *) SvRV(*svp); + + if (SvTYPE(hvNew) != SVt_PVHV) + elog(ERROR, "plperl: $_TD->{new} is not a hash"); + + plkeys = plperl_get_keys(hvNew); + natts = av_len(plkeys)+1; + if (natts != tupdesc->natts) + elog(ERROR, "plperl: $_TD->{new} has an incorrect number of keys."); + + modattrs = palloc0(natts * sizeof(int)); + modvalues = palloc0(natts * sizeof(Datum)); + modnulls = palloc0(natts * sizeof(char)); + + for (i = 0; i < natts; i++) + { + FmgrInfo finfo; + Oid typinput; + Oid typelem; + + platt = plperl_get_key(plkeys, i); + + attn = modattrs[i] = SPI_fnumber(tupdesc, platt); + + if (attn == SPI_ERROR_NOATTRIBUTE) + elog(ERROR, "plperl: invalid attribute `%s' in tuple.", platt); + atti = attn - 1; + + plval = plperl_get_elem(hvNew, platt); + + typetup = SearchSysCache(TYPEOID, ObjectIdGetDatum(tupdesc->attrs[atti]->atttypid), 0, 0, 0); + typinput = ((Form_pg_type) GETSTRUCT(typetup))->typinput; + typelem = ((Form_pg_type) GETSTRUCT(typetup))->typelem; + ReleaseSysCache(typetup); + fmgr_info(typinput, &finfo); + + if (plval) + { + modvalues[i] = FunctionCall3(&finfo, + CStringGetDatum(plval), + ObjectIdGetDatum(typelem), + Int32GetDatum(tupdesc->attrs[atti]->atttypmod)); + modnulls[i] = ' '; + } + else + { + modvalues[i] = (Datum) 0; + modnulls[i] = 'n'; + } + } + rtup = SPI_modifytuple(tdata->tg_relation, otup, natts, modattrs, modvalues, modnulls); + + pfree(modattrs); + pfree(modvalues); + pfree(modnulls); + if (rtup == NULL) + elog(ERROR, "plperl: SPI_modifytuple failed -- error: %d", SPI_result); + + return rtup; +} /********************************************************************** * plperl_call_handler - This is the only visible function @@ -262,17 +576,7 @@ plperl_call_handler(PG_FUNCTION_ARGS) * call appropriate subhandler ************************************************************/ if (CALLED_AS_TRIGGER(fcinfo)) - { - ereport(ERROR, - (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), - errmsg("cannot use perl in triggers yet"))); - - /* - * retval = PointerGetDatum(plperl_trigger_handler(fcinfo)); - */ - /* make the compiler happy */ - retval = (Datum) 0; - } + retval = PointerGetDatum(plperl_trigger_handler(fcinfo)); else retval = plperl_func_handler(fcinfo); @@ -295,6 +599,7 @@ plperl_create_sub(char *s, bool trusted) ENTER; SAVETMPS; PUSHMARK(SP); + XPUSHs(sv_2mortal(newSVpv("my $_TD=$_[0]; shift;", 0))); XPUSHs(sv_2mortal(newSVpv(s, 0))); PUTBACK; @@ -387,6 +692,7 @@ plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo) SAVETMPS; PUSHMARK(SP); + XPUSHs(sv_2mortal(newSVpv("undef", 0))); for (i = 0; i < desc->nargs; i++) { if (desc->arg_is_rowtype[i]) @@ -468,6 +774,57 @@ plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo) return retval; } +/********************************************************************** + * plperl_call_perl_trigger_func() - calls a perl function affected by trigger + * through the RV stored in the prodesc structure. massages the input parms properly + **********************************************************************/ +static SV * +plperl_call_perl_trigger_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo, SV * td) +{ + dSP; + SV *retval; + int i; + int count; + char *ret_test; + + ENTER; + SAVETMPS; + + PUSHMARK(sp); + XPUSHs(td); + for (i = 0; i < ((TriggerData *) fcinfo->context)->tg_trigger->tgnargs; i++) + XPUSHs(sv_2mortal(newSVpv(((TriggerData *) fcinfo->context)->tg_trigger->tgargs[i], 0))); + PUTBACK; + + count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL | G_KEEPERR); + + SPAGAIN; + + if (count != 1) + { + PUTBACK; + FREETMPS; + LEAVE; + elog(ERROR, "plperl: didn't get a return item from function"); + } + + if (SvTRUE(ERRSV)) + { + POPs; + PUTBACK; + FREETMPS; + LEAVE; + elog(ERROR, "plperl: error from function: %s", SvPV(ERRSV, PL_na)); + } + + retval = newSVsv(POPs); + + PUTBACK; + FREETMPS; + LEAVE; + + return retval; +} /********************************************************************** * plperl_func_handler() - Handler for regular function calls @@ -481,11 +838,17 @@ plperl_func_handler(PG_FUNCTION_ARGS) /* Find or compile the function */ prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false); - /************************************************************ * Call the Perl function ************************************************************/ perlret = plperl_call_perl_func(prodesc, fcinfo); + if (prodesc->fn_retistuple && SRF_IS_FIRSTCALL()) + { + + if (SvTYPE(perlret) != SVt_RV) + elog(ERROR, "plperl: this function must return a reference"); + g_column_keys = newAV(); + } /************************************************************ * Disconnect from SPI manager and then create the return @@ -496,14 +859,146 @@ plperl_func_handler(PG_FUNCTION_ARGS) if (SPI_finish() != SPI_OK_FINISH) elog(ERROR, "SPI_finish() failed"); - if (!(perlret && SvOK(perlret))) + if (!(perlret && SvOK(perlret) && SvTYPE(perlret)!=SVt_NULL )) { /* return NULL if Perl code returned undef */ retval = (Datum) 0; fcinfo->isnull = true; } + + if (prodesc->fn_retistuple) + { + /* SRF support */ + HV *ret_hv; + AV *ret_av; + + FuncCallContext *funcctx; + int call_cntr; + int max_calls; + TupleDesc tupdesc; + TupleTableSlot *slot; + AttInMetadata *attinmeta; + bool isset = 0; + char **values = NULL; + ReturnSetInfo *rsinfo = (ReturnSetInfo *) fcinfo->resultinfo; + + if (!rsinfo) + ereport(ERROR, + (errcode(ERRCODE_SYNTAX_ERROR), + errmsg("returning a composite type is not allowed in this context"), + errhint("This function is intended for use in the FROM clause."))); + + if (SvTYPE(perlret) != SVt_RV) + elog(ERROR, "plperl: this function must return a reference"); + + isset = plperl_is_set(perlret); + + if (SvTYPE(SvRV(perlret)) == SVt_PVHV) + ret_hv = (HV *) SvRV(perlret); + else + ret_av = (AV *) SvRV(perlret); + + if (SRF_IS_FIRSTCALL()) + { + MemoryContext oldcontext; + int i; + + funcctx = SRF_FIRSTCALL_INIT(); + + oldcontext = MemoryContextSwitchTo(funcctx->multi_call_memory_ctx); + + if (SvTYPE(SvRV(perlret)) == SVt_PVHV) + { + if (isset) + funcctx->max_calls = hv_iterinit(ret_hv); + else + funcctx->max_calls = 1; + } + else + { + if (isset) + funcctx->max_calls = av_len(ret_av) + 1; + else + funcctx->max_calls = 1; + } + + tupdesc = CreateTupleDescCopy(rsinfo->expectedDesc); + + g_attr_num = tupdesc->natts; + + for (i = 0; i < tupdesc->natts; i++) + av_store(g_column_keys, i + 1, eval_pv(SPI_fname(tupdesc, i + 1), TRUE)); + + slot = TupleDescGetSlot(tupdesc); + funcctx->slot = slot; + attinmeta = TupleDescGetAttInMetadata(tupdesc); + funcctx->attinmeta = attinmeta; + MemoryContextSwitchTo(oldcontext); + } + + funcctx = SRF_PERCALL_SETUP(); + call_cntr = funcctx->call_cntr; + max_calls = funcctx->max_calls; + slot = funcctx->slot; + attinmeta = funcctx->attinmeta; + + if (call_cntr < max_calls) + { + HeapTuple tuple; + Datum result; + int i; + char *column_key; + char *elem; + + if (isset) + { + HV *row_hv; + SV **svp; + char *row_key; + + svp = av_fetch(ret_av, call_cntr, FALSE); + + row_hv = (HV *) SvRV(*svp); + + values = (char **) palloc(g_attr_num * sizeof(char *)); + + for (i = 0; i < g_attr_num; i++) + { + column_key = plperl_get_key(g_column_keys, i + 1); + elem = plperl_get_elem(row_hv, column_key); + if (elem) + values[i] = elem; + else + values[i] = NULL; + } + } else { + int i; + + values = (char **) palloc(g_attr_num * sizeof(char *)); + for (i = 0; i < g_attr_num; i++) + { + column_key = SPI_fname(tupdesc, i + 1); + elem = plperl_get_elem(ret_hv, column_key); + if (elem) + values[i] = elem; + else + values[i] = NULL; + } + } + tuple = BuildTupleFromCStrings(attinmeta, values); + result = TupleGetDatum(slot, tuple); + SRF_RETURN_NEXT(funcctx, result); + } + else + { + SvREFCNT_dec(perlret); + SRF_RETURN_DONE(funcctx); + } + } + else if (! fcinfo->isnull) + { retval = FunctionCall3(&prodesc->result_in_func, PointerGetDatum(SvPV(perlret, PL_na)), ObjectIdGetDatum(prodesc->result_typioparam), @@ -511,10 +1006,101 @@ plperl_func_handler(PG_FUNCTION_ARGS) } SvREFCNT_dec(perlret); - return retval; } +/********************************************************************** + * plperl_trigger_handler() - Handler for trigger function calls + **********************************************************************/ +static Datum +plperl_trigger_handler(PG_FUNCTION_ARGS) +{ + plperl_proc_desc *prodesc; + SV *perlret; + Datum retval; + char *tmp; + SV *svTD; + HV *hvTD; + + /* Find or compile the function */ + prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, true); + + /************************************************************ + * Call the Perl function + ************************************************************/ + /* + * call perl trigger function and build TD hash + */ + svTD = plperl_trigger_build_args(fcinfo); + perlret = plperl_call_perl_trigger_func(prodesc, fcinfo, svTD); + + hvTD = (HV *) SvRV(svTD); /* convert SV TD structure to Perl Hash + * structure */ + + tmp = SvPV(perlret, PL_na); + + /************************************************************ + * Disconnect from SPI manager and then create the return + * values datum (if the input function does a palloc for it + * this must not be allocated in the SPI memory context + * because SPI_finish would free it). + ************************************************************/ + if (SPI_finish() != SPI_OK_FINISH) + elog(ERROR, "plperl: SPI_finish() failed"); + + if (!(perlret && SvOK(perlret))) + { + TriggerData *trigdata = ((TriggerData *) fcinfo->context); + + if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event)) + retval = (Datum) trigdata->tg_trigtuple; + else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event)) + retval = (Datum) trigdata->tg_newtuple; + else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event)) + retval = (Datum) trigdata->tg_trigtuple; + } + else + { + if (!fcinfo->isnull) + { + + HeapTuple trv; + + if (strcasecmp(tmp, "SKIP") == 0) + trv = NULL; + else if (strcasecmp(tmp, "MODIFY") == 0) + { + TriggerData *trigdata = (TriggerData *) fcinfo->context; + + if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event)) + trv = plperl_modify_tuple(hvTD, trigdata, trigdata->tg_trigtuple, fcinfo->flinfo->fn_oid); + else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event)) + trv = plperl_modify_tuple(hvTD, trigdata, trigdata->tg_newtuple, fcinfo->flinfo->fn_oid); + else + { + trv = NULL; + elog(WARNING, "plperl: Ignoring modified tuple in DELETE trigger"); + } + } + else if (strcasecmp(tmp, "OK")) + { + trv = NULL; + elog(ERROR, "plperl: Expected return to be undef, 'SKIP' or 'MODIFY'"); + } + else + { + trv = NULL; + elog(ERROR, "plperl: Expected return to be undef, 'SKIP' or 'MODIFY'"); + } + retval = PointerGetDatum(trv); + } + } + + SvREFCNT_dec(perlret); + + fcinfo->isnull = false; + return retval; +} /********************************************************************** * compile_plperl_function - compile (or hopefully just look up) function @@ -544,6 +1130,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger) sprintf(internal_proname, "__PLPerl_proc_%u", fn_oid); else sprintf(internal_proname, "__PLPerl_proc_%u_trigger", fn_oid); + proname_len = strlen(internal_proname); /************************************************************ @@ -637,10 +1224,11 @@ compile_plperl_function(Oid fn_oid, bool is_trigger) } typeStruct = (Form_pg_type) GETSTRUCT(typeTup); - /* Disallow pseudotype result, except VOID */ + /* Disallow pseudotype result, except VOID or RECORD */ if (typeStruct->typtype == 'p') { - if (procStruct->prorettype == VOIDOID) + if (procStruct->prorettype == VOIDOID || + procStruct->prorettype == RECORDOID) /* okay */ ; else if (procStruct->prorettype == TRIGGEROID) { @@ -661,13 +1249,10 @@ compile_plperl_function(Oid fn_oid, bool is_trigger) } } - if (typeStruct->typtype == 'c') + if (typeStruct->typtype == 'c' || procStruct->prorettype == RECORDOID) { - free(prodesc->proname); - free(prodesc); - ereport(ERROR, - (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), - errmsg("plperl functions cannot return tuples yet"))); + prodesc->fn_retistuple = true; + prodesc->ret_oid = typeStruct->typrelid; } perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func)); |