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.

Comments welcome.

-- ams
--- pl/plperl/spi_internal.h~   2005-06-12 15:45:31.000000000 +0530
+++ pl/plperl/spi_internal.h    2005-06-12 15:45:59.000000000 +0530
@@ -18,3 +18,5 @@
 /* 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 *);

--- pl/plperl/SPI.xs~   2005-06-05 14:49:59.000000000 +0530
+++ pl/plperl/SPI.xs    2005-06-12 15:31:37.000000000 +0530
@@ -103,5 +103,21 @@
        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 */

--- pl/plperl/plperl.c~ 2005-06-29 07:40:25.132358971 +0530
+++ pl/plperl/plperl.c  2005-06-29 14:29:30.269050201 +0530
@@ -118,6 +118,7 @@
 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);
 
@@ -225,6 +226,7 @@
        "$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 ]);"
                           ;
 
@@ -1519,3 +1521,77 @@
        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;
+}

--- pl/plperl/sql/plperl.sql~   2005-06-29 08:51:26.602006376 +0530
+++ pl/plperl/sql/plperl.sql    2005-06-29 15:04:25.744032754 +0530
@@ -247,3 +247,16 @@
 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();

--- pl/plperl/expected/plperl.out~      2005-06-29 15:04:37.749935678 +0530
+++ pl/plperl/expected/plperl.out       2005-06-29 15:06:08.967002756 +0530
@@ -350,3 +350,20 @@
   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)
+
---------------------------(end of broadcast)---------------------------
TIP 6: Have you searched our list archives?

               http://archives.postgresql.org

Reply via email to