The attached patch implements spi_query() and spi_fetchrow() functions

for PL/Perl, to avoid loading the entire result set into memory as the
existing spi_exec_query() function does.

Here's how one might use the new functions:

    $x = spi_query("select ...");
    while (defined ($y = spi_fetchrow($x))) {
        ...
        return_next(...);
    }

The changes do not affect the spi_exec_query() interface in any way.

Abhijit Menon-Sen

diff --git a/src/pl/plperl/SPI.xs b/src/pl/plperl/SPI.xs
index d1bab6d39b75e574282f70d9bdb5a9f87a942f93..496e8896a92fb888b88dc3d695b9d389bb5f0137 100644 (file)
--- a/src/pl/plperl/SPI.xs
+++ b/src/pl/plperl/SPI.xs
@@ -103,5 +103,21 @@ spi_return_next(rv)
    CODE:
        plperl_return_next(rv);
 
+SV *
+spi_spi_query(query)
+   char *query;
+   CODE:
+       RETVAL = plperl_spi_query(query);
+   OUTPUT:
+       RETVAL
+
+SV *
+spi_spi_fetchrow(cursor)
+   char *cursor;
+   CODE:
+       RETVAL = plperl_spi_fetchrow(cursor);
+   OUTPUT:
+       RETVAL
+
 BOOT:
     items = 0;  /* avoid 'unused variable' warning */

diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out
index ea067c972405d64f94359a8b0bd9b80eaaad7414..29d24d95a2e38544240336102471357e0d486131 100644 (file)
--- a/src/pl/plperl/expected/plperl.out
+++ b/src/pl/plperl/expected/plperl.out
@@ -350,3 +350,20 @@ SELECT * from perl_srf_rn() AS (f1 INTEGER, f2 TEXT, f3 TEXT);
   3 | Hello | PL/Perl
 (3 rows)
 
+--
+-- Test spi_query/spi_fetchrow
+--
+CREATE OR REPLACE FUNCTION perl_spi_func() RETURNS SETOF INTEGER AS $$
+$x = spi_query("select 1 as a union select 2 as a");
+while (defined ($y = spi_fetchrow($x))) {
+    return_next($y->{a});
+}
+return;
+$$ LANGUAGE plperl;
+SELECT * from perl_spi_func();
+ perl_spi_func 
+---------------
+             1
+             2
+(2 rows)
+

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index b543963d192d3588bc355b0f12ad1932190ffc68..9fa71d94ccdeab4c93e483dc2e214d5c93d8f68d 100644 (file)
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -33,7 +33,7 @@
  *   ENHANCEMENTS, OR MODIFICATIONS.
  *
  * IDENTIFICATION
- *   $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.81 2005/07/06 22:44:49 momjian Exp $
+ *   $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.82 2005/07/10 15:19:43 momjian Exp $
  *
  **********************************************************************/
 
@@ -118,6 +118,7 @@ Datum       plperl_validator(PG_FUNCTION_ARGS);
 void       plperl_init(void);
 
 HV        *plperl_spi_exec(char *query, int limit);
+SV        *plperl_spi_query(char *);
 
 static Datum plperl_func_handler(PG_FUNCTION_ARGS);
 
@@ -229,6 +230,7 @@ plperl_safe_init(void)
    "$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 "
    "&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED ]);"
               ;
 
@@ -1525,3 +1527,77 @@ plperl_return_next(SV *sv)
    heap_freetuple(tuple);
    MemoryContextSwitchTo(cxt);
 }
+
+
+SV *
+plperl_spi_query(char *query)
+{
+   SV *cursor;
+
+   MemoryContext oldcontext = CurrentMemoryContext;
+   ResourceOwner oldowner = CurrentResourceOwner;
+
+   BeginInternalSubTransaction(NULL);
+   MemoryContextSwitchTo(oldcontext);
+
+   PG_TRY();
+   {
+       void *plan;
+       Portal portal = NULL;
+
+       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);
+
+       ReleaseCurrentSubTransaction();
+       MemoryContextSwitchTo(oldcontext);
+       CurrentResourceOwner = oldowner;
+       SPI_restore_connection();
+   }
+   PG_CATCH();
+   {
+       ErrorData  *edata;
+
+       MemoryContextSwitchTo(oldcontext);
+       edata = CopyErrorData();
+       FlushErrorState();
+
+       RollbackAndReleaseCurrentSubTransaction();
+       MemoryContextSwitchTo(oldcontext);
+       CurrentResourceOwner = oldowner;
+
+       SPI_restore_connection();
+       croak("%s", edata->message);
+       return NULL;
+   }
+   PG_END_TRY();
+
+   return cursor;
+}
+
+
+SV *
+plperl_spi_fetchrow(char *cursor)
+{
+   SV *row = newSV(0);
+   Portal p = SPI_cursor_find(cursor);
+
+   if (!p)
+       return row;
+
+   SPI_cursor_fetch(p, true, 1);
+   if (SPI_processed == 0) {
+       SPI_cursor_close(p);
+       return row;
+   }
+
+   row = plperl_hash_from_tuple(SPI_tuptable->vals[0],
+                                SPI_tuptable->tupdesc);
+   SPI_freetuptable(SPI_tuptable);
+
+   return row;
+}

diff --git a/src/pl/plperl/spi_internal.h b/src/pl/plperl/spi_internal.h
index d1dfe5838fb981f7125af4a9f06816ff7d460995..5c511fce47b5ab133f127f6b45159334bcbcf358 100644 (file)
--- a/src/pl/plperl/spi_internal.h
+++ b/src/pl/plperl/spi_internal.h
@@ -18,3 +18,5 @@ int           spi_ERROR(void);
 /* this is actually in plperl.c */
 HV        *plperl_spi_exec(char *, int);
 void plperl_return_next(SV *);
+SV *plperl_spi_query(char *);
+SV *plperl_spi_fetchrow(char *);

diff --git a/src/pl/plperl/sql/plperl.sql b/src/pl/plperl/sql/plperl.sql
index 3e601173ddf316ec038dde50f105a55b7e44e6c9..3cafb590c764fda28c7dbb5f1f1bd7e95a783745 100644 (file)
--- a/src/pl/plperl/sql/plperl.sql
+++ b/src/pl/plperl/sql/plperl.sql
@@ -247,3 +247,16 @@ for ("World", "PostgreSQL", "PL/Perl") {
 return;
 $$ language plperl;
 SELECT * from perl_srf_rn() AS (f1 INTEGER, f2 TEXT, f3 TEXT);
+
+--
+-- Test spi_query/spi_fetchrow
+--
+
+CREATE OR REPLACE FUNCTION perl_spi_func() RETURNS SETOF INTEGER AS $$
+$x = spi_query("select 1 as a union select 2 as a");
+while (defined ($y = spi_fetchrow($x))) {
+    return_next($y->{a});
+}
+return;
+$$ LANGUAGE plperl;
+SELECT * from perl_spi_func();