Database locking: Tcl: for errorCode, use pg_exec, not pg_execute

We would like to be able to retry db transactions.  To do this we need
to know why they failed (if they did).

But pg_execute does not set errorCode.  (This is clearly a bug.)  And
since it immediately discards a failed statement, any error
information has been lost by the time pg_execute returns.

So, instead, use pg_exec, and manually mess about with fishing
suitable information out of a failed statement handle, and generating
an appropriate errorCode.

There are no current consumers of this errorCode: that will come in a
moment.

A wrinkle is that as a result it is no longer possible to use
db-execute on a SELECT statement nor db-execute-array on a non-SELECT
statement.  This is because 1. the `ok' status that we have to
check for is different for statements which are commands and ones
which return tuples and 2. we need to fish a different return value out
of the statement handle (-cmdTuples vs -numTuples).  But all uses in
the codebase are now fine for this distinction.

Signed-off-by: Ian Jackson <Ian.Jackson@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
---
v3: Put emsg at the start of errorInfo; things that print errors that
    print errorInfo typically print _only_ errorInfo.

diff --git a/tcl/JobDB-Executive.tcl b/tcl/JobDB-Executive.tcl
index 237e07b72eb0babf89546787cbdce80246c2d509..f7235771b9b8d2ff5f6a2b9d09ab4f0140277db4 100644 (file)
--- a/tcl/JobDB-Executive.tcl
+++ b/tcl/JobDB-Executive.tcl
@@ -121,13 +121,61 @@ proc db-execute-debug {stmt} {
        puts stderr "EXECUTING >$stmt<"
     }
 }
+
+proc db--exec-check {shvar stmt expected_status body} {
+    # pg_execute does not set errorCode and it throws away the
+    # statement handle so we can't get the error out.  So
+    # use pg_exec, as wrapped up here.
+
+    # db--exec-check executes stmt and checks that the status is
+    # `expected_status'.  If OK, executes body with $shvar set to the
+    # stmt handle.   Otherwise throws with errorCode
+    #   {OSSTEST-PSQL <pg-status> <pg-sqlstate>}
+
+    global errorInfo errorCode
+    upvar 1 $shvar sh
+
+    set sh [pg_exec dbh $stmt]
+
+    set rc [catch {
+       set status [pg_result $sh -status]
+       if {[string compare $status $expected_status]} {
+           set emsg [pg_result $sh -error]
+           set sqlstate [pg_result $sh -error sqlstate]
+           if {![string length $emsg]} {
+               set emsg "osstest expected status $expected_status got $status"
+           }
+           set context [pg_result $sh -error context]
+           error $emsg \
+ "$emsg\n    while executing SQL\n$stmt\n    in SQL context\n$context" \
+               [list OSSTEST-PSQL $status $sqlstate]
+       }
+       uplevel 1 $body
+    } emsg]
+
+    set ei $errorInfo
+    set ec $errorCode
+    catch { pg_result $sh -clear }
+
+    return -code $rc -errorinfo $ei -errorcode $ec $emsg
+}
+
 proc db-execute {stmt} {
     db-execute-debug $stmt
-    uplevel 1 [list pg_execute dbh $stmt]
+    db--exec-check sh $stmt PGRES_COMMAND_OK {
+       return [pg_result $sh -cmdTuples]
+    }
 }
-proc db-execute-array {arrayvar stmt args} {
+proc db-execute-array {arrayvar stmt {body {}}} {
     db-execute-debug $stmt
-    uplevel 1 [list pg_execute -array $arrayvar dbh $stmt] $args
+    db--exec-check sh $stmt PGRES_TUPLES_OK {
+       set nrows [pg_result $sh -numTuples]
+       for {set row 0} {$row < $nrows} {incr row} {
+           uplevel 1 [list pg_result $sh -tupleArray $row $arrayvar]
+           uplevel 1 $body
+       }
+       return $nrows
+    }
 }
 
 proc lock-tables {tables} {