diff options
Diffstat (limited to 'src/pl/tcl/pltcl.c')
| -rw-r--r-- | src/pl/tcl/pltcl.c | 53 |
1 files changed, 53 insertions, 0 deletions
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. @@ -2851,6 +2855,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 * |