Overview
Context
Changes
Modified db.scm
from [2c5f13a26c]
to [25662aed6c].
︙ | | |
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
|
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
|
-
+
|
(debug:print-info 8 *default-log-port* "db:get-tests-for-run run-id=" run-id ", qry=" qry)
(db:with-db dbstruct run-id #f
(lambda (db)
(sqlite3:for-each-row
(lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
;;(set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
;;(print (cons a b))
(set! res (cons (alist->db:test-rec (db:qry-gen-alist qryvalstr (cons a b))) res)))
(set! res (cons (db:test-rec-from-qry-long (cons a b)) res)))
db
qry
run-id
)))
(case qryvals
((shortlist)(map db:test-short-record->norm res))
|
︙ | | |
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
|
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
|
-
+
-
+
|
run-id
#f
(lambda (db)
(let ((res '()))
(sqlite3:for-each-row
(lambda (a . b)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
(set! res (cons (alist->db:test-rec (db:qry-gen-alist db:test-record-qry-selector (cons a b))) res)))
(set! res (cons (db:test-rec-from-qry-long (cons a b)) res)))
;;(set! res (cons (apply vector a b) res)))
db
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id in ("
(string-intersperse (map conc test-ids) ",") ");"))
res))))
(define (db:get-test-info dbstruct run-id testname item-path)
(db:with-db
dbstruct
run-id
#f
(lambda (db)
(let ((res #f))
(sqlite3:for-each-row
(lambda (a . b)
(set! res (alist->db:test-rec (db:qry-gen-alist db:test-record-qry-selector (cons a b)))))
(set! res (db:test-rec-from-qry-long (cons a b))))
;;(set! res (apply vector a b)))
db
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE testname=? AND item_path=?;")
test-name item-path)
res))))
(define (db:test-get-rundir-from-test-id dbstruct run-id test-id)
|
︙ | | |
Modified db_records.scm
from [6e4d1adc75]
to [8b4987b241].
︙ | | |
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(hash-table-ref/default (dbr:dbstruct-locdbs v) run-id #f))
(define (dbr:dbstruct-localdb-set! v run-id db)
(hash-table-set! (dbr:dbstruct-locdbs v) run-id db))
(require-extension typed-records)
(defstruct db:test-rec ((id -1) : number)
((run_id -1) : number)
((testname "") : string)
((state "") : string)
((status "") : string)
((event_time -1) : number)
((host "") : string)
((cpuload -1) : number)
((diskfree -1) : number)
((uname "") : string)
((rundir "") : string)
((item_path "") : string)
((run_duration -1) : number)
((final_logf "") : string)
((comment "") : string)
((process-id -1) : number)
((archived -1) : number)
((shortdir -1) : number)
((attemptnum -1) : number))
((run_id -1) : number)
((testname "") : string)
((state "") : string)
((status "") : string)
((event_time -1) : number)
((host "") : string)
((cpuload -1) : number)
((diskfree -1) : number)
((uname "") : string)
((rundir "") : string)
((item_path "") : string)
((run_duration -1) : number)
((final_logf "") : string)
((comment "") : string)
((process-id -1) : number)
((archived -1) : number)
((shortdir -1) : number)
((attemptnum -1) : number))
(define (db:qry-gen-alist qrystr listvals)
(define listqry (string-split qrystr ","))
(if (null? listqry)
'()
(let loop ((strhead (car listqry))
(strtail (cdr listqry))
(valhead (car listvals))
(valtail (cdr listvals))
(res '()))
(let* ((slot-val-pair (cons (string->symbol strhead) valhead)))
(if (or (null? strtail)
(null? valtail))
(cons slot-val-pair res);;(print strhead valhead));;(cons (cons (string->symbol strhead) valhead) res))
(loop (car strtail)(cdr strtail)(car valtail)(cdr valtail)(cons slot-val-pair res)))))))
(define listqry (string-split qrystr ","))
(if (null? listqry)
'()
(let loop ((strhead (car listqry))
(strtail (cdr listqry))
(valhead (car listvals))
(valtail (cdr listvals))
(res '()))
(let* ((slot-val-pair (cons (string->symbol strhead) valhead)))
(if (or (null? strtail)
(null? valtail))
(cons slot-val-pair res);;(print strhead valhead));;(cons (cons (string->symbol strhead) valhead) res))
(loop (car strtail)(cdr strtail)(car valtail)(cdr valtail)(cons slot-val-pair res)))))))
(define (db:test-rec-from-qry-long listvals)
(make-db:test-rec id: (list-ref listvals 0) run_id: (list-ref listvals 1) testname: (list-ref listvals 2)
state: (list-ref listvals 3) status: (list-ref listvals 4) event_time: (list-ref listvals 5)
host: (list-ref listvals 6) cpuload: (list-ref listvals 7) diskfree: (list-ref listvals 8)
uname: (list-ref listvals 9) rundir: (list-ref listvals 10) item_path: (list-ref listvals 11)
run_duration: (list-ref listvals 12) final_logf: (list-ref listvals 13) comment: (list-ref listvals 14)
shortdir: (list-ref listvals 15) attemptnum: (list-ref listvals 16) archived: (list-ref listvals 17)))
(define (db:test-rec-from-qry-short listvals)
(make-db:test-rec id: (list-ref listvals 0) run_id: (list-ref listvals 1) testname: (list-ref listvals 2)
state: (list-ref listvals 3) status: (list-ref listvals 4) event_time: (list-ref listvals 5)
host: (list-ref listvals 6) cpuload: (list-ref listvals 7) diskfree: (list-ref listvals 8)
uname: (list-ref listvals 9) rundir: (list-ref listvals 10) item_path: (list-ref listvals 11)
run_duration: (list-ref listvals 12) final_logf: (list-ref listvals 13) comment: (list-ref listvals 14)))
(define (db:test-get-id typed-rec) (db:test-rec-id typed-rec))
(define (db:test-get-run_id typed-rec) (db:test-rec-run_id typed-rec))
(define (db:test-get-testname typed-rec) (db:test-rec-testname typed-rec))
(define (db:test-get-state typed-rec) (db:test-rec-state typed-rec))
(define (db:test-get-status typed-rec) (db:test-rec-status typed-rec))
(define (db:test-get-event_time typed-rec) (db:test-rec-event_time typed-rec))
|
︙ | | |