Code review for spi_query/spi_fetchrow patch: handle errors sanely,

avoid leaking memory.  I would add a regression test for error handling
except it seems eval{} can't be used in unprivileged plperl :-(

diff --git a/src/pl/plperl/SPI.xs b/src/pl/plperl/SPI.xs
index 496e889..8d14f09 100644 (file)
--- a/src/pl/plperl/SPI.xs
+++ b/src/pl/plperl/SPI.xs
@@ -46,6 +46,33 @@ do_spi_elog(int level, char *message)
        PG_END_TRY();
 }
 
+/*
+ * Interface routine to catch ereports and punt them to Perl
+ */
+static void
+do_plperl_return_next(SV *sv)
+{
+       MemoryContext oldcontext = CurrentMemoryContext;
+
+       PG_TRY();
+       {
+               plperl_return_next(sv);
+       }
+       PG_CATCH();
+       {
+               ErrorData  *edata;
+
+               /* Must reset elog.c's state */
+               MemoryContextSwitchTo(oldcontext);
+               edata = CopyErrorData();
+               FlushErrorState();
+
+               /* Punt the error to Perl */
+               croak("%s", edata->message);
+       }
+       PG_END_TRY();
+}
+
 
 MODULE = SPI PREFIX = spi_
 
@@ -101,7 +128,7 @@ void
 spi_return_next(rv)
        SV *rv;
        CODE:
-               plperl_return_next(rv);
+               do_plperl_return_next(rv);
 
 SV *
 spi_spi_query(query)

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 5bd2943..01d7b24 100644 (file)
--- 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.93 2005/10/15 02:49:49 momjian Exp $
+ *       $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.94 2005/10/18 17:13:14 tgl Exp $
  *
  **********************************************************************/
 
@@ -119,9 +119,6 @@ Datum               plperl_call_handler(PG_FUNCTION_ARGS);
 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);
 
 static Datum plperl_trigger_handler(PG_FUNCTION_ARGS);
@@ -131,8 +128,6 @@ static SV  *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc);
 static void plperl_init_shared_libs(pTHX);
 static HV  *plperl_spi_execute_fetch_result(SPITupleTable *, int, int);
 
-void           plperl_return_next(SV *);
-
 /*
  * This routine is a crock, and so is everyplace that calls it.  The problem
  * 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,
 }
 
 
+/*
+ * Note: plperl_return_next is called both in Postgres and Perl contexts.
+ * We report any errors in Postgres fashion (via ereport).  If called in
+ * Perl context, it is SPI.xs's responsibility to catch the error and
+ * convert to a Perl error.  We assume (perhaps without adequate justification)
+ * that we need not abort the current transaction if the Perl code traps the
+ * error.
+ */
 void
-plperl_return_next(SV * sv)
+plperl_return_next(SV *sv)
 {
        plperl_proc_desc *prodesc = plperl_current_prodesc;
        FunctionCallInfo fcinfo = plperl_current_caller_info;
@@ -1566,20 +1569,16 @@ plperl_return_next(SV * sv)
                return;
 
        if (!prodesc->fn_retisset)
-       {
                ereport(ERROR,
                                (errcode(ERRCODE_SYNTAX_ERROR),
                                 errmsg("cannot use return_next in a non-SETOF function")));
-       }
 
        if (prodesc->fn_retistuple &&
                !(SvOK(sv) && SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVHV))
-       {
                ereport(ERROR,
                                (errcode(ERRCODE_DATATYPE_MISMATCH),
                                 errmsg("setof-composite-returning Perl function "
                                                "must call return_next with reference to hash")));
-       }
 
        cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory);
 
@@ -1637,10 +1636,15 @@ plperl_spi_query(char *query)
 {
        SV                 *cursor;
 
+       /*
+        * 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();
@@ -1648,6 +1652,7 @@ plperl_spi_query(char *query)
                void       *plan;
                Portal          portal = NULL;
 
+               /* Create a cursor for the query */
                plan = SPI_prepare(query, 0, NULL);
                if (plan)
                        portal = SPI_cursor_open(NULL, plan, NULL, NULL, false);
@@ -1656,25 +1661,42 @@ plperl_spi_query(char *query)
                else
                        cursor = newSV(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();
@@ -1686,22 +1708,80 @@ plperl_spi_query(char *query)
 SV *
 plperl_spi_fetchrow(char *cursor)
 {
-       SV                 *row = newSV(0);
-       Portal          p = SPI_cursor_find(cursor);
+       SV                 *row;
+
+       /*
+        * Execute the FETCH inside a sub-transaction, so we can cope with errors
+        * sanely
+        */
+       MemoryContext oldcontext = CurrentMemoryContext;
+       ResourceOwner oldowner = CurrentResourceOwner;
 
-       if (!p)
-               return row;
+       BeginInternalSubTransaction(NULL);
+       /* Want to run inside function's memory context */
+       MemoryContextSwitchTo(oldcontext);
 
-       SPI_cursor_fetch(p, true, 1);
-       if (SPI_processed == 0)
+       PG_TRY();
        {
-               SPI_cursor_close(p);
-               return row;
+               Portal          p = SPI_cursor_find(cursor);
+
+               if (!p)
+                       row = newSV(0);
+               else
+               {
+                       SPI_cursor_fetch(p, true, 1);
+                       if (SPI_processed == 0)
+                       {
+                               SPI_cursor_close(p);
+                               row = newSV(0);
+                       }
+                       else
+                       {
+                               row = plperl_hash_from_tuple(SPI_tuptable->vals[0],
+                                                                                        SPI_tuptable->tupdesc);
+                       }
+                       SPI_freetuptable(SPI_tuptable);
+               }
+
+               /* 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;
 
-       row = plperl_hash_from_tuple(SPI_tuptable->vals[0],
-                                                                SPI_tuptable->tupdesc);
-       SPI_freetuptable(SPI_tuptable);
+               /* 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 row;
 }