*** ./plperl.c.orig	2006-08-01 15:20:16.000000000 +0200
--- ./plperl.c	2006-08-01 15:45:50.000000000 +0200
***************
*** 52,57 ****
--- 52,58 ----
  	FmgrInfo	result_in_func; /* I/O function and arg for result type */
  	Oid			result_typioparam;
  	int			nargs;
+ 	int         num_out_args;   /* number of out arguments */
  	FmgrInfo	arg_out_func[FUNC_MAX_ARGS];
  	bool		arg_is_rowtype[FUNC_MAX_ARGS];
  	SV		   *reference;
***************
*** 118,123 ****
--- 119,125 ----
  static HV  *plperl_spi_execute_fetch_result(SPITupleTable *, int, int);
  
  static SV  *plperl_convert_to_pg_array(SV *src);
+ static SV *plperl_transform_result(plperl_proc_desc *prodesc, SV *result);
  
  /*
   * This routine is a crock, and so is everyplace that calls it.  The problem
***************
*** 698,709 ****
  	HeapTuple	tuple;
  	Form_pg_proc proc;
  	char		functyptype;
- 	int			numargs;
- 	Oid		   *argtypes;
- 	char	  **argnames;
- 	char	   *argmodes;
  	bool		istrigger = false;
- 	int			i;
  
  	/* Get the new function's pg_proc entry */
  	tuple = SearchSysCache(PROCOID,
--- 700,706 ----
***************
*** 731,748 ****
  							format_type_be(proc->prorettype))));
  	}
  
- 	/* Disallow pseudotypes in arguments (either IN or OUT) */
- 	numargs = get_func_arg_info(tuple,
- 								&argtypes, &argnames, &argmodes);
- 	for (i = 0; i < numargs; i++)
- 	{
- 		if (get_typtype(argtypes[i]) == 'p')
- 			ereport(ERROR,
- 					(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
- 					 errmsg("plperl functions cannot take type %s",
- 							format_type_be(argtypes[i]))));
- 	}
- 
  	ReleaseSysCache(tuple);
  
  	/* Postpone body checks if !check_function_bodies */
--- 728,733 ----
***************
*** 1149,1154 ****
--- 1134,1141 ----
  		/* Return a perl string converted to a Datum */
  		char	   *val;
  
+ 		perlret = plperl_transform_result(prodesc, perlret);
+ 
  		if (prodesc->fn_retisarray && SvROK(perlret) &&
  			SvTYPE(SvRV(perlret)) == SVt_PVAV)
  		{
***************
*** 1277,1283 ****
  	char		internal_proname[64];
  	int			proname_len;
  	plperl_proc_desc *prodesc = NULL;
- 	int			i;
  	SV		  **svp;
  
  	/* We'll need the pg_proc tuple in any case... */
--- 1264,1269 ----
***************
*** 1340,1345 ****
--- 1326,1337 ----
  		Datum		prosrcdatum;
  		bool		isnull;
  		char	   *proc_source;
+ 		int			i;
+ 		int			numargs;
+ 		Oid		   *argtypes;
+ 		char	  **argnames;
+ 		char	   *argmodes;
+ 
  
  		/************************************************************
  		 * Allocate a new procedure description block
***************
*** 1358,1363 ****
--- 1350,1374 ----
  		prodesc->fn_readonly =
  			(procStruct->provolatile != PROVOLATILE_VOLATILE);
  
+ 
+ 		/* Disallow pseudotypes in arguments (either IN or OUT) */
+ 		/* Count number of out arguments */
+ 		numargs = get_func_arg_info(procTup,
+ 									&argtypes, &argnames, &argmodes);
+ 		for (i = 0; i < numargs; i++)
+ 		{
+ 			if (get_typtype(argtypes[i]) == 'p')
+ 				ereport(ERROR,
+ 						(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+ 						 errmsg("plperl functions cannot take type %s",
+ 								format_type_be(argtypes[i]))));
+ 
+ 		    if (argmodes && argmodes[i] == PROARGMODE_OUT)
+ 				prodesc->num_out_args++;
+ 
+ 		}
+ 
+ 
  		/************************************************************
  		 * Lookup the pg_language tuple by Oid
  		 ************************************************************/
***************
*** 1697,1702 ****
--- 1708,1715 ----
  	fcinfo = current_call_data->fcinfo;
  	rsi = (ReturnSetInfo *) fcinfo->resultinfo;
  
+ 	sv = plperl_transform_result(prodesc, sv);
+ 
  	if (!prodesc->fn_retisset)
  		ereport(ERROR,
  				(errcode(ERRCODE_SYNTAX_ERROR),
***************
*** 2398,2400 ****
--- 2411,2456 ----
  
  	SPI_freeplan( plan);
  }
+ 
+ /*
+  * If plerl result is hash and fce result is scalar, it's hash form of
+  * out argument. Then, transform it to scalar
+  */
+ 
+ static SV *
+ plperl_transform_result(plperl_proc_desc *prodesc, SV *result)
+ {
+ 	bool        exactly_one_field = false;
+ 	HV         *hvr;
+ 	SV		   *val;
+ 	char	   *key;
+ 	I32			klen;
+ 
+ 
+ 	if (prodesc->num_out_args == 1 && SvOK(result) 
+ 		&& SvTYPE(result) == SVt_RV && SvTYPE(SvRV(result)) == SVt_PVHV)
+ 	{
+ 		hvr = (HV *) SvRV(result);
+ 		hv_iterinit(hvr);
+ 
+ 		while ((val = hv_iternextsv(hvr, &key, &klen)))
+ 		{
+ 			if (exactly_one_field)
+ 				ereport(ERROR,
+ 						(errcode(ERRCODE_UNDEFINED_COLUMN),
+ 						 errmsg("Perl hash contains nonexistent column \"%s\"",
+ 								key)));
+ 			exactly_one_field = true;
+ 			result = val;
+ 		}
+ 
+ 		if (!exactly_one_field)
+ 			ereport(ERROR,
+ 					(errcode(ERRCODE_UNDEFINED_COLUMN),
+ 					 errmsg("Perl hash is empty")));
+ 			
+ 		hv_iterinit(hvr);
+ 	}	    
+ 
+ 	return result;
+ }
*** ./sql/plperl.sql.orig	2006-08-01 15:20:49.000000000 +0200
--- ./sql/plperl.sql	2006-08-01 16:13:34.000000000 +0200
***************
*** 371,374 ****
--- 371,423 ----
  DROP FUNCTION test_out_params_array();
  DROP FUNCTION test_out_params_set_array();
  
+ -- one out argument can be returned as scalar or hash
+ CREATE OR REPLACE FUNCTION test01(OUT a varchar) AS $$
+   return 'ahoj';
+ $$ LANGUAGE plperl ;
+ SELECT '01' AS i,* FROM test01();
+ 
+ CREATE OR REPLACE FUNCTION test02(OUT a varchar[]) AS $$
+   return {a=>['ahoj']};
+ $$ LANGUAGE plperl;
+ SELECT '02' AS i,a[1] FROM test02();
+ 
+ CREATE OR REPLACE FUNCTION test03(OUT a varchar[]) RETURNS SETOF varchar[] AS $$
+   return_next { a=> ['ahoj']};
+   return_next { a=> ['ahoj']};
+   return_next { a=> ['ahoj']};
+ $$ LANGUAGE plperl;
+ SELECT '03' AS i,* FROM test03();
+ 
+ CREATE OR REPLACE FUNCTION test04() RETURNS SETOF VARCHAR[] AS $$
+   return_next ['ahoj'];
+   return_next ['ahoj'];
+ $$ LANGUAGE plperl;
+ SELECT '04' AS i,* FROM test04();
+ 
+ CREATE OR REPLACE FUNCTION test05(OUT a varchar) AS $$
+   return {a=>'ahoj'};
+ $$ LANGUAGE plperl;
+ SELECT '05' AS i,a FROM test05();
+ 
+ CREATE OR REPLACE FUNCTION test06(OUT a varchar) RETURNS SETOF varchar AS $$
+   return_next { a=> 'ahoj'};
+   return_next { a=> 'ahoj'};
+   return_next { a=> 'ahoj'};
+ $$ LANGUAGE plperl;
+ SELECT '06' AS i,* FROM test06();
+ 
+ CREATE OR REPLACE FUNCTION test07() RETURNS SETOF VARCHAR AS $$
+   return_next 'ahoj';
+   return_next 'ahoj';
+ $$ LANGUAGE plperl;
+ SELECT '07' AS i,* FROM test07();
+ 
+ DROP FUNCTION test01();
+ DROP FUNCTION test02();
+ DROP FUNCTION test03();
+ DROP FUNCTION test04();
+ DROP FUNCTION test05();
+ DROP FUNCTION test06();
+ DROP FUNCTION test07();