From b58fd4a9cab21e9d937a4e369bab31b3a5d24710 Mon Sep 17 00:00:00 2001
From: Tom Lane <tgl@sss.pgh.pa.us>
Date: Sat, 11 Mar 2017 14:37:05 -0500
Subject: [PATCH] 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 | 112 ++++++++++++++++++--
src/pl/tcl/Makefile | 2 +-
src/pl/tcl/expected/pltcl_subxact.out | 143 ++++++++++++++++++++++++++
src/pl/tcl/pltcl.c | 53 ++++++++++
src/pl/tcl/sql/pltcl_subxact.sql | 95 +++++++++++++++++
5 files changed, 398 insertions(+), 7 deletions(-)
create mode 100644 src/pl/tcl/expected/pltcl_subxact.out
create mode 100644 src/pl/tcl/sql/pltcl_subxact.sql
diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml
index ad216dd5b75..ed745a74810 100644
--- a/doc/src/sgml/pltcl.sgml
+++ b/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
- are not caught but are allowed to propagate out to the top level of
- execution of the PL/Tcl function, they turn into database errors.
+ within Tcl using the Tcl <function>catch</function> command. If an
+ error is not caught but is allowed to propagate out to the top level of
+ 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,
- they turn back into database errors.
+ (Each of these PL/Tcl commands runs its SQL operation in a
+ 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>
diff --git a/src/pl/tcl/Makefile b/src/pl/tcl/Makefile
index 1096c4faf04..0275c125b12 100644
--- a/src/pl/tcl/Makefile
+++ b/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
diff --git a/src/pl/tcl/expected/pltcl_subxact.out b/src/pl/tcl/expected/pltcl_subxact.out
new file mode 100644
index 00000000000..4393f4acf69
--- /dev/null
+++ b/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;
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index 2cf7e6619b0..b8fcf0673d3 100644
--- a/src/pl/tcl/pltcl.c
+++ b/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
diff --git a/src/pl/tcl/sql/pltcl_subxact.sql b/src/pl/tcl/sql/pltcl_subxact.sql
new file mode 100644
index 00000000000..0625736ea4b
--- /dev/null
+++ b/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;
--
GitLab