diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out index 29d24d95a2e38544240336102471357e0d486131..2ba89ea2c3eae3496a190818ee2d603f56729371 100644 --- a/src/pl/plperl/expected/plperl.out +++ b/src/pl/plperl/expected/plperl.out @@ -367,3 +367,56 @@ SELECT * from perl_spi_func(); 2 (2 rows) +--- +--- Test recursion via SPI +--- +CREATE OR REPLACE FUNCTION recurse(i int) RETURNS SETOF TEXT LANGUAGE plperl +AS $$ + + my $i = shift; + foreach my $x (1..$i) + { + return_next "hello $x"; + } + if ($i > 2) + { + my $z = $i-1; + my $cursor = spi_query("select * from recurse($z)"); + while (defined(my $row = spi_fetchrow($cursor))) + { + return_next "recurse $i: $row->{recurse}"; + } + } + return undef; + +$$; +SELECT * FROM recurse(2); + recurse +--------- + hello 1 + hello 2 +(2 rows) + +SELECT * FROM recurse(3); + recurse +-------------------- + hello 1 + hello 2 + hello 3 + recurse 3: hello 1 + recurse 3: hello 2 +(5 rows) + +--- +--- Test arrary return +--- +CREATE OR REPLACE FUNCTION array_of_text() RETURNS TEXT[][] +LANGUAGE plperl as $$ + return [['a"b','c,d'],['e\\f','g']]; +$$; +SELECT array_of_text(); + array_of_text +----------------------------- + {{"a\"b","c,d"},{"e\\f",g}} +(1 row) + diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index 957c7c67a2991dcef5d6ee11f77a2c633e76ba45..664688a32b92938c5e3255cb03e09218be78c50f 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.84 2005/07/10 16:13:13 momjian Exp $ + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.85 2005/07/12 01:16:21 tgl Exp $ * **********************************************************************/ @@ -90,9 +90,6 @@ typedef struct plperl_proc_desc FmgrInfo arg_out_func[FUNC_MAX_ARGS]; bool arg_is_rowtype[FUNC_MAX_ARGS]; SV *reference; - FunctionCallInfo caller_info; - Tuplestorestate *tuple_store; - TupleDesc tuple_desc; } plperl_proc_desc; @@ -106,8 +103,11 @@ static HV *plperl_proc_hash = NULL; static bool plperl_use_strict = false; -/* this is saved and restored by plperl_call_handler */ +/* these are saved and restored by plperl_call_handler */ static plperl_proc_desc *plperl_current_prodesc = NULL; +static FunctionCallInfo plperl_current_caller_info; +static Tuplestorestate *plperl_current_tuple_store; +static TupleDesc plperl_current_tuple_desc; /********************************************************************** * Forward declarations @@ -577,10 +577,16 @@ plperl_call_handler(PG_FUNCTION_ARGS) { Datum retval; plperl_proc_desc *save_prodesc; + FunctionCallInfo save_caller_info; + Tuplestorestate *save_tuple_store; + TupleDesc save_tuple_desc; plperl_init_all(); save_prodesc = plperl_current_prodesc; + save_caller_info = plperl_current_caller_info; + save_tuple_store = plperl_current_tuple_store; + save_tuple_desc = plperl_current_tuple_desc; PG_TRY(); { @@ -592,11 +598,17 @@ plperl_call_handler(PG_FUNCTION_ARGS) PG_CATCH(); { plperl_current_prodesc = save_prodesc; + plperl_current_caller_info = save_caller_info; + plperl_current_tuple_store = save_tuple_store; + plperl_current_tuple_desc = save_tuple_desc; PG_RE_THROW(); } PG_END_TRY(); plperl_current_prodesc = save_prodesc; + plperl_current_caller_info = save_caller_info; + plperl_current_tuple_store = save_tuple_store; + plperl_current_tuple_desc = save_tuple_desc; return retval; } @@ -897,6 +909,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) SV *perlret; Datum retval; ReturnSetInfo *rsi; + SV* array_ret = NULL; if (SPI_connect() != SPI_OK_CONNECT) elog(ERROR, "could not connect to SPI manager"); @@ -904,9 +917,9 @@ plperl_func_handler(PG_FUNCTION_ARGS) prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false); plperl_current_prodesc = prodesc; - prodesc->caller_info = fcinfo; - prodesc->tuple_store = 0; - prodesc->tuple_desc = 0; + plperl_current_caller_info = fcinfo; + plperl_current_tuple_store = 0; + plperl_current_tuple_desc = 0; perlret = plperl_call_perl_func(prodesc, fcinfo); @@ -958,10 +971,10 @@ plperl_func_handler(PG_FUNCTION_ARGS) } rsi->returnMode = SFRM_Materialize; - if (prodesc->tuple_store) + if (plperl_current_tuple_store) { - rsi->setResult = prodesc->tuple_store; - rsi->setDesc = prodesc->tuple_desc; + rsi->setResult = plperl_current_tuple_store; + rsi->setDesc = plperl_current_tuple_desc; } retval = (Datum)0; } @@ -1006,7 +1019,6 @@ plperl_func_handler(PG_FUNCTION_ARGS) { /* Return a perl string converted to a Datum */ char *val; - SV* array_ret; if (prodesc->fn_retisarray && SvTYPE(SvRV(perlret)) == SVt_PVAV) @@ -1024,7 +1036,9 @@ plperl_func_handler(PG_FUNCTION_ARGS) Int32GetDatum(-1)); } - SvREFCNT_dec(perlret); + if (array_ret == NULL) + SvREFCNT_dec(perlret); + return retval; } @@ -1526,7 +1540,7 @@ void plperl_return_next(SV *sv) { plperl_proc_desc *prodesc = plperl_current_prodesc; - FunctionCallInfo fcinfo = prodesc->caller_info; + FunctionCallInfo fcinfo = plperl_current_caller_info; ReturnSetInfo *rsi = (ReturnSetInfo *)fcinfo->resultinfo; MemoryContext cxt; HeapTuple tuple; @@ -1553,8 +1567,9 @@ plperl_return_next(SV *sv) cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory); - if (!prodesc->tuple_store) - prodesc->tuple_store = tuplestore_begin_heap(true, false, work_mem); + if (!plperl_current_tuple_store) + plperl_current_tuple_store = + tuplestore_begin_heap(true, false, work_mem); if (prodesc->fn_retistuple) { @@ -1590,10 +1605,10 @@ plperl_return_next(SV *sv) tuple = heap_form_tuple(tupdesc, &ret, &isNull); } - if (!prodesc->tuple_desc) - prodesc->tuple_desc = tupdesc; + if (!plperl_current_tuple_desc) + plperl_current_tuple_desc = tupdesc; - tuplestore_puttuple(prodesc->tuple_store, tuple); + tuplestore_puttuple(plperl_current_tuple_store, tuple); heap_freetuple(tuple); MemoryContextSwitchTo(cxt); } diff --git a/src/pl/plperl/sql/plperl.sql b/src/pl/plperl/sql/plperl.sql index 3cafb590c764fda28c7dbb5f1f1bd7e95a783745..c274659e7c4415c760e9eef434ddaa714920e642 100644 --- a/src/pl/plperl/sql/plperl.sql +++ b/src/pl/plperl/sql/plperl.sql @@ -260,3 +260,44 @@ while (defined ($y = spi_fetchrow($x))) { return; $$ LANGUAGE plperl; SELECT * from perl_spi_func(); + + +--- +--- Test recursion via SPI +--- + + +CREATE OR REPLACE FUNCTION recurse(i int) RETURNS SETOF TEXT LANGUAGE plperl +AS $$ + + my $i = shift; + foreach my $x (1..$i) + { + return_next "hello $x"; + } + if ($i > 2) + { + my $z = $i-1; + my $cursor = spi_query("select * from recurse($z)"); + while (defined(my $row = spi_fetchrow($cursor))) + { + return_next "recurse $i: $row->{recurse}"; + } + } + return undef; + +$$; + +SELECT * FROM recurse(2); +SELECT * FROM recurse(3); + + +--- +--- Test arrary return +--- +CREATE OR REPLACE FUNCTION array_of_text() RETURNS TEXT[][] +LANGUAGE plperl as $$ + return [['a"b','c,d'],['e\\f','g']]; +$$; + +SELECT array_of_text();