Fix plperl to discard cached function definition after CREATE OR

REPLACE FUNCTION.  Clean up typlen/typmod errors inherited from pltcl.

1 files changed, 167 insertions, 1624 deletions

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index b59486860e4..c1229a5305f 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -33,10 +33,11 @@
  *	  ENHANCEMENTS, OR MODIFICATIONS.
  *
  * IDENTIFICATION
- *	  $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.23 2001/10/06 23:21:44 tgl Exp $
+ *	  $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.24 2001/10/19 22:43:49 tgl Exp $
  *
  **********************************************************************/
 
+#include "postgres.h"
 
 /* system stuff */
 #include <stdio.h>
@@ -56,6 +57,7 @@
 
 #include "tcop/tcopprot.h"
 #include "utils/syscache.h"
+#include "catalog/pg_language.h"
 #include "catalog/pg_proc.h"
 #include "catalog/pg_type.h"
 
@@ -87,36 +89,20 @@
 typedef struct plperl_proc_desc
 {
 	char	   *proname;
+	TransactionId fn_xmin;
+	CommandId	fn_cmin;
+	bool		lanpltrusted;
 	FmgrInfo	result_in_func;
 	Oid			result_in_elem;
-	int			result_in_len;
 	int			nargs;
 	FmgrInfo	arg_out_func[FUNC_MAX_ARGS];
 	Oid			arg_out_elem[FUNC_MAX_ARGS];
-	int			arg_out_len[FUNC_MAX_ARGS];
 	int			arg_is_rel[FUNC_MAX_ARGS];
-	bool		lanpltrusted;
 	SV		   *reference;
 }			plperl_proc_desc;
 
 
 /**********************************************************************
- * The information we cache about prepared and saved plans
- **********************************************************************/
-typedef struct plperl_query_desc
-{
-	char		qname[20];
-	void	   *plan;
-	int			nargs;
-	Oid		   *argtypes;
-	FmgrInfo   *arginfuncs;
-	Oid		   *argtypelems;
-	Datum	   *argvalues;
-	int		   *arglen;
-}			plperl_query_desc;
-
-
-/**********************************************************************
  * Global data
  **********************************************************************/
 static int	plperl_firstcall = 1;
@@ -125,11 +111,6 @@ static int	plperl_restart_in_progress = 0;
 static PerlInterpreter *plperl_interp = NULL;
 static HV  *plperl_proc_hash = NULL;
 
-#if REALLYHAVEITONTHEBALL
-static Tcl_HashTable *plperl_query_hash = NULL;
-
-#endif
-
 /**********************************************************************
  * Forward declarations
  **********************************************************************/
@@ -140,29 +121,11 @@ Datum		plperl_call_handler(PG_FUNCTION_ARGS);
 
 static Datum plperl_func_handler(PG_FUNCTION_ARGS);
 
+static plperl_proc_desc *compile_plperl_function(Oid fn_oid, bool is_trigger);
+
 static SV  *plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc);
 static void plperl_init_shared_libs(void);
 
-#ifdef REALLYHAVEITONTHEBALL
-static HeapTuple plperl_trigger_handler(PG_FUNCTION_ARGS);
-
-static int plperl_elog(ClientData cdata, Tcl_Interp *interp,
-			int argc, char *argv[]);
-static int plperl_quote(ClientData cdata, Tcl_Interp *interp,
-			 int argc, char *argv[]);
-
-static int plperl_SPI_exec(ClientData cdata, Tcl_Interp *interp,
-				int argc, char *argv[]);
-static int plperl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
-				   int argc, char *argv[]);
-static int plperl_SPI_execp(ClientData cdata, Tcl_Interp *interp,
-				 int argc, char *argv[]);
-
-static void plperl_set_tuple_values(Tcl_Interp *interp, char *arrayname,
-						int tupno, HeapTuple tuple, TupleDesc tupdesc);
-
-#endif
-
 
 /*
  * This routine is a crock, and so is everyplace that calls it.  The problem
@@ -196,7 +159,7 @@ plperl_init_all(void)
 
 
 	/************************************************************
-	 * Destroy the existing safe interpreter
+	 * Destroy the existing Perl interpreter
 	 ************************************************************/
 	if (plperl_interp != NULL)
 	{
@@ -216,25 +179,16 @@ plperl_init_all(void)
 	}
 
 	/************************************************************
-	 * Free the prepared query hash table
-	 ************************************************************/
-
-	/*
-	 * if (plperl_query_hash != NULL) { }
-	 */
-
-	/************************************************************
-	 * Now recreate a new safe interpreter
+	 * Now recreate a new Perl interpreter
 	 ************************************************************/
 	plperl_init_interp();
 
 	plperl_firstcall = 0;
-	return;
 }
 
 
 /**********************************************************************
- * plperl_init_interp() - Create the safe Perl interpreter
+ * plperl_init_interp() - Create the Perl interpreter
  **********************************************************************/
 static void
 plperl_init_interp(void)
@@ -266,7 +220,7 @@ plperl_init_interp(void)
 
 	/************************************************************
 	 * Initialize the proc and query hash tables
-	 ************************* ***********************************/
+	 ************************************************************/
 	plperl_proc_hash = newHV();
 
 }
@@ -300,7 +254,7 @@ plperl_call_handler(PG_FUNCTION_ARGS)
 	if (SPI_connect() != SPI_OK_CONNECT)
 		elog(ERROR, "plperl: cannot connect to SPI manager");
 	/************************************************************
-	 * Keep track about the nesting of Tcl-SPI-Tcl-... calls
+	 * Keep track about the nesting of Perl-SPI-Perl-... calls
 	 ************************************************************/
 	plperl_call_level++;
 
@@ -454,7 +408,7 @@ plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo)
 				tmp = DatumGetCString(FunctionCall3(&(desc->arg_out_func[i]),
 													fcinfo->arg[i],
 								 ObjectIdGetDatum(desc->arg_out_elem[i]),
-								   Int32GetDatum(desc->arg_out_len[i])));
+													Int32GetDatum(-1)));
 				XPUSHs(sv_2mortal(newSVpv(tmp, 0)));
 				pfree(tmp);
 			}
@@ -500,188 +454,15 @@ plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo)
 static Datum
 plperl_func_handler(PG_FUNCTION_ARGS)
 {
-	int			i;
-	char		internal_proname[512];
-	int			proname_len;
 	plperl_proc_desc *prodesc;
 	SV		   *perlret;
 	Datum		retval;
 	sigjmp_buf	save_restart;
 
-	/************************************************************
-	 * Build our internal proc name from the functions Oid
-	 ************************************************************/
-	sprintf(internal_proname, "__PLPerl_proc_%u", fcinfo->flinfo->fn_oid);
-	proname_len = strlen(internal_proname);
-
-	/************************************************************
-	 * Lookup the internal proc name in the hashtable
-	 ************************************************************/
-	if (!hv_exists(plperl_proc_hash, internal_proname, proname_len))
-	{
-		/************************************************************
-		 * If we haven't found it in the hashtable, we analyze
-		 * the functions arguments and returntype and store
-		 * the in-/out-functions in the prodesc block and create
-		 * a new hashtable entry for it.
-		 *
-		 * Then we load the procedure into the safe interpreter.
-		 ************************************************************/
-		HeapTuple	procTup;
-		HeapTuple	langTup;
-		HeapTuple	typeTup;
-		Form_pg_proc procStruct;
-        Form_pg_language langStruct;
-		Form_pg_type typeStruct;
-		char	   *proc_source;
-
-		/************************************************************
-		 * Allocate a new procedure description block
-		 ************************************************************/
-		prodesc = (plperl_proc_desc *) malloc(sizeof(plperl_proc_desc));
-		prodesc->proname = malloc(strlen(internal_proname) + 1);
-		strcpy(prodesc->proname, internal_proname);
-
-
-		/************************************************************
-		 * Lookup the pg_proc tuple by Oid
-		 ************************************************************/
-		procTup = SearchSysCache(PROCOID,
-								 ObjectIdGetDatum(fcinfo->flinfo->fn_oid),
-								 0, 0, 0);
-		if (!HeapTupleIsValid(procTup))
-		{
-			free(prodesc->proname);
-			free(prodesc);
-			elog(ERROR, "plperl: cache lookup for proc %u failed",
-				 fcinfo->flinfo->fn_oid);
-		}
-		procStruct = (Form_pg_proc) GETSTRUCT(procTup);
-
-		/************************************************************
-		* Lookup the pg_language tuple by Oid
-		************************************************************/
-		langTup = SearchSysCache(LANGOID,
-			ObjectIdGetDatum(procStruct->prolang),
-			0, 0, 0);
-		if (!HeapTupleIsValid(langTup))
-		{
-			free(prodesc->proname);
-			free(prodesc);
-			elog(ERROR, "plperl: cache lookup for language %u failed",
-				procStruct->prolang);
-		}
-		langStruct = (Form_pg_language) GETSTRUCT(langTup);
-
-		prodesc->lanpltrusted = langStruct->lanpltrusted;
-		ReleaseSysCache(langTup);
-
-		/************************************************************
-		 * Get the required information for input conversion of the
-		 * return value.
-		 ************************************************************/
-		typeTup = SearchSysCache(TYPEOID,
-								 ObjectIdGetDatum(procStruct->prorettype),
-								 0, 0, 0);
-		if (!HeapTupleIsValid(typeTup))
-		{
-			free(prodesc->proname);
-			free(prodesc);
-			if (!OidIsValid(procStruct->prorettype))
-				elog(ERROR, "plperl functions cannot return type \"opaque\""
-					 "\n\texcept when used as triggers");
-			else
-				elog(ERROR, "plperl: cache lookup for return type %u failed",
-					 procStruct->prorettype);
-		}
-		typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
-
-		if (typeStruct->typrelid != InvalidOid)
-		{
-			free(prodesc->proname);
-			free(prodesc);
-			elog(ERROR, "plperl: return types of tuples not supported yet");
-		}
-
-		perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
-		prodesc->result_in_elem = (Oid) (typeStruct->typelem);
-		prodesc->result_in_len = typeStruct->typlen;
-
-		ReleaseSysCache(typeTup);
-
-		/************************************************************
-		 * Get the required information for output conversion
-		 * of all procedure arguments
-		 ************************************************************/
-		prodesc->nargs = procStruct->pronargs;
-		for (i = 0; i < prodesc->nargs; i++)
-		{
-			typeTup = SearchSysCache(TYPEOID,
-							ObjectIdGetDatum(procStruct->proargtypes[i]),
-									 0, 0, 0);
-			if (!HeapTupleIsValid(typeTup))
-			{
-				free(prodesc->proname);
-				free(prodesc);
-				if (!OidIsValid(procStruct->proargtypes[i]))
-					elog(ERROR, "plperl functions cannot take type \"opaque\"");
-				else
-					elog(ERROR, "plperl: cache lookup for argument type %u failed",
-						 procStruct->proargtypes[i]);
-			}
-			typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
-
-			if (typeStruct->typrelid != InvalidOid)
-				prodesc->arg_is_rel[i] = 1;
-			else
-				prodesc->arg_is_rel[i] = 0;
-
-			perm_fmgr_info(typeStruct->typoutput, &(prodesc->arg_out_func[i]));
-			prodesc->arg_out_elem[i] = (Oid) (typeStruct->typelem);
-			prodesc->arg_out_len[i] = typeStruct->typlen;
-			ReleaseSysCache(typeTup);
-		}
-
-		/************************************************************
-		 * create the text of the anonymous subroutine.
-		 * we do not use a named subroutine so that we can call directly
-		 * through the reference.
-		 *
-		 ************************************************************/
-		proc_source = DatumGetCString(DirectFunctionCall1(textout,
-								  PointerGetDatum(&procStruct->prosrc)));
-
-		/************************************************************
-		 * Create the procedure in the interpreter
-		 ************************************************************/
-		prodesc->reference = plperl_create_sub(proc_source, prodesc->lanpltrusted);
-		pfree(proc_source);
-		if (!prodesc->reference)
-		{
-			free(prodesc->proname);
-			free(prodesc);
-			elog(ERROR, "plperl: cannot create internal procedure %s",
-				 internal_proname);
-		}
-
-		/************************************************************
-		 * Add the proc description block to the hashtable
-		 ************************************************************/
-		hv_store(plperl_proc_hash, internal_proname, proname_len,
-				 newSViv((IV) prodesc), 0);
-
-		ReleaseSysCache(procTup);
-	}
-	else
-	{
-		/************************************************************
-		 * Found the proc description block in the hashtable
-		 ************************************************************/
-		prodesc = (plperl_proc_desc *) SvIV(*hv_fetch(plperl_proc_hash,
-									  internal_proname, proname_len, 0));
-	}
-
+	/* Find or compile the function */
+	prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);
 
+	/* Set up error handling */
 	memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
 
 	if (sigsetjmp(Warn_restart, 1) != 0)
@@ -693,7 +474,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 		siglongjmp(Warn_restart, 1);
 	}
 
-
 	/************************************************************
 	 * Call the Perl function
 	 ************************************************************/
@@ -719,7 +499,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 		retval = FunctionCall3(&prodesc->result_in_func,
 							   PointerGetDatum(SvPV(perlret, PL_na)),
 							   ObjectIdGetDatum(prodesc->result_in_elem),
-							   Int32GetDatum(prodesc->result_in_len));
+							   Int32GetDatum(-1));
 	}
 
 	SvREFCNT_dec(perlret);
@@ -736,1447 +516,210 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 }
 
 
-#ifdef REALLYHAVEITONTHEBALL
 /**********************************************************************
- * plperl_trigger_handler() - Handler for trigger calls
+ * compile_plperl_function	- compile (or hopefully just look up) function
  **********************************************************************/
-static HeapTuple
-plperl_trigger_handler(PG_FUNCTION_ARGS)
+static plperl_proc_desc *
+compile_plperl_function(Oid fn_oid, bool is_trigger)
 {
-	TriggerData *trigdata = (TriggerData *) fcinfo->context;
-	char		internal_proname[512];
-	char	   *stroid;
-	Tcl_HashEntry *hashent;
-	int			hashnew;
-	plperl_proc_desc *prodesc;
-	TupleDesc	tupdesc;
-	HeapTuple	rettup;
-	Tcl_DString tcl_cmd;
-	Tcl_DString tcl_trigtup;
-	Tcl_DString tcl_newtup;
-	int			tcl_rc;
+	HeapTuple	procTup;
+	Form_pg_proc procStruct;
+	char		internal_proname[64];
+	int			proname_len;
+	plperl_proc_desc *prodesc = NULL;
 	int			i;
 
-	int		   *modattrs;
-	Datum	   *modvalues;
-	char	   *modnulls;
-
-	int			ret_numvals;
-	char	  **ret_values;
-
-	sigjmp_buf	save_restart;
+	/* We'll need the pg_proc tuple in any case... */
+	procTup = SearchSysCache(PROCOID,
+							 ObjectIdGetDatum(fn_oid),
+							 0, 0, 0);
+	if (!HeapTupleIsValid(procTup))
+		elog(ERROR, "plperl: cache lookup for proc %u failed", fn_oid);
+	procStruct = (Form_pg_proc) GETSTRUCT(procTup);
 
 	/************************************************************
 	 * Build our internal proc name from the functions Oid
 	 ************************************************************/
-	sprintf(internal_proname, "__PLPerl_proc_%u", fcinfo->flinfo->fn_oid);
+	if (!is_trigger)
+		sprintf(internal_proname, "__PLPerl_proc_%u", fn_oid);
+	else
+		sprintf(internal_proname, "__PLPerl_proc_%u_trigger", fn_oid);
+	proname_len = strlen(internal_proname);
 
 	/************************************************************
 	 * Lookup the internal proc name in the hashtable
 	 ************************************************************/
-	hashent = Tcl_FindHashEntry(plperl_proc_hash, internal_proname);
-	if (hashent == NULL)
+	if (hv_exists(plperl_proc_hash, internal_proname, proname_len))
 	{
-		/************************************************************
-		 * If we haven't found it in the hashtable,
-		 * we load the procedure into the safe interpreter.
-		 ************************************************************/
-		Tcl_DString proc_internal_def;
-		Tcl_DString proc_internal_body;
-		HeapTuple	procTup;
-		Form_pg_proc procStruct;
-		char	   *proc_source;
-
-		/************************************************************
-		 * Allocate a new procedure description block
-		 ************************************************************/
-		prodesc = (plperl_proc_desc *) malloc(sizeof(plperl_proc_desc));
-		memset(prodesc, 0, sizeof(plperl_proc_desc));
-		prodesc->proname = malloc(strlen(internal_proname) + 1);
-		strcpy(prodesc->proname, internal_proname);
-
-		/************************************************************
-		 * Lookup the pg_proc tuple by Oid
-		 ************************************************************/
-		procTup = SearchSysCache(PROCOID,
-								 ObjectIdGetDatum(fcinfo->flinfo->fn_oid),
-								 0, 0, 0);
-		if (!HeapTupleIsValid(procTup))
-		{
-			free(prodesc->proname);
-			free(prodesc);
-			elog(ERROR, "plperl: cache lookup for proc %u failed",
-				 fcinfo->flinfo->fn_oid);
-		}
-		procStruct = (Form_pg_proc) GETSTRUCT(procTup);
+		bool		uptodate;
 
-		/************************************************************
-		 * Create the tcl command to define the internal
-		 * procedure
-		 ************************************************************/
-		Tcl_DStringInit(&proc_internal_def);
-		Tcl_DStringInit(&proc_internal_body);
-		Tcl_DStringAppendElement(&proc_internal_def, "proc");
-		Tcl_DStringAppendElement(&proc_internal_def, internal_proname);
-		Tcl_DStringAppendElement(&proc_internal_def,
-								 "TG_name TG_relid TG_relatts TG_when TG_level TG_op __PLTcl_Tup_NEW __PLTcl_Tup_OLD args");
+		prodesc = (plperl_proc_desc *) SvIV(*hv_fetch(plperl_proc_hash,
+									  internal_proname, proname_len, 0));
 
 		/************************************************************
-		 * prefix procedure body with
-		 * upvar #0 <internal_procname> GD
-		 * and with appropriate setting of NEW, OLD,
-		 * and the arguments as numerical variables.
+		 * If it's present, must check whether it's still up to date.
+		 * This is needed because CREATE OR REPLACE FUNCTION can modify the
+		 * function's pg_proc entry without changing its OID.
 		 ************************************************************/
-		Tcl_DStringAppend(&proc_internal_body, "upvar #0 ", -1);
-		Tcl_DStringAppend(&proc_internal_body, internal_proname, -1);
-		Tcl_DStringAppend(&proc_internal_body, " GD\n", -1);
-
-		Tcl_DStringAppend(&proc_internal_body,
-						  "array set NEW $__PLTcl_Tup_NEW\n", -1);
-		Tcl_DStringAppend(&proc_internal_body,
-						  "array set OLD $__PLTcl_Tup_OLD\n", -1);
-
-		Tcl_DStringAppend(&proc_internal_body,
-						  "set i 0\n"
-						  "set v 0\n"
-						  "foreach v $args {\n"
-						  "  incr i\n"
-						  "  set $i $v\n"
-						  "}\n"
-						  "unset i v\n\n", -1);
-
-		proc_source = DatumGetCString(DirectFunctionCall1(textout,
-								  PointerGetDatum(&procStruct->prosrc)));
-		Tcl_DStringAppend(&proc_internal_body, proc_source, -1);
-		pfree(proc_source);
-		Tcl_DStringAppendElement(&proc_internal_def,
-								 Tcl_DStringValue(&proc_internal_body));
-		Tcl_DStringFree(&proc_internal_body);
+		uptodate = (prodesc->fn_xmin == procTup->t_data->t_xmin &&
+					prodesc->fn_cmin == procTup->t_data->t_cmin);
 
-		/************************************************************
-		 * Create the procedure in the safe interpreter
-		 ************************************************************/
-		tcl_rc = Tcl_GlobalEval(plperl_safe_interp,
-								Tcl_DStringValue(&proc_internal_def));
-		Tcl_DStringFree(&proc_internal_def);
-		if (tcl_rc != TCL_OK)
+		if (!uptodate)
 		{
-			free(prodesc->proname);
-			free(prodesc);
-			elog(ERROR, "plperl: cannot create internal procedure %s - %s",
-				 internal_proname, plperl_safe_interp->result);
+			/* need we delete old entry? */
+			prodesc = NULL;
 		}
-
-		/************************************************************
-		 * Add the proc description block to the hashtable
-		 ************************************************************/
-		hashent = Tcl_CreateHashEntry(plperl_proc_hash,
-									  prodesc->proname, &hashnew);
-		Tcl_SetHashValue(hashent, (ClientData) prodesc);
-
-		ReleaseSysCache(procTup);
-	}
-	else
-	{
-		/************************************************************
-		 * Found the proc description block in the hashtable
-		 ************************************************************/
-		prodesc = (plperl_proc_desc *) Tcl_GetHashValue(hashent);
 	}
 
-	tupdesc = trigdata->tg_relation->rd_att;
-
 	/************************************************************
-	 * Create the tcl command to call the internal
-	 * proc in the safe interpreter
+	 * If we haven't found it in the hashtable, we analyze
+	 * the functions arguments and returntype and store
+	 * the in-/out-functions in the prodesc block and create
+	 * a new hashtable entry for it.
+	 *
+	 * Then we load the procedure into the Perl interpreter.
 	 ************************************************************/
-	Tcl_DStringInit(&tcl_cmd);
-	Tcl_DStringInit(&tcl_trigtup);
-	Tcl_DStringInit(&tcl_newtup);
-
-	/************************************************************
-	 * We call external functions below - care for elog(ERROR)
-	 ************************************************************/
-	memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
-	if (sigsetjmp(Warn_restart, 1) != 0)
-	{
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-		Tcl_DStringFree(&tcl_cmd);
-		Tcl_DStringFree(&tcl_trigtup);
-		Tcl_DStringFree(&tcl_newtup);
-		plperl_restart_in_progress = 1;
-		if (--plperl_call_level == 0)
-			plperl_restart_in_progress = 0;
-		siglongjmp(Warn_restart, 1);
-	}
-
-	/* The procedure name */
-	Tcl_DStringAppendElement(&tcl_cmd, internal_proname);
-
-	/* The trigger name for argument TG_name */
-	Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgname);
-
-	/* The oid of the trigger relation for argument TG_relid */
-	stroid = DatumGetCString(DirectFunctionCall1(oidout,
-						ObjectIdGetDatum(trigdata->tg_relation->rd_id)));
-	Tcl_DStringAppendElement(&tcl_cmd, stroid);
-	pfree(stroid);
-
-	/* A list of attribute names for argument TG_relatts */
-	Tcl_DStringAppendElement(&tcl_trigtup, "");
-	for (i = 0; i < tupdesc->natts; i++)
-		Tcl_DStringAppendElement(&tcl_trigtup, tupdesc->attrs[i]->attname.data);
-	Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
-	Tcl_DStringFree(&tcl_trigtup);
-	Tcl_DStringInit(&tcl_trigtup);
-
-	/* The when part of the event for TG_when */
-	if (TRIGGER_FIRED_BEFORE(trigdata->tg_event))
-		Tcl_DStringAppendElement(&tcl_cmd, "BEFORE");
-	else if (TRIGGER_FIRED_AFTER(trigdata->tg_event))
-		Tcl_DStringAppendElement(&tcl_cmd, "AFTER");
-	else
-		Tcl_DStringAppendElement(&tcl_cmd, "UNKNOWN");
-
-	/* The level part of the event for TG_level */
-	if (TRIGGER_FIRED_FOR_ROW(trigdata->tg_event))
-		Tcl_DStringAppendElement(&tcl_cmd, "ROW");
-	else if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event))
-		Tcl_DStringAppendElement(&tcl_cmd, "STATEMENT");
-	else
-		Tcl_DStringAppendElement(&tcl_cmd, "UNKNOWN");
-
-	/* Build the data list for the trigtuple */
-	plperl_build_tuple_argument(trigdata->tg_trigtuple,
-								tupdesc, &tcl_trigtup);
-
-	/*
-	 * Now the command part of the event for TG_op and data for NEW and
-	 * OLD
-	 */
-	if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
-	{
-		Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
-
-		Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
-		Tcl_DStringAppendElement(&tcl_cmd, "");
-
-		rettup = trigdata->tg_trigtuple;
-	}
-	else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
+	if (prodesc == NULL)
 	{
-		Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
-
-		Tcl_DStringAppendElement(&tcl_cmd, "");
-		Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
-
-		rettup = trigdata->tg_trigtuple;
-	}
-	else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
-	{
-		Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
-
-		plperl_build_tuple_argument(trigdata->tg_newtuple,
-									tupdesc, &tcl_newtup);
-
-		Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_newtup));
-		Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
-
-		rettup = trigdata->tg_newtuple;
-	}
-	else
-	{
-		Tcl_DStringAppendElement(&tcl_cmd, "UNKNOWN");
-
-		Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
-		Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
-
-		rettup = trigdata->tg_trigtuple;
-	}
-
-	memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-	Tcl_DStringFree(&tcl_trigtup);
-	Tcl_DStringFree(&tcl_newtup);
-
-	/************************************************************
-	 * Finally append the arguments from CREATE TRIGGER
-	 ************************************************************/
-	for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
-		Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgargs[i]);
-
-	/************************************************************
-	 * Call the Tcl function
-	 ************************************************************/
-	tcl_rc = Tcl_GlobalEval(plperl_safe_interp, Tcl_DStringValue(&tcl_cmd));
-	Tcl_DStringFree(&tcl_cmd);
-
-	/************************************************************
-	 * Check the return code from Tcl and handle
-	 * our special restart mechanism to get rid
-	 * of all nested call levels on transaction
-	 * abort.
-	 ************************************************************/
-	if (tcl_rc == TCL_ERROR || plperl_restart_in_progress)
-	{
-		if (!plperl_restart_in_progress)
-		{
-			plperl_restart_in_progress = 1;
-			if (--plperl_call_level == 0)
-				plperl_restart_in_progress = 0;
-			elog(ERROR, "plperl: %s", plperl_safe_interp->result);
-		}
-		if (--plperl_call_level == 0)
-			plperl_restart_in_progress = 0;
-		siglongjmp(Warn_restart, 1);
-	}
-
-	switch (tcl_rc)
-	{
-		case TCL_OK:
-			break;
-
-		default:
-			elog(ERROR, "plperl: unsupported TCL return code %d", tcl_rc);
-	}
-
-	/************************************************************
-	 * The return value from the procedure might be one of
-	 * the magic strings OK or SKIP or a list from array get
-	 ************************************************************/
-	if (SPI_finish() != SPI_OK_FINISH)
-		elog(ERROR, "plperl: SPI_finish() failed");
-
-	if (strcmp(plperl_safe_interp->result, "OK") == 0)
-		return rettup;
-	if (strcmp(plperl_safe_interp->result, "SKIP") == 0)
-	{
-		return (HeapTuple) NULL;;
-	}
-
-	/************************************************************
-	 * Convert the result value from the safe interpreter
-	 * and setup structures for SPI_modifytuple();
-	 ************************************************************/
-	if (Tcl_SplitList(plperl_safe_interp, plperl_safe_interp->result,
-					  &ret_numvals, &ret_values) != TCL_OK)
-	{
-		elog(NOTICE, "plperl: cannot split return value from trigger");
-		elog(ERROR, "plperl: %s", plperl_safe_interp->result);
-	}
-
-	if (ret_numvals % 2 != 0)
-	{
-		ckfree(ret_values);
-		elog(ERROR, "plperl: invalid return list from trigger - must have even # of elements");
-	}
-
-	modattrs = (int *) palloc(tupdesc->natts * sizeof(int));
-	modvalues = (Datum *) palloc(tupdesc->natts * sizeof(Datum));
-	for (i = 0; i < tupdesc->natts; i++)
-	{
-		modattrs[i] = i + 1;
-		modvalues[i] = (Datum) NULL;
-	}
-
-	modnulls = palloc(tupdesc->natts + 1);
-	memset(modnulls, 'n', tupdesc->natts);
-	modnulls[tupdesc->natts] = '\0';
-
-	/************************************************************
-	 * Care for possible elog(ERROR)'s below
-	 ************************************************************/
-	if (sigsetjmp(Warn_restart, 1) != 0)
-	{
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-		ckfree(ret_values);
-		plperl_restart_in_progress = 1;
-		if (--plperl_call_level == 0)
-			plperl_restart_in_progress = 0;
-		siglongjmp(Warn_restart, 1);
-	}
-
-	i = 0;
-	while (i < ret_numvals)
-	{
-		int			attnum;
+		HeapTuple	langTup;
 		HeapTuple	typeTup;
-		Oid			typinput;
-		Oid			typelem;
-		FmgrInfo	finfo;
-
-		/************************************************************
-		 * Ignore pseudo elements with a dot name
-		 ************************************************************/
-		if (*(ret_values[i]) == '.')
-		{
-			i += 2;
-			continue;
-		}
+		Form_pg_language langStruct;
+		Form_pg_type typeStruct;
+		char	   *proc_source;
 
 		/************************************************************
-		 * Get the attribute number
+		 * Allocate a new procedure description block
 		 ************************************************************/
-		attnum = SPI_fnumber(tupdesc, ret_values[i++]);
-		if (attnum == SPI_ERROR_NOATTRIBUTE)
-			elog(ERROR, "plperl: invalid attribute '%s'", ret_values[--i]);
+		prodesc = (plperl_proc_desc *) malloc(sizeof(plperl_proc_desc));
+		if (prodesc == NULL)
+			elog(ERROR, "plperl: out of memory");
+		MemSet(prodesc, 0, sizeof(plperl_proc_desc));
+		prodesc->proname = strdup(internal_proname);
+		prodesc->fn_xmin = procTup->t_data->t_xmin;
+		prodesc->fn_cmin = procTup->t_data->t_cmin;
 
 		/************************************************************
-		 * Lookup the attribute type in the syscache
-		 * for the input function
+		 * Lookup the pg_language tuple by Oid
 		 ************************************************************/
-		typeTup = SearchSysCache(TYPEOID,
-				  ObjectIdGetDatum(tupdesc->attrs[attnum - 1]->atttypid),
+		langTup = SearchSysCache(LANGOID,
+								 ObjectIdGetDatum(procStruct->prolang),
 								 0, 0, 0);
-		if (!HeapTupleIsValid(typeTup))
+		if (!HeapTupleIsValid(langTup))
 		{
-			elog(ERROR, "plperl: Cache lookup for attribute '%s' type %u failed",
-				 ret_values[--i],
-				 tupdesc->attrs[attnum - 1]->atttypid);
+			free(prodesc->proname);
+			free(prodesc);
+			elog(ERROR, "plperl: cache lookup for language %u failed",
+				 procStruct->prolang);
 		}
-		typinput = (Oid) (((Form_pg_type) GETSTRUCT(typeTup))->typinput);
-		typelem = (Oid) (((Form_pg_type) GETSTRUCT(typeTup))->typelem);
-		ReleaseSysCache(typeTup);
+		langStruct = (Form_pg_language) GETSTRUCT(langTup);
+		prodesc->lanpltrusted = langStruct->lanpltrusted;
+		ReleaseSysCache(langTup);
 
 		/************************************************************
-		 * Set the attribute to NOT NULL and convert the contents
+		 * Get the required information for input conversion of the
+		 * return value.
 		 ************************************************************/
-		modnulls[attnum - 1] = ' ';
-		fmgr_info(typinput, &finfo);
-		modvalues[attnum - 1] =
-			FunctionCall3(&finfo,
-						  CStringGetDatum(ret_values[i++]),
-						  ObjectIdGetDatum(typelem),
-				   Int32GetDatum(tupdesc->attrs[attnum - 1]->atttypmod));
-	}
-
-
-	rettup = SPI_modifytuple(trigdata->tg_relation, rettup, tupdesc->natts,
-							 modattrs, modvalues, modnulls);
-
-	pfree(modattrs);
-	pfree(modvalues);
-	pfree(modnulls);
-
-	if (rettup == NULL)
-		elog(ERROR, "plperl: SPI_modifytuple() failed - RC = %d\n", SPI_result);
-
-	ckfree(ret_values);
-	memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-
-	return rettup;
-}
-
-
-/**********************************************************************
- * plperl_elog()		- elog() support for PLTcl
- **********************************************************************/
-static int
-plperl_elog(ClientData cdata, Tcl_Interp *interp,
-			int argc, char *argv[])
-{
-	int			level;
-	sigjmp_buf	save_restart;
-
-	/************************************************************
-	 * Suppress messages during the restart process
-	 ************************************************************/
-	if (plperl_restart_in_progress)
-		return TCL_ERROR;
-
-	/************************************************************
-	 * Catch the restart longjmp and begin a controlled
-	 * return though all interpreter levels if it happens
-	 ************************************************************/
-	memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
-	if (sigsetjmp(Warn_restart, 1) != 0)
-	{
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-		plperl_restart_in_progress = 1;
-		return TCL_ERROR;
-	}
-
-	if (argc != 3)
-	{
-		Tcl_SetResult(interp, "syntax error - 'elog level msg'",
-					  TCL_VOLATILE);
-		return TCL_ERROR;
-	}
-
-	if (strcmp(argv[1], "NOTICE") == 0)
-		level = NOTICE;
-	else if (strcmp(argv[1], "WARN") == 0)
-		level = ERROR;
-	else if (strcmp(argv[1], "ERROR") == 0)
-		level = ERROR;
-	else if (strcmp(argv[1], "FATAL") == 0)
-		level = FATAL;
-	else if (strcmp(argv[1], "DEBUG") == 0)
-		level = DEBUG;
-	else
-	{
-		Tcl_AppendResult(interp, "Unknown elog level '", argv[1],
-						 "'", NULL);
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-		return TCL_ERROR;
-	}
-
-	/************************************************************
-	 * Call elog(), restore the original restart address
-	 * and return to the caller (if not catched)
-	 ************************************************************/
-	elog(level, argv[2]);
-	memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-	return TCL_OK;
-}
-
-
-/**********************************************************************
- * plperl_quote()	- quote literal strings that are to
- *			  be used in SPI_exec query strings
- **********************************************************************/
-static int
-plperl_quote(ClientData cdata, Tcl_Interp *interp,
-			 int argc, char *argv[])
-{
-	char	   *tmp;
-	char	   *cp1;
-	char	   *cp2;
-
-	/************************************************************
-	 * Check call syntax
-	 ************************************************************/
-	if (argc != 2)
-	{
-		Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_VOLATILE);
-		return TCL_ERROR;
-	}
-
-	/************************************************************
-	 * Allocate space for the maximum the string can
-	 * grow to and initialize pointers
-	 ************************************************************/
-	tmp = palloc(strlen(argv[1]) * 2 + 1);
-	cp1 = argv[1];
-	cp2 = tmp;
-
-	/************************************************************
-	 * Walk through string and double every quote and backslash
-	 ************************************************************/
-	while (*cp1)
-	{
-		if (*cp1 == '\'')
-			*cp2++ = '\'';
-		else
-		{
-			if (*cp1 == '\\')
-				*cp2++ = '\\';
-		}
-		*cp2++ = *cp1++;
-	}
-
-	/************************************************************
-	 * Terminate the string and set it as result
-	 ************************************************************/
-	*cp2 = '\0';
-	Tcl_SetResult(interp, tmp, TCL_VOLATILE);
-	pfree(tmp);
-	return TCL_OK;
-}
-
-
-/**********************************************************************
- * plperl_SPI_exec()		- The builtin SPI_exec command
- *				  for the safe interpreter
- **********************************************************************/
-static int
-plperl_SPI_exec(ClientData cdata, Tcl_Interp *interp,
-				int argc, char *argv[])
-{
-	int			spi_rc;
-	char		buf[64];
-	int			count = 0;
-	char	   *arrayname = NULL;
-	int			query_idx;
-	int			i;
-	int			loop_rc;
-	int			ntuples;
-	HeapTuple  *tuples;
-	TupleDesc	tupdesc = NULL;
-	sigjmp_buf	save_restart;
-
-	char	   *usage = "syntax error - 'SPI_exec "
-	"?-count n? "
-	"?-array name? query ?loop body?";
-
-	/************************************************************
-	 * Don't do anything if we are already in restart mode
-	 ************************************************************/
-	if (plperl_restart_in_progress)
-		return TCL_ERROR;
-
-	/************************************************************
-	 * Check the call syntax and get the count option
-	 ************************************************************/
-	if (argc < 2)
-	{
-		Tcl_SetResult(interp, usage, TCL_VOLATILE);
-		return TCL_ERROR;
-	}
-
-	i = 1;
-	while (i < argc)
-	{
-		if (strcmp(argv[i], "-array") == 0)
+		if (!is_trigger)
 		{
-			if (++i >= argc)
+			typeTup = SearchSysCache(TYPEOID,
+									 ObjectIdGetDatum(procStruct->prorettype),
+									 0, 0, 0);
+			if (!HeapTupleIsValid(typeTup))
 			{
-				Tcl_SetResult(interp, usage, TCL_VOLATILE);
-				return TCL_ERROR;
+				free(prodesc->proname);
+				free(prodesc);
+				if (!OidIsValid(procStruct->prorettype))
+					elog(ERROR, "plperl functions cannot return type \"opaque\""
+						 "\n\texcept when used as triggers");
+				else
+					elog(ERROR, "plperl: cache lookup for return type %u failed",
+						 procStruct->prorettype);
 			}
-			arrayname = argv[i++];
-			continue;
-		}
+			typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
 
-		if (strcmp(argv[i], "-count") == 0)
-		{
-			if (++i >= argc)
+			if (typeStruct->typrelid != InvalidOid)
 			{
-				Tcl_SetResult(interp, usage, TCL_VOLATILE);
-				return TCL_ERROR;
+				free(prodesc->proname);
+				free(prodesc);
+				elog(ERROR, "plperl: return types of tuples not supported yet");
 			}
-			if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
-				return TCL_ERROR;
-			continue;
-		}
-
-		break;
-	}
-
-	query_idx = i;
-	if (query_idx >= argc)
-	{
-		Tcl_SetResult(interp, usage, TCL_VOLATILE);
-		return TCL_ERROR;
-	}
-
-	/************************************************************
-	 * Prepare to start a controlled return through all
-	 * interpreter levels on transaction abort
-	 ************************************************************/
-	memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
-	if (sigsetjmp(Warn_restart, 1) != 0)
-	{
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-		plperl_restart_in_progress = 1;
-		Tcl_SetResult(interp, "Transaction abort", TCL_VOLATILE);
-		return TCL_ERROR;
-	}
-
-	/************************************************************
-	 * Execute the query and handle return codes
-	 ************************************************************/
-	spi_rc = SPI_exec(argv[query_idx], count);
-	memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-
-	switch (spi_rc)
-	{
-		case SPI_OK_UTILITY:
-			Tcl_SetResult(interp, "0", TCL_VOLATILE);
-			return TCL_OK;
-
-		case SPI_OK_SELINTO:
-		case SPI_OK_INSERT:
-		case SPI_OK_DELETE:
-		case SPI_OK_UPDATE:
-			sprintf(buf, "%d", SPI_processed);
-			Tcl_SetResult(interp, buf, TCL_VOLATILE);
-			return TCL_OK;
-
-		case SPI_OK_SELECT:
-			break;
-
-		case SPI_ERROR_ARGUMENT:
-			Tcl_SetResult(interp,
-						"plperl: SPI_exec() failed - SPI_ERROR_ARGUMENT",
-						  TCL_VOLATILE);
-			return TCL_ERROR;
-
-		case SPI_ERROR_UNCONNECTED:
-			Tcl_SetResult(interp,
-					 "plperl: SPI_exec() failed - SPI_ERROR_UNCONNECTED",
-						  TCL_VOLATILE);
-			return TCL_ERROR;
-
-		case SPI_ERROR_COPY:
-			Tcl_SetResult(interp,
-						  "plperl: SPI_exec() failed - SPI_ERROR_COPY",
-						  TCL_VOLATILE);
-			return TCL_ERROR;
-
-		case SPI_ERROR_CURSOR:
-			Tcl_SetResult(interp,
-						  "plperl: SPI_exec() failed - SPI_ERROR_CURSOR",
-						  TCL_VOLATILE);
-			return TCL_ERROR;
-
-		case SPI_ERROR_TRANSACTION:
-			Tcl_SetResult(interp,
-					 "plperl: SPI_exec() failed - SPI_ERROR_TRANSACTION",
-						  TCL_VOLATILE);
-			return TCL_ERROR;
-
-		case SPI_ERROR_OPUNKNOWN:
-			Tcl_SetResult(interp,
-					   "plperl: SPI_exec() failed - SPI_ERROR_OPUNKNOWN",
-						  TCL_VOLATILE);
-			return TCL_ERROR;
-
-		default:
-			sprintf(buf, "%d", spi_rc);
-			Tcl_AppendResult(interp, "plperl: SPI_exec() failed - ",
-							 "unknown RC ", buf, NULL);
-			return TCL_ERROR;
-	}
-
-	/************************************************************
-	 * Only SELECT queries fall through to here - remember the
-	 * tuples we got
-	 ************************************************************/
-
-	ntuples = SPI_processed;
-	if (ntuples > 0)
-	{
-		tuples = SPI_tuptable->vals;
-		tupdesc = SPI_tuptable->tupdesc;
-	}
-
-	/************************************************************
-	 * Again prepare for elog(ERROR)
-	 ************************************************************/
-	if (sigsetjmp(Warn_restart, 1) != 0)
-	{
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-		plperl_restart_in_progress = 1;
-		Tcl_SetResult(interp, "Transaction abort", TCL_VOLATILE);
-		return TCL_ERROR;
-	}
-
-	/************************************************************
-	 * If there is no loop body given, just set the variables
-	 * from the first tuple (if any) and return the number of
-	 * tuples selected
-	 ************************************************************/
-	if (argc == query_idx + 1)
-	{
-		if (ntuples > 0)
-			plperl_set_tuple_values(interp, arrayname, 0, tuples[0], tupdesc);
-		sprintf(buf, "%d", ntuples);
-		Tcl_SetResult(interp, buf, TCL_VOLATILE);
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-		return TCL_OK;
-	}
-
-	/************************************************************
-	 * There is a loop body - process all tuples and evaluate
-	 * the body on each
-	 ************************************************************/
-	query_idx++;
-	for (i = 0; i < ntuples; i++)
-	{
-		plperl_set_tuple_values(interp, arrayname, i, tuples[i], tupdesc);
-
-		loop_rc = Tcl_Eval(interp, argv[query_idx]);
-
-		if (loop_rc == TCL_OK)
-			continue;
-		if (loop_rc == TCL_CONTINUE)
-			continue;
-		if (loop_rc == TCL_RETURN)
-		{
-			memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-			return TCL_RETURN;
-		}
-		if (loop_rc == TCL_BREAK)
-			break;
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-		return TCL_ERROR;
-	}
-
-	/************************************************************
-	 * Finally return the number of tuples
-	 ************************************************************/
-	memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-	sprintf(buf, "%d", ntuples);
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
-	return TCL_OK;
-}
-
-
-/**********************************************************************
- * plperl_SPI_prepare()		- Builtin support for prepared plans
- *				  The Tcl command SPI_prepare
- *				  allways saves the plan using
- *				  SPI_saveplan and returns a key for
- *				  access. There is no chance to prepare
- *				  and not save the plan currently.
- **********************************************************************/
-static int
-plperl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
-				   int argc, char *argv[])
-{
-	int			nargs;
-	char	  **args;
-	plperl_query_desc *qdesc;
-	void	   *plan;
-	int			i;
-	HeapTuple	typeTup;
-	Tcl_HashEntry *hashent;
-	int			hashnew;
-	sigjmp_buf	save_restart;
-
-	/************************************************************
-	 * Don't do anything if we are already in restart mode
-	 ************************************************************/
-	if (plperl_restart_in_progress)
-		return TCL_ERROR;
-
-	/************************************************************
-	 * Check the call syntax
-	 ************************************************************/
-	if (argc != 3)
-	{
-		Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'",
-					  TCL_VOLATILE);
-		return TCL_ERROR;
-	}
-
-	/************************************************************
-	 * Split the argument type list
-	 ************************************************************/
-	if (Tcl_SplitList(interp, argv[2], &nargs, &args) != TCL_OK)
-		return TCL_ERROR;
-
-	/************************************************************
-	 * Allocate the new querydesc structure
-	 ************************************************************/
-	qdesc = (plperl_query_desc *) malloc(sizeof(plperl_query_desc));
-	sprintf(qdesc->qname, "%lx", (long) qdesc);
-	qdesc->nargs = nargs;
-	qdesc->argtypes = (Oid *) malloc(nargs * sizeof(Oid));
-	qdesc->arginfuncs = (FmgrInfo *) malloc(nargs * sizeof(FmgrInfo));
-	qdesc->argtypelems = (Oid *) malloc(nargs * sizeof(Oid));
-	qdesc->argvalues = (Datum *) malloc(nargs * sizeof(Datum));
-	qdesc->arglen = (int *) malloc(nargs * sizeof(int));
-
-	/************************************************************
-	 * Prepare to start a controlled return through all
-	 * interpreter levels on transaction abort
-	 ************************************************************/
-	memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
-	if (sigsetjmp(Warn_restart, 1) != 0)
-	{
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-		plperl_restart_in_progress = 1;
-		free(qdesc->argtypes);
-		free(qdesc->arginfuncs);
-		free(qdesc->argtypelems);
-		free(qdesc->argvalues);
-		free(qdesc->arglen);
-		free(qdesc);
-		ckfree(args);
-		return TCL_ERROR;
-	}
-
-	/************************************************************
-	 * Lookup the argument types by name in the system cache
-	 * and remember the required information for input conversion
-	 ************************************************************/
-	for (i = 0; i < nargs; i++)
-	{
-		typeTup = SearchSysCache(TYPNAME,
-								 PointerGetDatum(args[i]),
-								 0, 0, 0);
-		if (!HeapTupleIsValid(typeTup))
-			elog(ERROR, "plperl: Cache lookup of type %s failed", args[i]);
-		qdesc->argtypes[i] = typeTup->t_data->t_oid;
-		perm_fmgr_info(((Form_pg_type) GETSTRUCT(typeTup))->typinput,
-					   &(qdesc->arginfuncs[i]));
-		qdesc->argtypelems[i] = ((Form_pg_type) GETSTRUCT(typeTup))->typelem;
-		qdesc->argvalues[i] = (Datum) NULL;
-		qdesc->arglen[i] = (int) (((Form_pg_type) GETSTRUCT(typeTup))->typlen);
-		ReleaseSysCache(typeTup);
-	}
 
-	/************************************************************
-	 * Prepare the plan and check for errors
-	 ************************************************************/
-	plan = SPI_prepare(argv[1], nargs, qdesc->argtypes);
-
-	if (plan == NULL)
-	{
-		char		buf[128];
-		char	   *reason;
-
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-
-		switch (SPI_result)
-		{
-			case SPI_ERROR_ARGUMENT:
-				reason = "SPI_ERROR_ARGUMENT";
-				break;
-
-			case SPI_ERROR_UNCONNECTED:
-				reason = "SPI_ERROR_UNCONNECTED";
-				break;
-
-			case SPI_ERROR_COPY:
-				reason = "SPI_ERROR_COPY";
-				break;
-
-			case SPI_ERROR_CURSOR:
-				reason = "SPI_ERROR_CURSOR";
-				break;
-
-			case SPI_ERROR_TRANSACTION:
-				reason = "SPI_ERROR_TRANSACTION";
-				break;
-
-			case SPI_ERROR_OPUNKNOWN:
-				reason = "SPI_ERROR_OPUNKNOWN";
-				break;
+			perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
+			prodesc->result_in_elem = typeStruct->typelem;
 
-			default:
-				sprintf(buf, "unknown RC %d", SPI_result);
-				reason = buf;
-				break;
-
-		}
-
-		elog(ERROR, "plperl: SPI_prepare() failed - %s", reason);
-	}
-
-	/************************************************************
-	 * Save the plan
-	 ************************************************************/
-	qdesc->plan = SPI_saveplan(plan);
-	if (qdesc->plan == NULL)
-	{
-		char		buf[128];
-		char	   *reason;
-
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-
-		switch (SPI_result)
-		{
-			case SPI_ERROR_ARGUMENT:
-				reason = "SPI_ERROR_ARGUMENT";
-				break;
-
-			case SPI_ERROR_UNCONNECTED:
-				reason = "SPI_ERROR_UNCONNECTED";
-				break;
-
-			default:
-				sprintf(buf, "unknown RC %d", SPI_result);
-				reason = buf;
-				break;
-
-		}
-
-		elog(ERROR, "plperl: SPI_saveplan() failed - %s", reason);
-	}
-
-	/************************************************************
-	 * Insert a hashtable entry for the plan and return
-	 * the key to the caller
-	 ************************************************************/
-	memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-	hashent = Tcl_CreateHashEntry(plperl_query_hash, qdesc->qname, &hashnew);
-	Tcl_SetHashValue(hashent, (ClientData) qdesc);
-
-	Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE);
-	return TCL_OK;
-}
-
-
-/**********************************************************************
- * plperl_SPI_execp()		- Execute a prepared plan
- **********************************************************************/
-static int
-plperl_SPI_execp(ClientData cdata, Tcl_Interp *interp,
-				 int argc, char *argv[])
-{
-	int			spi_rc;
-	char		buf[64];
-	int			i,
-				j;
-	int			loop_body;
-	Tcl_HashEntry *hashent;
-	plperl_query_desc *qdesc;
-	char	   *nulls = NULL;
-	char	   *arrayname = NULL;
-	int			count = 0;
-	int			callnargs;
-	static char **callargs = NULL;
-	int			loop_rc;
-	int			ntuples;
-	HeapTuple  *tuples = NULL;
-	TupleDesc	tupdesc = NULL;
-	sigjmp_buf	save_restart;
-
-	char	   *usage = "syntax error - 'SPI_execp "
-	"?-nulls string? ?-count n? "
-	"?-array name? query ?args? ?loop body?";
-
-	/************************************************************
-	 * Tidy up from an earlier abort
-	 ************************************************************/
-	if (callargs != NULL)
-	{
-		ckfree(callargs);
-		callargs = NULL;
-	}
-
-	/************************************************************
-	 * Don't do anything if we are already in restart mode
-	 ************************************************************/
-	if (plperl_restart_in_progress)
-		return TCL_ERROR;
-
-	/************************************************************
-	 * Get the options and check syntax
-	 ************************************************************/
-	i = 1;
-	while (i < argc)
-	{
-		if (strcmp(argv[i], "-array") == 0)
-		{
-			if (++i >= argc)
-			{
-				Tcl_SetResult(interp, usage, TCL_VOLATILE);
-				return TCL_ERROR;
-			}
-			arrayname = argv[i++];
-			continue;
-		}
-		if (strcmp(argv[i], "-nulls") == 0)
-		{
-			if (++i >= argc)
-			{
-				Tcl_SetResult(interp, usage, TCL_VOLATILE);
-				return TCL_ERROR;
-			}
-			nulls = argv[i++];
-			continue;
-		}
-		if (strcmp(argv[i], "-count") == 0)
-		{
-			if (++i >= argc)
-			{
-				Tcl_SetResult(interp, usage, TCL_VOLATILE);
-				return TCL_ERROR;
-			}
-			if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
-				return TCL_ERROR;
-			continue;
-		}
-
-		break;
-	}
-
-	/************************************************************
-	 * Check minimum call arguments
-	 ************************************************************/
-	if (i >= argc)
-	{
-		Tcl_SetResult(interp, usage, TCL_VOLATILE);
-		return TCL_ERROR;
-	}
-
-	/************************************************************
-	 * Get the prepared plan descriptor by it's key
-	 ************************************************************/
-	hashent = Tcl_FindHashEntry(plperl_query_hash, argv[i++]);
-	if (hashent == NULL)
-	{
-		Tcl_AppendResult(interp, "invalid queryid '", argv[--i], "'", NULL);
-		return TCL_ERROR;
-	}
-	qdesc = (plperl_query_desc *) Tcl_GetHashValue(hashent);
-
-	/************************************************************
-	 * If a nulls string is given, check for correct length
-	 ************************************************************/
-	if (nulls != NULL)
-	{
-		if (strlen(nulls) != qdesc->nargs)
-		{
-			Tcl_SetResult(interp,
-				   "length of nulls string doesn't match # of arguments",
-						  TCL_VOLATILE);
-			return TCL_ERROR;
-		}
-	}
-
-	/************************************************************
-	 * If there was a argtype list on preparation, we need
-	 * an argument value list now
-	 ************************************************************/
-	if (qdesc->nargs > 0)
-	{
-		if (i >= argc)
-		{
-			Tcl_SetResult(interp, "missing argument list", TCL_VOLATILE);
-			return TCL_ERROR;
-		}
-
-		/************************************************************
-		 * Split the argument values
-		 ************************************************************/
-		if (Tcl_SplitList(interp, argv[i++], &callnargs, &callargs) != TCL_OK)
-			return TCL_ERROR;
-
-		/************************************************************
-		 * Check that the # of arguments matches
-		 ************************************************************/
-		if (callnargs != qdesc->nargs)
-		{
-			Tcl_SetResult(interp,
-			"argument list length doesn't match # of arguments for query",
-						  TCL_VOLATILE);
-			if (callargs != NULL)
-			{
-				ckfree(callargs);
-				callargs = NULL;
-			}
-			return TCL_ERROR;
+			ReleaseSysCache(typeTup);
 		}
 
 		/************************************************************
-		 * Prepare to start a controlled return through all
-		 * interpreter levels on transaction abort during the
-		 * parse of the arguments
+		 * Get the required information for output conversion
+		 * of all procedure arguments
 		 ************************************************************/
-		memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
-		if (sigsetjmp(Warn_restart, 1) != 0)
+		if (!is_trigger)
 		{
-			memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-			for (j = 0; j < callnargs; j++)
+			prodesc->nargs = procStruct->pronargs;
+			for (i = 0; i < prodesc->nargs; i++)
 			{
-				if (qdesc->arglen[j] < 0 &&
-					qdesc->argvalues[j] != (Datum) NULL)
+				typeTup = SearchSysCache(TYPEOID,
+										 ObjectIdGetDatum(procStruct->proargtypes[i]),
+										 0, 0, 0);
+				if (!HeapTupleIsValid(typeTup))
 				{
-					pfree((char *) (qdesc->argvalues[j]));
-					qdesc->argvalues[j] = (Datum) NULL;
+					free(prodesc->proname);
+					free(prodesc);
+					if (!OidIsValid(procStruct->proargtypes[i]))
+						elog(ERROR, "plperl functions cannot take type \"opaque\"");
+					else
+						elog(ERROR, "plperl: cache lookup for argument type %u failed",
+							 procStruct->proargtypes[i]);
 				}
-			}
-			ckfree(callargs);
-			callargs = NULL;
-			plperl_restart_in_progress = 1;
-			Tcl_SetResult(interp, "Transaction abort", TCL_VOLATILE);
-			return TCL_ERROR;
-		}
+				typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
 
-		/************************************************************
-		 * Setup the value array for the SPI_execp() using
-		 * the type specific input functions
-		 ************************************************************/
-		for (j = 0; j < callnargs; j++)
-		{
-			qdesc->argvalues[j] =
-				FunctionCall3(&qdesc->arginfuncs[j],
-							  CStringGetDatum(callargs[j]),
-							  ObjectIdGetDatum(qdesc->argtypelems[j]),
-							  Int32GetDatum(qdesc->arglen[j]));
-		}
-
-		/************************************************************
-		 * Free the splitted argument value list
-		 ************************************************************/
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-		ckfree(callargs);
-		callargs = NULL;
-	}
-	else
-		callnargs = 0;
-
-	/************************************************************
-	 * Remember the index of the last processed call
-	 * argument - a loop body for SELECT might follow
-	 ************************************************************/
-	loop_body = i;
+				if (typeStruct->typrelid != InvalidOid)
+					prodesc->arg_is_rel[i] = 1;
+				else
+					prodesc->arg_is_rel[i] = 0;
 
-	/************************************************************
-	 * Prepare to start a controlled return through all
-	 * interpreter levels on transaction abort
-	 ************************************************************/
-	memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
-	if (sigsetjmp(Warn_restart, 1) != 0)
-	{
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-		for (j = 0; j < callnargs; j++)
-		{
-			if (qdesc->arglen[j] < 0 && qdesc->argvalues[j] != (Datum) NULL)
-			{
-				pfree((char *) (qdesc->argvalues[j]));
-				qdesc->argvalues[j] = (Datum) NULL;
+				perm_fmgr_info(typeStruct->typoutput, &(prodesc->arg_out_func[i]));
+				prodesc->arg_out_elem[i] = typeStruct->typelem;
+				ReleaseSysCache(typeTup);
 			}
 		}
-		plperl_restart_in_progress = 1;
-		Tcl_SetResult(interp, "Transaction abort", TCL_VOLATILE);
-		return TCL_ERROR;
-	}
-
-	/************************************************************
-	 * Execute the plan
-	 ************************************************************/
-	spi_rc = SPI_execp(qdesc->plan, qdesc->argvalues, nulls, count);
-	memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-
-	/************************************************************
-	 * For varlena data types, free the argument values
-	 ************************************************************/
-	for (j = 0; j < callnargs; j++)
-	{
-		if (qdesc->arglen[j] < 0 && qdesc->argvalues[j] != (Datum) NULL)
-		{
-			pfree((char *) (qdesc->argvalues[j]));
-			qdesc->argvalues[j] = (Datum) NULL;
-		}
-	}
-
-	/************************************************************
-	 * Check the return code from SPI_execp()
-	 ************************************************************/
-	switch (spi_rc)
-	{
-		case SPI_OK_UTILITY:
-			Tcl_SetResult(interp, "0", TCL_VOLATILE);
-			return TCL_OK;
-
-		case SPI_OK_SELINTO:
-		case SPI_OK_INSERT:
-		case SPI_OK_DELETE:
-		case SPI_OK_UPDATE:
-			sprintf(buf, "%d", SPI_processed);
-			Tcl_SetResult(interp, buf, TCL_VOLATILE);
-			return TCL_OK;
-
-		case SPI_OK_SELECT:
-			break;
-
-		case SPI_ERROR_ARGUMENT:
-			Tcl_SetResult(interp,
-						"plperl: SPI_exec() failed - SPI_ERROR_ARGUMENT",
-						  TCL_VOLATILE);
-			return TCL_ERROR;
-
-		case SPI_ERROR_UNCONNECTED:
-			Tcl_SetResult(interp,
-					 "plperl: SPI_exec() failed - SPI_ERROR_UNCONNECTED",
-						  TCL_VOLATILE);
-			return TCL_ERROR;
-
-		case SPI_ERROR_COPY:
-			Tcl_SetResult(interp,
-						  "plperl: SPI_exec() failed - SPI_ERROR_COPY",
-						  TCL_VOLATILE);
-			return TCL_ERROR;
-
-		case SPI_ERROR_CURSOR:
-			Tcl_SetResult(interp,
-						  "plperl: SPI_exec() failed - SPI_ERROR_CURSOR",
-						  TCL_VOLATILE);
-			return TCL_ERROR;
-
-		case SPI_ERROR_TRANSACTION:
-			Tcl_SetResult(interp,
-					 "plperl: SPI_exec() failed - SPI_ERROR_TRANSACTION",
-						  TCL_VOLATILE);
-			return TCL_ERROR;
-
-		case SPI_ERROR_OPUNKNOWN:
-			Tcl_SetResult(interp,
-					   "plperl: SPI_exec() failed - SPI_ERROR_OPUNKNOWN",
-						  TCL_VOLATILE);
-			return TCL_ERROR;
-
-		default:
-			sprintf(buf, "%d", spi_rc);
-			Tcl_AppendResult(interp, "plperl: SPI_exec() failed - ",
-							 "unknown RC ", buf, NULL);
-			return TCL_ERROR;
-	}
-
-	/************************************************************
-	 * Only SELECT queries fall through to here - remember the
-	 * tuples we got
-	 ************************************************************/
-
-	ntuples = SPI_processed;
-	if (ntuples > 0)
-	{
-		tuples = SPI_tuptable->vals;
-		tupdesc = SPI_tuptable->tupdesc;
-	}
-
-	/************************************************************
-	 * Prepare to start a controlled return through all
-	 * interpreter levels on transaction abort during
-	 * the ouput conversions of the results
-	 ************************************************************/
-	memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
-	if (sigsetjmp(Warn_restart, 1) != 0)
-	{
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-		plperl_restart_in_progress = 1;
-		Tcl_SetResult(interp, "Transaction abort", TCL_VOLATILE);
-		return TCL_ERROR;
-	}
-
-	/************************************************************
-	 * If there is no loop body given, just set the variables
-	 * from the first tuple (if any) and return the number of
-	 * tuples selected
-	 ************************************************************/
-	if (loop_body >= argc)
-	{
-		if (ntuples > 0)
-			plperl_set_tuple_values(interp, arrayname, 0, tuples[0], tupdesc);
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-		sprintf(buf, "%d", ntuples);
-		Tcl_SetResult(interp, buf, TCL_VOLATILE);
-		return TCL_OK;
-	}
-
-	/************************************************************
-	 * There is a loop body - process all tuples and evaluate
-	 * the body on each
-	 ************************************************************/
-	for (i = 0; i < ntuples; i++)
-	{
-		plperl_set_tuple_values(interp, arrayname, i, tuples[i], tupdesc);
-
-		loop_rc = Tcl_Eval(interp, argv[loop_body]);
-
-		if (loop_rc == TCL_OK)
-			continue;
-		if (loop_rc == TCL_CONTINUE)
-			continue;
-		if (loop_rc == TCL_RETURN)
-		{
-			memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-			return TCL_RETURN;
-		}
-		if (loop_rc == TCL_BREAK)
-			break;
-		memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-		return TCL_ERROR;
-	}
-
-	/************************************************************
-	 * Finally return the number of tuples
-	 ************************************************************/
-	memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
-	sprintf(buf, "%d", ntuples);
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
-	return TCL_OK;
-}
-
-
-/**********************************************************************
- * plperl_set_tuple_values() - Set variables for all attributes
- *				  of a given tuple
- **********************************************************************/
-static void
-plperl_set_tuple_values(Tcl_Interp *interp, char *arrayname,
-						int tupno, HeapTuple tuple, TupleDesc tupdesc)
-{
-	int			i;
-	char	   *outputstr;
-	char		buf[64];
-	Datum		attr;
-	bool		isnull;
-
-	char	   *attname;
-	HeapTuple	typeTup;
-	Oid			typoutput;
-	Oid			typelem;
-
-	char	  **arrptr;
-	char	  **nameptr;
-	char	   *nullname = NULL;
-
-	/************************************************************
-	 * Prepare pointers for Tcl_SetVar2() below and in array
-	 * mode set the .tupno element
-	 ************************************************************/
-	if (arrayname == NULL)
-	{
-		arrptr = &attname;
-		nameptr = &nullname;
-	}
-	else
-	{
-		arrptr = &arrayname;
-		nameptr = &attname;
-		sprintf(buf, "%d", tupno);
-		Tcl_SetVar2(interp, arrayname, ".tupno", buf, 0);
-	}
-
-	for (i = 0; i < tupdesc->natts; i++)
-	{
-		/************************************************************
-		 * Get the attribute name
-		 ************************************************************/
-		attname = tupdesc->attrs[i]->attname.data;
 
 		/************************************************************
-		 * Get the attributes value
+		 * create the text of the anonymous subroutine.
+		 * we do not use a named subroutine so that we can call directly
+		 * through the reference.
+		 *
 		 ************************************************************/
-		attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
+		proc_source = DatumGetCString(DirectFunctionCall1(textout,
+								  PointerGetDatum(&procStruct->prosrc)));
 
 		/************************************************************
-		 * Lookup the attribute type in the syscache
-		 * for the output function
+		 * Create the procedure in the interpreter
 		 ************************************************************/
-		typeTup = SearchSysCache(TYPEOID,
-						   ObjectIdGetDatum(tupdesc->attrs[i]->atttypid),
-								 0, 0, 0);
-		if (!HeapTupleIsValid(typeTup))
+		prodesc->reference = plperl_create_sub(proc_source, prodesc->lanpltrusted);
+		pfree(proc_source);
+		if (!prodesc->reference)
 		{
-			elog(ERROR, "plperl: Cache lookup for attribute '%s' type %u failed",
-				 attname, tupdesc->attrs[i]->atttypid);
+			free(prodesc->proname);
+			free(prodesc);
+			elog(ERROR, "plperl: cannot create internal procedure %s",
+				 internal_proname);
 		}
 
-		typoutput = (Oid) (((Form_pg_type) GETSTRUCT(typeTup))->typoutput);
-		typelem = (Oid) (((Form_pg_type) GETSTRUCT(typeTup))->typelem);
-		ReleaseSysCache(typeTup);
-
 		/************************************************************
-		 * If there is a value, set the variable
-		 * If not, unset it
-		 *
-		 * Hmmm - Null attributes will cause functions to
-		 *		  crash if they don't expect them - need something
-		 *		  smarter here.
+		 * Add the proc description block to the hashtable
 		 ************************************************************/
-		if (!isnull && OidIsValid(typoutput))
-		{
-			outputstr = DatumGetCString(OidFunctionCall3(typoutput,
-														 attr,
-											   ObjectIdGetDatum(typelem),
-							  Int32GetDatum(tupdesc->attrs[i]->attlen)));
-			Tcl_SetVar2(interp, *arrptr, *nameptr, outputstr, 0);
-			pfree(outputstr);
-		}
-		else
-			Tcl_UnsetVar2(interp, *arrptr, *nameptr, 0);
+		hv_store(plperl_proc_hash, internal_proname, proname_len,
+				 newSViv((IV) prodesc), 0);
 	}
+
+	ReleaseSysCache(procTup);
+
+	return prodesc;
 }
 
 
-#endif
 /**********************************************************************
  * plperl_build_tuple_argument() - Build a string for a ref to a hash
  *				  from all attributes of a given tuple
@@ -2188,7 +731,6 @@ plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
 	SV		   *output;
 	Datum		attr;
 	bool		isnull;
-
 	char	   *attname;
 	char	   *outputstr;
 	HeapTuple	typeTup;
@@ -2210,6 +752,15 @@ plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
 		attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
 
 		/************************************************************
+		 *	If it is null it will be set to undef in the hash.
+		 ************************************************************/
+		if (isnull)
+		{
+			sv_catpvf(output, "'%s' => undef,", attname);
+			continue;
+		}
+
+		/************************************************************
 		 * Lookup the attribute type in the syscache
 		 * for the output function
 		 ************************************************************/
@@ -2217,32 +768,24 @@ plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
 						   ObjectIdGetDatum(tupdesc->attrs[i]->atttypid),
 								 0, 0, 0);
 		if (!HeapTupleIsValid(typeTup))
-		{
 			elog(ERROR, "plperl: Cache lookup for attribute '%s' type %u failed",
 				 attname, tupdesc->attrs[i]->atttypid);
-		}
 
-		typoutput = (Oid) (((Form_pg_type) GETSTRUCT(typeTup))->typoutput);
-		typelem = (Oid) (((Form_pg_type) GETSTRUCT(typeTup))->typelem);
+		typoutput = ((Form_pg_type) GETSTRUCT(typeTup))->typoutput;
+		typelem = ((Form_pg_type) GETSTRUCT(typeTup))->typelem;
 		ReleaseSysCache(typeTup);
 
 		/************************************************************
-		 * If there is a value, append the attribute name and the
-		 * value to the list.
-		 *	If it is null it will be set to undef.
+		 * Append the attribute name and the value to the list.
 		 ************************************************************/
-		if (!isnull && OidIsValid(typoutput))
-		{
-			outputstr = DatumGetCString(OidFunctionCall3(typoutput,
-														 attr,
-											   ObjectIdGetDatum(typelem),
-							  Int32GetDatum(tupdesc->attrs[i]->attlen)));
-			sv_catpvf(output, "'%s' => '%s',", attname, outputstr);
-			pfree(outputstr);
-		}
-		else
-			sv_catpvf(output, "'%s' => undef,", attname);
+		outputstr = DatumGetCString(OidFunctionCall3(typoutput,
+													 attr,
+													 ObjectIdGetDatum(typelem),
+													 Int32GetDatum(tupdesc->attrs[i]->atttypmod)));
+		sv_catpvf(output, "'%s' => '%s',", attname, outputstr);
+		pfree(outputstr);
 	}
+
 	sv_catpv(output, "}");
 	output = perl_eval_pv(SvPV(output, PL_na), TRUE);
 	return output;