| ︙ | | |
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
+
+
+
+
+
|
(declare (uses processmod))
(declare (uses runsmod))
(declare (uses rmtmod))
(declare (uses subrunmod))
(declare (uses tree))
(declare (uses vgmod))
(declare (uses testsmod))
(declare (uses tasksmod))
;; (declare (uses dashboard-guimonitor))
;; (declare (uses dashboard-main))
(module dashboard
*
(import (prefix iup iup:))
(import canvas-draw)
(import canvas-draw-iup)
(import ducttape-lib
bigmod)
(import (prefix sqlite3 sqlite3:)
srfi-1
chicken.file.posix
chicken.string
chicken.process-context
chicken.process-context.posix
regex regex-case srfi-69
typed-records
sparse-vectors
format
srfi-4
srfi-14
)
;; (include "common_records.scm")
;; (include "db_records.scm")
;; (include "run_records.scm")
;; (include "task_records.scm")
;; (include "megatest-version.scm")
|
| ︙ | | |
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
-
+
+
+
|
rmtmod
subrunmod
vgmod
dcommon
tree
dashboard-context-menu
dashboard-tests
testsmod)
testsmod
tasksmod
)
(define help (conc
"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
license GPL, Copyright (C) Matt Welland 2012-2017
Usage: dashboard [options]
|
| ︙ | | |
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
|
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
|
+
-
+
|
;; data from sql db
(keys (rmt:get-keys)) ;; to be removed when targets handling is refactored
(runs (make-sparse-vector)) ;; id => runrec
(runsbynum (make-vector 100 #f)) ;; vector num => runrec
(targ-runid (make-hash-table)) ;; area/target/runname => run-id ;; not sure this will be needed
(tests (make-hash-table)) ;; test[/itempath] => list of test rec
(path-run-ids (make-hash-table)) ;; path => run-id (this is a guess based on code reference)
;; run sql filters
(targ-sql-filt "%")
(runname-sql-filt "%")
(run-state-sql-filt "%")
(run-status-sql-filt "%")
;; test sql filter
|
| ︙ | | |
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
|
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
|
-
+
|
id ;; testid
state ;; test state
status ;; test status
)
;; default is to NOT set the cell if the column and row names are not pre-existing
;;
(define (dboard:runsdat-set-test-cell dat target runname testname itempath test-id state status #!key (force-set #f))
#;(define (dboard:runsdat-set-test-cell dat target runname testname itempath test-id state status #!key (force-set #f))
(let* ((col-num (dcommon:runsdat-get-col-num dat target runname force-set))
(row-num (dcommon:runsdat-get-row-num dat testname itempath force-set)))
(if (and row-num col-num)
(let ((tdat (dboard:testdat
id: test-id
state: state
status: status)))
|
| ︙ | | |
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
|
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
|
-
+
|
(define (tree-path->run-id tabdat path)
(if (not (null? path))
(hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) path #f)
#f))
(define (new-tree-path->run-id rdat path)
(if (not (null? path))
(hash-table-ref/default (dboard:rdat-path-run-ids tabdat) path #f)
(hash-table-ref/default (dboard:rdat-path-run-ids rdat) path #f)
#f))
;; (define (dboard:get-tests-dat tabdat run-id last-update)
;; (let* ((access-mode (dboard:tabdat-access-mode tabdat))
;; (tdat (if run-id (db:dispatch-query access-mode rmt:get-tests-for-run db:get-tests-for-run
;; run-id
;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
|
| ︙ | | |
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
|
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
|
-
+
|
(if (equal? (car parts) "sqlite3")
(cadr parts)
(begin
(debug:print 0 *default-log-port* "ERROR: I only know sqlite3 databases for now: " dbstr)
#f)))))
(if (and dbpth (file-readable? dbpth))
(let ((db (sqlite3:open-database dbpth))) ;; (open-database dbpth)))
(sqlite3:set-busy-handler! db (make-busy-timeout 10000))
(sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 10000))
db)
#f)))
;; sqlite3:path tablename timefieldname varfieldname field1 field2 ...
;;
(define (dboard:graph-read-data cmdstring tstart tend)
(let* ((parts (string-split cmdstring))) ;; spaces not allowed
|
| ︙ | | |
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
|
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
|
+
+
+
|
(let ((th1 (make-thread (lambda ()
(thread-sleep! 1)
(dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab
) "update buttons once"))
(th2 (make-thread iup:main-loop "Main loop")))
(thread-start! th2)
(thread-join! th2)))))
)
(import dashboard)
;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
(if (common:file-exists? debugcontrolf)
(load debugcontrolf)))
(if (args:get-arg "-repl")
(repl)
(main))
|