On Sun, 8 Jan 2017 20:57:50 +0300
Victor Wagner <vi...@wagner.pp.ru> wrote:

> Collegues!
> 
> Recently I've found out that PL/Python have very nice feature -
> explicit subtransaction object, which allows to execute block of code
> in the context of subtransaction.
> 
[skip]

> 
> I'm attaching the patch which implements subtransaction command for

Sorry, unfortunately attached empty file instead of patch
-- 
                                   Victor Wagner <vi...@wagner.pp.ru>
diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml
index 8afaf4a..7a532b7 100644
--- a/doc/src/sgml/pltcl.sgml
+++ b/doc/src/sgml/pltcl.sgml
@@ -901,6 +901,85 @@ if {[catch { spi_exec $sql_command }]} {
      is a global variable.)
     </para>
    </sect1>
+   <sect1 id="pltcl-subransaction">
+   <title>Explicit Subtransactions</title>
+  <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>
+
+  <sect2>
+   <title>Subtransaction command</title>
+
+   <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 correctly"
+}
+set plan [spi_prepare "INSERT INTO operations (result) VALUES ($1)"]
+spi_execp -count 1 $plan, [list $result)
+$$ LANGUAGE pltclu;
+</programlisting>
+    If the second <literal>UPDATE</literal> statement results in an
+    exception being raised, this function will report the error, but
+    the result of the first <literal>UPDATE</literal> 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.
+   </para>
+
+   <para>
+    To avoid such issues, you can wrap your
+    <literal>spi_exec</literal> calls in an explicit
+    subtransaction.  The PL/Tcl provides a
+    commmand <literal>subtransaction</literal> to manage explicit
+	subtransactions.
+     Using explicit subtransactions
+    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 correctly"
+	}
+    set plan  [spi_prepare "INSERT INTO operations (result) VALUES ($1)"]
+    spi_execp $plan, [list $result]
+$$ LANGUAGE pltclu;
+</programlisting>
+    Note that the use of <literal>catch</literal> is still
+    required.  Otherwise the exception would propagate to the top of
+    the  stack and would cause the whole function to abort with
+    a <productname>PostgreSQL</productname> error, so that the
+    <literal>operations</literal> table would not have any row
+    inserted into it.  The <literal>subtransaction</literal> command does not
+    trap errors, it only assures that all database operations executed
+    inside its scope will be atomically committed or rolled back.  A
+    rollback of the subtransaction block occurs on any kind of
+    exception exit, not only ones caused by errors originating from
+    database access.  A regular Tcl exception raised inside an
+    explicit subtransaction block would also cause the subtransaction
+    to be rolled back.
+   </para>
+  </sect2>
+  </sect1>
 
    <sect1 id="pltcl-unknown">
        <title>Modules and the <function>unknown</> Command</title>
diff --git a/src/pl/tcl/Makefile b/src/pl/tcl/Makefile
index 25082ec..614385d 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_unicode
+REGRESS = pltcl_setup pltcl_queries pltcl_unicode pltcl_subxact
 
 # 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 0000000..17b9d90
--- /dev/null
+++ b/src/pl/tcl/expected/pltcl_subxact.out
@@ -0,0 +1,145 @@
+--
+-- Test explicit subtransactions
+--
+-- Test table to see if transactions get properly rolled back
+CREATE TABLE subtransaction_tbl (
+    i integer
+);
+CREATE FUNCTION subtransaction_ctx_test(what_error text = NULL) RETURNS text
+AS $$
+subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+    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 subtransaction_ctx_test();
+ subtransaction_ctx_test 
+-------------------------
+ 
+(1 row)
+
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+ 1
+ 2
+(2 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT subtransaction_ctx_test('SPI');
+ERROR:  invalid input syntax for integer: "oops"
+CONTEXT:  invalid input syntax for integer: "oops"
+    while executing
+"spi_exec "INSERT INTO subtransaction_tbl VALUES ('oops')""
+    invoked from within
+"subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+    if {$1 == "SPI"..."
+    (procedure "__PLTcl_proc_16494" line 3)
+    invoked from within
+"__PLTcl_proc_16494 SPI"
+in PL/Tcl function "subtransaction_ctx_test"
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT subtransaction_ctx_test('Tcl');
+ERROR:  Tcl error
+CONTEXT:  Tcl error
+    while executing
+"elog ERROR "Tcl error""
+    invoked from within
+"subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+    if {$1 == "SPI"..."
+    (procedure "__PLTcl_proc_16494" line 3)
+    invoked from within
+"__PLTcl_proc_16494 Tcl"
+in PL/Tcl function "subtransaction_ctx_test"
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+-- Nested subtransactions
+CREATE FUNCTION subtransaction_nested_test(swallow boolean = 'f') RETURNS text
+AS $$
+elog NOTICE "subtransaction_tested_test got arg '$1'"
+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 subtransaction_nested_test();
+NOTICE:  subtransaction_tested_test got arg 'f'
+ERROR:  syntax error at or near "error"
+CONTEXT:  syntax error at or near "error"
+    while executing
+"spi_exec "error""
+    invoked from within
+"subtransaction {
+            spi_exec "INSERT INTO subtransaction_tbl VALUES (3)"
+            spi_exec "error"
+		}"
+    invoked from within
+"if [catch {
+	    subtransaction {
+            spi_exec "INSERT INTO subtransaction_tbl VALUES (3)"
+            spi_exec "error"
+		}
+    } errormsg] {
+..."
+    invoked from within
+"subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (2)"
+    if [catch {
+	    subtransaction {
+            spi_exec "INSERT INTO subt..."
+    (procedure "__PLTcl_proc_16498" line 5)
+    invoked from within
+"__PLTcl_proc_16498 f"
+in PL/Tcl function "subtransaction_nested_test"
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+(0 rows)
+
+TRUNCATE subtransaction_tbl;
+SELECT subtransaction_nested_test('t');
+NOTICE:  subtransaction_tested_test got arg 't'
+NOTICE:  Swallowed syntax error at or near "error"
+ subtransaction_nested_test 
+----------------------------
+ ok
+(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 d813dcb..f03ecf1 100644
--- a/src/pl/tcl/pltcl.c
+++ b/src/pl/tcl/pltcl.c
@@ -307,6 +307,8 @@ static HeapTuple pltcl_build_tuple_result(Tcl_Interp *interp,
 						 pltcl_call_state *call_state);
 static void pltcl_init_tuple_store(pltcl_call_state *call_state);
 
+static int pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp,
+	int objc, Tcl_Obj *const objv[]);
 
 /*
  * Hack to override Tcl's builtin Notifier subsystem.  This prevents the
@@ -483,7 +485,8 @@ pltcl_init_interp(pltcl_interp_desc *interp_desc, 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);
 	/************************************************************
 	 * Try to load the unknown procedure from pltcl_modules
 	 ************************************************************/
@@ -3070,3 +3073,43 @@ pltcl_init_tuple_store(pltcl_call_state *call_state)
 	CurrentResourceOwner = oldowner;
 	MemoryContextSwitchTo(oldcxt);
 }
+
+/* 
+ * pltcl_subtransaction - implements tcl level subtransaction block
+ * Called with exactly one argument - piece of Tcl Code, and executes
+ * this code inside subtransaction.
+ * Rolls subtransaction back if Tcl_EvalEx returns TCL_ERROR
+ */
+static int 
+pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp,
+                     int objc, Tcl_Obj *const objv[]) 
+{
+    /* Initialize local memory context */
+    MemoryContext oldcontext = CurrentMemoryContext;
+	ResourceOwner oldowner = CurrentResourceOwner;
+	int retcode;
+	if (objc != 2) 
+	{
+		Tcl_WrongNumArgs(interp,1,objv,"command");
+		return TCL_ERROR;
+	}
+	
+	BeginInternalSubTransaction(NULL);
+	MemoryContextSwitchTo(TopTransactionContext);
+	
+    retcode = Tcl_EvalObjEx(interp, objv[1],0);
+	
+    if (retcode == TCL_ERROR) 
+	{
+  	   /* Roollback the subtransaction */
+       RollbackAndReleaseCurrentSubTransaction();
+	} 
+	else 
+	{
+  	   /* Commit the subtransaction */
+	   ReleaseCurrentSubTransaction();
+    }
+	MemoryContextSwitchTo(oldcontext);
+	CurrentResourceOwner = oldowner;
+    return retcode;
+}
diff --git a/src/pl/tcl/sql/pltcl_subxact.sql b/src/pl/tcl/sql/pltcl_subxact.sql
new file mode 100644
index 0000000..c5859e1
--- /dev/null
+++ b/src/pl/tcl/sql/pltcl_subxact.sql
@@ -0,0 +1,63 @@
+--
+-- Test explicit subtransactions
+--
+
+-- Test table to see if transactions get properly rolled back
+
+CREATE TABLE subtransaction_tbl (
+    i integer
+);
+
+CREATE FUNCTION subtransaction_ctx_test(what_error text = NULL) RETURNS text
+AS $$
+subtransaction {
+    spi_exec "INSERT INTO subtransaction_tbl VALUES (1)"
+    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 subtransaction_ctx_test();
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+SELECT subtransaction_ctx_test('SPI');
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+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 $$
+elog NOTICE "subtransaction_tested_test got arg '$1'"
+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 subtransaction_nested_test();
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
+
+SELECT subtransaction_nested_test('t');
+SELECT * FROM subtransaction_tbl;
+TRUNCATE subtransaction_tbl;
-- 
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers

Reply via email to