From 6d92f2106fa840a497e3cdc88bb4883e9a4712e8 Mon Sep 17 00:00:00 2001
From: Bruce Momjian <bruce@momjian.us>
Date: Sun, 10 Jul 2005 15:19:43 +0000
Subject: [PATCH] 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
---
src/pl/plperl/SPI.xs | 16 +++++++
src/pl/plperl/expected/plperl.out | 17 +++++++
src/pl/plperl/plperl.c | 78 ++++++++++++++++++++++++++++++-
src/pl/plperl/spi_internal.h | 2 +
src/pl/plperl/sql/plperl.sql | 13 ++++++
5 files changed, 125 insertions(+), 1 deletion(-)
diff --git a/src/pl/plperl/SPI.xs b/src/pl/plperl/SPI.xs
index d1bab6d39b7..496e8896a92 100644
--- 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 ea067c97240..29d24d95a2e 100644
--- 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 b543963d192..9fa71d94ccd 100644
--- 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 d1dfe5838fb..5c511fce47b 100644
--- 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 3e601173ddf..3cafb590c76 100644
--- 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();
--
GitLab