Add a "subtransaction" command to PL/Tcl.

This allows rolling back the effects of some SPI commands without
having to fail the entire PL/Tcl function.

Victor Wagner, reviewed by Pavel Stehule

Discussion: https://postgr.es/m/20170108205750.2dab04a1@wagner.wagner.home

doc/src/sgml/pltcl.sgml

@@ -476,6 +476,20 @@ $$ LANGUAGE pltcl;
       </listitem>
      </varlistentry>
 
+     <varlistentry>
+      <term><function>subtransaction</function> <replaceable>command</replaceable></term>
+      <listitem>
+       <para>
+        The Tcl script contained in <replaceable>command</replaceable> is
+        executed within a SQL subtransaction.  If the script returns an
+        error, that entire subtransaction is rolled back before returning the
+        error out to the surrounding Tcl code.
+        See <xref linkend="pltcl-subtransactions"> for more details and an
+        example.
+       </para>
+      </listitem>
+     </varlistentry>
+
      <varlistentry>
       <term><function>quote</> <replaceable>string</replaceable></term>
       <listitem>
@@ -844,18 +858,22 @@ CREATE EVENT TRIGGER tcl_a_snitch ON ddl_command_start EXECUTE PROCEDURE tclsnit
      either by executing some invalid operation or by generating an error
      using the Tcl <function>error</function> command or
      PL/Tcl's <function>elog</function> command.  Such errors can be caught
-     within Tcl using the Tcl <function>catch</function> command.  If they
+     within Tcl using the Tcl <function>catch</function> command.  If an
-     are not caught but are allowed to propagate out to the top level of
+     error is not caught but is allowed to propagate out to the top level of
-     execution of the PL/Tcl function, they turn into database errors.
+     execution of the PL/Tcl function, it is reported as a SQL error in the
+     function's calling query.
     </para>
 
     <para>
-     Conversely, database errors that occur within PL/Tcl's
+     Conversely, SQL errors that occur within PL/Tcl's
      <function>spi_exec</function>, <function>spi_prepare</function>,
      and <function>spi_execp</function> commands are reported as Tcl errors,
      so they are catchable by Tcl's <function>catch</function> command.
-     Again, if they propagate out to the top level without being caught,
+     (Each of these PL/Tcl commands runs its SQL operation in a
-     they turn back into database errors.
+     subtransaction, which is rolled back on error, so that any
+     partially-completed operation is automatically cleaned up.)
+     Again, if an error propagates out to the top level without being caught,
+     it turns back into a SQL error.
     </para>
 
     <para>
@@ -902,6 +920,88 @@ if {[catch { spi_exec $sql_command }]} {
     </para>
    </sect1>
 
+   <sect1 id="pltcl-subtransactions">
+    <title>Explicit Subtransactions in PL/Tcl</title>
+
+    <indexterm>
+     <primary>subtransactions</primary>
+     <secondary>in PL/Tcl</secondary>
+    </indexterm>
+
+    <para>
+     Recovering from errors caused by database access as described in
+     <xref linkend="pltcl-error-handling"> can lead to an undesirable
+     situation where some operations succeed before one of them fails,
+     and after recovering from that error the data is left in an
+     inconsistent state.  PL/Tcl offers a solution to this problem in
+     the form of explicit subtransactions.
+    </para>
+
+    <para>
+     Consider a function that implements a transfer between two accounts:
+<programlisting>
+CREATE FUNCTION transfer_funds() RETURNS void AS $$
+    if [catch {
+        spi_exec "UPDATE accounts SET balance = balance - 100 WHERE account_name = 'joe'"
+        spi_exec "UPDATE accounts SET balance = balance + 100 WHERE account_name = 'mary'"
+    } errormsg] {
+        set result [format "error transferring funds: %s" $errormsg]
+    } else {
+        set result "funds transferred successfully"
+    }
+    spi_exec "INSERT INTO operations (result) VALUES ('[quote $result]')"
+$$ LANGUAGE pltcl;
+</programlisting>
+     If the second <command>UPDATE</command> statement results in an
+     exception being raised, this function will log the failure, but
+     the result of the first <command>UPDATE</command> will
+     nevertheless be committed.  In other words, the funds will be
+     withdrawn from Joe's account, but will not be transferred to
+     Mary's account.  This happens because each <function>spi_exec</function>
+     is a separate subtransaction, and only one of those subtransactions
+     got rolled back.
+    </para>
+
+    <para>
+     To handle such cases, you can wrap multiple database operations in an
+     explicit subtransaction, which will succeed or roll back as a whole.
+     PL/Tcl provides a <function>subtransaction</function> command to manage
+     this.  We can rewrite our function as:
+<programlisting>
+CREATE FUNCTION transfer_funds2() RETURNS void AS $$
+    if [catch {
+        subtransaction {
+            spi_exec "UPDATE accounts SET balance = balance - 100 WHERE account_name = 'joe'"
+            spi_exec "UPDATE accounts SET balance = balance + 100 WHERE account_name = 'mary'"
+        }
+    } errormsg] {
+        set result [format "error transferring funds: %s" $errormsg]
+    } else {
+        set result "funds transferred successfully"
+    }
+    spi_exec "INSERT INTO operations (result) VALUES ('[quote $result]')"
+$$ LANGUAGE pltcl;
+</programlisting>
+     Note that use of <function>catch</function> is still required for this
+     purpose.  Otherwise the error would propagate to the top level of the
+     function, preventing the desired insertion into
+     the <structname>operations</structname> table.
+     The <function>subtransaction</function> command does not trap errors, it
+     only assures that all database operations executed inside its scope will
+     be rolled back together when an error is reported.
+    </para>
+
+    <para>
+     A rollback of an explicit subtransaction occurs on any error reported
+     by the contained Tcl code, not only errors originating from database
+     access.  Thus a regular Tcl exception raised inside
+     a <function>subtransaction</function> command will also cause the
+     subtransaction to be rolled back.  However, non-error exits out of the
+     contained Tcl code (for instance, due to <function>return</function>) do
+     not cause a rollback.
+    </para>
+   </sect1>
+
    <sect1 id="pltcl-config">
     <title>PL/Tcl Configuration</title>
 

src/pl/tcl/Makefile

@@ -28,7 +28,7 @@ DATA = pltcl.control pltcl--1.0.sql pltcl--unpackaged--1.0.sql \
        pltclu.control pltclu--1.0.sql pltclu--unpackaged--1.0.sql
 
 REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-extension=pltcl
-REGRESS = pltcl_setup pltcl_queries pltcl_start_proc pltcl_unicode
+REGRESS = pltcl_setup pltcl_queries pltcl_start_proc pltcl_subxact pltcl_unicode
 
 # Tcl on win32 ships with import libraries only for Microsoft Visual C++,
 # which are not compatible with mingw gcc. Therefore we need to build a

src/pl/tcl/expected/pltcl_subxact.out

@@ -0,0 +1,143 @@
+--
+-- Test explicit subtransactions
+--
+CREATE TABLE subtransaction_tbl (
+    i integer
+);
+--
+-- We use this wrapper to catch errors and return errormsg only,
+-- because values of $::errorinfo variable contain procedure name which
+-- includes OID, so it's not stable
+--
+CREATE FUNCTION pltcl_wrapper(statement text) RETURNS text
+AS $$
+    if [catch {spi_exec $1} msg] {
+        return "ERROR: $msg"
+    } else {
+        return "SUCCESS: $msg"
+    }
+$$ LANGUAGE pltcl;
+-- Test subtransaction successfully committed
+CREATE FUNCTION subtransaction_ctx_success() RETURNS void
+AS $$
+    spi_exec "INSERT INTO subtransaction_tbl VALUES(1)"
+    subtransaction {
+        spi_exec "INSERT INTO subtransaction_tbl VALUES(2)"
+    }
+$$ LANGUAGE pltcl;
+BEGIN;
+INSERT INTO subtransaction_tbl VALUES(0);
+SELECT subtransaction_ctx_success();
+ subtransaction_ctx_success 
+----------------------------
+ 
+(1 row)
+
+COMMIT;
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+ 0
+ 1
+ 2
+(3 rows)
+
+TRUNCATE subtransaction_tbl;
+-- Test subtransaction rollback
+CREATE FUNCTION subtransaction_ctx_test(what_error text = NULL) RETURNS void
+AS $$
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+    subtransaction {
+        spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+        if {$1 == "SPI"} {
+            spi_exec "INSERT INTO subtransaction_tbl VALUES ('oops')"
+        } elseif { $1 == "Tcl"} {
+            elog ERROR "Tcl error"
+        }
+    }
+$$ LANGUAGE pltcl;
+SELECT pltcl_wrapper('SELECT subtransaction_ctx_test()');
+ pltcl_wrapper 
+---------------
+ SUCCESS: 1
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+ 1
+ 2
+(2 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT pltcl_wrapper('SELECT subtransaction_ctx_test(''SPI'')');
+                  pltcl_wrapper                  
+-------------------------------------------------
+ ERROR: invalid input syntax for integer: "oops"
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT pltcl_wrapper('SELECT subtransaction_ctx_test(''Tcl'')');
+  pltcl_wrapper   
+------------------
+ ERROR: Tcl error
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+-- Nested subtransactions
+CREATE FUNCTION subtransaction_nested_test(swallow boolean = 'f') RETURNS text
+AS $$
+spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+    if [catch {
+        subtransaction {
+            spi_exec "INSERT INTO subtransaction_tbl VALUES (3)"
+            spi_exec "error"
+        }
+    } errormsg] {
+        if {$1 != "t"} {
+            error $errormsg $::errorInfo $::errorCode
+        }
+        elog NOTICE "Swallowed $errormsg"
+    }
+}
+return "ok"
+$$ LANGUAGE pltcl;
+SELECT pltcl_wrapper('SELECT subtransaction_nested_test()');
+             pltcl_wrapper              
+----------------------------------------
+ ERROR: syntax error at or near "error"
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT pltcl_wrapper('SELECT subtransaction_nested_test(''t'')');
+NOTICE:  Swallowed syntax error at or near "error"
+ pltcl_wrapper 
+---------------
+ SUCCESS: 1
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+ 1
+ 2
+(2 rows)
+
+TRUNCATE subtransaction_tbl;

src/pl/tcl/pltcl.c

@@ -306,6 +306,8 @@ static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
 					   int objc, Tcl_Obj *const objv[]);
 static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
 				  int objc, Tcl_Obj *const objv[]);
+static int pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp,
+					 int objc, Tcl_Obj *const objv[]);
 
 static void pltcl_subtrans_begin(MemoryContext oldcontext,
 					 ResourceOwner oldowner);
@@ -516,6 +518,8 @@ pltcl_init_interp(pltcl_interp_desc *interp_desc, Oid prolang, bool pltrusted)
 						 pltcl_SPI_execute_plan, NULL, NULL);
 	Tcl_CreateObjCommand(interp, "spi_lastoid",
 						 pltcl_SPI_lastoid, NULL, NULL);
+	Tcl_CreateObjCommand(interp, "subtransaction",
+						 pltcl_subtransaction, NULL, NULL);
 
 	/************************************************************
 	 * Call the appropriate start_proc, if there is one.
@@ -2850,6 +2854,55 @@ pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
 }
 
 
+/**********************************************************************
+ * pltcl_subtransaction()	- Execute some Tcl code in a subtransaction
+ *
+ * The subtransaction is aborted if the Tcl code fragment returns TCL_ERROR,
+ * otherwise it's subcommitted.
+ **********************************************************************/
+static int
+pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp,
+					 int objc, Tcl_Obj *const objv[])
+{
+	MemoryContext oldcontext = CurrentMemoryContext;
+	ResourceOwner oldowner = CurrentResourceOwner;
+	int			retcode;
+
+	if (objc != 2)
+	{
+		Tcl_WrongNumArgs(interp, 1, objv, "command");
+		return TCL_ERROR;
+	}
+
+	/*
+	 * Note: we don't use pltcl_subtrans_begin and friends here because we
+	 * don't want the error handling in pltcl_subtrans_abort.  But otherwise
+	 * the processing should be about the same as in those functions.
+	 */
+	BeginInternalSubTransaction(NULL);
+	MemoryContextSwitchTo(oldcontext);
+
+	retcode = Tcl_EvalObjEx(interp, objv[1], 0);
+
+	if (retcode == TCL_ERROR)
+	{
+		/* Rollback the subtransaction */
+		RollbackAndReleaseCurrentSubTransaction();
+	}
+	else
+	{
+		/* Commit the subtransaction */
+		ReleaseCurrentSubTransaction();
+	}
+
+	/* In either case, restore previous memory context and resource owner */
+	MemoryContextSwitchTo(oldcontext);
+	CurrentResourceOwner = oldowner;
+
+	return retcode;
+}
+
+
 /**********************************************************************
  * pltcl_set_tuple_values() - Set variables for all attributes
  *				  of a given tuple

src/pl/tcl/sql/pltcl_subxact.sql

@@ -0,0 +1,95 @@
+--
+-- Test explicit subtransactions
+--
+
+CREATE TABLE subtransaction_tbl (
+    i integer
+);
+
+--
+-- We use this wrapper to catch errors and return errormsg only,
+-- because values of $::errorinfo variable contain procedure name which
+-- includes OID, so it's not stable
+--
+CREATE FUNCTION pltcl_wrapper(statement text) RETURNS text
+AS $$
+    if [catch {spi_exec $1} msg] {
+        return "ERROR: $msg"
+    } else {
+        return "SUCCESS: $msg"
+    }
+$$ LANGUAGE pltcl;
+
+-- Test subtransaction successfully committed
+
+CREATE FUNCTION subtransaction_ctx_success() RETURNS void
+AS $$
+    spi_exec "INSERT INTO subtransaction_tbl VALUES(1)"
+    subtransaction {
+        spi_exec "INSERT INTO subtransaction_tbl VALUES(2)"
+    }
+$$ LANGUAGE pltcl;
+
+BEGIN;
+INSERT INTO subtransaction_tbl VALUES(0);
+SELECT subtransaction_ctx_success();
+COMMIT;
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+
+-- Test subtransaction rollback
+
+CREATE FUNCTION subtransaction_ctx_test(what_error text = NULL) RETURNS void
+AS $$
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+    subtransaction {
+        spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+        if {$1 == "SPI"} {
+            spi_exec "INSERT INTO subtransaction_tbl VALUES ('oops')"
+        } elseif { $1 == "Tcl"} {
+            elog ERROR "Tcl error"
+        }
+    }
+$$ LANGUAGE pltcl;
+
+SELECT pltcl_wrapper('SELECT subtransaction_ctx_test()');
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+
+SELECT pltcl_wrapper('SELECT subtransaction_ctx_test(''SPI'')');
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+
+SELECT pltcl_wrapper('SELECT subtransaction_ctx_test(''Tcl'')');
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+
+-- Nested subtransactions
+
+CREATE FUNCTION subtransaction_nested_test(swallow boolean = 'f') RETURNS text
+AS $$
+spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+    if [catch {
+        subtransaction {
+            spi_exec "INSERT INTO subtransaction_tbl VALUES (3)"
+            spi_exec "error"
+        }
+    } errormsg] {
+        if {$1 != "t"} {
+            error $errormsg $::errorInfo $::errorCode
+        }
+        elog NOTICE "Swallowed $errormsg"
+    }
+}
+return "ok"
+$$ LANGUAGE pltcl;
+
+SELECT pltcl_wrapper('SELECT subtransaction_nested_test()');
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+
+SELECT pltcl_wrapper('SELECT subtransaction_nested_test(''t'')');
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;