︙ | | | ︙ | |
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
|
0
(dboard:rundat-last-update run-dat)))
(last-db-time (if do-not-use-db-file-timestamps
0
(dboard:rundat-last-db-time run-dat)))
(db-path (or (dboard:rundat-db-path run-dat)
(let* ((db-dir (common:get-db-tmp-area))
(db-pth (conc db-dir "/.megatest/main.db")))
(dboard:rundat-db-path-set! run-dat db-pth)
db-pth)))
(db-mod-time (common:lazy-sqlite-db-modification-time db-path))
(db-modified (>= db-mod-time last-db-time))
(multi-get (> (dboard:rundat-run-data-offset run-dat) 0)) ;; multi-get in progress
(tmptests (if (or do-not-use-db-file-timestamps
(dboard:tabdat-filters-changed tabdat)
|
|
|
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
|
0
(dboard:rundat-last-update run-dat)))
(last-db-time (if do-not-use-db-file-timestamps
0
(dboard:rundat-last-db-time run-dat)))
(db-path (or (dboard:rundat-db-path run-dat)
(let* ((db-dir (common:get-db-tmp-area))
(db-pth (conc db-dir "/" *dbdir* "/main.db")))
(dboard:rundat-db-path-set! run-dat db-pth)
db-pth)))
(db-mod-time (common:lazy-sqlite-db-modification-time db-path))
(db-modified (>= db-mod-time last-db-time))
(multi-get (> (dboard:rundat-run-data-offset run-dat) 0)) ;; multi-get in progress
(tmptests (if (or do-not-use-db-file-timestamps
(dboard:tabdat-filters-changed tabdat)
|
︙ | | | ︙ | |
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
|
;;======================================================================
(stop-the-train)
(define (main)
;; (print "Starting dashboard main")
(let* ((mtdb-path (conc *toppath* "/.megatest/main.db"))
(target (args:get-arg "-target"))
(commondat (dboard:commondat-make)))
(if target
(begin
(args:remove-arg-from-ht "-target")
(dboard:commondat-target-set! commondat target)
)
|
|
|
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
|
;;======================================================================
(stop-the-train)
(define (main)
;; (print "Starting dashboard main")
(let* ((mtdb-path (conc *toppath* "/" *dbdir* "/main.db"))
(target (args:get-arg "-target"))
(commondat (dboard:commondat-make)))
(if target
(begin
(args:remove-arg-from-ht "-target")
(dboard:commondat-target-set! commondat target)
)
|
︙ | | | ︙ | |
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
|
(if (not (common:on-homehost?))
(begin
(debug:print 0 *default-log-port* "WARNING: You are starting the dashboard on a machine that is not the homehost:" (common:get-homehost))
(debug:print 0 *default-log-port* "It will be slower.")
))
(if (and (common:file-exists? mtdb-path)
(file-write-access? mtdb-path))
(if (not (args:get-arg "-skip-version-check"))
(common:exit-on-version-changed)))
(let* ()
;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
(cond
((args:get-arg "-test") ;; run-id,test-id
(let* ((dat (let ((d (map string->number (string-split (args:get-arg "-test") ","))))
(if (> (length d) 1)
d
|
<
<
<
<
<
|
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
|
(if (not (common:on-homehost?))
(begin
(debug:print 0 *default-log-port* "WARNING: You are starting the dashboard on a machine that is not the homehost:" (common:get-homehost))
(debug:print 0 *default-log-port* "It will be slower.")
))
(let* ()
;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
(cond
((args:get-arg "-test") ;; run-id,test-id
(let* ((dat (let ((d (map string->number (string-split (args:get-arg "-test") ","))))
(if (> (length d) 1)
d
|
︙ | | | ︙ | |
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
|
(define last-copy-time 0)
;; Sync to tmp only if in read-only mode.
(define (sync-db-to-tmp tabdat)
(let* ((db-file "./.megatest/main.db"))
(if (and (not (file-write-access? db-file)) ( > (current-seconds) (+ last-copy-time 5)))
(begin
(db:multi-db-sync (db:setup #f) 'old2new)
(set! last-copy-time (current-seconds))
)
)
)
|
|
|
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
|
(define last-copy-time 0)
;; Sync to tmp only if in read-only mode.
(define (sync-db-to-tmp tabdat)
(let* ((db-file (conc "./" *dbdir* "/main.db")))
(if (and (not (file-write-access? db-file)) ( > (current-seconds) (+ last-copy-time 5)))
(begin
(db:multi-db-sync (db:setup #f) 'old2new)
(set! last-copy-time (current-seconds))
)
)
)
|
︙ | | | ︙ | |