1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
|
'(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
))
;; do not run these as part of the transaction
(define db:special-queries '(rollup-tests-pass-fail
db:roll-up-pass-fail-counts
login
immediate))
;; not used, intended to indicate to run in calling process
(define db:run-local-queries '()) ;; rollup-tests-pass-fail))
;; The queue is a list of vectors where the zeroth slot indicates the type of query to
;; apply and the second slot is the time of the query and the third entry is a list of
;; values to be applied
|
|
>
|
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
|
'(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
))
;; do not run these as part of the transaction
(define db:special-queries '(rollup-tests-pass-fail
db:roll-up-pass-fail-counts
login
immediate
flush))
;; not used, intended to indicate to run in calling process
(define db:run-local-queries '()) ;; rollup-tests-pass-fail))
;; The queue is a list of vectors where the zeroth slot indicates the type of query to
;; apply and the second slot is the time of the query and the third entry is a list of
;; values to be applied
|
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
|
(if (not (hash-table-ref/default queries stmt-key #f))
(let ((stmt (alist-ref stmt-key db:queries)))
(debug:print-info 11 "stmt-key=" stmt-key ", stmt=" stmt)
(if stmt
(hash-table-set! queries stmt-key (sqlite3:prepare db (car stmt)))
(if (procedure? stmt-key)
(hash-table-set! queries stmt-key #f)
(debug:print 0 "ERROR: Missing query spec for " stmt-key "!")))))))
data)
;; outer loop to handle special queries that cannot be handled in the
;; transaction.
(let outerloop ((special-qry #f)
(stmts data))
(debug:print-info 11 "special-qry=" special-qry ", stmts=" stmts)
|
>
|
|
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
|
(if (not (hash-table-ref/default queries stmt-key #f))
(let ((stmt (alist-ref stmt-key db:queries)))
(debug:print-info 11 "stmt-key=" stmt-key ", stmt=" stmt)
(if stmt
(hash-table-set! queries stmt-key (sqlite3:prepare db (car stmt)))
(if (procedure? stmt-key)
(hash-table-set! queries stmt-key #f)
(if (not (member stmt-key db:special-queries))
(debug:print 0 "ERROR: Missing query spec for " stmt-key "!"))))))))
data)
;; outer loop to handle special queries that cannot be handled in the
;; transaction.
(let outerloop ((special-qry #f)
(stmts data))
(debug:print-info 11 "special-qry=" special-qry ", stmts=" stmts)
|
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
|
(client-key (caddr params)))
(if (and (equal? calling-path *toppath*)
(equal? megatest-version calling-vers))
(begin
(hash-table-set! *logged-in-clients* client-key (current-seconds))
(server:reply pubsock return-address '(#t "successful login"))) ;; path matches - pass! Should vet the caller at this time ...
(list #f (conc "Login failed due to mismatch paths: " calling-path ", " *toppath*))))))
(else
(debug:print 0 "ERROR: Unrecognised queued call " qry " " params)))))
(if (not (null? stmts))
(outerloop #f stmts)))
;; handle normal queries
(let ((rem (sqlite3:with-transaction
|
>
>
|
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
|
(client-key (caddr params)))
(if (and (equal? calling-path *toppath*)
(equal? megatest-version calling-vers))
(begin
(hash-table-set! *logged-in-clients* client-key (current-seconds))
(server:reply pubsock return-address '(#t "successful login"))) ;; path matches - pass! Should vet the caller at this time ...
(list #f (conc "Login failed due to mismatch paths: " calling-path ", " *toppath*))))))
((flush)
(server:reply pubsock return-address '(#t "sucessful flush")))
(else
(debug:print 0 "ERROR: Unrecognised queued call " qry " " params)))))
(if (not (null? stmts))
(outerloop #f stmts)))
;; handle normal queries
(let ((rem (sqlite3:with-transaction
|