Skip to content

Commit 6d92f21

Browse files
bmomjianbmomjian
committed
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
1 parent d1cffe2 commit 6d92f21

File tree

5 files changed

+125
-1
lines changed

5 files changed

+125
-1
lines changed

‎src/pl/plperl/SPI.xs

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -103,5 +103,21 @@ spi_return_next(rv)
103103
CODE:
104104
plperl_return_next(rv);
105105

106+
SV *
107+
spi_spi_query(query)
108+
char *query;
109+
CODE:
110+
RETVAL = plperl_spi_query(query);
111+
OUTPUT:
112+
RETVAL
113+
114+
SV *
115+
spi_spi_fetchrow(cursor)
116+
char *cursor;
117+
CODE:
118+
RETVAL = plperl_spi_fetchrow(cursor);
119+
OUTPUT:
120+
RETVAL
121+
106122
BOOT:
107123
items = 0; /* avoid 'unused variable' warning */

‎src/pl/plperl/expected/plperl.out

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -350,3 +350,20 @@ SELECT * from perl_srf_rn() AS (f1 INTEGER, f2 TEXT, f3 TEXT);
350350
3 | Hello | PL/Perl
351351
(3 rows)
352352

353+
--
354+
-- Test spi_query/spi_fetchrow
355+
--
356+
CREATE OR REPLACE FUNCTION perl_spi_func() RETURNS SETOF INTEGER AS $$
357+
$x = spi_query("select 1 as a union select 2 as a");
358+
while (defined ($y = spi_fetchrow($x))) {
359+
return_next($y->{a});
360+
}
361+
return;
362+
$$ LANGUAGE plperl;
363+
SELECT * from perl_spi_func();
364+
perl_spi_func
365+
---------------
366+
1
367+
2
368+
(2 rows)
369+

‎src/pl/plperl/plperl.c

Lines changed: 77 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@
3333
* ENHANCEMENTS, OR MODIFICATIONS.
3434
*
3535
* IDENTIFICATION
36-
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.81 2005/07/06 22:44:49 momjian Exp $
36+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.82 2005/07/10 15:19:43 momjian Exp $
3737
*
3838
**********************************************************************/
3939

@@ -118,6 +118,7 @@ Datum plperl_validator(PG_FUNCTION_ARGS);
118118
void plperl_init(void);
119119

120120
HV *plperl_spi_exec(char *query, int limit);
121+
SV *plperl_spi_query(char *);
121122

122123
static Datum plperl_func_handler(PG_FUNCTION_ARGS);
123124

@@ -229,6 +230,7 @@ plperl_safe_init(void)
229230
"$PLContainer->permit_only(':default');"
230231
"$PLContainer->permit(qw[:base_math !:base_io sort time]);"
231232
"$PLContainer->share(qw[&elog &spi_exec_query &return_next "
233+
"&spi_query &spi_fetchrow "
232234
"&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED ]);"
233235
;
234236

@@ -1525,3 +1527,77 @@ plperl_return_next(SV *sv)
15251527
heap_freetuple(tuple);
15261528
MemoryContextSwitchTo(cxt);
15271529
}
1530+
1531+
1532+
SV *
1533+
plperl_spi_query(char *query)
1534+
{
1535+
SV *cursor;
1536+
1537+
MemoryContext oldcontext = CurrentMemoryContext;
1538+
ResourceOwner oldowner = CurrentResourceOwner;
1539+
1540+
BeginInternalSubTransaction(NULL);
1541+
MemoryContextSwitchTo(oldcontext);
1542+
1543+
PG_TRY();
1544+
{
1545+
void *plan;
1546+
Portal portal = NULL;
1547+
1548+
plan = SPI_prepare(query, 0, NULL);
1549+
if (plan)
1550+
portal = SPI_cursor_open(NULL, plan, NULL, NULL, false);
1551+
if (portal)
1552+
cursor = newSVpv(portal->name, 0);
1553+
else
1554+
cursor = newSV(0);
1555+
1556+
ReleaseCurrentSubTransaction();
1557+
MemoryContextSwitchTo(oldcontext);
1558+
CurrentResourceOwner = oldowner;
1559+
SPI_restore_connection();
1560+
}
1561+
PG_CATCH();
1562+
{
1563+
ErrorData *edata;
1564+
1565+
MemoryContextSwitchTo(oldcontext);
1566+
edata = CopyErrorData();
1567+
FlushErrorState();
1568+
1569+
RollbackAndReleaseCurrentSubTransaction();
1570+
MemoryContextSwitchTo(oldcontext);
1571+
CurrentResourceOwner = oldowner;
1572+
1573+
SPI_restore_connection();
1574+
croak("%s", edata->message);
1575+
return NULL;
1576+
}
1577+
PG_END_TRY();
1578+
1579+
return cursor;
1580+
}
1581+
1582+
1583+
SV *
1584+
plperl_spi_fetchrow(char *cursor)
1585+
{
1586+
SV *row = newSV(0);
1587+
Portal p = SPI_cursor_find(cursor);
1588+
1589+
if (!p)
1590+
return row;
1591+
1592+
SPI_cursor_fetch(p, true, 1);
1593+
if (SPI_processed == 0) {
1594+
SPI_cursor_close(p);
1595+
return row;
1596+
}
1597+
1598+
row = plperl_hash_from_tuple(SPI_tuptable->vals[0],
1599+
SPI_tuptable->tupdesc);
1600+
SPI_freetuptable(SPI_tuptable);
1601+
1602+
return row;
1603+
}

‎src/pl/plperl/spi_internal.h

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,3 +18,5 @@ int spi_ERROR(void);
1818
/* this is actually in plperl.c */
1919
HV *plperl_spi_exec(char *, int);
2020
void plperl_return_next(SV *);
21+
SV *plperl_spi_query(char *);
22+
SV *plperl_spi_fetchrow(char *);

‎src/pl/plperl/sql/plperl.sql

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -247,3 +247,16 @@ for ("World", "PostgreSQL", "PL/Perl") {
247247
return;
248248
$$ language plperl;
249249
SELECT * from perl_srf_rn() AS (f1 INTEGER, f2 TEXT, f3 TEXT);
250+
251+
--
252+
-- Test spi_query/spi_fetchrow
253+
--
254+
255+
CREATE OR REPLACE FUNCTION perl_spi_func() RETURNS SETOF INTEGER AS $$
256+
$x = spi_query("select 1 as a union select 2 as a");
257+
while (defined ($y = spi_fetchrow($x))) {
258+
return_next($y->{a});
259+
}
260+
return;
261+
$$ LANGUAGE plperl;
262+
SELECT * from perl_spi_func();

0 commit comments

Comments
 (0)