Following up a previous thought I had, yesterday I realised how to return arays nicely without having to make the plperl programmer aware of anything. The attached patch allows plperl to return an arrayref where the function returns an array type. It silently calls a perl function to stringify the array before passing it to the pg array parser. Non-array returns are handled as before (i.e. passed through this process) so it is backwards compatible. I will presently submit regression tests and docs.

example:

andrew=# create or replace function blah() returns text[][] language plperl as $$ return [['a"b','c,d'],['e\\f','g']]; $$;
CREATE FUNCTION
andrew=# select blah();
blah -----------------------------
{{"a\"b","c,d"},{"e\\f",g}}


This would complete half of the TODO item:

 . Pass arrays natively instead of as text between plperl and postgres

(The other half is translating pg array arguments to perl arrays - that will have to wait for 8.1).

Some of this patch is adapted from a previously submitted patch from Sergej Sergeev. Both he and Abhijit Menon-Sen have looked it over briefly and tentatively said it looks ok.

cheers

andrew
Index: plperl.c
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/plperl.c,v
retrieving revision 1.78
diff -c -r1.78 plperl.c
*** plperl.c	22 Jun 2005 16:45:51 -0000	1.78
--- plperl.c	1 Jul 2005 16:13:06 -0000
***************
*** 81,86 ****
--- 81,87 ----
  	bool		lanpltrusted;
  	bool		fn_retistuple;	/* true, if function returns tuple */
  	bool		fn_retisset;	/* true, if function returns set */
+ 	bool        fn_retisarray;  /* true if function returns array */
  	Oid			result_oid;		/* Oid of result type */
  	FmgrInfo	result_in_func;	/* I/O function and arg for result type */
  	Oid			result_typioparam;
***************
*** 191,198 ****
--- 192,220 ----
  		/* all one string follows (no commas please) */
  		"SPI::bootstrap(); use vars qw(%_SHARED);"
  		"sub ::mkunsafefunc {return eval(qq[ sub { $_[0] $_[1] } ]); }"
+ 		"sub ::_plperl_to_pg_array"
+ 		"{"
+ 		"  my $arg = shift; ref $arg eq 'ARRAY' || return $arg; "
+ 		"  my $res = ''; my $first = 1; "
+ 		"  foreach my $elem (@$arg) "
+ 		"  { "
+ 		"    $res .= ', ' unless $first; $first = undef; "
+ 		"    if (ref $elem) "
+ 		"    { "
+ 		"      $res .= _plperl_to_pg_array($elem); "
+ 		"    } "
+ 		"    else "
+ 		"    { "
+ 		"      my $str = qq($elem); "
+ 		"      $str =~ s/([\"\\\\])/\\\\$1/g; "
+ 		"      $res .= qq(\"$str\"); "
+ 		"    } "
+ 		"  } "
+ 		"  return qq({$res}); "
+ 		"} "
  	};
  
+ 
  	static char	   *strict_embedding[3] = {
  		"", "-e",
  		/* all one string follows (no commas please) */
***************
*** 225,230 ****
--- 247,253 ----
  	"$PLContainer->permit_only(':default');"
  	"$PLContainer->permit(qw[:base_math !:base_io sort time]);"
  	"$PLContainer->share(qw[&elog &spi_exec_query &return_next "
+ 	"&_plperl_to_pg_array "
  	"&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED ]);"
  			   ;
  
***************
*** 325,330 ****
--- 348,381 ----
  	return tup;
  }
  
+ /*
+  * convert perl array to postgres string representation
+  */
+ static SV*
+ plperl_convert_to_pg_array(SV *src)
+ {
+     SV* rv;
+ 	int count;
+ 	dSP ;
+ 
+ 	PUSHMARK(SP) ;
+ 	XPUSHs(src);
+ 	PUTBACK ;
+ 
+ 	count = call_pv("_plperl_to_pg_array", G_SCALAR);
+ 
+ 	SPAGAIN ;
+ 
+ 	if (count != 1)
+ 		croak("Big trouble\n") ;
+ 
+ 	rv = POPs;
+ 			   
+ 	PUTBACK ;
+ 
+     return rv;
+ }
+ 
  
  /* Set up the arguments for a trigger call. */
  
***************
*** 863,869 ****
  
  	rsi = (ReturnSetInfo *)fcinfo->resultinfo;
  
! 	if (prodesc->fn_retisset) {
  		if (!rsi || !IsA(rsi, ReturnSetInfo) ||
  			(rsi->allowedModes & SFRM_Materialize) == 0 ||
  			rsi->expectedDesc == NULL)
--- 914,921 ----
  
  	rsi = (ReturnSetInfo *)fcinfo->resultinfo;
  
! 	if (prodesc->fn_retisset) 
! 	{
  		if (!rsi || !IsA(rsi, ReturnSetInfo) ||
  			(rsi->allowedModes & SFRM_Materialize) == 0 ||
  			rsi->expectedDesc == NULL)
***************
*** 884,890 ****
  			int i = 0;
  			SV **svp = 0;
  			AV *rav = (AV *)SvRV(perlret);
! 			while ((svp = av_fetch(rav, i, FALSE)) != NULL) {
  				plperl_return_next(*svp);
  				i++;
  			}
--- 936,943 ----
  			int i = 0;
  			SV **svp = 0;
  			AV *rav = (AV *)SvRV(perlret);
! 			while ((svp = av_fetch(rav, i, FALSE)) != NULL) 
! 			{
  				plperl_return_next(*svp);
  				i++;
  			}
***************
*** 898,904 ****
  		}
  
  		rsi->returnMode = SFRM_Materialize;
! 		if (prodesc->tuple_store) {
  			rsi->setResult = prodesc->tuple_store;
  			rsi->setDesc = prodesc->tuple_desc;
  		}
--- 951,958 ----
  		}
  
  		rsi->returnMode = SFRM_Materialize;
! 		if (prodesc->tuple_store) 
! 		{
  			rsi->setResult = prodesc->tuple_store;
  			rsi->setDesc = prodesc->tuple_desc;
  		}
***************
*** 943,950 ****
  	}
  	else
  	{
! 		/* Return a perl string converted to a Datum */
! 		char *val = SvPV(perlret, PL_na);
  		retval = FunctionCall3(&prodesc->result_in_func,
  							   CStringGetDatum(val),
  							   ObjectIdGetDatum(prodesc->result_typioparam),
--- 997,1016 ----
  	}
  	else
  	{
!         /* Return a perl string converted to a Datum */
!         char *val;
!         SV* array_ret;
!  
! 
!         if (prodesc->fn_retisarray && SvTYPE(SvRV(perlret)) == SVt_PVAV)
!         {
!             array_ret = plperl_convert_to_pg_array(perlret);
!             SvREFCNT_dec(perlret);
!             perlret = array_ret;
!         }
! 
! 		val = SvPV(perlret, PL_na);
! 
  		retval = FunctionCall3(&prodesc->result_in_func,
  							   CStringGetDatum(val),
  							   ObjectIdGetDatum(prodesc->result_typioparam),
***************
*** 1202,1207 ****
--- 1268,1276 ----
  			prodesc->fn_retistuple = (typeStruct->typtype == 'c' ||
  									  procStruct->prorettype == RECORDOID);
  
+ 			prodesc->fn_retisarray = 
+ 				(typeStruct->typlen == -1 && typeStruct->typelem) ;
+ 
  			perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
  			prodesc->result_typioparam = getTypeIOParam(typeTup);
  
---------------------------(end of broadcast)---------------------------
TIP 9: In versions below 8.0, the planner will ignore your desire to
       choose an index scan if your joining column's datatypes do not
       match

Reply via email to