implement prepared queries in plperl

Started by Dmitry Karasikabout 20 years ago15 messages
#1Dmitry Karasik
dmitry@karasik.eu.org

--
Sincerely,
Dmitry Karasik

diff -rcN plperl.cvs/SPI.xs plperl.0/SPI.xs
*** plperl.cvs/SPI.xs	Thu Oct 27 12:34:29 2005
--- plperl.0/SPI.xs	Thu Dec  8 10:35:38 2005
***************
*** 146,150 ****
--- 146,226 ----
  	OUTPUT:
  		RETVAL
+ SV*
+ spi_spi_prepare(query, ...)
+ 	char* query;
+ 	CODE:
+ 		int i;
+ 		SV** argv;
+ 		if (items < 1) 
+ 			Perl_croak(aTHX_ "Usage: spi_prepare(query, ...)");
+ 		argv = ( SV**) palloc(( items - 1) * sizeof(SV*));
+ 		if ( argv == NULL) 
+ 			Perl_croak(aTHX_ "spi_prepare: not enough memory");
+ 		for ( i = 1; i < items; i++) 
+ 			argv[i - 1] = ST(i);
+ 		RETVAL = plperl_spi_prepare(query, items - 1, argv);
+ 		pfree( argv);
+ 	OUTPUT:
+ 		RETVAL
+ 
+ SV*
+ spi_spi_exec_prepared(query, ...)
+ 	char * query;
+ 	PREINIT:
+ 		HV *ret_hash;
+ 	CODE:
+ 		HV *attr = NULL;
+ 		int i, offset = 1, argc;
+ 		SV ** argv;
+ 		if ( items < 1) 
+ 			Perl_croak(aTHX_ "Usage: spi_exec_prepared(query, [\\%%attr,] [\\@bind_values]");
+ 		if ( items > 1 && SvROK( ST( 1)) && SvTYPE( SvRV( ST( 1))) == SVt_PVHV) { 
+ 			attr = ( HV*) SvRV(ST(1));
+ 			offset++;
+ 		}
+ 		argc = items - offset;
+ 		argv = ( SV**) palloc( argc * sizeof(SV*));
+ 		if ( argv == NULL) 
+ 			Perl_croak(aTHX_ "spi_exec_prepared: not enough memory");
+ 		for ( i = 0; offset < items; offset++, i++) 
+ 			argv[i] = ST(offset);
+ 		ret_hash = plperl_spi_exec_prepared(query, attr, argc, argv);
+ 		RETVAL = newRV_noinc((SV*)ret_hash);
+ 		pfree( argv);
+ 	OUTPUT:
+ 		RETVAL
+ 
+ SV*
+ spi_spi_query_prepared(query, ...)
+ 	char * query;
+ 	CODE:
+ 		int i;
+ 		SV ** argv;
+ 		if ( items < 1) 
+ 			Perl_croak(aTHX_ "Usage: spi_query_prepared(query, [\\@bind_values]");
+ 		argv = ( SV**) palloc(( items - 1) * sizeof(SV*));
+ 		if ( argv == NULL) 
+ 			Perl_croak(aTHX_ "spi_query_prepared: not enough memory");
+ 		for ( i = 1; i < items; i++) 
+ 			argv[i - 1] = ST(i);
+ 		RETVAL = plperl_spi_query_prepared(query, items - 1, argv);
+ 		pfree( argv);
+ 	OUTPUT:
+ 		RETVAL
+ 
+ void
+ spi_spi_freeplan(query)
+ 	char *query;
+ 	CODE:
+ 		plperl_spi_freeplan(query);
+ 
+ void
+ spi_spi_cursor_close(cursor)
+ 	char *cursor;
+ 	CODE:
+ 		plperl_spi_cursor_close(cursor);
+ 
+ 
  BOOT:
      items = 0;  /* avoid 'unused variable' warning */
diff -rcN plperl.cvs/expected/plperl.out plperl.0/expected/plperl.out
*** plperl.cvs/expected/plperl.out	Tue Nov 22 11:48:57 2005
--- plperl.0/expected/plperl.out	Thu Dec  8 10:35:57 2005
***************
*** 367,372 ****
--- 367,386 ----
               2
  (2 rows)
+ --
+ -- Test spi_fetchrow abort
+ --
+ CREATE OR REPLACE FUNCTION perl_spi_func2() RETURNS INTEGER AS $$
+ my $x = spi_query("select 1 as a union select 2 as a");
+ spi_cursor_close( $x);
+ return 0;
+ $$ LANGUAGE plperl;
+ SELECT * from perl_spi_func2();
+  perl_spi_func2 
+ ----------------
+               0
+ (1 row)
+ 
  ---
  --- Test recursion via SPI
  ---
***************
*** 419,422 ****
--- 433,470 ----
  ---------------------------------------
   {{"a\"b",NULL,"c,d"},{"e\\f",NULL,g}}
  (1 row)
+ 
+ --
+ -- Test spi_prepare/spi_exec_prepared/spi_freeplan
+ --
+ CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$
+    my $x = spi_prepare('select $1 AS a', 'INT4');
+    my $q = spi_exec_prepared( $x, $_[0] + 1);
+    spi_freeplan($x);
+ return $q->{rows}->[0]->{a};
+ $$ LANGUAGE plperl;
+ SELECT * from perl_spi_prepared(42);
+  perl_spi_prepared 
+ -------------------
+                 43
+ (1 row)
+ 
+ --
+ -- Test spi_prepare/spi_query_prepared/spi_freeplan
+ --
+ CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF INTEGER AS $$
+   my $x = spi_prepare('SELECT $1 AS a union select $2 as a', 'INT4', 'INT4');
+   my $q = spi_query_prepared( $x, 1+$_[0], 2+$_[1]);
+   while (defined (my $y = spi_fetchrow($q))) {
+       return_next $y->{a};
+   }
+   spi_freeplan($x);
+   return;
+ $$ LANGUAGE plperl;
+ SELECT * from perl_spi_prepared_set(1,2);
+  perl_spi_prepared_set 
+ -----------------------
+                      2
+                      4
+ (2 rows)
diff -rcN plperl.cvs/plperl.c plperl.0/plperl.c
*** plperl.cvs/plperl.c	Thu Dec  1 13:49:22 2005
--- plperl.0/plperl.c	Thu Dec  8 10:51:31 2005
***************
*** 55,60 ****
--- 55,61 ----
  #include "utils/typcache.h"
  #include "miscadmin.h"
  #include "mb/pg_wchar.h"
+ #include "parser/parse_type.h"
  /* perl stuff */
  #include "EXTERN.h"
***************
*** 92,97 ****
--- 93,110 ----
  	SV		   *reference;
  } plperl_proc_desc;
+ /**********************************************************************
+  * The information we cache about prepared and saved plans
+  **********************************************************************/
+ typedef struct plperl_query_desc
+ {
+ 	char		qname[sizeof(long) * 2 + 1];
+ 	void	   *plan;
+ 	int			nargs;
+ 	Oid		   *argtypes;
+ 	FmgrInfo   *arginfuncs;
+ 	Oid		   *argtypioparams;
+ } plperl_query_desc;
  /**********************************************************************
   * Global data
***************
*** 100,105 ****
--- 113,119 ----
  static bool plperl_safe_init_done = false;
  static PerlInterpreter *plperl_interp = NULL;
  static HV  *plperl_proc_hash = NULL;
+ static HV  *plperl_query_hash = NULL;

static bool plperl_use_strict = false;

***************
*** 229,235 ****
  	"$PLContainer->permit_only(':default');" \
  	"$PLContainer->permit(qw[:base_math !:base_io sort time]);" \
  	"$PLContainer->share(qw[&elog &spi_exec_query &return_next " \
! 	"&spi_query &spi_fetchrow " \
  	"&_plperl_to_pg_array " \
  	"&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED ]);" \
  	"sub ::mksafefunc {" \
--- 243,250 ----
  	"$PLContainer->permit_only(':default');" \
  	"$PLContainer->permit(qw[:base_math !:base_io sort time]);" \
  	"$PLContainer->share(qw[&elog &spi_exec_query &return_next " \
! 	"&spi_query &spi_fetchrow &spi_cursor_close " \
! 	"&spi_prepare &spi_exec_prepared &spi_query_prepared &spi_freeplan " \
  	"&_plperl_to_pg_array " \
  	"&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED ]);" \
  	"sub ::mksafefunc {" \
***************
*** 269,274 ****
--- 284,290 ----
  	perl_run(plperl_interp);

plperl_proc_hash = newHV();
+ plperl_query_hash = newHV();
}

***************
*** 1184,1190 ****
{
bool uptodate;

! prodesc = (plperl_proc_desc *) SvIV(*svp);

  		/************************************************************
  		 * If it's present, must check whether it's still up to date.
--- 1200,1206 ----
  	{
  		bool		uptodate;

! prodesc = INT2PTR( plperl_proc_desc *, SvUV(*svp));

/************************************************************
* If it's present, must check whether it's still up to date.
***************
*** 1382,1388 ****
}

hv_store(plperl_proc_hash, internal_proname, proname_len,
! newSViv((IV) prodesc), 0);
}

  	ReleaseSysCache(procTup);
--- 1398,1404 ----
  		}

hv_store(plperl_proc_hash, internal_proname, proname_len,
! newSVuv( PTR2UV( prodesc)), 0);
}

ReleaseSysCache(procTup);
***************
*** 1654,1669 ****
PG_TRY();
{
void *plan;
! Portal portal = NULL;

/* Create a cursor for the query */
plan = SPI_prepare(query, 0, NULL);
! if (plan)
! portal = SPI_cursor_open(NULL, plan, NULL, NULL, false);
! if (portal)
! cursor = newSVpv(portal->name, 0);
! else
! cursor = newSV(0);

  		/* Commit the inner transaction, return to outer xact context */
  		ReleaseCurrentSubTransaction();
--- 1670,1689 ----
  	PG_TRY();
  	{
  		void	   *plan;
! 		Portal		portal;

/* Create a cursor for the query */
plan = SPI_prepare(query, 0, NULL);
! if ( plan == NULL)
! elog(ERROR, "SPI_prepare() failed:%s",
! SPI_result_code_string(SPI_result));
!
! portal = SPI_cursor_open(NULL, plan, NULL, NULL, false);
! SPI_freeplan( plan);
! if ( portal == NULL)
! elog(ERROR, "SPI_cursor_open() failed:%s",
! SPI_result_code_string(SPI_result));
! cursor = newSVpv(portal->name, 0);

/* Commit the inner transaction, return to outer xact context */
ReleaseCurrentSubTransaction();
***************
*** 1730,1743 ****
Portal p = SPI_cursor_find(cursor);

  		if (!p)
! 			row = newSV(0);
  		else
  		{
  			SPI_cursor_fetch(p, true, 1);
  			if (SPI_processed == 0)
  			{
  				SPI_cursor_close(p);
! 				row = newSV(0);
  			}
  			else
  			{
--- 1750,1763 ----
  		Portal		p = SPI_cursor_find(cursor);
  		if (!p)
! 			row = &PL_sv_undef;
  		else
  		{
  			SPI_cursor_fetch(p, true, 1);
  			if (SPI_processed == 0)
  			{
  				SPI_cursor_close(p);
! 				row = &PL_sv_undef;
  			}
  			else
  			{
***************
*** 1788,1791 ****
--- 1808,2242 ----
  	PG_END_TRY();
  	return row;
+ }
+ 
+ void
+ plperl_spi_cursor_close(char *cursor)
+ {
+ 	Portal p = SPI_cursor_find(cursor);
+ 	if (p)
+ 		SPI_cursor_close(p);
+ }
+ 
+ SV *
+ plperl_spi_prepare(char* query, int argc, SV ** argv)
+ {
+ 	plperl_query_desc *qdesc;
+ 	void	   *plan;
+ 	int			i;
+ 	HeapTuple	typeTup;
+ 
+ 	MemoryContext oldcontext = CurrentMemoryContext;
+ 	ResourceOwner oldowner = CurrentResourceOwner;
+ 
+ 	BeginInternalSubTransaction(NULL);
+ 	MemoryContextSwitchTo(oldcontext);
+ 
+ 	/************************************************************
+ 	 * Allocate the new querydesc structure
+ 	 ************************************************************/
+ 	qdesc = (plperl_query_desc *) malloc(sizeof(plperl_query_desc));
+ 	MemSet(qdesc, 0, sizeof(plperl_query_desc));
+ 	snprintf(qdesc-> qname, sizeof(qdesc-> qname), "%lx", (long) qdesc);
+ 	qdesc-> nargs = argc;
+ 	qdesc-> argtypes = (Oid *) malloc(argc * sizeof(Oid));
+ 	qdesc-> arginfuncs = (FmgrInfo *) malloc(argc * sizeof(FmgrInfo));
+ 	qdesc-> argtypioparams = (Oid *) malloc(argc * sizeof(Oid));
+ 
+ 	PG_TRY();
+ 	{
+ 		/************************************************************
+ 		 * Lookup the argument types by name in the system cache
+ 		 * and remember the required information for input conversion
+ 		 ************************************************************/
+ 		for (i = 0; i < argc; i++)
+ 		{
+ 			char	   *argcopy;
+ 			List	   *names = NIL;
+ 			ListCell   *l;
+ 			TypeName   *typename;
+ 
+ 			/************************************************************
+ 			 * Use SplitIdentifierString() on a copy of the type name,
+ 			 * turn the resulting pointer list into a TypeName node
+ 			 * and call typenameType() to get the pg_type tuple.
+ 			 ************************************************************/
+ 			argcopy = pstrdup(SvPV(argv[i],PL_na));
+ 			SplitIdentifierString(argcopy, '.', &names);
+ 			typename = makeNode(TypeName);
+ 			foreach(l, names)
+ 				typename->names = lappend(typename->names, makeString(lfirst(l)));
+ 
+ 			typeTup = typenameType(typename);
+ 			qdesc->argtypes[i] = HeapTupleGetOid(typeTup);
+ 			perm_fmgr_info(((Form_pg_type) GETSTRUCT(typeTup))->typinput,
+ 						   &(qdesc->arginfuncs[i]));
+ 			qdesc->argtypioparams[i] = getTypeIOParam(typeTup);
+ 			ReleaseSysCache(typeTup);
+ 
+ 			list_free(typename->names);
+ 			pfree(typename);
+ 			list_free(names);
+ 			pfree(argcopy);
+ 		}
+ 
+ 		/************************************************************
+ 		 * Prepare the plan and check for errors
+ 		 ************************************************************/
+ 		plan = SPI_prepare(query, argc, qdesc->argtypes);
+ 
+ 		if (plan == NULL)
+ 			elog(ERROR, "SPI_prepare() failed:%s",
+ 				SPI_result_code_string(SPI_result));
+ 
+ 		/************************************************************
+ 		 * Save the plan into permanent memory (right now it's in the
+ 		 * SPI procCxt, which will go away at function end).
+ 		 ************************************************************/
+ 		qdesc->plan = SPI_saveplan(plan);
+ 		if (qdesc->plan == NULL)
+ 			elog(ERROR, "SPI_saveplan() failed: %s", 
+ 				SPI_result_code_string(SPI_result));
+ 
+ 		/* Release the procCxt copy to avoid within-function memory leak */
+ 		SPI_freeplan(plan);
+ 
+ 		/* Commit the inner transaction, return to outer xact context */
+ 		ReleaseCurrentSubTransaction();
+ 		MemoryContextSwitchTo(oldcontext);
+ 		CurrentResourceOwner = oldowner;
+ 		/*
+ 		 * AtEOSubXact_SPI() should not have popped any SPI context,
+ 		 * but just in case it did, make sure we remain connected.
+ 		 */
+ 		SPI_restore_connection();
+ 	}
+ 	PG_CATCH();
+ 	{
+ 		ErrorData  *edata;
+ 		
+ 		free(qdesc-> argtypes);
+ 		free(qdesc-> arginfuncs);
+ 		free(qdesc-> argtypioparams);
+ 		free(qdesc);
+ 
+ 		/* Save error info */
+ 		MemoryContextSwitchTo(oldcontext);
+ 		edata = CopyErrorData();
+ 		FlushErrorState();
+ 
+ 		/* Abort the inner transaction */
+ 		RollbackAndReleaseCurrentSubTransaction();
+ 		MemoryContextSwitchTo(oldcontext);
+ 		CurrentResourceOwner = oldowner;
+ 
+ 		/*
+ 		 * If AtEOSubXact_SPI() popped any SPI context of the subxact,
+ 		 * it will have left us in a disconnected state.  We need this
+ 		 * hack to return to connected state.
+ 		 */
+ 		SPI_restore_connection();
+ 
+ 		/* Punt the error to Perl */
+ 		croak("%s", edata->message);
+ 
+ 		/* Can't get here, but keep compiler quiet */
+ 		return NULL;
+ 	}
+ 	PG_END_TRY();
+ 
+ 	/************************************************************
+ 	 * Insert a hashtable entry for the plan and return
+ 	 * the key to the caller.
+ 	 ************************************************************/
+ 	hv_store( plperl_query_hash, qdesc->qname, strlen(qdesc->qname), newSVuv( PTR2UV( qdesc)), 0);
+ 
+ 	return newSVpv( qdesc->qname, strlen(qdesc->qname));
+ }	
+ 
+ HV *
+ plperl_spi_exec_prepared(char* query, HV * attr, int argc, SV ** argv)
+ {
+ 	HV		   *ret_hv;
+ 	SV **sv;
+ 	int i, limit, spi_rv;
+ 	char * nulls;
+ 	Datum	   *argvalues;
+ 	plperl_query_desc *qdesc;
+ 
+ 	/*
+ 	 * Execute the query inside a sub-transaction, so we can cope with
+ 	 * errors sanely
+ 	 */
+ 	MemoryContext oldcontext = CurrentMemoryContext;
+ 	ResourceOwner oldowner = CurrentResourceOwner;
+ 
+ 	BeginInternalSubTransaction(NULL);
+ 	/* Want to run inside function's memory context */
+ 	MemoryContextSwitchTo(oldcontext);
+ 
+ 	PG_TRY();
+ 	{
+ 		/************************************************************
+ 		 * Fetch the saved plan descriptor, see if it's o.k.
+ 		 ************************************************************/
+ 		sv = hv_fetch(plperl_query_hash, query, strlen(query), 0);
+ 		if ( sv == NULL) 
+ 			elog(ERROR, "spi_exec_prepared: Invalid prepared query passed");
+ 		if ( *sv == NULL || !SvOK( *sv))
+ 			elog(ERROR, "spi_exec_prepared: panic - plperl_query_hash value corrupted");
+ 
+ 		qdesc = INT2PTR( plperl_query_desc *, SvUV(*sv));
+ 		if ( qdesc == NULL)
+ 			elog(ERROR, "spi_exec_prepared: panic - plperl_query_hash value vanished");
+ 
+ 		if ( qdesc-> nargs != argc) 
+ 			elog(ERROR, "spi_exec_prepared: expected %d argument(s), %d passed", 
+ 				qdesc-> nargs, argc);
+ 		
+ 		/************************************************************
+ 		 * Parse eventual attributes
+ 		 ************************************************************/
+ 		limit = 0;
+ 		if ( attr != NULL) {
+ 			sv = hv_fetch( attr, "limit", 5, 0);
+ 			if ( *sv && SvIOK( *sv))
+ 				limit = SvIV( *sv);
+ 		}
+ 		/************************************************************
+ 		 * Set up arguments
+ 		 ************************************************************/
+ 		if ( argc > 0) {
+ 			nulls = (char *)palloc( argc);
+ 			argvalues = (Datum *) palloc(argc * sizeof(Datum));
+ 			if ( nulls == NULL || argvalues == NULL) 
+ 				elog(ERROR, "spi_exec_prepared: not enough memory");
+ 		} else {
+ 			nulls = NULL;
+ 			argvalues = NULL;
+ 		}
+ 
+ 		for ( i = 0; i < argc; i++) {
+ 			if ( SvTYPE( argv[i]) != SVt_NULL) {
+ 				argvalues[i] =
+ 					FunctionCall3( &qdesc->arginfuncs[i],
+ 						  CStringGetDatum( SvPV( argv[i], PL_na)),
+ 						  ObjectIdGetDatum( qdesc->argtypioparams[i]),
+ 						  Int32GetDatum(-1)
+ 					);
+ 				nulls[i] = ' ';
+ 			} else {
+ 				argvalues[i] = (Datum) 0;
+ 				nulls[i] = 'n';
+ 			}
+ 		}
+ 
+ 		/************************************************************
+ 		 * go
+ 		 ************************************************************/
+ 		spi_rv = SPI_execute_plan(qdesc-> plan, argvalues, nulls, 
+ 							 plperl_current_prodesc->fn_readonly, limit);
+ 		ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed,
+ 												 spi_rv);
+ 		if ( argc > 0) {
+ 			pfree( argvalues);
+ 			pfree( nulls);
+ 		}
+ 
+ 		/* Commit the inner transaction, return to outer xact context */
+ 		ReleaseCurrentSubTransaction();
+ 		MemoryContextSwitchTo(oldcontext);
+ 		CurrentResourceOwner = oldowner;
+ 		/*
+ 		 * AtEOSubXact_SPI() should not have popped any SPI context,
+ 		 * but just in case it did, make sure we remain connected.
+ 		 */
+ 		SPI_restore_connection();
+ 	}
+ 	PG_CATCH();
+ 	{
+ 		ErrorData  *edata;
+ 
+ 		/* Save error info */
+ 		MemoryContextSwitchTo(oldcontext);
+ 		edata = CopyErrorData();
+ 		FlushErrorState();
+ 
+ 		/* Abort the inner transaction */
+ 		RollbackAndReleaseCurrentSubTransaction();
+ 		MemoryContextSwitchTo(oldcontext);
+ 		CurrentResourceOwner = oldowner;
+ 
+ 		/*
+ 		 * If AtEOSubXact_SPI() popped any SPI context of the subxact,
+ 		 * it will have left us in a disconnected state.  We need this
+ 		 * hack to return to connected state.
+ 		 */
+ 		SPI_restore_connection();
+ 
+ 		/* Punt the error to Perl */
+ 		croak("%s", edata->message);
+ 
+ 		/* Can't get here, but keep compiler quiet */
+ 		return NULL;
+ 	}
+ 	PG_END_TRY();
+ 
+ 	return ret_hv;
+ }
+ 
+ SV *
+ plperl_spi_query_prepared(char* query, int argc, SV ** argv)
+ {
+ 	SV **sv;
+ 	int i;
+ 	char * nulls;
+ 	Datum	   *argvalues;
+ 	plperl_query_desc *qdesc;
+ 	SV *cursor;
+ 	Portal portal = NULL;
+ 
+ 	/*
+ 	 * Execute the query inside a sub-transaction, so we can cope with
+ 	 * errors sanely
+ 	 */
+ 	MemoryContext oldcontext = CurrentMemoryContext;
+ 	ResourceOwner oldowner = CurrentResourceOwner;
+ 
+ 	BeginInternalSubTransaction(NULL);
+ 	/* Want to run inside function's memory context */
+ 	MemoryContextSwitchTo(oldcontext);
+ 
+ 	PG_TRY();
+ 	{
+ 		/************************************************************
+ 		 * Fetch the saved plan descriptor, see if it's o.k.
+ 		 ************************************************************/
+ 		sv = hv_fetch(plperl_query_hash, query, strlen(query), 0);
+ 		if ( sv == NULL) 
+ 			elog(ERROR, "spi_query_prepared: Invalid prepared query passed");
+ 		if ( *sv == NULL || !SvOK( *sv))
+ 			elog(ERROR, "spi_query_prepared: panic - plperl_query_hash value corrupted");
+ 
+ 		qdesc = INT2PTR( plperl_query_desc *, SvUV(*sv));
+ 		if ( qdesc == NULL)
+ 			elog(ERROR, "spi_query_prepared: panic - plperl_query_hash value vanished");
+ 
+ 		if ( qdesc-> nargs != argc) 
+ 			elog(ERROR, "spi_query_prepared: expected %d argument(s), %d passed", 
+ 				qdesc-> nargs, argc);
+ 		
+ 		/************************************************************
+ 		 * Set up arguments
+ 		 ************************************************************/
+ 		if ( argc > 0) {
+ 			nulls = (char *)palloc( argc);
+ 			argvalues = (Datum *) palloc(argc * sizeof(Datum));
+ 			if ( nulls == NULL || argvalues == NULL) 
+ 				elog(ERROR, "spi_query_prepared: not enough memory");
+ 		} else {
+ 			nulls = NULL;
+ 			argvalues = NULL;
+ 		}
+ 
+ 		for ( i = 0; i < argc; i++) {
+ 			if ( SvTYPE( argv[i]) != SVt_NULL) {
+ 				argvalues[i] =
+ 					FunctionCall3( &qdesc->arginfuncs[i],
+ 						  CStringGetDatum( SvPV( argv[i], PL_na)),
+ 						  ObjectIdGetDatum( qdesc->argtypioparams[i]),
+ 						  Int32GetDatum(-1)
+ 					);
+ 				nulls[i] = ' ';
+ 			} else {
+ 				argvalues[i] = (Datum) 0;
+ 				nulls[i] = 'n';
+ 			}
+ 		}
+ 
+ 		/************************************************************
+ 		 * go
+ 		 ************************************************************/
+ 		portal = SPI_cursor_open(NULL, qdesc-> plan, argvalues, nulls, 
+ 							plperl_current_prodesc->fn_readonly);
+ 		if ( argc > 0) {
+ 			pfree( argvalues);
+ 			pfree( nulls);
+ 		}
+ 		if ( portal == NULL) 
+ 			elog(ERROR, "SPI_cursor_open() failed:%s",
+ 				SPI_result_code_string(SPI_result));
+ 
+ 		cursor = newSVpv(portal->name, 0);
+ 
+ 		/* Commit the inner transaction, return to outer xact context */
+ 		ReleaseCurrentSubTransaction();
+ 		MemoryContextSwitchTo(oldcontext);
+ 		CurrentResourceOwner = oldowner;
+ 		/*
+ 		 * AtEOSubXact_SPI() should not have popped any SPI context,
+ 		 * but just in case it did, make sure we remain connected.
+ 		 */
+ 		SPI_restore_connection();
+ 	}
+ 	PG_CATCH();
+ 	{
+ 		ErrorData  *edata;
+ 
+ 		/* Save error info */
+ 		MemoryContextSwitchTo(oldcontext);
+ 		edata = CopyErrorData();
+ 		FlushErrorState();
+ 
+ 		/* Abort the inner transaction */
+ 		RollbackAndReleaseCurrentSubTransaction();
+ 		MemoryContextSwitchTo(oldcontext);
+ 		CurrentResourceOwner = oldowner;
+ 
+ 		/*
+ 		 * If AtEOSubXact_SPI() popped any SPI context of the subxact,
+ 		 * it will have left us in a disconnected state.  We need this
+ 		 * hack to return to connected state.
+ 		 */
+ 		SPI_restore_connection();
+ 
+ 		/* Punt the error to Perl */
+ 		croak("%s", edata->message);
+ 
+ 		/* Can't get here, but keep compiler quiet */
+ 		return NULL;
+ 	}
+ 	PG_END_TRY();
+ 
+ 	return cursor;
+ }
+ 
+ void
+ plperl_spi_freeplan(char *query)
+ {
+ 	SV ** sv;
+ 	void * plan;
+ 	plperl_query_desc *qdesc;
+ 
+ 	sv = hv_fetch(plperl_query_hash, query, strlen(query), 0);
+ 	if ( sv == NULL) 
+ 		elog(ERROR, "spi_exec_freeplan: Invalid prepared query passed");
+ 	if ( *sv == NULL || !SvOK( *sv))
+ 		elog(ERROR, "spi_exec_freeplan: panic - plperl_query_hash value corrupted");
+ 
+ 	qdesc = INT2PTR( plperl_query_desc *, SvUV(*sv));
+ 	if ( qdesc == NULL)
+ 		elog(ERROR, "spi_exec_freeplan: panic - plperl_query_hash value vanished");
+ 
+ 	/*
+ 	*	free all memory before SPI_freeplan, so if it dies, nothing will be left over
+ 	*/
+ 	hv_delete(plperl_query_hash, query, strlen(query), G_DISCARD);
+ 	plan = qdesc-> plan;
+ 	free(qdesc-> argtypes);
+ 	free(qdesc-> arginfuncs);
+ 	free(qdesc-> argtypioparams);
+ 	free(qdesc);
+ 
+ 	SPI_freeplan( plan);
  }
diff -rcN plperl.cvs/spi_internal.h plperl.0/spi_internal.h
*** plperl.cvs/spi_internal.h	Thu Oct 27 12:34:30 2005
--- plperl.0/spi_internal.h	Thu Dec  8 10:35:57 2005
***************
*** 20,22 ****
--- 20,27 ----
  void		plperl_return_next(SV *);
  SV		   *plperl_spi_query(char *);
  SV		   *plperl_spi_fetchrow(char *);
+ SV *plperl_spi_prepare(char *, int, SV **);
+ HV *plperl_spi_exec_prepared(char *, HV *, int, SV **);
+ SV *plperl_spi_query_prepared(char *, int, SV **);
+ void plperl_spi_freeplan(char *);
+ void plperl_spi_cursor_close(char *);
diff -rcN plperl.cvs/sql/plperl.sql plperl.0/sql/plperl.sql
*** plperl.cvs/sql/plperl.sql	Tue Nov 22 11:48:57 2005
--- plperl.0/sql/plperl.sql	Thu Dec  8 10:36:00 2005
***************
*** 261,266 ****
--- 261,276 ----
  $$ LANGUAGE plperl;
  SELECT * from perl_spi_func();
+ --
+ -- Test spi_fetchrow abort
+ --
+ CREATE OR REPLACE FUNCTION perl_spi_func2() RETURNS INTEGER AS $$
+ my $x = spi_query("select 1 as a union select 2 as a");
+ spi_cursor_close( $x);
+ return 0;
+ $$ LANGUAGE plperl;
+ SELECT * from perl_spi_func2();
+ 
  ---
  --- Test recursion via SPI
***************
*** 300,303 ****
      return [['a"b',undef,'c,d'],['e\\f',undef,'g']]; 
  $$;
! SELECT array_of_text(); 
--- 310,339 ----
      return [['a"b',undef,'c,d'],['e\\f',undef,'g']]; 
  $$;

! SELECT array_of_text();
!
! --
! -- Test spi_prepare/spi_exec_prepared/spi_freeplan
! --
! CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$
! my $x = spi_prepare('select $1 AS a', 'INT4');
! my $q = spi_exec_prepared( $x, $_[0] + 1);
! spi_freeplan($x);
! return $q->{rows}->[0]->{a};
! $$ LANGUAGE plperl;
! SELECT * from perl_spi_prepared(42);
!
! --
! -- Test spi_prepare/spi_query_prepared/spi_freeplan
! --
! CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF INTEGER AS $$
! my $x = spi_prepare('SELECT $1 AS a union select $2 as a', 'INT4', 'INT4');
! my $q = spi_query_prepared( $x, 1+$_[0], 2+$_[1]);
! while (defined (my $y = spi_fetchrow($q))) {
! return_next $y->{a};
! }
! spi_freeplan($x);
! return;
! $$ LANGUAGE plperl;
! SELECT * from perl_spi_prepared_set(1,2);
!

#2Andrew Dunstan
andrew@dunslane.net
In reply to: Dmitry Karasik (#1)
Re: implement prepared queries in plperl

Dmitry,

please supply documentation (i.e. a patch to the SGML) to accompany this
patch, or at the very least a description of how it works, with the
promise of proper documentation to follow.

cheers

andrew

#3Dmitry Karasik
dmitry@karasik.eu.org
In reply to: Andrew Dunstan (#2)
Re: implement prepared queries in plperl

Dmitry,

please supply documentation (i.e. a patch to the SGML) to accompany this
patch, or at the very least a description of how it works, with the
promise of proper documentation to follow.

I am willing to write a proper documentation, but I haven't found the place
where to add descriptions for the new functions, and neither the SGML document
you're referring to, but I can submit a patch to it if you tell me where it is.
If you take this as a promise of proper documentation, I'll explain in short
how it works here:

I added the following functions:

* spi_prepare( $QUERY, @ARGUMENT_TYPES) : $PREPARED_QUERY - prepares a query
with typed parameters, returns a prepared query token.

* spi_exec_prepared( $PREPARED_QUERY, [%ATTRIBUTES], @ARGUMENTS) : $RESULT -
executes a prepared query, returns the result in the same format as
spi_exec_query() does. %ATTRIBUTES currently recognizes the only integer
'limit', which is the same as limit in spi_exec_query().

* spi_query_prepared( $PREPARED_QUERY, @ARGUMENTS) : $CURSOR - same as spi_query(),
but instead of a text query statement, expects a result of spi_prepare() as the
first parameter.

* spi_freeplan( $PREPARED_QUERY) - frees the prepared query, must be called explicitly.

* spi_cursor_close($CURSOR) - a wrapper around SPI_cursor_close(),
to cancel a query session early, which would normally be freed after the last
spi_fetchrow() is called. $CURSOR is returned either by spi_query() or
spi_query_prepared().

There are also the following fixes to the existing code:

- A fix to memory leaks in spi_fetchrow(), by replacing newSV(0) that is intended
to signal an error but was never freed, to PL_sv_undef that is safe to return
as a non-mortal scalar.

- Replace (pointer_type*) SvIV(pointer) to INT2PTR( pointer_type*, SvUV(pointer)),
to extinguish warnings.

- Changed logic in plperl_spi_query() which I don't think correctly handled the
case when SPI_prepare() fails.

--
Sincerely,
Dmitry Karasik

---
catpipe Systems ApS
*BSD solutions, consulting, development
www.catpipe.net
+45 7021 0050

#4Andrew Dunstan
andrew@dunslane.net
In reply to: Dmitry Karasik (#3)
Re: implement prepared queries in plperl

Dmitry Karasik wrote:

Dmitry,

please supply documentation (i.e. a patch to the SGML) to accompany this
patch, or at the very least a description of how it works, with the
promise of proper documentation to follow.

I am willing to write a proper documentation, but I haven't found the place
where to add descriptions for the new functions, and neither the SGML document
you're referring to, but I can submit a patch to it if you tell me where it is.

You should probably be working from a CVS checkout, on which case the
file you would need to edit is doc/src/sgml/plperl.sgml

You might find the following references useful if you haven't read them
already:

http://www.postgresql.org/developer/sourcecode and
http://www.postgresql.org/docs/faqs.FAQ_DEV.html

If you take this as a promise of proper documentation, I'll explain in short
how it works here:

I will look this over in the next few weeks.

cheers

andrew

#5Dmitry Karasik
dmitry@karasik.eu.org
In reply to: Andrew Dunstan (#4)
Re: implement prepared queries in plperl

You should probably be working from a CVS checkout, on which case the
file you would need to edit is doc/src/sgml/plperl.sgml

Thanks! Next question: how do I convert these sgml files to html
or text or anything to proofread? If I run gmake, all I get is errors:
http://karasik.eu.org/misc/gmake . The script collateindex.pl is also
not included in the cvstree, so I'm not sure if I've installed the
required version.

--
Sincerely,
Dmitry Karasik

#6Dmitry Karasik
dmitry@karasik.eu.org
In reply to: Dmitry Karasik (#3)
1 attachment(s)
Re: implement prepared queries in plperl

please supply documentation (i.e. a patch to the SGML) to accompany this
patch

the patch to doc/src/sgml/plperl.sgml is attached.

--
Sincerely,
Dmitry Karasik

Attachments:

difftext/plain; charset=koi8-rDownload
Index: plperl.sgml
===================================================================
RCS file: /projects/cvsroot/pgsql/doc/src/sgml/plperl.sgml,v
retrieving revision 2.49
diff -c -r2.49 plperl.sgml
*** plperl.sgml	4 Nov 2005 23:14:00 -0000	2.49
--- plperl.sgml	9 Dec 2005 12:47:54 -0000
***************
*** 296,302 ****
    </para>
  
    <para>
!    PL/Perl provides three additional Perl commands:
  
     <variablelist>
      <varlistentry>
--- 296,302 ----
    </para>
  
    <para>
!    PL/Perl provides additional Perl commands:
  
     <variablelist>
      <varlistentry>
***************
*** 306,314 ****
       </indexterm>
  
       <term><literal><function>spi_exec_query</>(<replaceable>query</replaceable> [, <replaceable>max-rows</replaceable>])</literal></term>
-      <term><literal><function>spi_exec_query</>(<replaceable>command</replaceable>)</literal></term>
       <term><literal><function>spi_query</>(<replaceable>command</replaceable>)</literal></term>
!      <term><literal><function>spi_fetchrow</>(<replaceable>command</replaceable>)</literal></term>
  
       <listitem>
        <para>
--- 306,318 ----
       </indexterm>
  
       <term><literal><function>spi_exec_query</>(<replaceable>query</replaceable> [, <replaceable>max-rows</replaceable>])</literal></term>
       <term><literal><function>spi_query</>(<replaceable>command</replaceable>)</literal></term>
!      <term><literal><function>spi_fetchrow</>(<replaceable>cursor</replaceable>)</literal></term>
!      <term><literal><function>spi_prepare</>(<replaceable>command</replaceable>, <replaceable>argument types</replaceable>)</literal></term>
!      <term><literal><function>spi_exec_prepared</>(<replaceable>plan</replaceable>)</literal></term>
!      <term><literal><function>spi_query_prepared</>(<replaceable>plan</replaceable> [, <replaceable>attributes</replaceable>], <replaceable>arguments</replaceable>)</literal></term>
!      <term><literal><function>spi_cursor_close</>(<replaceable>cursor</replaceable>)</literal></term>
!      <term><literal><function>spi_freeplan</>(<replaceable>plan</replaceable>)</literal></term>
  
       <listitem>
        <para>
***************
*** 419,424 ****
--- 423,488 ----
  SELECT * from lotsa_md5(500);
  </programlisting>
      </para>
+       
+     <para>
+     <literal>spi_prepare</literal>, <literal>spi_query_prepared</literal>, <literal>spi_exec_prepared</literal>, 
+     and <literal>spi_freeplan</literal> implement the same functionality but for prepared queries. Once
+     a query plan is prepared by a call to <literal>spi_prepare</literal>, the plan can be used instead
+     of the string query, either in <literal>spi_exec_prepared</literal>, where the result is the same as returned
+     by <literal>spi_exec_query</literal>, or in <literal>spi_query_prepared</literal> which returns a cursor
+     exactly as <literal>spi_query</literal> does, which can be later passed to <literal>spi_fetchrow</literal>.
+     </para>
+     
+     <para>
+     The advantage of prepared queries is that is it possible to use one prepared plan for more
+     than one query execution. After the plan is not needed anymore, it must be freed with 
+     <literal>spi_freeplan</literal>:
+     </para>
+ 
+     <para>
+     <programlisting>
+ CREATE OR REPLACE FUNCTION init() RETURNS INTEGER AS $$
+ 	$_SHARED{my_plan} = spi_prepare( 'SELECT (now() + $1)::date AS now', 'INTERVAL');
+ $$ LANGUAGE plperl;
+ 
+ CREATE OR REPLACE FUNCTION add_time( INTERVAL ) RETURNS TEXT AS $$
+ 	return spi_exec_prepared( 
+ 		$_SHARED{my_plan},
+ 		$_[0],
+ 	)->{rows}->[0]->{now};
+ $$ LANGUAGE plperl;
+ 
+ CREATE OR REPLACE FUNCTION done() RETURNS INTEGER AS $$
+ 	spi_freeplan( $_SHARED{my_plan});
+ 	undef $_SHARED{my_plan};
+ $$ LANGUAGE plperl;
+ 
+ SELECT init();
+ SELECT add_time('1 day'), add_time('2 days'), add_time('3 days');
+ SELECT done();
+ 
+   add_time  |  add_time  |  add_time  
+ ------------+------------+------------
+  2005-12-10 | 2005-12-11 | 2005-12-12
+     </programlisting>
+     </para>
+ 
+     <para>
+     Note that the parameter subscript in <literal>spi_prepare</literal> is defined via
+     $1, $2, $3, etc, so avoid declaring query strings in double quotes that might easily
+     lead to hard-to-catch bugs.
+     </para>
+ 
+     <para>
+     <literal>spi_cursor_close</literal> can be used to abort sequence of
+     <literal>spi_fetchrow</literal> calls. Normally, the call to
+     <literal>spi_fetchrow</literal> that returns <literal>undef</literal> is
+     the signal that there are no more rows to read. Also
+     that call automatically frees the cursor associated with the query. If it is desired not
+     to read all retuned rows, <literal>spi_cursor_close</literal> must be
+     called to avoid memory leaks.  
+     </para>
+ 
  
       </listitem>
      </varlistentry>
#7Peter Eisentraut
peter_e@gmx.net
In reply to: Dmitry Karasik (#5)
Re: implement prepared queries in plperl

Dmitry Karasik wrote:

Thanks! Next question: how do I convert these sgml files to html
or text or anything to proofread? If I run gmake, all I get is
errors: http://karasik.eu.org/misc/gmake . The script collateindex.pl
is also not included in the cvstree, so I'm not sure if I've
installed the required version.

See here for the required tools:
http://www.postgresql.org/docs/8.1/static/docguide.html

--
Peter Eisentraut
http://developer.postgresql.org/~petere/

#8Andrew Dunstan
andrew@dunslane.net
In reply to: Dmitry Karasik (#1)
1 attachment(s)
Re: implement prepared queries in plperl

Dmitry Karasik wrote:

[patch snipped]

I have cleaned this patch somewhat by removing some bitrot that occurred
since it was submitted, and adjusting formatting to something more
closely resembling postgresql style (please remember to follow our style
in future).

The attached works on HEAD and passes the supplied regression tests.

But why do we have to call spi_freeplan? pltcl, which has prepared
queries, doesn't require this AFAICS. If memory leaks are an issue,
maybe we should bless the object into a class with a DESTROY method that
calls spi_freeplan automatically (not sure to do that in XS but I assume
it's possible).

cheers

andrew

Attachments:

pq-updated.patchtext/x-patch; name=pq-updated.patchDownload
Index: SPI.xs
===================================================================
RCS file: /cvsroot/pgsql/src/pl/plperl/SPI.xs,v
retrieving revision 1.18
diff -c -r1.18 SPI.xs
*** SPI.xs	8 Jan 2006 22:27:52 -0000	1.18
--- SPI.xs	19 Feb 2006 16:17:40 -0000
***************
*** 111,117 ****
  		int limit = 0;
  	CODE:
  		if (items > 2)
! 			croak("Usage: spi_exec_query(query, limit) or spi_exec_query(query)");
  		if (items == 2)
  			limit = SvIV(ST(1));
  		ret_hash = plperl_spi_exec(query, limit);
--- 111,118 ----
  		int limit = 0;
  	CODE:
  		if (items > 2)
! 			croak("Usage: spi_exec_query(query, limit) "
! 				  "or spi_exec_query(query)");
  		if (items == 2)
  			limit = SvIV(ST(1));
  		ret_hash = plperl_spi_exec(query, limit);
***************
*** 141,145 ****
--- 142,225 ----
  	OUTPUT:
  		RETVAL
  
+ SV*
+ spi_spi_prepare(query, ...)
+ 	char* query;
+ 	CODE:
+ 		int i;
+ 		SV** argv;
+ 		if (items < 1) 
+ 			Perl_croak(aTHX_ "Usage: spi_prepare(query, ...)");
+ 		argv = ( SV**) palloc(( items - 1) * sizeof(SV*));
+ 		if ( argv == NULL) 
+ 			Perl_croak(aTHX_ "spi_prepare: not enough memory");
+ 		for ( i = 1; i < items; i++) 
+ 			argv[i - 1] = ST(i);
+ 		RETVAL = plperl_spi_prepare(query, items - 1, argv);
+ 		pfree( argv);
+ 	OUTPUT:
+ 		RETVAL
+ 
+ SV*
+ spi_spi_exec_prepared(query, ...)
+ 	char * query;
+ 	PREINIT:
+ 		HV *ret_hash;
+ 	CODE:
+ 		HV *attr = NULL;
+ 		int i, offset = 1, argc;
+ 		SV ** argv;
+ 		if ( items < 1) 
+ 			Perl_croak(aTHX_ "Usage: spi_exec_prepared(query, [\\%%attr,] " 
+ 					   "[\\@bind_values])");
+ 		if ( items > 1 && SvROK( ST( 1)) && SvTYPE( SvRV( ST( 1))) == SVt_PVHV)
+ 		{ 
+ 			attr = ( HV*) SvRV(ST(1));
+ 			offset++;
+ 		}
+ 		argc = items - offset;
+ 		argv = ( SV**) palloc( argc * sizeof(SV*));
+ 		if ( argv == NULL) 
+ 			Perl_croak(aTHX_ "spi_exec_prepared: not enough memory");
+ 		for ( i = 0; offset < items; offset++, i++) 
+ 			argv[i] = ST(offset);
+ 		ret_hash = plperl_spi_exec_prepared(query, attr, argc, argv);
+ 		RETVAL = newRV_noinc((SV*)ret_hash);
+ 		pfree( argv);
+ 	OUTPUT:
+ 		RETVAL
+ 
+ SV*
+ spi_spi_query_prepared(query, ...)
+ 	char * query;
+ 	CODE:
+ 		int i;
+ 		SV ** argv;
+ 		if ( items < 1) 
+ 			Perl_croak(aTHX_ "Usage: spi_query_prepared(query, "
+ 					   "[\\@bind_values])");
+ 		argv = ( SV**) palloc(( items - 1) * sizeof(SV*));
+ 		if ( argv == NULL) 
+ 			Perl_croak(aTHX_ "spi_query_prepared: not enough memory");
+ 		for ( i = 1; i < items; i++) 
+ 			argv[i - 1] = ST(i);
+ 		RETVAL = plperl_spi_query_prepared(query, items - 1, argv);
+ 		pfree( argv);
+ 	OUTPUT:
+ 		RETVAL
+ 
+ void
+ spi_spi_freeplan(query)
+ 	char *query;
+ 	CODE:
+ 		plperl_spi_freeplan(query);
+ 
+ void
+ spi_spi_cursor_close(cursor)
+ 	char *cursor;
+ 	CODE:
+ 		plperl_spi_cursor_close(cursor);
+ 
+ 
  BOOT:
      items = 0;  /* avoid 'unused variable' warning */
Index: plperl.c
===================================================================
RCS file: /cvsroot/pgsql/src/pl/plperl/plperl.c,v
retrieving revision 1.101
diff -c -r1.101 plperl.c
*** plperl.c	28 Jan 2006 16:20:31 -0000	1.101
--- plperl.c	19 Feb 2006 16:17:41 -0000
***************
*** 56,61 ****
--- 56,62 ----
  #include "utils/typcache.h"
  #include "miscadmin.h"
  #include "mb/pg_wchar.h"
+ #include "parser/parse_type.h"
  
  /* define this before the perl headers get a chance to mangle DLLIMPORT */
  extern DLLIMPORT bool check_function_bodies;
***************
*** 99,104 ****
--- 100,117 ----
  	MemoryContext	  tmp_cxt;
  } plperl_call_data;
  
+ /**********************************************************************
+  * The information we cache about prepared and saved plans
+  **********************************************************************/
+ typedef struct plperl_query_desc
+ {
+ 	char		qname[sizeof(long) * 2 + 1];
+ 	void	   *plan;
+ 	int			nargs;
+ 	Oid		   *argtypes;
+ 	FmgrInfo   *arginfuncs;
+ 	Oid		   *argtypioparams;
+ } plperl_query_desc;
  
  /**********************************************************************
   * Global data
***************
*** 107,112 ****
--- 120,126 ----
  static bool plperl_safe_init_done = false;
  static PerlInterpreter *plperl_interp = NULL;
  static HV  *plperl_proc_hash = NULL;
+ static HV  *plperl_query_hash = NULL;
  
  static bool plperl_use_strict = false;
  
***************
*** 233,239 ****
  	"$PLContainer->permit_only(':default');" \
  	"$PLContainer->permit(qw[:base_math !:base_io sort time]);" \
  	"$PLContainer->share(qw[&elog &spi_exec_query &return_next " \
! 	"&spi_query &spi_fetchrow " \
  	"&_plperl_to_pg_array " \
  	"&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED ]);" \
  	"sub ::mksafefunc {" \
--- 247,254 ----
  	"$PLContainer->permit_only(':default');" \
  	"$PLContainer->permit(qw[:base_math !:base_io sort time]);" \
  	"$PLContainer->share(qw[&elog &spi_exec_query &return_next " \
! 	"&spi_query &spi_fetchrow &spi_cursor_close " \
! 	"&spi_prepare &spi_exec_prepared &spi_query_prepared &spi_freeplan " \
  	"&_plperl_to_pg_array " \
  	"&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED ]);" \
  	"sub ::mksafefunc {" \
***************
*** 312,317 ****
--- 327,333 ----
  	perl_run(plperl_interp);
  
  	plperl_proc_hash = newHV();
+ 	plperl_query_hash = newHV();
  
  #ifdef WIN32
  
***************
*** 1302,1308 ****
  	{
  		bool		uptodate;
  
! 		prodesc = (plperl_proc_desc *) SvIV(*svp);
  
  		/************************************************************
  		 * If it's present, must check whether it's still up to date.
--- 1318,1324 ----
  	{
  		bool		uptodate;
  
! 		prodesc = INT2PTR( plperl_proc_desc *, SvUV(*svp));
  
  		/************************************************************
  		 * If it's present, must check whether it's still up to date.
***************
*** 1500,1506 ****
  		}
  
  		hv_store(plperl_proc_hash, internal_proname, proname_len,
! 				 newSViv((IV) prodesc), 0);
  	}
  
  	ReleaseSysCache(procTup);
--- 1516,1522 ----
  		}
  
  		hv_store(plperl_proc_hash, internal_proname, proname_len,
! 				 newSVuv( PTR2UV( prodesc)), 0);
  	}
  
  	ReleaseSysCache(procTup);
***************
*** 1810,1825 ****
  	PG_TRY();
  	{
  		void	   *plan;
! 		Portal		portal = NULL;
  
  		/* Create a cursor for the query */
  		plan = SPI_prepare(query, 0, NULL);
! 		if (plan)
! 			portal = SPI_cursor_open(NULL, plan, NULL, NULL, false);
! 		if (portal)
! 			cursor = newSVpv(portal->name, 0);
! 		else
! 			cursor = newSV(0);
  
  		/* Commit the inner transaction, return to outer xact context */
  		ReleaseCurrentSubTransaction();
--- 1826,1845 ----
  	PG_TRY();
  	{
  		void	   *plan;
! 		Portal		portal;
  
  		/* Create a cursor for the query */
  		plan = SPI_prepare(query, 0, NULL);
! 		if ( plan == NULL)
! 			elog(ERROR, "SPI_prepare() failed:%s",
! 				SPI_result_code_string(SPI_result));
! 
! 		portal = SPI_cursor_open(NULL, plan, NULL, NULL, false);
! 		SPI_freeplan( plan);
! 		if ( portal == NULL) 
! 			elog(ERROR, "SPI_cursor_open() failed:%s",
! 				SPI_result_code_string(SPI_result));
! 		cursor = newSVpv(portal->name, 0);
  
  		/* Commit the inner transaction, return to outer xact context */
  		ReleaseCurrentSubTransaction();
***************
*** 1886,1899 ****
  		Portal		p = SPI_cursor_find(cursor);
  
  		if (!p)
! 			row = newSV(0);
  		else
  		{
  			SPI_cursor_fetch(p, true, 1);
  			if (SPI_processed == 0)
  			{
  				SPI_cursor_close(p);
! 				row = newSV(0);
  			}
  			else
  			{
--- 1906,1921 ----
  		Portal		p = SPI_cursor_find(cursor);
  
  		if (!p)
! 		{
! 			row = &PL_sv_undef;
! 		}
  		else
  		{
  			SPI_cursor_fetch(p, true, 1);
  			if (SPI_processed == 0)
  			{
  				SPI_cursor_close(p);
! 				row = &PL_sv_undef;
  			}
  			else
  			{
***************
*** 1945,1947 ****
--- 1967,2417 ----
  
  	return row;
  }
+ 
+ void
+ plperl_spi_cursor_close(char *cursor)
+ {
+ 	Portal p = SPI_cursor_find(cursor);
+ 	if (p)
+ 		SPI_cursor_close(p);
+ }
+ 
+ SV *
+ plperl_spi_prepare(char* query, int argc, SV ** argv)
+ {
+ 	plperl_query_desc *qdesc;
+ 	void	   *plan;
+ 	int			i;
+ 	HeapTuple	typeTup;
+ 
+ 	MemoryContext oldcontext = CurrentMemoryContext;
+ 	ResourceOwner oldowner = CurrentResourceOwner;
+ 
+ 	BeginInternalSubTransaction(NULL);
+ 	MemoryContextSwitchTo(oldcontext);
+ 
+ 	/************************************************************
+ 	 * Allocate the new querydesc structure
+ 	 ************************************************************/
+ 	qdesc = (plperl_query_desc *) malloc(sizeof(plperl_query_desc));
+ 	MemSet(qdesc, 0, sizeof(plperl_query_desc));
+ 	snprintf(qdesc-> qname, sizeof(qdesc-> qname), "%lx", (long) qdesc);
+ 	qdesc-> nargs = argc;
+ 	qdesc-> argtypes = (Oid *) malloc(argc * sizeof(Oid));
+ 	qdesc-> arginfuncs = (FmgrInfo *) malloc(argc * sizeof(FmgrInfo));
+ 	qdesc-> argtypioparams = (Oid *) malloc(argc * sizeof(Oid));
+ 
+ 	PG_TRY();
+ 	{
+ 		/************************************************************
+ 		 * Lookup the argument types by name in the system cache
+ 		 * and remember the required information for input conversion
+ 		 ************************************************************/
+ 		for (i = 0; i < argc; i++)
+ 		{
+ 			char	   *argcopy;
+ 			List	   *names = NIL;
+ 			ListCell   *l;
+ 			TypeName   *typename;
+ 
+ 			/************************************************************
+ 			 * Use SplitIdentifierString() on a copy of the type name,
+ 			 * turn the resulting pointer list into a TypeName node
+ 			 * and call typenameType() to get the pg_type tuple.
+ 			 ************************************************************/
+ 			argcopy = pstrdup(SvPV(argv[i],PL_na));
+ 			SplitIdentifierString(argcopy, '.', &names);
+ 			typename = makeNode(TypeName);
+ 			foreach(l, names)
+ 				typename->names = lappend(typename->names, makeString(lfirst(l)));
+ 
+ 			typeTup = typenameType(typename);
+ 			qdesc->argtypes[i] = HeapTupleGetOid(typeTup);
+ 			perm_fmgr_info(((Form_pg_type) GETSTRUCT(typeTup))->typinput,
+ 						   &(qdesc->arginfuncs[i]));
+ 			qdesc->argtypioparams[i] = getTypeIOParam(typeTup);
+ 			ReleaseSysCache(typeTup);
+ 
+ 			list_free(typename->names);
+ 			pfree(typename);
+ 			list_free(names);
+ 			pfree(argcopy);
+ 		}
+ 
+ 		/************************************************************
+ 		 * Prepare the plan and check for errors
+ 		 ************************************************************/
+ 		plan = SPI_prepare(query, argc, qdesc->argtypes);
+ 
+ 		if (plan == NULL)
+ 			elog(ERROR, "SPI_prepare() failed:%s",
+ 				SPI_result_code_string(SPI_result));
+ 
+ 		/************************************************************
+ 		 * Save the plan into permanent memory (right now it's in the
+ 		 * SPI procCxt, which will go away at function end).
+ 		 ************************************************************/
+ 		qdesc->plan = SPI_saveplan(plan);
+ 		if (qdesc->plan == NULL)
+ 			elog(ERROR, "SPI_saveplan() failed: %s", 
+ 				SPI_result_code_string(SPI_result));
+ 
+ 		/* Release the procCxt copy to avoid within-function memory leak */
+ 		SPI_freeplan(plan);
+ 
+ 		/* Commit the inner transaction, return to outer xact context */
+ 		ReleaseCurrentSubTransaction();
+ 		MemoryContextSwitchTo(oldcontext);
+ 		CurrentResourceOwner = oldowner;
+ 		/*
+ 		 * AtEOSubXact_SPI() should not have popped any SPI context,
+ 		 * but just in case it did, make sure we remain connected.
+ 		 */
+ 		SPI_restore_connection();
+ 	}
+ 	PG_CATCH();
+ 	{
+ 		ErrorData  *edata;
+ 		
+ 		free(qdesc-> argtypes);
+ 		free(qdesc-> arginfuncs);
+ 		free(qdesc-> argtypioparams);
+ 		free(qdesc);
+ 
+ 		/* Save error info */
+ 		MemoryContextSwitchTo(oldcontext);
+ 		edata = CopyErrorData();
+ 		FlushErrorState();
+ 
+ 		/* Abort the inner transaction */
+ 		RollbackAndReleaseCurrentSubTransaction();
+ 		MemoryContextSwitchTo(oldcontext);
+ 		CurrentResourceOwner = oldowner;
+ 
+ 		/*
+ 		 * If AtEOSubXact_SPI() popped any SPI context of the subxact,
+ 		 * it will have left us in a disconnected state.  We need this
+ 		 * hack to return to connected state.
+ 		 */
+ 		SPI_restore_connection();
+ 
+ 		/* Punt the error to Perl */
+ 		croak("%s", edata->message);
+ 
+ 		/* Can't get here, but keep compiler quiet */
+ 		return NULL;
+ 	}
+ 	PG_END_TRY();
+ 
+ 	/************************************************************
+ 	 * Insert a hashtable entry for the plan and return
+ 	 * the key to the caller.
+ 	 ************************************************************/
+ 	hv_store( plperl_query_hash, qdesc->qname, strlen(qdesc->qname), newSVuv( PTR2UV( qdesc)), 0);
+ 
+ 	return newSVpv( qdesc->qname, strlen(qdesc->qname));
+ }	
+ 
+ HV *
+ plperl_spi_exec_prepared(char* query, HV * attr, int argc, SV ** argv)
+ {
+ 	HV		   *ret_hv;
+ 	SV **sv;
+ 	int i, limit, spi_rv;
+ 	char * nulls;
+ 	Datum	   *argvalues;
+ 	plperl_query_desc *qdesc;
+ 
+ 	/*
+ 	 * Execute the query inside a sub-transaction, so we can cope with
+ 	 * errors sanely
+ 	 */
+ 	MemoryContext oldcontext = CurrentMemoryContext;
+ 	ResourceOwner oldowner = CurrentResourceOwner;
+ 
+ 	BeginInternalSubTransaction(NULL);
+ 	/* Want to run inside function's memory context */
+ 	MemoryContextSwitchTo(oldcontext);
+ 
+ 	PG_TRY();
+ 	{
+ 		/************************************************************
+ 		 * Fetch the saved plan descriptor, see if it's o.k.
+ 		 ************************************************************/
+ 		sv = hv_fetch(plperl_query_hash, query, strlen(query), 0);
+ 		if ( sv == NULL) 
+ 			elog(ERROR, "spi_exec_prepared: Invalid prepared query passed");
+ 		if ( *sv == NULL || !SvOK( *sv))
+ 			elog(ERROR, "spi_exec_prepared: panic - plperl_query_hash value corrupted");
+ 
+ 		qdesc = INT2PTR( plperl_query_desc *, SvUV(*sv));
+ 		if ( qdesc == NULL)
+ 			elog(ERROR, "spi_exec_prepared: panic - plperl_query_hash value vanished");
+ 
+ 		if ( qdesc-> nargs != argc) 
+ 			elog(ERROR, "spi_exec_prepared: expected %d argument(s), %d passed", 
+ 				qdesc-> nargs, argc);
+ 		
+ 		/************************************************************
+ 		 * Parse eventual attributes
+ 		 ************************************************************/
+ 		limit = 0;
+ 		if ( attr != NULL) 
+ 		{
+ 			sv = hv_fetch( attr, "limit", 5, 0);
+ 			if ( *sv && SvIOK( *sv))
+ 				limit = SvIV( *sv);
+ 		}
+ 		/************************************************************
+ 		 * Set up arguments
+ 		 ************************************************************/
+ 		if ( argc > 0) 
+ 		{
+ 			nulls = (char *)palloc( argc);
+ 			argvalues = (Datum *) palloc(argc * sizeof(Datum));
+ 			if ( nulls == NULL || argvalues == NULL) 
+ 				elog(ERROR, "spi_exec_prepared: not enough memory");
+ 		} 
+ 		else 
+ 		{
+ 			nulls = NULL;
+ 			argvalues = NULL;
+ 		}
+ 
+ 		for ( i = 0; i < argc; i++) 
+ 		{
+ 			if ( SvTYPE( argv[i]) != SVt_NULL) 
+ 			{
+ 				argvalues[i] =
+ 					FunctionCall3( &qdesc->arginfuncs[i],
+ 						  CStringGetDatum( SvPV( argv[i], PL_na)),
+ 						  ObjectIdGetDatum( qdesc->argtypioparams[i]),
+ 						  Int32GetDatum(-1)
+ 					);
+ 				nulls[i] = ' ';
+ 			} 
+ 			else 
+ 			{
+ 				argvalues[i] = (Datum) 0;
+ 				nulls[i] = 'n';
+ 			}
+ 		}
+ 
+ 		/************************************************************
+ 		 * go
+ 		 ************************************************************/
+ 		spi_rv = SPI_execute_plan(qdesc-> plan, argvalues, nulls, 
+ 							 current_call_data->prodesc->fn_readonly, limit);
+ 		ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed,
+ 												 spi_rv);
+ 		if ( argc > 0) 
+ 		{
+ 			pfree( argvalues);
+ 			pfree( nulls);
+ 		}
+ 
+ 		/* Commit the inner transaction, return to outer xact context */
+ 		ReleaseCurrentSubTransaction();
+ 		MemoryContextSwitchTo(oldcontext);
+ 		CurrentResourceOwner = oldowner;
+ 		/*
+ 		 * AtEOSubXact_SPI() should not have popped any SPI context,
+ 		 * but just in case it did, make sure we remain connected.
+ 		 */
+ 		SPI_restore_connection();
+ 	}
+ 	PG_CATCH();
+ 	{
+ 		ErrorData  *edata;
+ 
+ 		/* Save error info */
+ 		MemoryContextSwitchTo(oldcontext);
+ 		edata = CopyErrorData();
+ 		FlushErrorState();
+ 
+ 		/* Abort the inner transaction */
+ 		RollbackAndReleaseCurrentSubTransaction();
+ 		MemoryContextSwitchTo(oldcontext);
+ 		CurrentResourceOwner = oldowner;
+ 
+ 		/*
+ 		 * If AtEOSubXact_SPI() popped any SPI context of the subxact,
+ 		 * it will have left us in a disconnected state.  We need this
+ 		 * hack to return to connected state.
+ 		 */
+ 		SPI_restore_connection();
+ 
+ 		/* Punt the error to Perl */
+ 		croak("%s", edata->message);
+ 
+ 		/* Can't get here, but keep compiler quiet */
+ 		return NULL;
+ 	}
+ 	PG_END_TRY();
+ 
+ 	return ret_hv;
+ }
+ 
+ SV *
+ plperl_spi_query_prepared(char* query, int argc, SV ** argv)
+ {
+ 	SV **sv;
+ 	int i;
+ 	char * nulls;
+ 	Datum	   *argvalues;
+ 	plperl_query_desc *qdesc;
+ 	SV *cursor;
+ 	Portal portal = NULL;
+ 
+ 	/*
+ 	 * Execute the query inside a sub-transaction, so we can cope with
+ 	 * errors sanely
+ 	 */
+ 	MemoryContext oldcontext = CurrentMemoryContext;
+ 	ResourceOwner oldowner = CurrentResourceOwner;
+ 
+ 	BeginInternalSubTransaction(NULL);
+ 	/* Want to run inside function's memory context */
+ 	MemoryContextSwitchTo(oldcontext);
+ 
+ 	PG_TRY();
+ 	{
+ 		/************************************************************
+ 		 * Fetch the saved plan descriptor, see if it's o.k.
+ 		 ************************************************************/
+ 		sv = hv_fetch(plperl_query_hash, query, strlen(query), 0);
+ 		if ( sv == NULL) 
+ 			elog(ERROR, "spi_query_prepared: Invalid prepared query passed");
+ 		if ( *sv == NULL || !SvOK( *sv))
+ 			elog(ERROR, "spi_query_prepared: panic - plperl_query_hash value corrupted");
+ 
+ 		qdesc = INT2PTR( plperl_query_desc *, SvUV(*sv));
+ 		if ( qdesc == NULL)
+ 			elog(ERROR, "spi_query_prepared: panic - plperl_query_hash value vanished");
+ 
+ 		if ( qdesc-> nargs != argc) 
+ 			elog(ERROR, "spi_query_prepared: expected %d argument(s), %d passed", 
+ 				qdesc-> nargs, argc);
+ 		
+ 		/************************************************************
+ 		 * Set up arguments
+ 		 ************************************************************/
+ 		if ( argc > 0) 
+ 		{
+ 			nulls = (char *)palloc( argc);
+ 			argvalues = (Datum *) palloc(argc * sizeof(Datum));
+ 			if ( nulls == NULL || argvalues == NULL) 
+ 				elog(ERROR, "spi_query_prepared: not enough memory");
+ 		} 
+ 		else 
+ 		{
+ 			nulls = NULL;
+ 			argvalues = NULL;
+ 		}
+ 
+ 		for ( i = 0; i < argc; i++) 
+ 		{
+ 			if ( SvTYPE( argv[i]) != SVt_NULL) 
+ 			{
+ 				argvalues[i] =
+ 					FunctionCall3( &qdesc->arginfuncs[i],
+ 						  CStringGetDatum( SvPV( argv[i], PL_na)),
+ 						  ObjectIdGetDatum( qdesc->argtypioparams[i]),
+ 						  Int32GetDatum(-1)
+ 					);
+ 				nulls[i] = ' ';
+ 			} 
+ 			else 
+ 			{
+ 				argvalues[i] = (Datum) 0;
+ 				nulls[i] = 'n';
+ 			}
+ 		}
+ 
+ 		/************************************************************
+ 		 * go
+ 		 ************************************************************/
+ 		portal = SPI_cursor_open(NULL, qdesc-> plan, argvalues, nulls, 
+ 							current_call_data->prodesc->fn_readonly);
+ 		if ( argc > 0) 
+ 		{
+ 			pfree( argvalues);
+ 			pfree( nulls);
+ 		}
+ 		if ( portal == NULL) 
+ 			elog(ERROR, "SPI_cursor_open() failed:%s",
+ 				SPI_result_code_string(SPI_result));
+ 
+ 		cursor = newSVpv(portal->name, 0);
+ 
+ 		/* Commit the inner transaction, return to outer xact context */
+ 		ReleaseCurrentSubTransaction();
+ 		MemoryContextSwitchTo(oldcontext);
+ 		CurrentResourceOwner = oldowner;
+ 		/*
+ 		 * AtEOSubXact_SPI() should not have popped any SPI context,
+ 		 * but just in case it did, make sure we remain connected.
+ 		 */
+ 		SPI_restore_connection();
+ 	}
+ 	PG_CATCH();
+ 	{
+ 		ErrorData  *edata;
+ 
+ 		/* Save error info */
+ 		MemoryContextSwitchTo(oldcontext);
+ 		edata = CopyErrorData();
+ 		FlushErrorState();
+ 
+ 		/* Abort the inner transaction */
+ 		RollbackAndReleaseCurrentSubTransaction();
+ 		MemoryContextSwitchTo(oldcontext);
+ 		CurrentResourceOwner = oldowner;
+ 
+ 		/*
+ 		 * If AtEOSubXact_SPI() popped any SPI context of the subxact,
+ 		 * it will have left us in a disconnected state.  We need this
+ 		 * hack to return to connected state.
+ 		 */
+ 		SPI_restore_connection();
+ 
+ 		/* Punt the error to Perl */
+ 		croak("%s", edata->message);
+ 
+ 		/* Can't get here, but keep compiler quiet */
+ 		return NULL;
+ 	}
+ 	PG_END_TRY();
+ 
+ 	return cursor;
+ }
+ 
+ void
+ plperl_spi_freeplan(char *query)
+ {
+ 	SV ** sv;
+ 	void * plan;
+ 	plperl_query_desc *qdesc;
+ 
+ 	sv = hv_fetch(plperl_query_hash, query, strlen(query), 0);
+ 	if ( sv == NULL) 
+ 		elog(ERROR, "spi_exec_freeplan: Invalid prepared query passed");
+ 	if ( *sv == NULL || !SvOK( *sv))
+ 		elog(ERROR, "spi_exec_freeplan: panic - plperl_query_hash value corrupted");
+ 
+ 	qdesc = INT2PTR( plperl_query_desc *, SvUV(*sv));
+ 	if ( qdesc == NULL)
+ 		elog(ERROR, "spi_exec_freeplan: panic - plperl_query_hash value vanished");
+ 
+ 	/*
+ 	*	free all memory before SPI_freeplan, so if it dies, nothing will be left over
+ 	*/
+ 	hv_delete(plperl_query_hash, query, strlen(query), G_DISCARD);
+ 	plan = qdesc-> plan;
+ 	free(qdesc-> argtypes);
+ 	free(qdesc-> arginfuncs);
+ 	free(qdesc-> argtypioparams);
+ 	free(qdesc);
+ 
+ 	SPI_freeplan( plan);
+ }
Index: plperl.h
===================================================================
RCS file: /cvsroot/pgsql/src/pl/plperl/plperl.h,v
retrieving revision 1.2
diff -c -r1.2 plperl.h
*** plperl.h	12 Jan 2006 22:15:56 -0000	1.2
--- plperl.h	19 Feb 2006 16:17:41 -0000
***************
*** 51,56 ****
--- 51,62 ----
  void		plperl_return_next(SV *);
  SV		   *plperl_spi_query(char *);
  SV		   *plperl_spi_fetchrow(char *);
+ SV *plperl_spi_prepare(char *, int, SV **);
+ HV *plperl_spi_exec_prepared(char *, HV *, int, SV **);
+ SV *plperl_spi_query_prepared(char *, int, SV **);
+ void plperl_spi_freeplan(char *);
+ void plperl_spi_cursor_close(char *);
+ 
  
  
  #endif /* PL_PERL_H */
Index: expected/plperl.out
===================================================================
RCS file: /cvsroot/pgsql/src/pl/plperl/expected/plperl.out,v
retrieving revision 1.6
diff -c -r1.6 plperl.out
*** expected/plperl.out	18 Nov 2005 17:00:28 -0000	1.6
--- expected/plperl.out	19 Feb 2006 16:17:41 -0000
***************
*** 367,372 ****
--- 367,386 ----
               2
  (2 rows)
  
+ --
+ -- Test spi_fetchrow abort
+ --
+ CREATE OR REPLACE FUNCTION perl_spi_func2() RETURNS INTEGER AS $$
+ my $x = spi_query("select 1 as a union select 2 as a");
+ spi_cursor_close( $x);
+ return 0;
+ $$ LANGUAGE plperl;
+ SELECT * from perl_spi_func2();
+  perl_spi_func2 
+ ----------------
+               0
+ (1 row)
+ 
  ---
  --- Test recursion via SPI
  ---
***************
*** 420,422 ****
--- 434,470 ----
   {{"a\"b",NULL,"c,d"},{"e\\f",NULL,g}}
  (1 row)
  
+ --
+ -- Test spi_prepare/spi_exec_prepared/spi_freeplan
+ --
+ CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$
+    my $x = spi_prepare('select $1 AS a', 'INT4');
+    my $q = spi_exec_prepared( $x, $_[0] + 1);
+    spi_freeplan($x);
+ return $q->{rows}->[0]->{a};
+ $$ LANGUAGE plperl;
+ SELECT * from perl_spi_prepared(42);
+  perl_spi_prepared 
+ -------------------
+                 43
+ (1 row)
+ 
+ --
+ -- Test spi_prepare/spi_query_prepared/spi_freeplan
+ --
+ CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF INTEGER AS $$
+   my $x = spi_prepare('SELECT $1 AS a union select $2 as a', 'INT4', 'INT4');
+   my $q = spi_query_prepared( $x, 1+$_[0], 2+$_[1]);
+   while (defined (my $y = spi_fetchrow($q))) {
+       return_next $y->{a};
+   }
+   spi_freeplan($x);
+   return;
+ $$ LANGUAGE plperl;
+ SELECT * from perl_spi_prepared_set(1,2);
+  perl_spi_prepared_set 
+ -----------------------
+                      2
+                      4
+ (2 rows)
+ 
Index: sql/plperl.sql
===================================================================
RCS file: /cvsroot/pgsql/src/pl/plperl/sql/plperl.sql,v
retrieving revision 1.6
diff -c -r1.6 plperl.sql
*** sql/plperl.sql	18 Nov 2005 17:00:28 -0000	1.6
--- sql/plperl.sql	19 Feb 2006 16:17:41 -0000
***************
*** 261,266 ****
--- 261,276 ----
  $$ LANGUAGE plperl;
  SELECT * from perl_spi_func();
  
+ --
+ -- Test spi_fetchrow abort
+ --
+ CREATE OR REPLACE FUNCTION perl_spi_func2() RETURNS INTEGER AS $$
+ my $x = spi_query("select 1 as a union select 2 as a");
+ spi_cursor_close( $x);
+ return 0;
+ $$ LANGUAGE plperl;
+ SELECT * from perl_spi_func2();
+ 
  
  ---
  --- Test recursion via SPI
***************
*** 300,303 ****
      return [['a"b',undef,'c,d'],['e\\f',undef,'g']]; 
  $$;
  
! SELECT array_of_text(); 
--- 310,339 ----
      return [['a"b',undef,'c,d'],['e\\f',undef,'g']]; 
  $$;
  
! SELECT array_of_text();
! 
! --
! -- Test spi_prepare/spi_exec_prepared/spi_freeplan
! --
! CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$
!    my $x = spi_prepare('select $1 AS a', 'INT4');
!    my $q = spi_exec_prepared( $x, $_[0] + 1);
!    spi_freeplan($x);
! return $q->{rows}->[0]->{a};
! $$ LANGUAGE plperl;
! SELECT * from perl_spi_prepared(42);
! 
! --
! -- Test spi_prepare/spi_query_prepared/spi_freeplan
! --
! CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF INTEGER AS $$
!   my $x = spi_prepare('SELECT $1 AS a union select $2 as a', 'INT4', 'INT4');
!   my $q = spi_query_prepared( $x, 1+$_[0], 2+$_[1]);
!   while (defined (my $y = spi_fetchrow($q))) {
!       return_next $y->{a};
!   }
!   spi_freeplan($x);
!   return;
! $$ LANGUAGE plperl;
! SELECT * from perl_spi_prepared_set(1,2);
! 
#9Bruce Momjian
pgman@candle.pha.pa.us
In reply to: Andrew Dunstan (#8)
Re: implement prepared queries in plperl

Is this patch going to be applied?

---------------------------------------------------------------------------

Andrew Dunstan wrote:

Dmitry Karasik wrote:

[patch snipped]

I have cleaned this patch somewhat by removing some bitrot that occurred
since it was submitted, and adjusting formatting to something more
closely resembling postgresql style (please remember to follow our style
in future).

The attached works on HEAD and passes the supplied regression tests.

But why do we have to call spi_freeplan? pltcl, which has prepared
queries, doesn't require this AFAICS. If memory leaks are an issue,
maybe we should bless the object into a class with a DESTROY method that
calls spi_freeplan automatically (not sure to do that in XS but I assume
it's possible).

cheers

andrew

---------------------------(end of broadcast)---------------------------
TIP 4: Have you searched our list archives?

http://archives.postgresql.org

--
Bruce Momjian http://candle.pha.pa.us
SRA OSS, Inc. http://www.sraoss.com

+ If your life is a hard drive, Christ can be your backup. +

#10Andrew Dunstan
andrew@dunslane.net
In reply to: Bruce Momjian (#9)
Re: implement prepared queries in plperl

I am waiting for an update from Dmitry.

cheers

andrew

Bruce Momjian wrote:

Show quoted text

Is this patch going to be applied?

---------------------------------------------------------------------------

Andrew Dunstan wrote:

I have cleaned this patch somewhat by removing some bitrot that occurred
since it was submitted, and adjusting formatting to something more
closely resembling postgresql style (please remember to follow our style
in future).

The attached works on HEAD and passes the supplied regression tests.

But why do we have to call spi_freeplan? pltcl, which has prepared
queries, doesn't require this AFAICS. If memory leaks are an issue,
maybe we should bless the object into a class with a DESTROY method that
calls spi_freeplan automatically (not sure to do that in XS but I assume
it's possible).

#11Dmitry Karasik
dmitry@karasik.eu.org
In reply to: Andrew Dunstan (#10)
Re: implement prepared queries in plperl

Bruce Momjian wrote:

Is this patch going to be applied?

I am waiting for an update from Dmitry.
cheers
andrew

I believe this is some kind of misunderstanding, sorry if from my part,
but I don't think any further updates are necessary.

But why do we have to call spi_freeplan? pltcl, which has prepared
queries, doesn't require this AFAICS. If memory leaks are an issue,
maybe we should bless the object into a class with a DESTROY method that
calls spi_freeplan automatically (not sure to do that in XS but I assume
it's possible).

I remember though that my answer to this question didn't hit the list so it's here again,
in case that was meant by 'the update':

I thought of that, indeed the automatic cleanup would be better from one point
of view, but I thought also about that the existing SPI interface is not
object-oriented, so I've extended it in functional style, and that the
mirroring of C SPI functions into Perl would be less encumbered by glue layers,
and again, implementing such a glue layer on top of new spi_ functions would be
trivial.

I also remember I heard about plans about writing a DBI-style API over SPI, and
thought that such (future/imaginary) layer would be ideal for implementing
queries as objects ( including DESTROY ).

Another thing, automatic destruction of a query would prohibit passing the
query handle outside a perl function where the handle has the scope. True, it
is possible to keep the reference count and the handle from destruction in
$_SHARED{}, if necessary, but when finally the handle has to be released, a
wrapper for spi_freeplan() has to be called anyway.

--
Sincerely,
Dmitry Karasik

#12Andrew Dunstan
andrew@dunslane.net
In reply to: Dmitry Karasik (#11)
Re: implement prepared queries in plperl

Dmitry Karasik wrote:

Bruce Momjian wrote:

Is this patch going to be applied?

I am waiting for an update from Dmitry.
cheers
andrew

I believe this is some kind of misunderstanding, sorry if from my part,
but I don't think any further updates are necessary.

OK, I'll take another look. I'm still curious to know why pltcl doesn't
need to call spi_free_plan. Maybe it does need to ...

cheers

andrew

#13Andrew Dunstan
andrew@dunslane.net
In reply to: Andrew Dunstan (#12)
Re: implement prepared queries in plperl

Andrew Dunstan wrote:

Dmitry Karasik wrote:

Bruce Momjian wrote:

Is this patch going to be applied?

I am waiting for an update from Dmitry.
cheers
andrew

I believe this is some kind of misunderstanding, sorry if from my part,
but I don't think any further updates are necessary.

OK, I'll take another look. I'm still curious to know why pltcl
doesn't need to call spi_free_plan. Maybe it does need to ...

I have committed the patch and docs for this - it's an important feature
and I would like people banging on it.

I'd like to review the API we provide to plperl, though - I don't like
it much. I think that should be an 8.2 TODO.

cheers

andrew

#14Dmitry Karasik
dmitry@karasik.eu.org
In reply to: Andrew Dunstan (#13)
Re: implement prepared queries in plperl

OK, I'll take another look. I'm still curious to know why pltcl
doesn't need to call spi_free_plan. Maybe it does need to ...

I have committed the patch and docs for this - it's an important feature
and I would like people banging on it.
I'd like to review the API we provide to plperl, though - I don't like
it much. I think that should be an 8.2 TODO.

Thanks!

If you'd be interested in my opinion, I thought that probably it would be
beneficial to have two layers of access to SPI, first, the existing spi_xxx()
set, and second, fully object oriented, with 'SPI->new' or
'SPI->query->rows->data' or whatever else imagined. That would've been a good
design for an average Perl XS module, because XS layer would only introduced
direct mappings to C functions, and the accompanied perl code in .pm file would
implement object bells and whistles based on C API as seen from perl. That's a
bit bloatish, so I'd understand if you would want to completely rewrite the
Perl API, however, I'd propose to do that in two phases: first, introduce
object API that is implemented on well-known spi_xxx(), and then, if necessary,
get rid of the latter.

btw, would be me appropriate to move the discussion into hackers@?

--
Sincerely,
Dmitry Karasik

#15Andrew Dunstan
andrew@dunslane.net
In reply to: Dmitry Karasik (#14)
Re: [PATCHES] implement prepared queries in plperl

[moving to -hackers]

Dmitry Karasik wrote:

I have committed the patch and docs for this - it's an important feature
and I would like people banging on it.
I'd like to review the API we provide to plperl, though - I don't like
it much. I think that should be an 8.2 TODO.

Thanks!

If you'd be interested in my opinion, I thought that probably it would be
beneficial to have two layers of access to SPI, first, the existing spi_xxx()
set, and second, fully object oriented, with 'SPI->new' or
'SPI->query->rows->data' or whatever else imagined. That would've been a good
design for an average Perl XS module, because XS layer would only introduced
direct mappings to C functions, and the accompanied perl code in .pm file would
implement object bells and whistles based on C API as seen from perl. That's a
bit bloatish, so I'd understand if you would want to completely rewrite the
Perl API, however, I'd propose to do that in two phases: first, introduce
object API that is implemented on well-known spi_xxx(), and then, if necessary,
get rid of the latter.

Well, if we want an OO API I'd like to get to where we have a DBI
handle. Perl programmers are familiar with how it works. In plperl it
would just be there (no need to open/close it). Someone already did
this, although it got dataed and is GPLed so we can't include it in the
postgresl core. But that's what I and many other plperl people want.

I would also like to see a nice clean procedural API, rather more
lightweight than DBI. But I don't think we need to be mirroring the SPI
API. The fact that we use SPI is an implementation detail. I know pltcl
calls things spi_foo. But especially if we are not exactly mirroring a
call in SPI we should not do that, IMNSHO.

btw, would be me appropriate to move the discussion into hackers@?

yes. done.

cheers

andrew