*** ./plperl.c.orig	2006-07-29 21:07:09.000000000 +0200
--- ./plperl.c	2006-08-01 14:51:09.000000000 +0200
***************
*** 117,122 ****
--- 117,124 ----
  static void plperl_init_shared_libs(pTHX);
  static HV  *plperl_spi_execute_fetch_result(SPITupleTable *, int, int);
  
+ static SV  *plperl_convert_to_pg_array(SV *src);
+ 
  /*
   * This routine is a crock, and so is everyplace that calls it.  The problem
   * is that the cached form of plperl functions/queries is allocated permanently
***************
*** 412,418 ****
  					(errcode(ERRCODE_UNDEFINED_COLUMN),
  					 errmsg("Perl hash contains nonexistent column \"%s\"",
  							key)));
! 		if (SvOK(val) && SvTYPE(val) != SVt_NULL)
  			values[attn - 1] = SvPV(val, PL_na);
  	}
  	hv_iterinit(perlhash);
--- 414,425 ----
  					(errcode(ERRCODE_UNDEFINED_COLUMN),
  					 errmsg("Perl hash contains nonexistent column \"%s\"",
  							key)));
! 
! 		/* if value is ref on array do to pg string array conversion */
! 		if (SvTYPE(val) == SVt_RV &&
! 			SvTYPE(SvRV(val)) == SVt_PVAV)
! 			values[attn - 1] = SvPV(plperl_convert_to_pg_array(val), PL_na);
! 		else if (SvOK(val) && SvTYPE(val) != SVt_NULL)
  			values[attn - 1] = SvPV(val, PL_na);
  	}
  	hv_iterinit(perlhash);
***************
*** 1767,1773 ****
  
  		if (SvOK(sv) && SvTYPE(sv) != SVt_NULL)
  		{
! 			char	   *val = SvPV(sv, PL_na);
  
  			ret = InputFunctionCall(&prodesc->result_in_func, val,
  									prodesc->result_typioparam, -1);
--- 1774,1789 ----
  
  		if (SvOK(sv) && SvTYPE(sv) != SVt_NULL)
  		{
! 			char	   *val;
! 			SV         *array_ret;
! 
! 			if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV )
! 			{
! 				array_ret = plperl_convert_to_pg_array(sv);
! 				sv = array_ret;
! 			}
! 
! 			val = SvPV(sv, PL_na);
  
  			ret = InputFunctionCall(&prodesc->result_in_func, val,
  									prodesc->result_typioparam, -1);
*** ./sql/plperl.sql.orig	2006-07-30 22:52:04.000000000 +0200
--- ./sql/plperl.sql	2006-08-01 15:02:53.000000000 +0200
***************
*** 337,339 ****
--- 337,374 ----
  $$ LANGUAGE plperl;
  SELECT * from perl_spi_prepared_set(1,2);
  
+ --- 
+ --- Some OUT and OUT array tests
+ ---
+ 
+ CREATE OR REPLACE FUNCTION test_out_params(OUT a varchar, OUT b varchar) AS $$
+   return { a=> 'ahoj', b=>'svete'};
+ $$ LANGUAGE plperl;
+ SELECT '01' AS i, * FROM test_out_params();
+ 
+ CREATE OR REPLACE FUNCTION test_out_params_array(OUT a varchar[], OUT b varchar[]) AS $$
+   return { a=> ['ahoj'], b=>['svete']};
+ $$ LANGUAGE plperl;
+ SELECT '02' AS i, * FROM test_out_params_array();
+ 
+ CREATE OR REPLACE FUNCTION test_out_params_set(OUT a varchar, out b varchar) RETURNS SETOF RECORD AS $$
+   return_next { a=> 'ahoj', b=>'svete'};
+   return_next { a=> 'ahoj', b=>'svete'};
+   return_next { a=> 'ahoj', b=>'svete'};
+ $$ LANGUAGE plperl;
+ SELECT '03' AS I,* FROM test_out_params_set();
+ 
+ CREATE OR REPLACE FUNCTION test_out_params_set_array(OUT a varchar[], out b varchar[]) RETURNS SETOF RECORD AS $$
+   return_next { a=> ['ahoj'], b=>['velky','svete']};
+   return_next { a=> ['ahoj'], b=>['velky','svete']};
+   return_next { a=> ['ahoj'], b=>['velky','svete']};
+ $$ LANGUAGE plperl;
+ SELECT '04' AS I,* FROM test_out_params_set_array();
+ 
+ 
+ DROP FUNCTION test_out_params();
+ DROP FUNCTION test_out_params_set();
+ DROP FUNCTION test_out_params_array();
+ DROP FUNCTION test_out_params_set_array();
+ 
+ 

