Andrew Dunstan wrote:
Andrew Dunstan wrote:
Looking further ... we already do this implicitly for prodesc in the
call handler - we would just need to do the same thing for per-call
structures and divorce them from prodesc, which can be repeated on
the implicit stack.
I'll work on that - changes should be quite small.
Attached is a patch that fixes (I hope) both a recently introduced
problem with recursion and a problem with array returns that became
evident as a result of not throwing away non-fatal warnings (thanks to
David Fetter for noticing this). Regression test updates to include
both cases are included in the patch.
I will start looking at putting the procedure descriptors in a dynahash.
and here's the patch this time.
cheers
andrew
Index: plperl.c
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/plperl.c,v
retrieving revision 1.84
diff -c -r1.84 plperl.c
*** plperl.c 10 Jul 2005 16:13:13 -0000 1.84
--- plperl.c 11 Jul 2005 13:08:26 -0000
***************
*** 90,98 ****
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;
--- 90,95 ----
***************
*** 106,113 ****
static bool plperl_use_strict = false;
! /* this is saved and restored by plperl_call_handler */
static plperl_proc_desc *plperl_current_prodesc = NULL;
/**********************************************************************
* Forward declarations
--- 103,113 ----
static bool plperl_use_strict = false;
! /* 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,586 ****
--- 577,592 ----
{
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,602 ****
--- 598,614 ----
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,902 ****
--- 909,915 ----
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,912 ****
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;
perlret = plperl_call_perl_func(prodesc, fcinfo);
--- 917,925 ----
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);
plperl_current_prodesc = prodesc;
! plperl_current_caller_info = fcinfo;
! plperl_current_tuple_store = 0;
! plperl_current_tuple_desc = 0;
perlret = plperl_call_perl_func(prodesc, fcinfo);
***************
*** 958,967 ****
}
rsi->returnMode = SFRM_Materialize;
! if (prodesc->tuple_store)
{
! rsi->setResult = prodesc->tuple_store;
! rsi->setDesc = prodesc->tuple_desc;
}
retval = (Datum)0;
}
--- 971,980 ----
}
rsi->returnMode = SFRM_Materialize;
! if (plperl_current_tuple_store)
{
! rsi->setResult = plperl_current_tuple_store;
! rsi->setDesc = plperl_current_tuple_desc;
}
retval = (Datum)0;
}
***************
*** 1006,1012 ****
{
/* Return a perl string converted to a Datum */
char *val;
- SV* array_ret;
if (prodesc->fn_retisarray && SvTYPE(SvRV(perlret)) == SVt_PVAV)
--- 1019,1024 ----
***************
*** 1024,1030 ****
Int32GetDatum(-1));
}
! SvREFCNT_dec(perlret);
return retval;
}
--- 1036,1044 ----
Int32GetDatum(-1));
}
! if (array_ret == NULL)
! SvREFCNT_dec(perlret);
!
return retval;
}
***************
*** 1526,1532 ****
plperl_return_next(SV *sv)
{
plperl_proc_desc *prodesc = plperl_current_prodesc;
! FunctionCallInfo fcinfo = prodesc->caller_info;
ReturnSetInfo *rsi = (ReturnSetInfo *)fcinfo->resultinfo;
MemoryContext cxt;
HeapTuple tuple;
--- 1540,1546 ----
plperl_return_next(SV *sv)
{
plperl_proc_desc *prodesc = plperl_current_prodesc;
! FunctionCallInfo fcinfo = plperl_current_caller_info;
ReturnSetInfo *rsi = (ReturnSetInfo *)fcinfo->resultinfo;
MemoryContext cxt;
HeapTuple tuple;
***************
*** 1553,1560 ****
cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory);
! if (!prodesc->tuple_store)
! prodesc->tuple_store = tuplestore_begin_heap(true, false, work_mem);
if (prodesc->fn_retistuple)
{
--- 1567,1575 ----
cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory);
! if (!plperl_current_tuple_store)
! plperl_current_tuple_store =
! tuplestore_begin_heap(true, false, work_mem);
if (prodesc->fn_retistuple)
{
***************
*** 1590,1599 ****
tuple = heap_form_tuple(tupdesc, &ret, &isNull);
}
! if (!prodesc->tuple_desc)
! prodesc->tuple_desc = tupdesc;
! tuplestore_puttuple(prodesc->tuple_store, tuple);
heap_freetuple(tuple);
MemoryContextSwitchTo(cxt);
}
--- 1605,1614 ----
tuple = heap_form_tuple(tupdesc, &ret, &isNull);
}
! if (!plperl_current_tuple_desc)
! plperl_current_tuple_desc = tupdesc;
! tuplestore_puttuple(plperl_current_tuple_store, tuple);
heap_freetuple(tuple);
MemoryContextSwitchTo(cxt);
}
Index: expected/plperl.out
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/expected/plperl.out,v
retrieving revision 1.3
diff -c -r1.3 plperl.out
*** expected/plperl.out 10 Jul 2005 15:19:43 -0000 1.3
--- expected/plperl.out 11 Jul 2005 13:08:26 -0000
***************
*** 367,369 ****
--- 367,422 ----
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)
+
Index: sql/plperl.sql
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/sql/plperl.sql,v
retrieving revision 1.3
diff -c -r1.3 plperl.sql
*** sql/plperl.sql 10 Jul 2005 15:19:43 -0000 1.3
--- sql/plperl.sql 11 Jul 2005 13:08:26 -0000
***************
*** 260,262 ****
--- 260,303 ----
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();
---------------------------(end of broadcast)---------------------------
TIP 3: Have you checked our extensive FAQ?
http://www.postgresql.org/docs/faq
