diff options
Diffstat (limited to 'src/pl/tcl/pltcl.c')
| -rw-r--r-- | src/pl/tcl/pltcl.c | 151 |
1 files changed, 148 insertions, 3 deletions
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c index 5b27c731b6e..b1d66e31a6e 100644 --- a/src/pl/tcl/pltcl.c +++ b/src/pl/tcl/pltcl.c @@ -212,6 +212,7 @@ static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid, static int pltcl_elog(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static void pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata); static int pltcl_quote(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, @@ -1648,7 +1649,8 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp, edata = CopyErrorData(); FlushErrorState(); - /* Pass the error message to Tcl */ + /* Pass the error data to Tcl */ + pltcl_construct_errorCode(interp, edata); UTF_BEGIN; Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1)); UTF_END; @@ -1663,6 +1665,148 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp, /********************************************************************** + * pltcl_construct_errorCode() - construct a Tcl errorCode + * list with detailed information from the PostgreSQL server + **********************************************************************/ +static void +pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata) +{ + Tcl_Obj *obj = Tcl_NewObj(); + + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("POSTGRES", -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(PG_VERSION, -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("SQLSTATE", -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(unpack_sql_state(edata->sqlerrcode), -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("message", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->message), -1)); + UTF_END; + if (edata->detail) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("detail", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->detail), -1)); + UTF_END; + } + if (edata->hint) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("hint", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->hint), -1)); + UTF_END; + } + if (edata->context) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("context", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->context), -1)); + UTF_END; + } + if (edata->schema_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("schema", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->schema_name), -1)); + UTF_END; + } + if (edata->table_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("table", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->table_name), -1)); + UTF_END; + } + if (edata->column_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("column", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->column_name), -1)); + UTF_END; + } + if (edata->datatype_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("datatype", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->datatype_name), -1)); + UTF_END; + } + if (edata->constraint_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("constraint", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->constraint_name), -1)); + UTF_END; + } + /* cursorpos is never interesting here; report internal query/pos */ + if (edata->internalquery) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("statement", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->internalquery), -1)); + UTF_END; + } + if (edata->internalpos > 0) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("cursor_position", -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewIntObj(edata->internalpos)); + } + if (edata->filename) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("filename", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->filename), -1)); + UTF_END; + } + if (edata->lineno > 0) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("lineno", -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewIntObj(edata->lineno)); + } + if (edata->funcname) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("funcname", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->funcname), -1)); + UTF_END; + } + + Tcl_SetObjErrorCode(interp, obj); +} + + +/********************************************************************** * pltcl_quote() - quote literal strings that are to * be used in SPI_execute query strings **********************************************************************/ @@ -1880,9 +2024,10 @@ pltcl_subtrans_abort(Tcl_Interp *interp, */ SPI_restore_connection(); - /* Pass the error message to Tcl */ + /* Pass the error data to Tcl */ + pltcl_construct_errorCode(interp, edata); UTF_BEGIN; - Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1)); UTF_END; FreeErrorData(edata); } |