Index: plperl.c
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/plperl.c,v
retrieving revision 1.123.2.4
diff -c -r1.123.2.4 plperl.c
*** plperl.c	22 Jan 2008 20:19:53 -0000	1.123.2.4
--- plperl.c	15 Dec 2008 16:20:21 -0000
***************
*** 53,58 ****
--- 53,59 ----
  	Oid			result_typioparam;
  	int			nargs;
  	FmgrInfo	arg_out_func[FUNC_MAX_ARGS];
+ 	Oid		arg_out_oid[FUNC_MAX_ARGS];
  	bool		arg_is_rowtype[FUNC_MAX_ARGS];
  	SV		   *reference;
  } plperl_proc_desc;
***************
*** 142,147 ****
--- 143,149 ----
  
  static Datum plperl_trigger_handler(PG_FUNCTION_ARGS);
  static plperl_proc_desc *compile_plperl_function(Oid fn_oid, bool is_trigger);
+ static Datum plperl_convert_sv_to_datum(Oid rtypeid, FmgrInfo *in_func, Oid typioparam, SV *sv);
  
  static SV  *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc);
  static void plperl_init_shared_libs(pTHX);
***************
*** 561,566 ****
--- 563,592 ----
  	return res;
  }
  
+ /* Build a Datum form an SV handling the case of bytea */
+ 
+ static Datum
+ plperl_convert_sv_to_datum(Oid rtypeid, FmgrInfo *in_func, Oid typioparam, SV *sv)
+ {
+ 	char *val;
+ 	STRLEN len;
+ 	Datum retval;
+ 
+ 	val = SvPV(sv, len);
+ 	if(rtypeid == BYTEAOID)
+ 	{
+ 		StringInfoData buf;
+ 		initStringInfo(&buf);
+ 		appendBinaryStringInfo(&buf, val, len);
+ 		retval = ReceiveFunctionCall(in_func, &buf,
+ 							   typioparam, -1);
+ 	}
+ 	else {
+ 		retval = InputFunctionCall(in_func, val,
+ 							   typioparam, -1);
+ 	}
+ 	return retval;
+ }
  
  /* Build a tuple from a hash. */
  
***************
*** 767,773 ****
  	while ((val = hv_iternextsv(hvNew, &key, &klen)))
  	{
  		int			attn = SPI_fnumber(tupdesc, key);
- 		Oid			typinput;
  		Oid			typioparam;
  		int32		atttypmod;
  		FmgrInfo	finfo;
--- 793,798 ----
***************
*** 778,793 ****
  					 errmsg("Perl hash contains nonexistent column \"%s\"",
  							key)));
  		/* XXX would be better to cache these lookups */
! 		getTypeInputInfo(tupdesc->attrs[attn - 1]->atttypid,
! 						 &typinput, &typioparam);
! 		fmgr_info(typinput, &finfo);
  		atttypmod = tupdesc->attrs[attn - 1]->atttypmod;
  		if (SvOK(val))
  		{
! 			modvalues[slotsused] = InputFunctionCall(&finfo,
! 													 SvPV(val, PL_na),
  													 typioparam,
  													 atttypmod);
  			modnulls[slotsused] = ' ';
  		}
  		else
--- 803,845 ----
  					 errmsg("Perl hash contains nonexistent column \"%s\"",
  							key)));
  		/* XXX would be better to cache these lookups */
! 		if(tupdesc->attrs[attn - 1]->atttypid == BYTEAOID)
! 		{
! 			Oid	typreceive;
! 			getTypeBinaryInputInfo(tupdesc->attrs[attn - 1]->atttypid,
! 							 &typreceive, &typioparam);
! 			fmgr_info(typreceive, &finfo);
! 		}
! 		else
! 		{
! 			Oid	typinput;
! 			getTypeInputInfo(tupdesc->attrs[attn - 1]->atttypid,
! 							 &typinput, &typioparam);
! 			fmgr_info(typinput, &finfo);
! 		}
  		atttypmod = tupdesc->attrs[attn - 1]->atttypmod;
  		if (SvOK(val))
  		{
! 			STRLEN len;
! 			char *str;
! 			str = SvPV(val, len);
! 			if(tupdesc->attrs[attn - 1]->atttypid == BYTEAOID)
! 			{
! 				StringInfoData buf;
! 				initStringInfo(&buf);
! 				appendBinaryStringInfo(&buf, str, len);
! 				modvalues[slotsused] = ReceiveFunctionCall(&finfo,
! 													 &buf,
  													 typioparam,
  													 atttypmod);
+ 			}
+ 			else
+ 			{
+ 				modvalues[slotsused] = InputFunctionCall(&finfo,
+ 													 str,
+ 													 typioparam,
+ 													 atttypmod);
+ 			}
  			modnulls[slotsused] = ' ';
  		}
  		else
***************
*** 1077,1089 ****
  		}
  		else
  		{
! 			char	   *tmp;
! 
! 			tmp = OutputFunctionCall(&(desc->arg_out_func[i]),
! 									 fcinfo->arg[i]);
! 			sv = newSVstring(tmp);
! 			XPUSHs(sv_2mortal(sv));
! 			pfree(tmp);
  		}
  	}
  	PUTBACK;
--- 1129,1152 ----
  		}
  		else
  		{
! 			if(desc->arg_out_oid[i] == BYTEAOID)
! 			{
! 				bytea	*tmpbytes;
! 				tmpbytes = SendFunctionCall(&(desc->arg_out_func[i]),
! 									 	fcinfo->arg[i]);
! 				sv = newSVpvn(VARDATA(tmpbytes), VARSIZE(tmpbytes) - VARHDRSZ);
! 				XPUSHs(sv_2mortal(sv));
! 				pfree(tmpbytes);
! 			}
! 			else
! 			{
! 				char	   *tmp;
! 				tmp = OutputFunctionCall(&(desc->arg_out_func[i]),
! 									 	fcinfo->arg[i]);
! 				sv = newSVstring(tmp);
! 				XPUSHs(sv_2mortal(sv));
! 				pfree(tmp);
! 			}
  		}
  	}
  	PUTBACK;
***************
*** 1309,1315 ****
  	else
  	{
  		/* Return a perl string converted to a Datum */
! 		char	   *val;
  
  		if (prodesc->fn_retisarray && SvROK(perlret) &&
  			SvTYPE(SvRV(perlret)) == SVt_PVAV)
--- 1372,1378 ----
  	else
  	{
  		/* Return a perl string converted to a Datum */
! 		char		*val;
  
  		if (prodesc->fn_retisarray && SvROK(perlret) &&
  			SvTYPE(SvRV(perlret)) == SVt_PVAV)
***************
*** 1319,1328 ****
  			perlret = array_ret;
  		}
  
! 		val = SvPV(perlret, PL_na);
! 
! 		retval = InputFunctionCall(&prodesc->result_in_func, val,
! 								   prodesc->result_typioparam, -1);
  	}
  
  	if (array_ret == NULL)
--- 1382,1389 ----
  			perlret = array_ret;
  		}
  
! 		retval = plperl_convert_sv_to_datum(prodesc->result_oid, &prodesc->result_in_func,
! 							prodesc->result_typioparam, perlret);
  	}
  
  	if (array_ret == NULL)
***************
*** 1598,1604 ****
  			prodesc->fn_retisarray =
  				(typeStruct->typlen == -1 && typeStruct->typelem);
  
! 			perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
  			prodesc->result_typioparam = getTypeIOParam(typeTup);
  
  			ReleaseSysCache(typeTup);
--- 1659,1672 ----
  			prodesc->fn_retisarray =
  				(typeStruct->typlen == -1 && typeStruct->typelem);
  
! 			if(procStruct->prorettype == BYTEAOID)
! 			{
! 				perm_fmgr_info(typeStruct->typreceive, &(prodesc->result_in_func));
! 			}
! 			else
! 			{
! 				perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
! 			}
  			prodesc->result_typioparam = getTypeIOParam(typeTup);
  
  			ReleaseSysCache(typeTup);
***************
*** 1636,1648 ****
  						format_type_be(procStruct->proargtypes.values[i]))));
  				}
  
  				if (typeStruct->typtype == 'c')
  					prodesc->arg_is_rowtype[i] = true;
  				else
  				{
  					prodesc->arg_is_rowtype[i] = false;
! 					perm_fmgr_info(typeStruct->typoutput,
! 								   &(prodesc->arg_out_func[i]));
  				}
  
  				ReleaseSysCache(typeTup);
--- 1704,1727 ----
  						format_type_be(procStruct->proargtypes.values[i]))));
  				}
  
+ 				/* Learn the types for later (needed for binary vs. string) */
+ 				prodesc->arg_out_oid[i] = procStruct->proargtypes.values[i];
+ 
  				if (typeStruct->typtype == 'c')
  					prodesc->arg_is_rowtype[i] = true;
  				else
  				{
  					prodesc->arg_is_rowtype[i] = false;
! 					if(prodesc->arg_out_oid[i] == BYTEAOID)
! 					{
! 						perm_fmgr_info(typeStruct->typsend,
! 								   	&(prodesc->arg_out_func[i]));
! 					}
! 					else
! 					{
! 						perm_fmgr_info(typeStruct->typoutput,
! 								   	&(prodesc->arg_out_func[i]));
! 					}
  				}
  
  				ReleaseSysCache(typeTup);
***************
*** 1706,1713 ****
  		Datum		attr;
  		bool		isnull;
  		char	   *attname;
- 		char	   *outputstr;
- 		Oid			typoutput;
  		bool		typisvarlena;
  
  		if (tupdesc->attrs[i]->attisdropped)
--- 1785,1790 ----
***************
*** 1723,1737 ****
  			continue;
  		}
  
! 		/* XXX should have a way to cache these lookups */
! 		getTypeOutputInfo(tupdesc->attrs[i]->atttypid,
! 						  &typoutput, &typisvarlena);
  
! 		outputstr = OidOutputFunctionCall(typoutput, attr);
  
! 		hv_store_string(hv, attname, newSVstring(outputstr));
  
! 		pfree(outputstr);
  	}
  
  	return newRV_noinc((SV *) hv);
--- 1800,1829 ----
  			continue;
  		}
  
! 		if(tupdesc->attrs[i]->atttypid == BYTEAOID)
! 		{
! 			bytea		*outputbytes;
! 			Oid		typsend;
! 			getTypeBinaryOutputInfo(tupdesc->attrs[i]->atttypid,
! 							  &typsend, &typisvarlena);
! 			outputbytes = OidSendFunctionCall(typsend, attr);
! 			hv_store_string(hv, attname, newSVpvn(VARDATA(outputbytes), VARSIZE(outputbytes) - VARHDRSZ));
! 			pfree(outputbytes);
! 		}
! 		else
! 		{
! 			char		*outputstr;
! 			Oid		typoutput;
! 			/* XXX should have a way to cache these lookups */
! 			getTypeOutputInfo(tupdesc->attrs[i]->atttypid,
! 							  &typoutput, &typisvarlena);
  
! 			outputstr = OidOutputFunctionCall(typoutput, attr);
  
! 			hv_store_string(hv, attname, newSVstring(outputstr));
  
! 			pfree(outputstr);
! 		}
  	}
  
  	return newRV_noinc((SV *) hv);
***************
*** 1942,1951 ****
  
  		if (SvOK(sv))
  		{
! 			char	   *val = SvPV(sv, PL_na);
! 
! 			ret = InputFunctionCall(&prodesc->result_in_func, val,
! 									prodesc->result_typioparam, -1);
  			isNull = false;
  		}
  		else
--- 2034,2041 ----
  
  		if (SvOK(sv))
  		{
! 			ret = plperl_convert_sv_to_datum(prodesc->result_oid, &prodesc->result_in_func,
! 								prodesc->result_typioparam, sv);
  			isNull = false;
  		}
  		else
***************
*** 2179,2186 ****
  											  "plperl_spi_prepare");
  			typeTup = typenameType(NULL, makeTypeNameFromNameList(names));
  			qdesc->argtypes[i] = HeapTupleGetOid(typeTup);
! 			perm_fmgr_info(((Form_pg_type) GETSTRUCT(typeTup))->typinput,
! 						   &(qdesc->arginfuncs[i]));
  			qdesc->argtypioparams[i] = getTypeIOParam(typeTup);
  			ReleaseSysCache(typeTup);
  		}
--- 2269,2284 ----
  											  "plperl_spi_prepare");
  			typeTup = typenameType(NULL, makeTypeNameFromNameList(names));
  			qdesc->argtypes[i] = HeapTupleGetOid(typeTup);
! 			if(qdesc->argtypes[i] == BYTEAOID)
! 			{
! 				perm_fmgr_info(((Form_pg_type) GETSTRUCT(typeTup))->typreceive,
! 						   	&(qdesc->arginfuncs[i]));
! 			}
! 			else
! 			{
! 				perm_fmgr_info(((Form_pg_type) GETSTRUCT(typeTup))->typinput,
! 						   	&(qdesc->arginfuncs[i]));
! 			}
  			qdesc->argtypioparams[i] = getTypeIOParam(typeTup);
  			ReleaseSysCache(typeTup);
  		}
***************
*** 2335,2344 ****
  		{
  			if (SvOK(argv[i]))
  			{
! 				argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],
! 												 SvPV(argv[i], PL_na),
! 												 qdesc->argtypioparams[i],
! 												 -1);
  				nulls[i] = ' ';
  			}
  			else
--- 2433,2442 ----
  		{
  			if (SvOK(argv[i]))
  			{
! 				argvalues[i] = plperl_convert_sv_to_datum(qdesc->argtypes[i],
! 												&qdesc->arginfuncs[i],
! 												qdesc->argtypioparams[i],
! 												argv[i]);
  				nulls[i] = ' ';
  			}
  			else
***************
*** 2466,2475 ****
  		{
  			if (SvOK(argv[i]))
  			{
! 				argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],
! 												 SvPV(argv[i], PL_na),
! 												 qdesc->argtypioparams[i],
! 												 -1);
  				nulls[i] = ' ';
  			}
  			else
--- 2564,2573 ----
  		{
  			if (SvOK(argv[i]))
  			{
! 				argvalues[i] = plperl_convert_sv_to_datum(qdesc->argtypes[i],
! 												&qdesc->arginfuncs[i],
! 												qdesc->argtypioparams[i],
! 												argv[i]);
  				nulls[i] = ' ';
  			}
  			else