3333 * ENHANCEMENTS, OR MODIFICATIONS.
3434 *
3535 * IDENTIFICATION
36- * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.93 2005/10/15 02:49:49 momjian Exp $
36+ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.94 2005/10/18 17:13:14 tgl Exp $
3737 *
3838 **********************************************************************/
3939
@@ -119,9 +119,6 @@ Datumplperl_call_handler(PG_FUNCTION_ARGS);
119119Datum plperl_validator (PG_FUNCTION_ARGS );
120120void plperl_init (void );
121121
122- HV * plperl_spi_exec (char * query ,int limit );
123- SV * plperl_spi_query (char * );
124-
125122static Datum plperl_func_handler (PG_FUNCTION_ARGS );
126123
127124static Datum plperl_trigger_handler (PG_FUNCTION_ARGS );
@@ -131,8 +128,6 @@ static SV *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc);
131128static void plperl_init_shared_libs (pTHX );
132129static HV * plperl_spi_execute_fetch_result (SPITupleTable * ,int ,int );
133130
134- void plperl_return_next (SV * );
135-
136131/*
137132 * This routine is a crock, and so is everyplace that calls it. The problem
138133 * is that the cached form of plperl functions/queries is allocated permanently
@@ -1552,8 +1547,16 @@ plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed,
15521547}
15531548
15541549
1550+ /*
1551+ * Note: plperl_return_next is called both in Postgres and Perl contexts.
1552+ * We report any errors in Postgres fashion (via ereport). If called in
1553+ * Perl context, it is SPI.xs's responsibility to catch the error and
1554+ * convert to a Perl error. We assume (perhaps without adequate justification)
1555+ * that we need not abort the current transaction if the Perl code traps the
1556+ * error.
1557+ */
15551558void
1556- plperl_return_next (SV * sv )
1559+ plperl_return_next (SV * sv )
15571560{
15581561plperl_proc_desc * prodesc = plperl_current_prodesc ;
15591562FunctionCallInfo fcinfo = plperl_current_caller_info ;
@@ -1566,20 +1569,16 @@ plperl_return_next(SV * sv)
15661569return ;
15671570
15681571if (!prodesc -> fn_retisset )
1569- {
15701572ereport (ERROR ,
15711573(errcode (ERRCODE_SYNTAX_ERROR ),
15721574errmsg ("cannot use return_next in a non-SETOF function" )));
1573- }
15741575
15751576if (prodesc -> fn_retistuple &&
15761577!(SvOK (sv )&& SvTYPE (sv )== SVt_RV && SvTYPE (SvRV (sv ))== SVt_PVHV ))
1577- {
15781578ereport (ERROR ,
15791579(errcode (ERRCODE_DATATYPE_MISMATCH ),
15801580errmsg ("setof-composite-returning Perl function "
15811581"must call return_next with reference to hash" )));
1582- }
15831582
15841583cxt = MemoryContextSwitchTo (rsi -> econtext -> ecxt_per_query_memory );
15851584
@@ -1637,17 +1636,23 @@ plperl_spi_query(char *query)
16371636{
16381637SV * cursor ;
16391638
1639+ /*
1640+ * Execute the query inside a sub-transaction, so we can cope with errors
1641+ * sanely
1642+ */
16401643MemoryContext oldcontext = CurrentMemoryContext ;
16411644ResourceOwner oldowner = CurrentResourceOwner ;
16421645
16431646BeginInternalSubTransaction (NULL );
1647+ /* Want to run inside function's memory context */
16441648MemoryContextSwitchTo (oldcontext );
16451649
16461650PG_TRY ();
16471651{
16481652void * plan ;
16491653Portal portal = NULL ;
16501654
1655+ /* Create a cursor for the query */
16511656plan = SPI_prepare (query ,0 ,NULL );
16521657if (plan )
16531658portal = SPI_cursor_open (NULL ,plan ,NULL ,NULL , false);
@@ -1656,25 +1661,42 @@ plperl_spi_query(char *query)
16561661else
16571662cursor = newSV (0 );
16581663
1664+ /* Commit the inner transaction, return to outer xact context */
16591665ReleaseCurrentSubTransaction ();
16601666MemoryContextSwitchTo (oldcontext );
16611667CurrentResourceOwner = oldowner ;
1668+
1669+ /*
1670+ * AtEOSubXact_SPI() should not have popped any SPI context, but just
1671+ * in case it did, make sure we remain connected.
1672+ */
16621673SPI_restore_connection ();
16631674}
16641675PG_CATCH ();
16651676{
16661677ErrorData * edata ;
16671678
1679+ /* Save error info */
16681680MemoryContextSwitchTo (oldcontext );
16691681edata = CopyErrorData ();
16701682FlushErrorState ();
16711683
1684+ /* Abort the inner transaction */
16721685RollbackAndReleaseCurrentSubTransaction ();
16731686MemoryContextSwitchTo (oldcontext );
16741687CurrentResourceOwner = oldowner ;
16751688
1689+ /*
1690+ * If AtEOSubXact_SPI() popped any SPI context of the subxact, it will
1691+ * have left us in a disconnected state. We need this hack to return
1692+ * to connected state.
1693+ */
16761694SPI_restore_connection ();
1695+
1696+ /* Punt the error to Perl */
16771697croak ("%s" ,edata -> message );
1698+
1699+ /* Can't get here, but keep compiler quiet */
16781700return NULL ;
16791701}
16801702PG_END_TRY ();
@@ -1686,22 +1708,80 @@ plperl_spi_query(char *query)
16861708SV *
16871709plperl_spi_fetchrow (char * cursor )
16881710{
1689- SV * row = newSV (0 );
1690- Portal p = SPI_cursor_find (cursor );
1711+ SV * row ;
1712+
1713+ /*
1714+ * Execute the FETCH inside a sub-transaction, so we can cope with errors
1715+ * sanely
1716+ */
1717+ MemoryContext oldcontext = CurrentMemoryContext ;
1718+ ResourceOwner oldowner = CurrentResourceOwner ;
16911719
1692- if (!p )
1693- return row ;
1720+ BeginInternalSubTransaction (NULL );
1721+ /* Want to run inside function's memory context */
1722+ MemoryContextSwitchTo (oldcontext );
16941723
1695- SPI_cursor_fetch (p , true,1 );
1696- if (SPI_processed == 0 )
1724+ PG_TRY ();
16971725{
1698- SPI_cursor_close (p );
1699- return row ;
1726+ Portal p = SPI_cursor_find (cursor );
1727+
1728+ if (!p )
1729+ row = newSV (0 );
1730+ else
1731+ {
1732+ SPI_cursor_fetch (p , true,1 );
1733+ if (SPI_processed == 0 )
1734+ {
1735+ SPI_cursor_close (p );
1736+ row = newSV (0 );
1737+ }
1738+ else
1739+ {
1740+ row = plperl_hash_from_tuple (SPI_tuptable -> vals [0 ],
1741+ SPI_tuptable -> tupdesc );
1742+ }
1743+ SPI_freetuptable (SPI_tuptable );
1744+ }
1745+
1746+ /* Commit the inner transaction, return to outer xact context */
1747+ ReleaseCurrentSubTransaction ();
1748+ MemoryContextSwitchTo (oldcontext );
1749+ CurrentResourceOwner = oldowner ;
1750+
1751+ /*
1752+ * AtEOSubXact_SPI() should not have popped any SPI context, but just
1753+ * in case it did, make sure we remain connected.
1754+ */
1755+ SPI_restore_connection ();
17001756}
1757+ PG_CATCH ();
1758+ {
1759+ ErrorData * edata ;
17011760
1702- row = plperl_hash_from_tuple (SPI_tuptable -> vals [0 ],
1703- SPI_tuptable -> tupdesc );
1704- SPI_freetuptable (SPI_tuptable );
1761+ /* Save error info */
1762+ MemoryContextSwitchTo (oldcontext );
1763+ edata = CopyErrorData ();
1764+ FlushErrorState ();
1765+
1766+ /* Abort the inner transaction */
1767+ RollbackAndReleaseCurrentSubTransaction ();
1768+ MemoryContextSwitchTo (oldcontext );
1769+ CurrentResourceOwner = oldowner ;
1770+
1771+ /*
1772+ * If AtEOSubXact_SPI() popped any SPI context of the subxact, it will
1773+ * have left us in a disconnected state. We need this hack to return
1774+ * to connected state.
1775+ */
1776+ SPI_restore_connection ();
1777+
1778+ /* Punt the error to Perl */
1779+ croak ("%s" ,edata -> message );
1780+
1781+ /* Can't get here, but keep compiler quiet */
1782+ return NULL ;
1783+ }
1784+ PG_END_TRY ();
17051785
17061786return row ;
17071787}