On Thu, 9 Mar 2017 12:04:31 +0100
Pavel Stehule <pavel.steh...@gmail.com> wrote:


> > Now test demonstrate how errors uncaught on the Tcl level interact
> > with postgresql error system.
> >
> 
> you can catch the exception outside and write own message

OK, here is patch with tests which don't depend on function OIDs

They ignore stack trace ($::errorinfo global variable) completely,
and analyze just error message.


-- 
                                   Victor Wagner <vi...@wagner.pp.ru>
diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml
index ad216dd..87bc4ad 100644
--- a/doc/src/sgml/pltcl.sgml
+++ b/doc/src/sgml/pltcl.sgml
@@ -901,6 +901,79 @@ if {[catch { spi_exec $sql_command }]} {
      is a global variable.)
     </para>
    </sect1>
+   <sect1 id="pltcl-subtransaction">
+   <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>
+   <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>
+  </sect1>
 
    <sect1 id="pltcl-config">
     <title>PL/Tcl Configuration</title>
diff --git a/src/pl/tcl/Makefile b/src/pl/tcl/Makefile
index 1096c4f..b6b6b19 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_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..3ea3ef3
--- /dev/null
+++ b/src/pl/tcl/expected/pltcl_subxact.out
@@ -0,0 +1,146 @@
+--
+-- Test explicit subtransactions
+--
+CREATE TABLE subtransaction_tbl (
+    i integer
+);
+-- test subtransaction successfully commited
+CREATE FUNCTION subtransaction_ctx_success() RETURNS text
+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
+(1 row)
+
+COMMIT;
+SELECT * FROM subtransaction_tbl;
+ i 
+---
+ 0
+ 1
+ 2
+(3 rows)
+
+TRUNCATE subtransaction_tbl;
+-- Test table to see if transactions get properly rolled back
+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;
+--
+-- We use this wrapper to catch errors and return errormsg only, 
+-- because values of $::errorinfo variable contain procedure name which
+-- includes OID, which may differ during make installcheck
+--
+CREATE FUNCTION pltcl_wrapper(statement text) RETURNS text 
+AS $$
+	if [catch {spi_exec $1} msg] {
+		return "ERROR: $msg"
+	} else {
+		return "SUCCESS: $msg"
+	}
+$$ 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 $$
+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 pltcl_wrapper('SELECT subtransaction_nested_test()');
+NOTICE:  subtransaction_tested_test got arg 'f'
+             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:  subtransaction_tested_test got arg '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 2cf7e66..266d7b9 100644
--- a/src/pl/tcl/pltcl.c
+++ b/src/pl/tcl/pltcl.c
@@ -323,6 +323,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
@@ -516,7 +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.
 	 *
@@ -3114,3 +3117,44 @@ 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[])
+{
+	/* Save resource owner and memory context in the local vars */
+	ResourceOwner oldowner = CurrentResourceOwner;
+	MemoryContext oldcontext = CurrentMemoryContext;
+	int retcode;
+	if (objc != 2)
+	{
+		Tcl_WrongNumArgs(interp,1,objv,"command");
+		return TCL_ERROR;
+	}
+
+	BeginInternalSubTransaction(NULL);
+
+	retcode = Tcl_EvalObjEx(interp, objv[1],0);
+
+	if (retcode == TCL_ERROR)
+	{
+		/* Roollback the subtransaction */
+		RollbackAndReleaseCurrentSubTransaction();
+	}
+	else
+	{
+		/* Commit the subtransaction */
+		ReleaseCurrentSubTransaction();
+	}
+	/* Restore resource owner and memory context
+	  In case they were changed inside subtransaction */
+	CurrentResourceOwner = oldowner;
+	MemoryContextSwitchTo(oldcontext);
+	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..071dbdf
--- /dev/null
+++ b/src/pl/tcl/sql/pltcl_subxact.sql
@@ -0,0 +1,94 @@
+--
+-- Test explicit subtransactions
+--
+
+
+CREATE TABLE subtransaction_tbl (
+    i integer
+);
+
+-- test subtransaction successfully commited
+
+CREATE FUNCTION subtransaction_ctx_success() RETURNS text
+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 table to see if transactions get properly rolled back
+
+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;
+
+--
+-- We use this wrapper to catch errors and return errormsg only, 
+-- because values of $::errorinfo variable contain procedure name which
+-- includes OID, which may differ during make installcheck
+--
+CREATE FUNCTION pltcl_wrapper(statement text) RETURNS text 
+AS $$
+	if [catch {spi_exec $1} msg] {
+		return "ERROR: $msg"
+	} else {
+		return "SUCCESS: $msg"
+	}
+$$ 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 $$
+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 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;
-- 
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