| ︙ | | | ︙ | |
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
((-1) "monitor.db")
((0) "main.db")
(else (conc run-id ".db")))
#f)))
(handle-exceptions
exn
(begin
(debug:print 0 #f "ERROR: Couldn't create path to " dbdir)
(exit 1))
(if (not (directory? dbdir))(create-directory dbdir #t)))
(if fname
(conc dbdir "/" fname)
dbdir)))
;; -1 => monitor.db
|
|
|
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
((-1) "monitor.db")
((0) "main.db")
(else (conc run-id ".db")))
#f)))
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "ERROR: Couldn't create path to " dbdir)
(exit 1))
(if (not (directory? dbdir))(create-directory dbdir #t)))
(if fname
(conc dbdir "/" fname)
dbdir)))
;; -1 => monitor.db
|
| ︙ | | | ︙ | |
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
|
#f)))))
(if db
db ;; merely return the already opened db
(let* ((dbfile (areadb:dbfile-path areadat run-id)) ;; not already opened, so open it
(db (if (file-exists? dbfile)
(open-database dbfile)
(begin
(debug:print 0 #f "ERROR: I was asked to open " dbfile ", but file does not exist or is not readable.")
#f))))
(case run-id
((-1)(areadat-monitordb-set! areadat db))
((0) (areadat-maindb-set! areadat db))
(else (rundat-db-set! rundat db)))
db))))
|
|
|
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
|
#f)))))
(if db
db ;; merely return the already opened db
(let* ((dbfile (areadb:dbfile-path areadat run-id)) ;; not already opened, so open it
(db (if (file-exists? dbfile)
(open-database dbfile)
(begin
(debug:print 0 *default-log-port* "ERROR: I was asked to open " dbfile ", but file does not exist or is not readable.")
#f))))
(case run-id
((-1)(areadat-monitordb-set! areadat db))
((0) (areadat-maindb-set! areadat db))
(else (rundat-db-set! rundat db)))
db))))
|
| ︙ | | | ︙ | |
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
|
(let ((id (list-ref row 0))
(dat (apply make-rundat (append row (list #f #f))))) ;; add placeholders for tests and db
(print row)
(hash-table-set! runs id dat))))
(sql maindb (conc "SELECT id,"
(string-intersperse keys "||'/'||")
",runname,state,status,event_time FROM runs WHERE state != 'deleted';")))
(debug:print 0 #f "ERROR: no main.db found at " (areadb:dbfile-path areadat 0)))
areadat))
;; given an areadat and target/runname patt fill up runs data
;;
;; ?????/
;; given a list of run-ids refresh/retrieve runs data into areadat
|
|
|
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
|
(let ((id (list-ref row 0))
(dat (apply make-rundat (append row (list #f #f))))) ;; add placeholders for tests and db
(print row)
(hash-table-set! runs id dat))))
(sql maindb (conc "SELECT id,"
(string-intersperse keys "||'/'||")
",runname,state,status,event_time FROM runs WHERE state != 'deleted';")))
(debug:print 0 *default-log-port* "ERROR: no main.db found at " (areadb:dbfile-path areadat 0)))
areadat))
;; given an areadat and target/runname patt fill up runs data
;;
;; ?????/
;; given a list of run-ids refresh/retrieve runs data into areadat
|
| ︙ | | | ︙ | |
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
|
(rows (tab-rows tab-dat))
(used-cols (hash-table-values headers))
(used-rows (hash-table-values rows))
(touched (make-hash-table)) ;; (vector row col) ==> true, touched cell
(view-type (dboard:get-view-type keys current-path))
(changed #f)
(state-statuses (list "PASS" "FAIL" "WARN" "CHECK" "SKIP" "RUNNING" "LAUNCHED")))
;; (debug:print 0 #f "current-matrix=" current-matrix)
(case view-type
((areas) ;; find row for this area, if not found, create new entry
(let* ((curr-rownum (hash-table-ref/default rows area-name #f))
(next-rownum (+ (apply max (cons 0 used-rows)) 1))
(rownum (or curr-rownum next-rownum))
(coord (conc rownum ":0")))
(if (not curr-rownum)(hash-table-set! rows area-name rownum))
|
|
|
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
|
(rows (tab-rows tab-dat))
(used-cols (hash-table-values headers))
(used-rows (hash-table-values rows))
(touched (make-hash-table)) ;; (vector row col) ==> true, touched cell
(view-type (dboard:get-view-type keys current-path))
(changed #f)
(state-statuses (list "PASS" "FAIL" "WARN" "CHECK" "SKIP" "RUNNING" "LAUNCHED")))
;; (debug:print 0 *default-log-port* "current-matrix=" current-matrix)
(case view-type
((areas) ;; find row for this area, if not found, create new entry
(let* ((curr-rownum (hash-table-ref/default rows area-name #f))
(next-rownum (+ (apply max (cons 0 used-rows)) 1))
(rownum (or curr-rownum next-rownum))
(coord (conc rownum ":0")))
(if (not curr-rownum)(hash-table-set! rows area-name rownum))
|
| ︙ | | | ︙ | |
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
|
area-panels))
(tabs (data-tabs data)))
(if (not (null? area-names))
(let loop ((index 0)
(hed (car area-names))
(tal (cdr area-names)))
;; (hash-table-set! tabs index hed)
(debug:print 0 #f "Adding area " hed " with index " index " to dashboard")
(iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
(if (not (null? tal))
(loop (+ index 1)(car tal)(cdr tal)))))
tabtop))))
;;======================================================================
|
|
|
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
|
area-panels))
(tabs (data-tabs data)))
(if (not (null? area-names))
(let loop ((index 0)
(hed (car area-names))
(tal (cdr area-names)))
;; (hash-table-set! tabs index hed)
(debug:print 0 *default-log-port* "Adding area " hed " with index " index " to dashboard")
(iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
(if (not (null? tal))
(loop (+ index 1)(car tal)(cdr tal)))))
tabtop))))
;;======================================================================
|
| ︙ | | | ︙ | |