1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
|
THEN 'PASS'
ELSE status
END WHERE id=?;")
'(test-set-log "UPDATE tests SET final_logf=? WHERE id=?;")
'(test-set-rundir-by-test-id "UPDATE tests SET rundir=? WHERE id=?")
'(test-set-rundir "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;")
'(delete-tests-in-state "DELETE FROM tests WHERE state=? AND run_id=?;")
'(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))
|
|
|
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
|
THEN 'PASS'
ELSE status
END WHERE id=?;")
'(test-set-log "UPDATE tests SET final_logf=? WHERE id=?;")
'(test-set-rundir-by-test-id "UPDATE tests SET rundir=? WHERE id=?")
'(test-set-rundir "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;")
'(delete-tests-in-state "DELETE FROM tests WHERE state=? AND run_id=?;")
'(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))
|
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
|
(< (cdb:packet-get-qtime a)(cdb:packet-get-qtime b))))))
(if (> (length data) 0)
(debug:print-info 4 "Writing cached data " data))
;; prepare the needed statements, do each only once
(for-each (lambda (request-item)
(let ((stmt-key (cdb:packet-get-qtype request-item)))
(if (and (not (hash-table-ref/default queries stmt-key #f))
(not (member stmt-key db:special-queries)))
(let ((stmt (alist-ref stmt-key db:queries)))
(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))
(if special-qry
;; handle a query that cannot be part of the grouped queries
(let* ((stmt-key (cdb:packet-get-qtype special-qry))
(return-address (cdb:packet-get-client-sig special-qry))
(qry (hash-table-ref/default queries stmt-key #f))
(params (cdb:packet-get-params special-qry)))
|
>
|
<
>
>
|
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
|
(< (cdb:packet-get-qtime a)(cdb:packet-get-qtime b))))))
(if (> (length data) 0)
(debug:print-info 4 "Writing cached data " data))
;; prepare the needed statements, do each only once
(for-each (lambda (request-item)
(let ((stmt-key (cdb:packet-get-qtype request-item)))
(debug:print-info 11 "stmt-key=" stmt-key ", request-item=" request-item)
(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)
(if special-qry
;; handle a query that cannot be part of the grouped queries
(let* ((stmt-key (cdb:packet-get-qtype special-qry))
(return-address (cdb:packet-get-client-sig special-qry))
(qry (hash-table-ref/default queries stmt-key #f))
(params (cdb:packet-get-params special-qry)))
|
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
|
(if (null? stmts)
stmts
(let innerloop ((hed (car stmts))
(tal (cdr stmts)))
(let ((params (cdb:packet-get-params hed))
(return-address (cdb:packet-get-client-sig hed))
(stmt-key (cdb:packet-get-qtype hed)))
(if (member stmt-key db:special-queries)
(begin
(debug:print-info 11 "Handling special statement " stmt-key)
(cons hed tal))
(begin
(debug:print-info 11 "Executing " stmt-key " for " params)
(apply sqlite3:execute (hash-table-ref queries stmt-key) params)
(server:reply pubsock return-address #t)
|
>
|
|
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
|
(if (null? stmts)
stmts
(let innerloop ((hed (car stmts))
(tal (cdr stmts)))
(let ((params (cdb:packet-get-params hed))
(return-address (cdb:packet-get-client-sig hed))
(stmt-key (cdb:packet-get-qtype hed)))
(if (or (not (hash-table-ref/default queries stmt-key #f))
(member stmt-key db:special-queries))
(begin
(debug:print-info 11 "Handling special statement " stmt-key)
(cons hed tal))
(begin
(debug:print-info 11 "Executing " stmt-key " for " params)
(apply sqlite3:execute (hash-table-ref queries stmt-key) params)
(server:reply pubsock return-address #t)
|