88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
-
-
-
-
-
+
+
+
+
+
|
db))
;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling proc idb . params)
(debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
(if (or *db-write-access*
(not (member proc *db:all-write-procs*)))
(let* ((db (if idb
(if (procedure? idb)
(idb)
idb)
(open-db)))
(let* ((db (cond
((sqlite3:database? idb) idb)
((not idb) (open-db))
((procedure? idb) (idb))
(else (open-db))))
(res #f))
(set! res (apply proc db params))
(if (not idb)(sqlite3:finalize! db))
(debug:print-info 11 "open-run-close-no-exception-handling END" )
res)
#f))
|
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
|
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
|
-
+
|
(debug:print-info 11 "Special queries/requests stmt-key=" stmt-key ", return-address=" return-address ", query=" query ", params=" params)
(if query
;; hand queries off to the write queue
(let ((response (case *transport-type*
((http)
(debug:print-info 7 "Queuing item " item " for wrapped write")
(db:queue-write-and-wait db qry-sig query params))
(else
(else
(apply sqlite3:execute db query params)
#t))))
(debug:print-info 7 "Received " response " from wrapped write")
(server:reply return-address qry-sig response response))
;; otherwise if appropriate flush the queue (this is a read or complex query)
(begin
(cond
|
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
|
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
|
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
|
(let* ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))
(res '()))
(if (sqlite3:database? tdb)
(handle-exceptions
exn
(debug:print 0 "ERROR: error on access to testdat for test with id " test-id)
'()
(begin
(sqlite3:for-each-row
(lambda (id test-id stepname state status event-time logfile)
(set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res)))
tdb
"SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
test-id)
(sqlite3:finalize! tdb)
(reverse res))
(sqlite3:for-each-row
(lambda (id test-id stepname state status event-time logfile)
(set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res)))
tdb
"SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
test-id)
(sqlite3:finalize! tdb)
(reverse res)))
'())))
;; get a pretty table to summarize steps
;;
(define (db:get-steps-table db test-id #!key (work-area #f))
(let ((steps (db:get-steps-for-test db test-id work-area: work-area)))
;; organise the steps for better readability
|