Prepared queries for PLPerl, plus fixing a small plperl memory leak. Patch
and docs from Dmitry Karasik, slightly editorialised.

doc/src/sgml/plperl.sgml

 <!--
-$PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.50 2006/03/01 06:30:32 neilc Exp $
+$PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.51 2006/03/05 16:40:51 adunstan Exp $
 -->
 
  <chapter id="plperl">
@@ -296,7 +296,7 @@ BEGIN { strict->import(); }
   </para>
 
   <para>
-   PL/Perl provides three additional Perl commands:
+   PL/Perl provides additional Perl commands:
 
    <variablelist>
     <varlistentry>
@@ -306,9 +306,13 @@ BEGIN { strict->import(); }
      </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>
+     <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,6 +423,66 @@ $$ LANGUAGE plperlu;
 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>

src/pl/plperl/SPI.xs

@@ -111,7 +111,8 @@ spi_spi_exec_query(query, ...)
 		int limit = 0;
 	CODE:
 		if (items > 2)
-			croak("Usage: spi_exec_query(query, limit) or spi_exec_query(query)");
+			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,5 +142,84 @@ spi_spi_fetchrow(cursor)
 	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 */

src/pl/plperl/expected/plperl.out

@@ -367,6 +367,20 @@ SELECT * from perl_spi_func();
              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,3 +434,37 @@ SELECT array_of_text();
  {{"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)
+

src/pl/plperl/plperl.h

@@ -8,7 +8,7 @@
  * Portions Copyright (c) 1996-2006, PostgreSQL Global Development Group
  * Portions Copyright (c) 1995, Regents of the University of California
  *
- * $PostgreSQL: pgsql/src/pl/plperl/plperl.h,v 1.3 2006/03/05 15:59:10 momjian Exp $
+ * $PostgreSQL: pgsql/src/pl/plperl/plperl.h,v 1.4 2006/03/05 16:40:51 adunstan Exp $
  */
 
 #ifndef PL_PERL_H
@@ -51,6 +51,12 @@ HV		   *plperl_spi_exec(char *, int);
 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 */

src/pl/plperl/sql/plperl.sql

@@ -261,6 +261,16 @@ return;
 $$ 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,4 +310,30 @@ LANGUAGE plperl as $$
     return [['a"b',undef,'c,d'],['e\\f',undef,'g']]; 
 $$;
 
-SELECT array_of_text(); 
+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);
+