42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
(declare (uses dashboard-tests))
(declare (uses tree))
(declare (uses dcommon))
(declare (uses dashboard-context-menu))
(declare (uses vg))
(declare (uses subrun))
(declare (uses mt))
(declare (uses dbfile))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
(include "vg_records.scm")
(dbfile:db-init-proc db:initialize-main-db)
(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]
|
>
>
|
>
>
>
>
>
>
>
>
>
|
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
|
(declare (uses dashboard-tests))
(declare (uses tree))
(declare (uses dcommon))
(declare (uses dashboard-context-menu))
(declare (uses vg))
(declare (uses subrun))
(declare (uses mt))
(declare (uses dbmod))
;; (declare (uses dbmemmod))
(declare (uses dbfile))
(declare (uses commonmod))
(declare (uses commonmod.import))
(import commonmod)
(import dbmod dbfile)
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
(include "vg_records.scm")
;; set some parameters here - these need to be put in something that can be loaded from other
;; executables such as dashboard and mtutil
;;
(include "dashboard-transport-mode.scm")
(dbfile:db-init-proc db:initialize-main-db)
(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]
|
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
|
(define (dboard:runsdat-make-init)
(make-dboard:runsdat
runs-index: (make-hash-table)
tests-index: (make-hash-table)
matrix-dat: (make-sparse-array)))
;; used to keep the rundata from rmt:get-tests-for-run
;; in sync.
;;
(defstruct dboard:rundat
run
tests-drawn ;; list of id's already drawn on screen
tests-notdrawn ;; list of id's NOT already drawn
rowsused ;; hash of lists covering what areas used - replace with quadtree
hierdat ;; put hierarchial sorted list here
tests ;; hash of id => testdat
((tests-by-name (make-hash-table)) : hash-table) ;; hash of testfullname => testdat
key-vals
((last-update 0) : number) ;; last query to db got records from before last-update
((last-db-time 0) : number) ;; last timestamp on main.db
((data-changed #f) : boolean)
((run-data-offset 0) : number) ;; get only 100 items per call, set back to zero when received less than 100 items
(db-path #f))
;; for the new runs view lets build up a few new record types and then consolidate later
;;
;; this is a two level deep pipeline for the incoming data:
;; sql query data ==> filters ==> data for display
;;
(defstruct dboard:rdat
|
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
|
(define (dboard:runsdat-make-init)
(make-dboard:runsdat
runs-index: (make-hash-table)
tests-index: (make-hash-table)
matrix-dat: (make-sparse-array)))
;; duplicated in dcommon.scm
;;
;; ;; used to keep the rundata from rmt:get-tests-for-run
;; ;; in sync.
;; ;;
;; (defstruct dboard:rundat
;; run
;; tests-drawn ;; list of id's already drawn on screen
;; tests-notdrawn ;; list of id's NOT already drawn
;; rowsused ;; hash of lists covering what areas used - replace with quadtree
;; hierdat ;; put hierarchial sorted list here
;; tests ;; hash of id => testdat
;; ((tests-by-name (make-hash-table)) : hash-table) ;; hash of testfullname => testdat
;; key-vals
;; ((last-update 0) : number) ;; last query to db got records from before last-update
;; ((last-db-time 0) : number) ;; last timestamp on main.db
;; ((data-changed #f) : boolean)
;; ((run-data-offset 0) : number) ;; get only 100 items per call, set back to zero when received less than 100 items
;; (db-path #f))
;; for the new runs view lets build up a few new record types and then consolidate later
;;
;; this is a two level deep pipeline for the incoming data:
;; sql query data ==> filters ==> data for display
;;
(defstruct dboard:rdat
|
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
|
;; optimized to get runs constrained by what is visible on the screen
;; - not appropriate for where all the runs are needed
;;
(define (update-buttons tabdat uidat numruns numtests)
(let* ((runs (if (> (length (dboard:tabdat-allruns tabdat)) numruns)
(take-right (dboard:tabdat-allruns tabdat) numruns)
(pad-list (dboard:tabdat-allruns tabdat) numruns)))
(lftcol (dboard:uidat-get-lftcol uidat))
(tableheader (dboard:uidat-get-header uidat))
(table (dboard:uidat-get-runsvec uidat))
(coln 0)
(all-test-names (make-hash-table))
(use-bgcolor (equal? (configf:lookup *configdat* "dashboard" "use-bgcolor") "yes")) ;; doesn't work
)
|
|
|
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
|
;; optimized to get runs constrained by what is visible on the screen
;; - not appropriate for where all the runs are needed
;;
(define (update-buttons tabdat uidat numruns numtests)
(let* ((runs (if (> (length (dboard:tabdat-allruns tabdat)) numruns)
(take-right (dboard:tabdat-allruns tabdat) numruns)
(pad-list (dboard:tabdat-allruns tabdat) numruns)))
(lftcol (dboard:uidat-get-lftcol uidat))
(tableheader (dboard:uidat-get-header uidat))
(table (dboard:uidat-get-runsvec uidat))
(coln 0)
(all-test-names (make-hash-table))
(use-bgcolor (equal? (configf:lookup *configdat* "dashboard" "use-bgcolor") "yes")) ;; doesn't work
)
|