1
2
3
4
5
6
7
8
|
;;======================================================================
;; Extracting the data to display for runs
;;
;; This needs to be re-entrant such that it does one column per call
;; on the zeroeth call update runs data
;; on each subsequent call update one run (configurable - could do two, three ... or update until tdelta exceeded
;; on last run reset to zeroeth
;;
|
|
|
1
2
3
4
5
6
7
8
|
;:rdat;======================================================================
;; Extracting the data to display for runs
;;
;; This needs to be re-entrant such that it does one column per call
;; on the zeroeth call update runs data
;; on each subsequent call update one run (configurable - could do two, three ... or update until tdelta exceeded
;; on last run reset to zeroeth
;;
|
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
;;
(define (dashboard:update-runs-data rdat)
(let* ((tb (dboard:rdat-runs-tree rdat))
(targ-sql-filt (dboard:rdat-targ-sql-filt rdat))
(runname-sql-filt (dboard:rdat-runname-sql-filt rdat))
(state-sql-filt (dboard:rdat-run-state-sql-filt rdat))
(status-sql-filt (dboard:rdat-run-status-sql-filt rdat))
;; Use (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
(data (rmt:simple-get-runs runname-sql-filt #f #f targ-sql-filt #f))
(numruns (length data)))
;; store in the runsbynum vector
(dboard:rdat-runsbynum-set! rdat (list->vector data))
;; update runs id => runrec
;; update targ-runid target/runname => run-id
(for-each
(lambda (runrec)
(let* ((run-id (simple-run-id runrec))
|
>
>
>
|
>
>
>
>
>
>
|
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
;;
(define (dashboard:update-runs-data rdat)
(let* ((tb (dboard:rdat-runs-tree rdat))
(targ-sql-filt (dboard:rdat-targ-sql-filt rdat))
(runname-sql-filt (dboard:rdat-runname-sql-filt rdat))
(state-sql-filt (dboard:rdat-run-state-sql-filt rdat))
(status-sql-filt (dboard:rdat-run-status-sql-filt rdat))
(offset (dboard:rdat-runs-offset rdat))
(count (dboard:rdat-runs-count rdat))
;; Use (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
(data (rmt:simple-get-runs runname-sql-filt count offset targ-sql-filt #f))
(numruns (length data)))
(print "Scan runs, offset: "offset" numruns: "numruns" count: "count)
(if (< numruns count) ;; i.e. there are no more runs to get
(begin
(dboard:rdat-runs-offset-set! rdat 0)) ;; start over
(dboard:rdat-runs-offset-set! rdat
(+ (dboard:rdat-runs-offset rdat) numruns)))
;; store in the runsbynum vector
(dboard:rdat-runsbynum-set! rdat (list->vector data))
;; update runs id => runrec
;; update targ-runid target/runname => run-id
(for-each
(lambda (runrec)
(let* ((run-id (simple-run-id runrec))
|
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
(let* ((run-tests-data (dboard:rdat-run-tests rdat)) ;; from dbmod.scm (define-record simple-run target id runname state status owner event_time)
(run-tests-mtx (dboard:rdat-runs-mtx rdat))
(runs-by-num (dboard:rdat-runsbynum rdat)) ;; this is the sequence num
(num-runs (vector-length runs-by-num))
)
(debug:print 0 *default-log-port* "num-runs: " num-runs)
(let loop ((col-num 1))
(let* ((runrec (vector-ref runs-by-num (- col-num 1)))
(run-id (simple-run-id runrec))
(target (simple-run-target runrec))
(runname (simple-run-runname runrec))
(vert-targ (string-translate (conc target "/" runname) "/" "\n"))
(run-tests (sparse-vector-ref run-tests-data run-id))
(changed #f)) ;; manage redraws on a column by column basis
(debug:print 0 *default-log-port* "run-tests: " run-tests)
(if (null? run-tests) ;; empty run
(if (< col-num num-runs) ;; NOT CORRECT
(loop (+ col-num)))
(begin
(set! changed (dcommon:modifiy-if-different ;; set the col header
run-tests-mtx
(conc "0:" col-num)
vert-targ
changed))
(let testloop ((inum 0)
|
>
|
>
>
|
|
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
(let* ((run-tests-data (dboard:rdat-run-tests rdat)) ;; from dbmod.scm (define-record simple-run target id runname state status owner event_time)
(run-tests-mtx (dboard:rdat-runs-mtx rdat))
(runs-by-num (dboard:rdat-runsbynum rdat)) ;; this is the sequence num
(num-runs (vector-length runs-by-num))
)
(debug:print 0 *default-log-port* "num-runs: " num-runs)
(let loop ((col-num 1))
(print "col-num: "col-num)
(let* ((runrec (vector-ref runs-by-num (- col-num 1)))
(run-id (simple-run-id runrec))
(target (simple-run-target runrec))
(runname (simple-run-runname runrec))
(vert-targ (string-translate (conc target "/" runname) "/" "\n"))
(run-tests (sparse-vector-ref run-tests-data run-id))
(changed #f)) ;; manage redraws on a column by column basis
(debug:print 0 *default-log-port* "num-runs: "num-runs" run-tests: "run-tests)
(if (null? run-tests) ;; empty run
(if (< col-num num-runs) ;; NOT CORRECT
(begin
(print "Empty run, num-runs: "num-runs" col-num: "col-num)
(loop (+ col-num 1))))
(begin
(set! changed (dcommon:modifiy-if-different ;; set the col header
run-tests-mtx
(conc "0:" col-num)
vert-targ
changed))
(let testloop ((inum 0)
|