Overview
Comment: | Dashboard starts |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65-real-new-runs-view-wip3 |
Files: | files | file ages | folders |
SHA1: |
a23657561e28b29c9dd425e9d7044b05 |
User & Date: | matt on 2021-02-28 02:18:13 |
Other Links: | branch diff | manifest | tags |
Context
2021-02-28
| ||
07:41 | Used codesplitter to confirm no important differences with v1.65-real-new-runs-view, d85f01faff9033 check-in: a0ffba076b user: matt tags: v1.65-real-new-runs-view-wip3, good-one | |
02:18 | Dashboard starts check-in: a23657561e user: matt tags: v1.65-real-new-runs-view-wip3 | |
2021-02-27
| ||
21:44 | Fixed order of uses in dashboard.scm check-in: ff6cbfba6c user: matt tags: v1.65-real-new-runs-view-wip3 | |
Changes
Modified commonmod.scm from [9d235648e1] to [3c7c56e5e8].
︙ | ︙ | |||
3861 3862 3863 3864 3865 3866 3867 | (mutex-lock! *homehost-mutex*) (cond (*home-host* (mutex-unlock! *homehost-mutex*) *home-host*) ((not *toppath*) (mutex-unlock! *homehost-mutex*) | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | | | | | | | | | | | | | | | 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 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 | (mutex-lock! *homehost-mutex*) (cond (*home-host* (mutex-unlock! *homehost-mutex*) *home-host*) ((not *toppath*) (mutex-unlock! *homehost-mutex*) (launch:setup) ;; safely mutexed now (if (> trynum 0) (begin (thread-sleep! 2) (common:get-homehost trynum: (- trynum 1))) #f)) (else (let* ((currhost (get-host-name)) (bestadrs (server:get-best-guess-address currhost)) ;; first look in config, then look in file .homehost, create it if not found (homehost (or (configf:lookup *configdat* "server" "homehost" ) (handle-exceptions exn (if (> trynum 0) (let ((delay-time (* (- 5 trynum) 5))) (mutex-unlock! *homehost-mutex*) (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)"] Failed to read .homehost file, delaying " delay-time " seconds and trying again, message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn) (thread-sleep! delay-time) (common:get-homehost trynum: (- trynum 1))) (begin (mutex-unlock! *homehost-mutex*) (debug:print 0 *default-log-port* "ERROR: ["(common:human-time) "] Failed to read .homehost file after trying five times. Giving up and exiting, message: " ((condition-property-accessor 'exn 'message) exn)) (exit 1))) (let ((hhf (conc *toppath* "/.homehost"))) (if (common:file-exists? hhf) (with-input-from-file hhf read-line) (if (file-write-access? *toppath*) (begin (with-output-to-file hhf (lambda () (print bestadrs))) (begin (mutex-unlock! *homehost-mutex*) (car (common:get-homehost)))) #f)))))) (at-home (or (equal? homehost currhost) (equal? homehost bestadrs)))) (set! *home-host* (cons homehost at-home)) (mutex-unlock! *homehost-mutex*) *home-host*)))) (define (common:wait-for-homehost-load maxnormload msg) (let* ((hh-dat (if (common:on-homehost?) ;; if we are on the homehost then pass in #f so the calls are local. #f (common:get-homehost))) (hh (if hh-dat (car hh-dat) #f))) (common:wait-for-normalized-load maxnormload msg hh))) |
︙ | ︙ |
Modified dashboard.scm from [04a8971b96] to [c9eae66688].
︙ | ︙ | |||
61 62 63 64 65 66 67 68 69 70 71 72 73 74 | (declare (uses dcommonmod)) (import dcommonmod) (declare (uses dcommonmod.import)) (declare (uses apimod)) (import apimod) ;; (declare (uses ods)) ;; (import ods) ;; (declare (uses dbmod)) (import dbmod) ;; (declare (uses dbmod.import)) | > > > | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | (declare (uses dcommonmod)) (import dcommonmod) (declare (uses dcommonmod.import)) (declare (uses apimod)) (import apimod) (declare (uses rmtmod)) (import rmtmod) ;; (declare (uses ods)) ;; (import ods) ;; (declare (uses dbmod)) (import dbmod) ;; (declare (uses dbmod.import)) |
︙ | ︙ | |||
95 96 97 98 99 100 101 102 103 104 105 106 107 108 | (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") ;; This is the new runs view (include "dashboard-new-runs-view.scm") (define help (conc "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest version " megatest-version " | > > | 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | (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") ;; (print "Got here #1") ;; This is the new runs view (include "dashboard-new-runs-view.scm") (define help (conc "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest version " megatest-version " |
︙ | ︙ | |||
179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 | (let ((fullpath (common:real-path (args:get-arg "-start-dir")))) (setenv "PWD" fullpath) (change-directory fullpath)) (begin (debug:print-error 0 *default-log-port* "non-existant start dir " (args:get-arg "-start-dir") " specified, exiting.") (exit 1)))) ;; TODO: Move this inside (main) ;; (if (not (launch:setup)) (begin (print "Failed to find megatest.config, exiting") (exit 1))) ;; deal with RH 5.11 gtk lib or iup lib missing detachbox feature ;; first check for the switch ;; (if (or (args:get-arg "-rh5.11") (configf:lookup *configdat* "dashboard" "no-detachbox") (not (file-exists? "/etc/os-release"))) (set! iup:detachbox iup:vbox)) (if (not (common:on-homehost?)) (begin (debug:print 0 *default-log-port* "WARNING: Current policy requires running dashboard on homehost: " (common:get-homehost)))) | > > > > > > > > > > > > | > > > > | 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 | (let ((fullpath (common:real-path (args:get-arg "-start-dir")))) (setenv "PWD" fullpath) (change-directory fullpath)) (begin (debug:print-error 0 *default-log-port* "non-existant start dir " (args:get-arg "-start-dir") " specified, exiting.") (exit 1)))) ;; (use trace) ;; (trace-call-sites #t) ;; (trace ;; launch:setup ;; configf:lookup ;; common:on-homehost? ;; common:get-homehost ;; server:get-best-guess-address ;; ) ;; (print "Got here #1.5") ;; TODO: Move this inside (main) ;; (if (not (launch:setup)) (begin (print "Failed to find megatest.config, exiting") (exit 1))) ;; deal with RH 5.11 gtk lib or iup lib missing detachbox feature ;; first check for the switch ;; (if (or (args:get-arg "-rh5.11") (configf:lookup *configdat* "dashboard" "no-detachbox") (not (file-exists? "/etc/os-release"))) (set! iup:detachbox iup:vbox)) (if (not (common:on-homehost?)) (begin (debug:print 0 *default-log-port* "WARNING: Current policy requires running dashboard on homehost: " (common:get-homehost)))) ;; (print "Got here #1.6") ;; RA => Might require revert for filters ;; create a watch dog to move changes from lt/.db/*.db to megatest.db ;; ;;;(if (file-write-access? (conc *toppath* "/megatest.db")) ;;(debug:print-info 13 *default-log-port* "Before common:watchdog spawn") (thread-start! (make-thread common:watchdog "Watchdog thread")) ;;(debug:print-info 13 *default-log-port* "After common:watchdog spawn") ;; (if (not (args:get-arg "-use-db-cache")) ;; (begin ;; (debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db") ;; (hash-table-set! args:arg-hash "-use-db-cache" #t)));;;) ;;) ;; data common to all tabs in dboard:commondat struct moved to dcommonmod ;; data from sql db ;; (keys (rmt:get-keys)) ;; to be removed when targets handling is r ;; (print "Got here #1.7") ;; RA => returns the tabdat stored at hashkey passed in commondat-tabdats table (e.g. 0 gives summary) ;; (define (dboard:common-get-tabdat commondat #!key (tab-num #f)) (let* ((tnum (or tab-num (dboard:commondat-curr-tab-num commondat) 0)) ;; tab-num value is curr-tab-num value in passed commondat |
︙ | ︙ | |||
358 359 360 361 362 363 364 365 366 367 368 369 370 371 | (let ((t-sort (assoc (configf:lookup *configdat* "dashboard" "testsort") *tests-sort-type-index*))) (if t-sort (cadr t-sort) 3))) (define (get-curr-sort) (vector-ref *tests-sort-options* *tests-sort-reverse*)) ;;====================================================================== ;;====================================================================== (common:debug-setup) ;; (define uidat #f) | > > | 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 | (let ((t-sort (assoc (configf:lookup *configdat* "dashboard" "testsort") *tests-sort-type-index*))) (if t-sort (cadr t-sort) 3))) (define (get-curr-sort) (vector-ref *tests-sort-options* *tests-sort-reverse*)) ;; (print "Got here #2") ;;====================================================================== ;;====================================================================== (common:debug-setup) ;; (define uidat #f) |
︙ | ︙ | |||
1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 | (if (eq? tstate 0) (hash-table-delete! alltgls item) (hash-table-set! alltgls item #t)) (let ((all (hash-table-keys alltgls))) (proc all))) "text-list-toggle-box")))) items)))) ;; Extract the various bits of data from tabdat and create the command line equivalent that will be displayed ;; (define (dashboard:update-run-command tabdat) (let* ((cmd-tb (dboard:tabdat-command-tb tabdat)) (cmd (dboard:tabdat-command tabdat)) (test-patt (let ((tp (dboard:tabdat-test-patts tabdat))) | > > | 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 | (if (eq? tstate 0) (hash-table-delete! alltgls item) (hash-table-set! alltgls item #t)) (let ((all (hash-table-keys alltgls))) (proc all))) "text-list-toggle-box")))) items)))) ;; (print "Got here #3") ;; Extract the various bits of data from tabdat and create the command line equivalent that will be displayed ;; (define (dashboard:update-run-command tabdat) (let* ((cmd-tb (dboard:tabdat-command-tb tabdat)) (cmd (dboard:tabdat-command tabdat)) (test-patt (let ((tp (dboard:tabdat-test-patts tabdat))) |
︙ | ︙ | |||
3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 | (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))))) ;; 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)) | > > | 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 | (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))))) ;; (print "Got here #4") ;; 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)) |
Modified dcommon.scm from [f3a8d144b3] to [bb4fd504cd].
︙ | ︙ | |||
43 44 45 46 47 48 49 50 51 52 53 54 55 56 | (import configfmod) (declare (uses dcommonmod)) (import dcommonmod) (declare (uses servermod)) (import servermod) ;; (declare (uses synchash)) (include "megatest-version.scm") (include "common_records.scm") (include "db_records.scm") (include "key_records.scm") | > > > | 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 | (import configfmod) (declare (uses dcommonmod)) (import dcommonmod) (declare (uses servermod)) (import servermod) (declare (uses rmtmod)) (import rmtmod) ;; (declare (uses synchash)) (include "megatest-version.scm") (include "common_records.scm") (include "db_records.scm") (include "key_records.scm") |
︙ | ︙ |