From 5d723d05c04fc0f589d4bb5ecb8780c4c0cb4302 Mon Sep 17 00:00:00 2001 From: Andrew Dunstan Date: Sun, 5 Mar 2006 16:40:51 +0000 Subject: [PATCH] Prepared queries for PLPerl, plus fixing a small plperl memory leak. Patch and docs from Dmitry Karasik, slightly editorialised. --- doc/src/sgml/plperl.sgml | 72 +++++- src/pl/plperl/SPI.xs | 82 ++++++- src/pl/plperl/expected/plperl.out | 48 ++++ src/pl/plperl/plperl.c | 496 +++++++++++++++++++++++++++++++++++++- src/pl/plperl/plperl.h | 8 +- src/pl/plperl/sql/plperl.sql | 38 ++- 6 files changed, 724 insertions(+), 20 deletions(-) diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml index 0bde245073..c71a8276e0 100644 --- a/doc/src/sgml/plperl.sgml +++ b/doc/src/sgml/plperl.sgml @@ -1,5 +1,5 @@ @@ -296,7 +296,7 @@ BEGIN { strict->import(); } - PL/Perl provides three additional Perl commands: + PL/Perl provides additional Perl commands: @@ -306,9 +306,13 @@ BEGIN { strict->import(); } spi_exec_query(query [, max-rows]) - spi_exec_query(command) spi_query(command) - spi_fetchrow(command) + spi_fetchrow(cursor) + spi_prepare(command, argument types) + spi_exec_prepared(plan) + spi_query_prepared(plan [, attributes], arguments) + spi_cursor_close(cursor) + spi_freeplan(plan) @@ -419,6 +423,66 @@ $$ LANGUAGE plperlu; SELECT * from lotsa_md5(500); + + + spi_prepare, spi_query_prepared, spi_exec_prepared, + and spi_freeplan implement the same functionality but for prepared queries. Once + a query plan is prepared by a call to spi_prepare, the plan can be used instead + of the string query, either in spi_exec_prepared, where the result is the same as returned + by spi_exec_query, or in spi_query_prepared which returns a cursor + exactly as spi_query does, which can be later passed to spi_fetchrow. + + + + The advantage of prepared queries is that is it possible to use one prepared plan for more + than one query execution. After the plan is not needed anymore, it must be freed with + spi_freeplan: + + + + +CREATE OR REPLACE FUNCTION init() RETURNS INTEGER AS $$ + $_SHARED{my_plan} = spi_prepare( 'SELECT (now() + $1)::date AS now', 'INTERVAL'); +$$ LANGUAGE plperl; + +CREATE OR REPLACE FUNCTION add_time( INTERVAL ) RETURNS TEXT AS $$ + return spi_exec_prepared( + $_SHARED{my_plan}, + $_[0], + )->{rows}->[0]->{now}; +$$ LANGUAGE plperl; + +CREATE OR REPLACE FUNCTION done() RETURNS INTEGER AS $$ + spi_freeplan( $_SHARED{my_plan}); + undef $_SHARED{my_plan}; +$$ LANGUAGE plperl; + +SELECT init(); +SELECT add_time('1 day'), add_time('2 days'), add_time('3 days'); +SELECT done(); + + add_time | add_time | add_time +------------+------------+------------ + 2005-12-10 | 2005-12-11 | 2005-12-12 + + + + + Note that the parameter subscript in spi_prepare is defined via + $1, $2, $3, etc, so avoid declaring query strings in double quotes that might easily + lead to hard-to-catch bugs. + + + + spi_cursor_close can be used to abort sequence of + spi_fetchrow calls. Normally, the call to + spi_fetchrow that returns undef is + the signal that there are no more rows to read. Also + that call automatically frees the cursor associated with the query. If it is desired not + to read all retuned rows, spi_cursor_close must be + called to avoid memory leaks. + + diff --git a/src/pl/plperl/SPI.xs b/src/pl/plperl/SPI.xs index 9d3dc39c75..738cbb6184 100644 --- a/src/pl/plperl/SPI.xs +++ b/src/pl/plperl/SPI.xs @@ -111,7 +111,8 @@ spi_spi_exec_query(query, ...) int limit = 0; CODE: if (items > 2) - croak("Usage: spi_exec_query(query, limit) or spi_exec_query(query)"); + croak("Usage: spi_exec_query(query, limit) " + "or spi_exec_query(query)"); if (items == 2) limit = SvIV(ST(1)); ret_hash = plperl_spi_exec(query, limit); @@ -141,5 +142,84 @@ spi_spi_fetchrow(cursor) OUTPUT: RETVAL +SV* +spi_spi_prepare(query, ...) + char* query; + CODE: + int i; + SV** argv; + if (items < 1) + Perl_croak(aTHX_ "Usage: spi_prepare(query, ...)"); + argv = ( SV**) palloc(( items - 1) * sizeof(SV*)); + if ( argv == NULL) + Perl_croak(aTHX_ "spi_prepare: not enough memory"); + for ( i = 1; i < items; i++) + argv[i - 1] = ST(i); + RETVAL = plperl_spi_prepare(query, items - 1, argv); + pfree( argv); + OUTPUT: + RETVAL + +SV* +spi_spi_exec_prepared(query, ...) + char * query; + PREINIT: + HV *ret_hash; + CODE: + HV *attr = NULL; + int i, offset = 1, argc; + SV ** argv; + if ( items < 1) + Perl_croak(aTHX_ "Usage: spi_exec_prepared(query, [\\%%attr,] " + "[\\@bind_values])"); + if ( items > 1 && SvROK( ST( 1)) && SvTYPE( SvRV( ST( 1))) == SVt_PVHV) + { + attr = ( HV*) SvRV(ST(1)); + offset++; + } + argc = items - offset; + argv = ( SV**) palloc( argc * sizeof(SV*)); + if ( argv == NULL) + Perl_croak(aTHX_ "spi_exec_prepared: not enough memory"); + for ( i = 0; offset < items; offset++, i++) + argv[i] = ST(offset); + ret_hash = plperl_spi_exec_prepared(query, attr, argc, argv); + RETVAL = newRV_noinc((SV*)ret_hash); + pfree( argv); + OUTPUT: + RETVAL + +SV* +spi_spi_query_prepared(query, ...) + char * query; + CODE: + int i; + SV ** argv; + if ( items < 1) + Perl_croak(aTHX_ "Usage: spi_query_prepared(query, " + "[\\@bind_values])"); + argv = ( SV**) palloc(( items - 1) * sizeof(SV*)); + if ( argv == NULL) + Perl_croak(aTHX_ "spi_query_prepared: not enough memory"); + for ( i = 1; i < items; i++) + argv[i - 1] = ST(i); + RETVAL = plperl_spi_query_prepared(query, items - 1, argv); + pfree( argv); + OUTPUT: + RETVAL + +void +spi_spi_freeplan(query) + char *query; + CODE: + plperl_spi_freeplan(query); + +void +spi_spi_cursor_close(cursor) + char *cursor; + CODE: + plperl_spi_cursor_close(cursor); + + BOOT: items = 0; /* avoid 'unused variable' warning */ diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out index 476e98b7b9..0e2887e86a 100644 --- a/src/pl/plperl/expected/plperl.out +++ b/src/pl/plperl/expected/plperl.out @@ -367,6 +367,20 @@ SELECT * from perl_spi_func(); 2 (2 rows) +-- +-- Test spi_fetchrow abort +-- +CREATE OR REPLACE FUNCTION perl_spi_func2() RETURNS INTEGER AS $$ +my $x = spi_query("select 1 as a union select 2 as a"); +spi_cursor_close( $x); +return 0; +$$ LANGUAGE plperl; +SELECT * from perl_spi_func2(); + perl_spi_func2 +---------------- + 0 +(1 row) + --- --- Test recursion via SPI --- @@ -420,3 +434,37 @@ SELECT array_of_text(); {{"a\"b",NULL,"c,d"},{"e\\f",NULL,g}} (1 row) +-- +-- Test spi_prepare/spi_exec_prepared/spi_freeplan +-- +CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$ + my $x = spi_prepare('select $1 AS a', 'INT4'); + my $q = spi_exec_prepared( $x, $_[0] + 1); + spi_freeplan($x); +return $q->{rows}->[0]->{a}; +$$ LANGUAGE plperl; +SELECT * from perl_spi_prepared(42); + perl_spi_prepared +------------------- + 43 +(1 row) + +-- +-- Test spi_prepare/spi_query_prepared/spi_freeplan +-- +CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF INTEGER AS $$ + my $x = spi_prepare('SELECT $1 AS a union select $2 as a', 'INT4', 'INT4'); + my $q = spi_query_prepared( $x, 1+$_[0], 2+$_[1]); + while (defined (my $y = spi_fetchrow($q))) { + return_next $y->{a}; + } + spi_freeplan($x); + return; +$$ LANGUAGE plperl; +SELECT * from perl_spi_prepared_set(1,2); + perl_spi_prepared_set +----------------------- + 2 + 4 +(2 rows) + diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index da1b8780d3..fb7fa4da33 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.103 2006/02/28 23:38:13 neilc Exp $ + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.104 2006/03/05 16:40:51 adunstan Exp $ * **********************************************************************/ @@ -56,6 +56,7 @@ #include "utils/typcache.h" #include "miscadmin.h" #include "mb/pg_wchar.h" +#include "parser/parse_type.h" /* define this before the perl headers get a chance to mangle DLLIMPORT */ extern DLLIMPORT bool check_function_bodies; @@ -99,6 +100,18 @@ typedef struct plperl_call_data MemoryContext tmp_cxt; } plperl_call_data; +/********************************************************************** + * The information we cache about prepared and saved plans + **********************************************************************/ +typedef struct plperl_query_desc +{ + char qname[sizeof(long) * 2 + 1]; + void *plan; + int nargs; + Oid *argtypes; + FmgrInfo *arginfuncs; + Oid *argtypioparams; +} plperl_query_desc; /********************************************************************** * Global data @@ -107,6 +120,7 @@ static bool plperl_firstcall = true; static bool plperl_safe_init_done = false; static PerlInterpreter *plperl_interp = NULL; static HV *plperl_proc_hash = NULL; +static HV *plperl_query_hash = NULL; static bool plperl_use_strict = false; @@ -233,7 +247,8 @@ plperl_init_all(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 " \ + "&spi_query &spi_fetchrow &spi_cursor_close " \ + "&spi_prepare &spi_exec_prepared &spi_query_prepared &spi_freeplan " \ "&_plperl_to_pg_array " \ "&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED ]);" \ "sub ::mksafefunc {" \ @@ -312,6 +327,7 @@ plperl_init_interp(void) perl_run(plperl_interp); plperl_proc_hash = newHV(); + plperl_query_hash = newHV(); #ifdef WIN32 @@ -1302,7 +1318,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger) { bool uptodate; - prodesc = (plperl_proc_desc *) SvIV(*svp); + prodesc = INT2PTR( plperl_proc_desc *, SvUV(*svp)); /************************************************************ * If it's present, must check whether it's still up to date. @@ -1500,7 +1516,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger) } hv_store(plperl_proc_hash, internal_proname, proname_len, - newSViv((IV) prodesc), 0); + newSVuv( PTR2UV( prodesc)), 0); } ReleaseSysCache(procTup); @@ -1810,16 +1826,20 @@ plperl_spi_query(char *query) PG_TRY(); { void *plan; - Portal portal = NULL; + Portal portal; /* Create a cursor for the query */ 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); + if ( plan == NULL) + elog(ERROR, "SPI_prepare() failed:%s", + SPI_result_code_string(SPI_result)); + + portal = SPI_cursor_open(NULL, plan, NULL, NULL, false); + SPI_freeplan( plan); + if ( portal == NULL) + elog(ERROR, "SPI_cursor_open() failed:%s", + SPI_result_code_string(SPI_result)); + cursor = newSVpv(portal->name, 0); /* Commit the inner transaction, return to outer xact context */ ReleaseCurrentSubTransaction(); @@ -1886,14 +1906,16 @@ plperl_spi_fetchrow(char *cursor) Portal p = SPI_cursor_find(cursor); if (!p) - row = newSV(0); + { + row = &PL_sv_undef; + } else { SPI_cursor_fetch(p, true, 1); if (SPI_processed == 0) { SPI_cursor_close(p); - row = newSV(0); + row = &PL_sv_undef; } else { @@ -1945,3 +1967,451 @@ plperl_spi_fetchrow(char *cursor) return row; } + +void +plperl_spi_cursor_close(char *cursor) +{ + Portal p = SPI_cursor_find(cursor); + if (p) + SPI_cursor_close(p); +} + +SV * +plperl_spi_prepare(char* query, int argc, SV ** argv) +{ + plperl_query_desc *qdesc; + void *plan; + int i; + HeapTuple typeTup; + + MemoryContext oldcontext = CurrentMemoryContext; + ResourceOwner oldowner = CurrentResourceOwner; + + BeginInternalSubTransaction(NULL); + MemoryContextSwitchTo(oldcontext); + + /************************************************************ + * Allocate the new querydesc structure + ************************************************************/ + qdesc = (plperl_query_desc *) malloc(sizeof(plperl_query_desc)); + MemSet(qdesc, 0, sizeof(plperl_query_desc)); + snprintf(qdesc-> qname, sizeof(qdesc-> qname), "%lx", (long) qdesc); + qdesc-> nargs = argc; + qdesc-> argtypes = (Oid *) malloc(argc * sizeof(Oid)); + qdesc-> arginfuncs = (FmgrInfo *) malloc(argc * sizeof(FmgrInfo)); + qdesc-> argtypioparams = (Oid *) malloc(argc * sizeof(Oid)); + + PG_TRY(); + { + /************************************************************ + * Lookup the argument types by name in the system cache + * and remember the required information for input conversion + ************************************************************/ + for (i = 0; i < argc; i++) + { + char *argcopy; + List *names = NIL; + ListCell *l; + TypeName *typename; + + /************************************************************ + * Use SplitIdentifierString() on a copy of the type name, + * turn the resulting pointer list into a TypeName node + * and call typenameType() to get the pg_type tuple. + ************************************************************/ + argcopy = pstrdup(SvPV(argv[i],PL_na)); + SplitIdentifierString(argcopy, '.', &names); + typename = makeNode(TypeName); + foreach(l, names) + typename->names = lappend(typename->names, makeString(lfirst(l))); + + typeTup = typenameType(typename); + qdesc->argtypes[i] = HeapTupleGetOid(typeTup); + perm_fmgr_info(((Form_pg_type) GETSTRUCT(typeTup))->typinput, + &(qdesc->arginfuncs[i])); + qdesc->argtypioparams[i] = getTypeIOParam(typeTup); + ReleaseSysCache(typeTup); + + list_free(typename->names); + pfree(typename); + list_free(names); + pfree(argcopy); + } + + /************************************************************ + * Prepare the plan and check for errors + ************************************************************/ + plan = SPI_prepare(query, argc, qdesc->argtypes); + + if (plan == NULL) + elog(ERROR, "SPI_prepare() failed:%s", + SPI_result_code_string(SPI_result)); + + /************************************************************ + * Save the plan into permanent memory (right now it's in the + * SPI procCxt, which will go away at function end). + ************************************************************/ + qdesc->plan = SPI_saveplan(plan); + if (qdesc->plan == NULL) + elog(ERROR, "SPI_saveplan() failed: %s", + SPI_result_code_string(SPI_result)); + + /* Release the procCxt copy to avoid within-function memory leak */ + SPI_freeplan(plan); + + /* Commit the inner transaction, return to outer xact context */ + ReleaseCurrentSubTransaction(); + MemoryContextSwitchTo(oldcontext); + CurrentResourceOwner = oldowner; + /* + * AtEOSubXact_SPI() should not have popped any SPI context, + * but just in case it did, make sure we remain connected. + */ + SPI_restore_connection(); + } + PG_CATCH(); + { + ErrorData *edata; + + free(qdesc-> argtypes); + free(qdesc-> arginfuncs); + free(qdesc-> argtypioparams); + free(qdesc); + + /* Save error info */ + MemoryContextSwitchTo(oldcontext); + edata = CopyErrorData(); + FlushErrorState(); + + /* Abort the inner transaction */ + RollbackAndReleaseCurrentSubTransaction(); + MemoryContextSwitchTo(oldcontext); + CurrentResourceOwner = oldowner; + + /* + * If AtEOSubXact_SPI() popped any SPI context of the subxact, + * it will have left us in a disconnected state. We need this + * hack to return to connected state. + */ + SPI_restore_connection(); + + /* Punt the error to Perl */ + croak("%s", edata->message); + + /* Can't get here, but keep compiler quiet */ + return NULL; + } + PG_END_TRY(); + + /************************************************************ + * Insert a hashtable entry for the plan and return + * the key to the caller. + ************************************************************/ + hv_store( plperl_query_hash, qdesc->qname, strlen(qdesc->qname), newSVuv( PTR2UV( qdesc)), 0); + + return newSVpv( qdesc->qname, strlen(qdesc->qname)); +} + +HV * +plperl_spi_exec_prepared(char* query, HV * attr, int argc, SV ** argv) +{ + HV *ret_hv; + SV **sv; + int i, limit, spi_rv; + char * nulls; + Datum *argvalues; + plperl_query_desc *qdesc; + + /* + * Execute the query inside a sub-transaction, so we can cope with + * errors sanely + */ + MemoryContext oldcontext = CurrentMemoryContext; + ResourceOwner oldowner = CurrentResourceOwner; + + BeginInternalSubTransaction(NULL); + /* Want to run inside function's memory context */ + MemoryContextSwitchTo(oldcontext); + + PG_TRY(); + { + /************************************************************ + * Fetch the saved plan descriptor, see if it's o.k. + ************************************************************/ + sv = hv_fetch(plperl_query_hash, query, strlen(query), 0); + if ( sv == NULL) + elog(ERROR, "spi_exec_prepared: Invalid prepared query passed"); + if ( *sv == NULL || !SvOK( *sv)) + elog(ERROR, "spi_exec_prepared: panic - plperl_query_hash value corrupted"); + + qdesc = INT2PTR( plperl_query_desc *, SvUV(*sv)); + if ( qdesc == NULL) + elog(ERROR, "spi_exec_prepared: panic - plperl_query_hash value vanished"); + + if ( qdesc-> nargs != argc) + elog(ERROR, "spi_exec_prepared: expected %d argument(s), %d passed", + qdesc-> nargs, argc); + + /************************************************************ + * Parse eventual attributes + ************************************************************/ + limit = 0; + if ( attr != NULL) + { + sv = hv_fetch( attr, "limit", 5, 0); + if ( *sv && SvIOK( *sv)) + limit = SvIV( *sv); + } + /************************************************************ + * Set up arguments + ************************************************************/ + if ( argc > 0) + { + nulls = (char *)palloc( argc); + argvalues = (Datum *) palloc(argc * sizeof(Datum)); + if ( nulls == NULL || argvalues == NULL) + elog(ERROR, "spi_exec_prepared: not enough memory"); + } + else + { + nulls = NULL; + argvalues = NULL; + } + + for ( i = 0; i < argc; i++) + { + if ( SvTYPE( argv[i]) != SVt_NULL) + { + argvalues[i] = + FunctionCall3( &qdesc->arginfuncs[i], + CStringGetDatum( SvPV( argv[i], PL_na)), + ObjectIdGetDatum( qdesc->argtypioparams[i]), + Int32GetDatum(-1) + ); + nulls[i] = ' '; + } + else + { + argvalues[i] = (Datum) 0; + nulls[i] = 'n'; + } + } + + /************************************************************ + * go + ************************************************************/ + spi_rv = SPI_execute_plan(qdesc-> plan, argvalues, nulls, + current_call_data->prodesc->fn_readonly, limit); + ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed, + spi_rv); + if ( argc > 0) + { + pfree( argvalues); + pfree( nulls); + } + + /* Commit the inner transaction, return to outer xact context */ + ReleaseCurrentSubTransaction(); + MemoryContextSwitchTo(oldcontext); + CurrentResourceOwner = oldowner; + /* + * AtEOSubXact_SPI() should not have popped any SPI context, + * but just in case it did, make sure we remain connected. + */ + SPI_restore_connection(); + } + PG_CATCH(); + { + ErrorData *edata; + + /* Save error info */ + MemoryContextSwitchTo(oldcontext); + edata = CopyErrorData(); + FlushErrorState(); + + /* Abort the inner transaction */ + RollbackAndReleaseCurrentSubTransaction(); + MemoryContextSwitchTo(oldcontext); + CurrentResourceOwner = oldowner; + + /* + * If AtEOSubXact_SPI() popped any SPI context of the subxact, + * it will have left us in a disconnected state. We need this + * hack to return to connected state. + */ + SPI_restore_connection(); + + /* Punt the error to Perl */ + croak("%s", edata->message); + + /* Can't get here, but keep compiler quiet */ + return NULL; + } + PG_END_TRY(); + + return ret_hv; +} + +SV * +plperl_spi_query_prepared(char* query, int argc, SV ** argv) +{ + SV **sv; + int i; + char * nulls; + Datum *argvalues; + plperl_query_desc *qdesc; + SV *cursor; + Portal portal = NULL; + + /* + * Execute the query inside a sub-transaction, so we can cope with + * errors sanely + */ + MemoryContext oldcontext = CurrentMemoryContext; + ResourceOwner oldowner = CurrentResourceOwner; + + BeginInternalSubTransaction(NULL); + /* Want to run inside function's memory context */ + MemoryContextSwitchTo(oldcontext); + + PG_TRY(); + { + /************************************************************ + * Fetch the saved plan descriptor, see if it's o.k. + ************************************************************/ + sv = hv_fetch(plperl_query_hash, query, strlen(query), 0); + if ( sv == NULL) + elog(ERROR, "spi_query_prepared: Invalid prepared query passed"); + if ( *sv == NULL || !SvOK( *sv)) + elog(ERROR, "spi_query_prepared: panic - plperl_query_hash value corrupted"); + + qdesc = INT2PTR( plperl_query_desc *, SvUV(*sv)); + if ( qdesc == NULL) + elog(ERROR, "spi_query_prepared: panic - plperl_query_hash value vanished"); + + if ( qdesc-> nargs != argc) + elog(ERROR, "spi_query_prepared: expected %d argument(s), %d passed", + qdesc-> nargs, argc); + + /************************************************************ + * Set up arguments + ************************************************************/ + if ( argc > 0) + { + nulls = (char *)palloc( argc); + argvalues = (Datum *) palloc(argc * sizeof(Datum)); + if ( nulls == NULL || argvalues == NULL) + elog(ERROR, "spi_query_prepared: not enough memory"); + } + else + { + nulls = NULL; + argvalues = NULL; + } + + for ( i = 0; i < argc; i++) + { + if ( SvTYPE( argv[i]) != SVt_NULL) + { + argvalues[i] = + FunctionCall3( &qdesc->arginfuncs[i], + CStringGetDatum( SvPV( argv[i], PL_na)), + ObjectIdGetDatum( qdesc->argtypioparams[i]), + Int32GetDatum(-1) + ); + nulls[i] = ' '; + } + else + { + argvalues[i] = (Datum) 0; + nulls[i] = 'n'; + } + } + + /************************************************************ + * go + ************************************************************/ + portal = SPI_cursor_open(NULL, qdesc-> plan, argvalues, nulls, + current_call_data->prodesc->fn_readonly); + if ( argc > 0) + { + pfree( argvalues); + pfree( nulls); + } + if ( portal == NULL) + elog(ERROR, "SPI_cursor_open() failed:%s", + SPI_result_code_string(SPI_result)); + + cursor = newSVpv(portal->name, 0); + + /* Commit the inner transaction, return to outer xact context */ + ReleaseCurrentSubTransaction(); + MemoryContextSwitchTo(oldcontext); + CurrentResourceOwner = oldowner; + /* + * AtEOSubXact_SPI() should not have popped any SPI context, + * but just in case it did, make sure we remain connected. + */ + SPI_restore_connection(); + } + PG_CATCH(); + { + ErrorData *edata; + + /* Save error info */ + MemoryContextSwitchTo(oldcontext); + edata = CopyErrorData(); + FlushErrorState(); + + /* Abort the inner transaction */ + RollbackAndReleaseCurrentSubTransaction(); + MemoryContextSwitchTo(oldcontext); + CurrentResourceOwner = oldowner; + + /* + * If AtEOSubXact_SPI() popped any SPI context of the subxact, + * it will have left us in a disconnected state. We need this + * hack to return to connected state. + */ + SPI_restore_connection(); + + /* Punt the error to Perl */ + croak("%s", edata->message); + + /* Can't get here, but keep compiler quiet */ + return NULL; + } + PG_END_TRY(); + + return cursor; +} + +void +plperl_spi_freeplan(char *query) +{ + SV ** sv; + void * plan; + plperl_query_desc *qdesc; + + sv = hv_fetch(plperl_query_hash, query, strlen(query), 0); + if ( sv == NULL) + elog(ERROR, "spi_exec_freeplan: Invalid prepared query passed"); + if ( *sv == NULL || !SvOK( *sv)) + elog(ERROR, "spi_exec_freeplan: panic - plperl_query_hash value corrupted"); + + qdesc = INT2PTR( plperl_query_desc *, SvUV(*sv)); + if ( qdesc == NULL) + elog(ERROR, "spi_exec_freeplan: panic - plperl_query_hash value vanished"); + + /* + * free all memory before SPI_freeplan, so if it dies, nothing will be left over + */ + hv_delete(plperl_query_hash, query, strlen(query), G_DISCARD); + plan = qdesc-> plan; + free(qdesc-> argtypes); + free(qdesc-> arginfuncs); + free(qdesc-> argtypioparams); + free(qdesc); + + SPI_freeplan( plan); +} diff --git a/src/pl/plperl/plperl.h b/src/pl/plperl/plperl.h index c9fd56ca04..53c7b164fa 100644 --- a/src/pl/plperl/plperl.h +++ b/src/pl/plperl/plperl.h @@ -8,7 +8,7 @@ * Portions Copyright (c) 1996-2006, PostgreSQL Global Development Group * Portions Copyright (c) 1995, Regents of the University of California * - * $PostgreSQL: pgsql/src/pl/plperl/plperl.h,v 1.3 2006/03/05 15:59:10 momjian Exp $ + * $PostgreSQL: pgsql/src/pl/plperl/plperl.h,v 1.4 2006/03/05 16:40:51 adunstan Exp $ */ #ifndef PL_PERL_H @@ -51,6 +51,12 @@ HV *plperl_spi_exec(char *, int); void plperl_return_next(SV *); SV *plperl_spi_query(char *); SV *plperl_spi_fetchrow(char *); +SV *plperl_spi_prepare(char *, int, SV **); +HV *plperl_spi_exec_prepared(char *, HV *, int, SV **); +SV *plperl_spi_query_prepared(char *, int, SV **); +void plperl_spi_freeplan(char *); +void plperl_spi_cursor_close(char *); + #endif /* PL_PERL_H */ diff --git a/src/pl/plperl/sql/plperl.sql b/src/pl/plperl/sql/plperl.sql index b1f13d3a41..e312cd24dc 100644 --- a/src/pl/plperl/sql/plperl.sql +++ b/src/pl/plperl/sql/plperl.sql @@ -261,6 +261,16 @@ return; $$ LANGUAGE plperl; SELECT * from perl_spi_func(); +-- +-- Test spi_fetchrow abort +-- +CREATE OR REPLACE FUNCTION perl_spi_func2() RETURNS INTEGER AS $$ +my $x = spi_query("select 1 as a union select 2 as a"); +spi_cursor_close( $x); +return 0; +$$ LANGUAGE plperl; +SELECT * from perl_spi_func2(); + --- --- Test recursion via SPI @@ -300,4 +310,30 @@ LANGUAGE plperl as $$ return [['a"b',undef,'c,d'],['e\\f',undef,'g']]; $$; -SELECT array_of_text(); +SELECT array_of_text(); + +-- +-- Test spi_prepare/spi_exec_prepared/spi_freeplan +-- +CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$ + my $x = spi_prepare('select $1 AS a', 'INT4'); + my $q = spi_exec_prepared( $x, $_[0] + 1); + spi_freeplan($x); +return $q->{rows}->[0]->{a}; +$$ LANGUAGE plperl; +SELECT * from perl_spi_prepared(42); + +-- +-- Test spi_prepare/spi_query_prepared/spi_freeplan +-- +CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF INTEGER AS $$ + my $x = spi_prepare('SELECT $1 AS a union select $2 as a', 'INT4', 'INT4'); + my $q = spi_query_prepared( $x, 1+$_[0], 2+$_[1]); + while (defined (my $y = spi_fetchrow($q))) { + return_next $y->{a}; + } + spi_freeplan($x); + return; +$$ LANGUAGE plperl; +SELECT * from perl_spi_prepared_set(1,2); + -- 2.11.0