Overview
Comment: | Update on db change working nicely. Added screen shot of summary tab |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | dev | kind-db-access |
Files: | files | file ages | folders |
SHA1: |
de73d1abe8950c349c983b364485c0c1 |
User & Date: | matt on 2013-07-04 02:40:39 |
Other Links: | branch diff | manifest | tags |
Context
2013-07-04
| ||
02:59 | Removed unnecessary updates to gui on summary page to minimize flicker check-in: 3b514befe4 user: matt tags: dev, kind-db-access | |
02:40 | Update on db change working nicely. Added screen shot of summary tab check-in: de73d1abe8 user: matt tags: dev, kind-db-access | |
2013-07-03
| ||
21:24 | Partial fix of balanced db access with new tabs check-in: a68eb8288b user: matt tags: dev, kind-db-access | |
Changes
Modified dashboard.scm from [12aa3146bd] to [33dd3bfe52].
︙ | ︙ | |||
116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | (define *buttondat* (make-hash-table)) ;; <run-id color text test run-key> (define *alltestnamelst* '()) (define *searchpatts* (make-hash-table)) (define *num-runs* 8) (define *tot-run-count* (cdb:remote-run db:get-num-runs #f "%")) ;; (define *tot-run-count* (db:get-num-runs *db* "%")) (define *last-update* (current-seconds)) (define *num-tests* 15) (define *start-run-offset* 0) (define *start-test-offset* 0) (define *examine-test-dat* (make-hash-table)) (define *exit-started* #f) (define *status-ignore-hash* (make-hash-table)) (define *state-ignore-hash* (make-hash-table)) | > > > > < < < < | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 | (define *buttondat* (make-hash-table)) ;; <run-id color text test run-key> (define *alltestnamelst* '()) (define *searchpatts* (make-hash-table)) (define *num-runs* 8) (define *tot-run-count* (cdb:remote-run db:get-num-runs #f "%")) ;; (define *tot-run-count* (db:get-num-runs *db* "%")) (define *last-update* (current-seconds)) (define *last-db-update-time* 0) (define *please-update-buttons* #t) (define *delayed-update* 0) (define *num-tests* 15) (define *start-run-offset* 0) (define *start-test-offset* 0) (define *examine-test-dat* (make-hash-table)) (define *exit-started* #f) (define *status-ignore-hash* (make-hash-table)) (define *state-ignore-hash* (make-hash-table)) (define *db-file-path* (conc *toppath* "/megatest.db")) (define *tests-sort-reverse* #f) (define *hide-empty-runs* #f) (define *current-tab-number* 0) |
︙ | ︙ | |||
173 174 175 176 177 178 179 | (define (colors-similar? color1 color2) (let* ((c1 (map string->number (string-split color1))) (c2 (map string->number (string-split color2))) (delta (map (lambda (a b)(abs (- a b))) c1 c2))) (null? (filter (lambda (x)(> x 3)) delta)))) ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) | | | < < < < < < < | | | | | | | | < < < < < < | | | | | | | | | | | | | | | | | | | | | | | < < < < | | | < | < < < < < | 173 174 175 176 177 178 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 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 | (define (colors-similar? color1 color2) (let* ((c1 (map string->number (string-split color1))) (c2 (map string->number (string-split color2))) (delta (map (lambda (a b)(abs (- a b))) c1 c2))) (null? (filter (lambda (x)(> x 3)) delta)))) ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) (define (update-rundat runnamepatt numruns testnamepatt keypatts) (let* ((referenced-run-ids '()) (allruns (cdb:remote-run db:get-runs #f runnamepatt numruns ;; (+ numruns 1) ;; (/ numruns 2)) *start-run-offset* keypatts)) (header (db:get-header allruns)) (runs (db:get-rows allruns)) (result '()) (maxtests 0) (states (hash-table-keys *state-ignore-hash*)) (statuses (hash-table-keys *status-ignore-hash*))) ;; ;; trim runs to only those that are changing often here ;; (for-each (lambda (run) (let* ((run-id (db:get-value-by-header run header "id")) (tests (let ((tsts (mt:get-tests-for-run run-id testnamepatt states statuses))) (if *tests-sort-reverse* (reverse tsts) tsts))) (key-vals (cdb:remote-run db:get-key-vals #f run-id))) ;; Not sure this is needed? (set! referenced-run-ids (cons run-id referenced-run-ids)) (if (> (length tests) maxtests) (set! maxtests (length tests))) (if (or (not *hide-empty-runs*) ;; this reduces the data burden when set (not (null? tests))) (let ((dstruct (vector run tests key-vals))) ;; ;; compare the tests with the tests in *allruns-by-id* same run-id ;; if different then increment value in *runchangerate* ;; (hash-table-set! *allruns-by-id* run-id dstruct) (set! result (cons dstruct result)))))) runs) (set! *header* header) (set! *allruns* result) (debug:print-info 6 "*allruns* has " (length *allruns*) " runs") maxtests)) (define *collapsed* (make-hash-table)) ; (define *row-lookup* (make-hash-table)) ;; testname => (rownum lableobj) (define (toggle-hide lnum) ; fulltestname) (let* ((btn (vector-ref (dboard:uidat-get-lftcol uidat) lnum)) (fulltestname (iup:attribute btn "TITLE")) |
︙ | ︙ | |||
318 319 320 321 322 323 324 | (vector-set! keycol i newval) (iup:attribute-set! lbl "TITLE" munged-val))) (iup:attribute-set! lbl "FGCOLOR" (if (hash-table-ref/default *collapsed* newval #f) "0 112 112" "0 0 0")) (if (< i maxn) (loop (+ i 1))))))) (define (update-buttons uidat numruns numtests) | < | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 | (vector-set! keycol i newval) (iup:attribute-set! lbl "TITLE" munged-val))) (iup:attribute-set! lbl "FGCOLOR" (if (hash-table-ref/default *collapsed* newval #f) "0 112 112" "0 0 0")) (if (< i maxn) (loop (+ i 1))))))) (define (update-buttons uidat numruns numtests) (let* ((runs (if (> (length *allruns*) numruns) (take-right *allruns* numruns) (pad-list *allruns* numruns))) (lftcol (dboard:uidat-get-lftcol uidat)) (tableheader (dboard:uidat-get-header uidat)) (table (dboard:uidat-get-runsvec uidat)) (coln 0)) (set! *alltestnamelst* '()) ;; create a concise list of test names (for-each (lambda (rundat) (if (vector? rundat) (let* ((testdat (vector-ref rundat 1)) (testnames (map test:test-get-fullname testdat))) (if (not (and *hide-empty-runs* (null? testnames))) (for-each (lambda (testname) (if (not (member testname *alltestnamelst*)) (begin (set! *alltestnamelst* (append *alltestnamelst* (list testname)))))) testnames))))) runs) (set! *alltestnamelst* (collapse-rows *alltestnamelst*)) ;;; argh. please clean up this sillyness (set! *alltestnamelst* (let ((xl (if (> (length *alltestnamelst*) *start-test-offset*) (drop *alltestnamelst* *start-test-offset*) '()))) (append xl (make-list (- *num-tests* (length xl)) "")))) (update-labels uidat) (for-each (lambda (rundat) (if (not rundat) ;; handle padded runs ;; ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration (set! rundat (vector (make-vector 20 #f) '() (map (lambda (x) "") *keys*))));; 3))) (let* ((run (vector-ref rundat 0)) (testsdat (vector-ref rundat 1)) (key-val-dat (vector-ref rundat 2)) (run-id (db:get-value-by-header run *header* "id")) (key-vals (append key-val-dat (list (let ((x (db:get-value-by-header run *header* "runname"))) (if x x ""))))) (run-key (string-intersperse key-vals "\n"))) ;; fill in the run header key values (let ((rown 0) (headercol (vector-ref tableheader coln))) (for-each (lambda (kval) (let* ((labl (vector-ref headercol rown))) (if (not (equal? kval (iup:attribute labl "TITLE"))) (iup:attribute-set! (vector-ref headercol rown) "TITLE" kval)) (set! rown (+ rown 1)))) key-vals)) ;; For this run now fill in the buttons for each test (let ((rown 0) (columndat (vector-ref table coln))) (for-each (lambda (testname) (let ((buttondat (hash-table-ref/default *buttondat* (mkstr coln rown) #f))) (if buttondat (let* ((test (let ((matching (filter (lambda (x)(equal? (test:test-get-fullname x) testname)) testsdat))) (if (null? matching) (vector -1 -1 "" "" "" 0 "" "" 0 "" "" "" 0 "" "") (car matching)))) (testname (db:test-get-testname test)) (itempath (db:test-get-item-path test)) (testfullname (test:test-get-fullname test)) (teststatus (db:test-get-status test)) (teststate (db:test-get-state test)) (teststart (db:test-get-event_time test)) (runtime (db:test-get-run_duration test)) (buttontxt (if (equal? teststate "COMPLETED") teststatus teststate)) (button (vector-ref columndat rown)) (color (common:get-color-for-state-status teststate teststatus)) (curr-color (vector-ref buttondat 1)) ;; (iup:attribute button "BGCOLOR")) (curr-title (vector-ref buttondat 2))) ;; (iup:attribute button "TITLE"))) (if (not (equal? curr-color color)) (iup:attribute-set! button "BGCOLOR" color)) (if (not (equal? curr-title buttontxt)) (iup:attribute-set! button "TITLE" buttontxt)) (vector-set! buttondat 0 run-id) (vector-set! buttondat 1 color) (vector-set! buttondat 2 buttontxt) (vector-set! buttondat 3 test) (vector-set! buttondat 4 run-key))) (set! rown (+ rown 1)))) *alltestnamelst*)) (set! coln (+ coln 1)))) runs))) (define (mkstr . x) (string-intersperse (map conc x) ",")) (define (update-search x val) ;; (print "Setting search for " x " to " val) (hash-table-set! *searchpatts* x val)) |
︙ | ︙ | |||
850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 | (iup:vbox ;; the header (apply iup:hbox (reverse hdrlst)) (apply iup:hbox (reverse bdylst)))))) controls)) (tabs (iup:tabs #:tabchangepos-cb (lambda (obj curr prev) (set! *current-tab-number* curr)) (dashboard:summary) runs-view (dashboard:run-controls) ))) ;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c))) (iup:attribute-set! tabs "TABTITLE0" "Summary") (iup:attribute-set! tabs "TABTITLE1" "Runs") (iup:attribute-set! tabs "TABTITLE2" "Run Control") tabs))) (vector keycol lftcol header runsvec))) (if (or (args:get-arg "-rows") (get-environment-variable "DASHBOARDROWS" )) (begin (set! *num-tests* (string->number (or (args:get-arg "-rows") (get-environment-variable "DASHBOARDROWS")))) | > | | > > > > > | < | | > > | > > | | < | | | | | | | | | | > | < < < | | > > > | > > > > | 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 | (iup:vbox ;; the header (apply iup:hbox (reverse hdrlst)) (apply iup:hbox (reverse bdylst)))))) controls)) (tabs (iup:tabs #:tabchangepos-cb (lambda (obj curr prev) (set! *please-update-buttons* #t) (set! *current-tab-number* curr)) (dashboard:summary) runs-view (dashboard:run-controls) ))) ;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c))) (iup:attribute-set! tabs "TABTITLE0" "Summary") (iup:attribute-set! tabs "TABTITLE1" "Runs") (iup:attribute-set! tabs "TABTITLE2" "Run Control") tabs))) (vector keycol lftcol header runsvec))) (if (or (args:get-arg "-rows") (get-environment-variable "DASHBOARDROWS" )) (begin (set! *num-tests* (string->number (or (args:get-arg "-rows") (get-environment-variable "DASHBOARDROWS")))) (update-rundat "%" *num-runs* "%/%" '())) (set! *num-tests* (min (max (update-rundat "%" *num-runs* "%/%" '()) 8) 20))) (define *tim* (iup:timer)) (define *ord* #f) (iup:attribute-set! *tim* "TIME" 300) (iup:attribute-set! *tim* "RUN" "YES") ;; Move this stuff to db.scm? I'm not sure that is the right thing to do... ;; (define *last-db-update-time* (file-modification-time (conc *toppath* "/megatest.db"))) (define (dashboard:been-changed) (> (file-modification-time (conc *toppath* "/megatest.db")) *last-db-update-time*)) (define (dashboard:set-db-update-time) (set! *last-db-update-time* (file-modification-time (conc *toppath* "/megatest.db")))) (define (dashboard:recalc modtime please-update-buttons last-db-update-time) (or please-update-buttons (and (> modtime last-db-update-time) (> (current-seconds)(+ last-db-update-time 1))))) (define (dashboard:run-update x) (let* ((modtime (file-modification-time *db-file-path*)) (run-update-time (current-seconds)) (recalc (dashboard:recalc modtime *please-update-buttons* *last-db-update-time*))) (if recalc (begin (case *current-tab-number* ((0) ;; (thread-sleep! 0.25) ;; (dashboard:update-summary-tab)) ((1) ;; The runs table is active (update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs* (hash-table-ref/default *searchpatts* "test-name" "%/%") ;; (hash-table-ref/default *searchpatts* "item-name" "%") (let ((res '())) (for-each (lambda (key) (if (not (equal? key "runname")) (let ((val (hash-table-ref/default *searchpatts* key #f))) (if val (set! res (cons (list key val) res)))))) *dbkeys*) res)) (update-buttons uidat *num-runs* *num-tests*))) (set! *please-update-buttons* #f) (set! *last-db-update-time* modtime) (set! *last-update* run-update-time))))) ;;====================================================================== ;; The heavy lifting starts here ;;====================================================================== ;; ease debugging by loading ~/.megatestrc (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc"))) (if (file-exists? debugcontrolf) (load debugcontrolf))) (cond ((args:get-arg "-run") (let ((runid (string->number (args:get-arg "-run")))) (if runid (begin (lambda (x) |
︙ | ︙ | |||
939 940 941 942 943 944 945 | ((args:get-arg "-guimonitor") (gui-monitor *db*)) (else (set! uidat (make-dashboard-buttons *num-runs* *num-tests* *dbkeys*)) (iup:callback-set! *tim* "ACTION_CB" (lambda (x) | | | | 927 928 929 930 931 932 933 934 935 936 937 | ((args:get-arg "-guimonitor") (gui-monitor *db*)) (else (set! uidat (make-dashboard-buttons *num-runs* *num-tests* *dbkeys*)) (iup:callback-set! *tim* "ACTION_CB" (lambda (x) (dashboard:run-update x) 1)))) (iup:main-loop) |
Modified dcommon.scm from [771ef77c06] to [767aa214b9].
︙ | ︙ | |||
163 164 165 166 167 168 169 | (for-each (lambda (entry) (let* ((row-name (car entry)) (col-name (cadr entry)) (value (caddr entry)) (row-num (cadr (assoc row-name row-indices))) (col-num (cadr (assoc col-name col-indices)))) (iup:attribute-set! stats-matrix (conc row-num ":" col-num) value))) | | > | 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | (for-each (lambda (entry) (let* ((row-name (car entry)) (col-name (cadr entry)) (value (caddr entry)) (row-num (cadr (assoc row-name row-indices))) (col-num (cadr (assoc col-name col-indices)))) (iup:attribute-set! stats-matrix (conc row-num ":" col-num) value))) run-stats) (iup:attribute-set! stats-matrix "REDRAW" "ALL"))))) (updater) (set! dashboard:update-summary-tab updater) (iup:attribute-set! stats-matrix "WIDTHDEF" "40") (iup:vbox (iup:label "Run statistics" #:expand "HORIZONTAL") stats-matrix))) |
︙ | ︙ |
Added docs/dashboard-summary-tab.png version [f52b6628fb].
cannot compute difference between binary files