diff options
| -rw-r--r-- | src/pl/plperl/SPI.xs | 16 | ||||
| -rw-r--r-- | src/pl/plperl/expected/plperl.out | 17 | ||||
| -rw-r--r-- | src/pl/plperl/plperl.c | 78 | ||||
| -rw-r--r-- | src/pl/plperl/spi_internal.h | 2 | ||||
| -rw-r--r-- | src/pl/plperl/sql/plperl.sql | 13 |
5 files changed, 125 insertions, 1 deletions
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(); |