1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
|
dbstruct
run-id
#f
(lambda (db)
(sqlite3:execute db "UPDATE tests SET archived=? WHERE id=?;"
archive-block-id test-id))))
;; (define (db:archive-allocate-testsuite/area-to-block block-id testsuite-name areakey)
;; (let* ((dbdat (db:get-db dbstruct #f)) ;; archive tables are in main.db
;; (db (db:dbdat-get-db dbdat))
;; (res '())
;; (blocks '())) ;; a block is an archive chunck that can be added too if there is space
;; (sqlite3:for-each-row #f)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
|
dbstruct
run-id
#f
(lambda (db)
(sqlite3:execute db "UPDATE tests SET archived=? WHERE id=?;"
archive-block-id test-id))))
;; Look up the archive block info given a block-id
;;
(define (db:test-get-archive-block-info dbstruct archive-block-id)
(db:with-db
dbstruct
#f
#f
(lambda (db)
(let ((res #f))
(sqlite3:for-each-row
;; 0 1 2 3 4 5
(lambda (id archive-disk-id disk-path last-du last-du-time creation-time)
(set! res (vector id archive-disk-id disk-path last-du last-du-time creation-time)))
db
"SELECT id,archive_disk_id,disk_path,last_du,last_du_time,creation_time FROM archive_blocks WHERE id=?;"
archive-block-id)
res))))
;; (define (db:archive-allocate-testsuite/area-to-block block-id testsuite-name areakey)
;; (let* ((dbdat (db:get-db dbstruct #f)) ;; archive tables are in main.db
;; (db (db:dbdat-get-db dbdat))
;; (res '())
;; (blocks '())) ;; a block is an archive chunck that can be added too if there is space
;; (sqlite3:for-each-row #f)
|
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
|
db
"SELECT attemptnum FROM tests WHERE id=?;"
#f
test-id))))
(define db:test-record-fields '("id" "run_id" "testname" "state" "status" "event_time"
"host" "cpuload" "diskfree" "uname" "rundir" "item_path"
"run_duration" "final_logf" "comment" "shortdir" "attemptnum"))
;; fields *must* be a non-empty list
;;
(define (db:field->number fieldname fields)
(if (null? fields)
#f
(let loop ((hed (car fields))
|
|
|
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
|
db
"SELECT attemptnum FROM tests WHERE id=?;"
#f
test-id))))
(define db:test-record-fields '("id" "run_id" "testname" "state" "status" "event_time"
"host" "cpuload" "diskfree" "uname" "rundir" "item_path"
"run_duration" "final_logf" "comment" "shortdir" "attemptnum" "archived"))
;; fields *must* be a non-empty list
;;
(define (db:field->number fieldname fields)
(if (null? fields)
#f
(let loop ((hed (car fields))
|
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
|
(let* ((dbdat (if (vector? dbstruct)
(db:get-db dbstruct run-id)
dbstruct)) ;; still settling on when to use dbstruct or dbdat
(db (db:dbdat-get-db dbdat))
(res '()))
(db:delay-if-busy dbdat)
(sqlite3:for-each-row
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
(set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum)
res)))
db
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE state != 'DELETED' AND run_id=?;")
run-id)
res))
(define (db:replace-test-records dbstruct run-id testrecs)
|
|
|
|
|
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
|
(let* ((dbdat (if (vector? dbstruct)
(db:get-db dbstruct run-id)
dbstruct)) ;; still settling on when to use dbstruct or dbdat
(db (db:dbdat-get-db dbdat))
(res '()))
(db:delay-if-busy dbdat)
(sqlite3:for-each-row
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum archived)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
(set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum archived)
res)))
db
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE state != 'DELETED' AND run_id=?;")
run-id)
res))
(define (db:replace-test-records dbstruct run-id testrecs)
|
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
|
(db:with-db
dbstruct
run-id
#f
(lambda (db)
(let ((res #f))
(sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum)))
db
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;")
test-id)
res))))
;; Use db:test-get* to access
;; Get test data using test_ids. NB// Only works within a single run!!
|
|
|
|
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
|
(db:with-db
dbstruct
run-id
#f
(lambda (db)
(let ((res #f))
(sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived)))
db
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;")
test-id)
res))))
;; Use db:test-get* to access
;; Get test data using test_ids. NB// Only works within a single run!!
|