--- 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) +