Fix plperl to do recursion safely, and fix a problem with array results.

Add suitable regression tests.  Andrew Dunstan

diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out
index 29d24d95a2e38544240336102471357e0d486131..2ba89ea2c3eae3496a190818ee2d603f56729371 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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();