54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
(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]
-h : this help
-test run-id test-id : open a test control panel on this test
|
>
>
>
>
|
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
(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)
;; globals to dashboard module
(define *updaters-running* #f)
(define *updaters-thread* #f)
(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]
-h : this help
-test run-id test-id : open a test control panel on this test
|
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
|
(let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f)))
(if val (set! res (cons (list key val) res))))))
dbkeys)
res))))
fres))))
(define (dashboard:runs-tab-updater commondat tab-num)
(debug:catch-and-dump
(lambda ()
(let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))
(dbkeys (dboard:tabdat-dbkeys tabdat)))
(dashboard:do-update-rundat tabdat)
(let ((uidat (dboard:commondat-uidat commondat)))
(update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
))
"dashboard:runs-tab-updater"))
;;======================================================================
;; The heavy lifting starts here
;;======================================================================
(stop-the-train)
|
|
|
|
|
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
|
(let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f)))
(if val (set! res (cons (list key val) res))))))
dbkeys)
res))))
fres))))
(define (dashboard:runs-tab-updater commondat tab-num)
;; (debug:catch-and-dump
;; (lambda ()
(let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))
(dbkeys (dboard:tabdat-dbkeys tabdat)))
(dashboard:do-update-rundat tabdat)
(let ((uidat (dboard:commondat-uidat commondat)))
(update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
))
;; "dashboard:runs-tab-updater"))
;;======================================================================
;; The heavy lifting starts here
;;======================================================================
(stop-the-train)
|
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
|
tab-num: 0)
;; may not want this alive (manually merged it from v1.66)
;; (dboard:commondat-add-updater
;; commondat
;; (lambda ()
;; (dashboard:runs-tab-updater commondat 1))
;; tab-num: 2)
(iup:callback-set! *tim*
"ACTION_CB"
(lambda (time-obj)
(let ((update-is-running #f))
(mutex-lock! (dboard:commondat-update-mutex commondat))
(set! update-is-running (dboard:commondat-updating commondat))
(if (not update-is-running)
(dboard:commondat-updating-set! commondat #t))
(mutex-unlock! (dboard:commondat-update-mutex commondat))
(if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update
(dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat)
(mutex-lock! (dboard:commondat-update-mutex commondat))
(dboard:commondat-updating-set! commondat #f)
(mutex-unlock! (dboard:commondat-update-mutex commondat)))
))
1))))
;; (debug:print 0 *default-log-port* "Starting updaters")
(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")))
;; (print "Starting main loop")
(thread-start! th2)
(thread-join! th2)
)
)
)
)
(define last-copy-time 0)
;; Sync to tmp only if in read-only mode.
(define (sync-db-to-tmp tabdat)
|
>
<
<
<
|
<
<
<
>
>
>
>
|
|
<
<
<
<
>
|
|
|
<
|
<
>
|
|
>
|
>
|
|
>
|
<
|
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
|
tab-num: 0)
;; may not want this alive (manually merged it from v1.66)
;; (dboard:commondat-add-updater
;; commondat
;; (lambda ()
;; (dashboard:runs-tab-updater commondat 1))
;; tab-num: 2)
(iup:callback-set! *tim*
"ACTION_CB"
(lambda (time-obj)
(if (not *updaters-thread*)
(begin
;; (debug:print-info 0 *default-log-port* "Updater started...")
(set! *updaters-thread*
(make-thread
(lambda ()
(dboard:common-run-curr-updaters commondat))))
(thread-start! *updaters-thread*))
(begin
(debug:print-info 0 *default-log-port* "Updater restarted...")
(thread-resume! *updaters-thread*)))
(thread-sleep! 0.25)
(if (eq? (thread-state *updaters-thread*) 'running)
(begin
(debug:print-info 0 *default-log-port* "Updater suspended...")
(thread-suspend! *updaters-thread*))
(begin
(set! *updaters-thread* #f)
;; (debug:print-info 0 *default-log-port* "Updater done...")
))
1))))
(iup:main-loop)
)))
(define last-copy-time 0)
;; Sync to tmp only if in read-only mode.
(define (sync-db-to-tmp tabdat)
|