Make plperl work with OUT parameters.

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index f9adb68..9b0cfe3 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.70 2005/03/29 00:17:20 tgl Exp $
+ *       $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.71 2005/04/01 19:34:06 tgl Exp $
  *
  **********************************************************************/
 
@@ -409,21 +409,16 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo)
  * NB: copy the result if needed for any great length of time
  */
 static TupleDesc
-get_function_tupdesc(Oid result_type, ReturnSetInfo *rsinfo)
+get_function_tupdesc(FunctionCallInfo fcinfo)
 {
-       if (result_type == RECORDOID)
-       {
-               /* We must get the information from call context */
-               if (!rsinfo || !IsA(rsinfo, ReturnSetInfo) ||
-                       rsinfo->expectedDesc == NULL)
-                       ereport(ERROR,
-                                       (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
-                                        errmsg("function returning record called in context "
-                                                       "that cannot accept type record")));
-               return rsinfo->expectedDesc;
-       }
-       else                            /* ordinary composite type */
-               return lookup_rowtype_tupdesc(result_type, -1);
+       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;
 }
 
 /**********************************************************************
@@ -897,8 +892,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 
                        /* Cache a copy of the result's tupdesc and attinmeta */
                        oldcontext = MemoryContextSwitchTo(funcctx->multi_call_memory_ctx);
-                       tupdesc = get_function_tupdesc(prodesc->result_oid,
-                                                                               (ReturnSetInfo *) fcinfo->resultinfo);
+                       tupdesc = get_function_tupdesc(fcinfo);
                        tupdesc = CreateTupleDescCopy(tupdesc);
                        funcctx->attinmeta = TupleDescGetAttInMetadata(tupdesc);
                        MemoryContextSwitchTo(oldcontext);
@@ -1003,8 +997,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
                /*
                 * XXX should cache the attinmeta data instead of recomputing
                 */
-               td = get_function_tupdesc(prodesc->result_oid,
-                                                                 (ReturnSetInfo *) fcinfo->resultinfo);
+               td = get_function_tupdesc(fcinfo);
                /* td = CreateTupleDescCopy(td); */
                attinmeta = TupleDescGetAttInMetadata(td);
 

diff --git a/src/pl/plperl/test/test.expected b/src/pl/plperl/test/test.expected
index 38782e8..340ed63 100644 (file)
--- a/src/pl/plperl/test/test.expected
+++ b/src/pl/plperl/test/test.expected
@@ -222,6 +222,61 @@ SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
   3 | Hello | PL/Perl
 (3 rows)
 
+CREATE OR REPLACE FUNCTION
+perl_out_params(f1 out integer, f2 out text, f3 out text) AS $$
+    return {f2 => 'hello', f1 => 1, f3 => 'world'};
+$$ LANGUAGE plperl;
+SELECT perl_out_params();
+ perl_out_params 
+-----------------
+ (1,hello,world)
+(1 row)
+
+SELECT * FROM perl_out_params();
+ f1 |  f2   |  f3   
+----+-------+-------
+  1 | hello | world
+(1 row)
+
+SELECT (perl_out_params()).f2;
+  f2   
+-------
+ hello
+(1 row)
+
+CREATE OR REPLACE FUNCTION
+perl_out_params_set(out f1 integer, out f2 text, out f3 text)
+RETURNS SETOF record AS $$
+    return [
+        { f1 => 1, f2 => 'Hello', f3 =>  'World' },
+        { f1 => 2, f2 => 'Hello', f3 =>  'PostgreSQL' },
+        { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
+    ];
+$$  LANGUAGE plperl;
+SELECT perl_out_params_set();
+ perl_out_params_set  
+----------------------
+ (1,Hello,World)
+ (2,Hello,PostgreSQL)
+ (3,Hello,PL/Perl)
+(3 rows)
+
+SELECT * FROM perl_out_params_set();
+ f1 |  f2   |     f3     
+----+-------+------------
+  1 | Hello | World
+  2 | Hello | PostgreSQL
+  3 | Hello | PL/Perl
+(3 rows)
+
+SELECT (perl_out_params_set()).f3;
+     f3     
+------------
+ World
+ PostgreSQL
+ PL/Perl
+(3 rows)
+
 CREATE TYPE footype AS (x INTEGER, y INTEGER);
 CREATE OR REPLACE FUNCTION foo_good() RETURNS SETOF footype AS $$
 return [

diff --git a/src/pl/plperl/test/test_queries.sql b/src/pl/plperl/test/test_queries.sql
index 37a0ce9..0cfcd17 100644 (file)
--- a/src/pl/plperl/test/test_queries.sql
+++ b/src/pl/plperl/test/test_queries.sql
@@ -135,6 +135,29 @@ SELECT perl_record_set();
 SELECT * FROM perl_record_set();
 SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
 
+CREATE OR REPLACE FUNCTION
+perl_out_params(f1 out integer, f2 out text, f3 out text) AS $$
+    return {f2 => 'hello', f1 => 1, f3 => 'world'};
+$$ LANGUAGE plperl;
+
+SELECT perl_out_params();
+SELECT * FROM perl_out_params();
+SELECT (perl_out_params()).f2;
+
+CREATE OR REPLACE FUNCTION
+perl_out_params_set(out f1 integer, out f2 text, out f3 text)
+RETURNS SETOF record AS $$
+    return [
+        { f1 => 1, f2 => 'Hello', f3 =>  'World' },
+        { f1 => 2, f2 => 'Hello', f3 =>  'PostgreSQL' },
+        { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
+    ];
+$$  LANGUAGE plperl;
+
+SELECT perl_out_params_set();
+SELECT * FROM perl_out_params_set();
+SELECT (perl_out_params_set()).f3;
+
 --
 -- Check behavior with erroneous return values
 --