Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -89,17 +89,20 @@ (if (not (launch:setup)) (begin (print "Failed to find megatest.config, exiting") (exit 1))) +;; data common to all tabs goes here +;; (defstruct dboard:commondat curr-tab-num please-update tabdats update-mutex updaters updating + uidat ;; needs to move to tabdat at some time hide-not-hide-tabs ) (define (dboard:commondat-make) (make-dboard:commondat @@ -122,11 +125,11 @@ (hash-table-set! (dboard:commondat-tabdats commondat) tabnum tabdat)) -;; create a stuct for all the miscellaneous state +;; data for each specific tab goes here ;; (defstruct dboard:tabdat allruns allruns-by-id buttondat @@ -168,10 +171,11 @@ target test-patts tests tests-tree tot-runs +;; uidat updater-for-runs ) (define (dboard:tabdat-target-string vec) (let ((targ (dboard:tabdat-target vec))) @@ -210,10 +214,23 @@ status-ignore-hash: (make-hash-table) ))) (dboard:setup-tabdat dat) (dboard:setup-num-rows dat) dat)) + +(define (dboard:setup-tabdat tabdat) + (dboard:tabdat-dbdir-set! tabdat (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) + (dboard:tabdat-dbfpath-set! tabdat (db:dbfile-path 0)) + (dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db")) + + ;; HACK ALERT: this is a hack, please fix. + (dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat)))) + + (dboard:tabdat-keys-set! tabdat (rmt:get-keys)) + (dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname"))) + (dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs "%")) + ) ;; data for runs, tests etc ;; (defstruct dboard:rundat ;; new system @@ -270,23 +287,10 @@ tdat) #f))) (define *dashboard-mode* (string->symbol (or (configf:lookup *configdat* "dashboard" "mode") "dashboard"))) -(define (dboard:setup-tabdat tabdat) - (dboard:tabdat-dbdir-set! tabdat (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) - (dboard:tabdat-dbfpath-set! tabdat (db:dbfile-path 0)) - (dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db")) - - ;; HACK ALERT: this is a hack, please fix. - (dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat)))) - - (dboard:tabdat-keys-set! tabdat (rmt:get-keys)) - (dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname"))) - (dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs "%")) - ) - (define *exit-started* #f) ;; sorting global data (would apply to many testsuites so leave it global for now) ;; @@ -321,11 +325,11 @@ (define (get-curr-sort) (vector-ref *tests-sort-options* *tests-sort-reverse*)) (debug:setup) -(define uidat #f) +;; (define uidat #f) (define-inline (dboard:uidat-get-keycol vec)(vector-ref vec 0)) (define-inline (dboard:uidat-get-lftcol vec)(vector-ref vec 1)) (define-inline (dboard:uidat-get-header vec)(vector-ref vec 2)) (define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3)) @@ -455,13 +459,12 @@ (dboard:tabdat-allruns-set! tabdat result) (debug:print-info 6 *default-log-port* "(dboard:tabdat-allruns tabdat) has " (length (dboard:tabdat-allruns tabdat)) " runs") maxtests)) (define *collapsed* (make-hash-table)) - ; (define *row-lookup* (make-hash-table)) ;; testname => (rownum lableobj) -(define (toggle-hide lnum) ; fulltestname) +(define (toggle-hide lnum uidat) ; fulltestname) (let* ((btn (vector-ref (dboard:uidat-get-lftcol uidat) lnum)) (fulltestname (iup:attribute btn "TITLE")) (parts (string-split fulltestname "(")) (basetestname (if (null? parts) "" (car parts)))) ;(print "Toggling " basetestname " currently " (hash-table-ref/default *collapsed* basetestname #f)) @@ -1636,11 +1639,11 @@ #:size "x15" #:expand "HORIZONTAL" #:fontsize "10" #:action (lambda (obj) (mark-for-update tabdat) - (toggle-hide testnum))))) ;; (iup:attribute obj "TITLE")))) + (toggle-hide testnum uidat))))) ;; (iup:attribute obj "TITLE")))) (vector-set! lftcol testnum labl) (loop (+ testnum 1)(cons labl res)))))) ;; (let loop ((runnum 0) (keynum 0) @@ -1805,51 +1808,53 @@ (apply max (map (lambda (filen) (file-modification-time filen)) (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db")))))) (define (dashboard:run-update x commondat) - (let* ((tabdat (dboard:common-get-tabdat commondat)) ;; uses curr-tab-num - (monitor-db-path (dboard:tabdat-monitor-db-path tabdat)) - (modtime (dashboard:get-youngest-run-db-mod-time tabdat)) ;; NOTE: ensure this is tabdat!! - (monitor-modtime (if (file-exists? monitor-db-path) - (file-modification-time monitor-db-path) - -1)) - (run-update-time (current-seconds)) - (recalc (dashboard:recalc modtime (dboard:commondat-please-update commondat) (dboard:tabdat-last-db-update tabdat)))) - (if (and (eq? (dboard:commondat-curr-tab-num commondat) 0) - (or (> monitor-modtime *last-monitor-update-time*) - (> (- run-update-time *last-monitor-update-time*) 5))) ;; update every 1/2 minute just in case - (begin - (set! *last-monitor-update-time* run-update-time) ;; monitor-modtime) - (if dashboard:update-servers-table (dashboard:update-servers-table)))) - (if recalc - (begin - (case (dboard:commondat-curr-tab-num commondat) - ((0) - (if dashboard:update-summary-tab (dashboard:update-summary-tab))) - ((1) ;; The runs table is active - (update-rundat tabdat (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat) - (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%") - ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%") - (let ((res '())) - (for-each (lambda (key) - (if (not (equal? key "runname")) - (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f))) - (if val (set! res (cons (list key val) res)))))) - (dboard:tabdat-dbkeys tabdat)) - res)) - (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat))) - ((2) - (dashboard:update-run-summary-tab)) - ((3) - (dashboard:update-new-view-tab)) - (else - (let ((updater (dboard:common-get-tabdat commondat))) - (if updater (updater))))) - (dboard:commondat-please-update-set! commondat #f) - (dboard:tabdat-last-db-update-set! tabdat modtime) - (set! *last-recalc-ended-time* (current-milliseconds)))))) + (let* ((tabdat (dboard:common-get-tabdat commondat))) ;; uses curr-tab-num + (if tabdat ;; if there is no tabdat then likely we are in a test control panel, no update calls needed + (let* ((monitor-db-path (dboard:tabdat-monitor-db-path tabdat)) + (modtime (dashboard:get-youngest-run-db-mod-time tabdat)) ;; NOTE: ensure this is tabdat!! + (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path)) + (file-modification-time monitor-db-path) + -1)) + (run-update-time (current-seconds)) + (uidat (dboard:commondat-uidat commondat)) + (recalc (dashboard:recalc modtime (dboard:commondat-please-update commondat) (dboard:tabdat-last-db-update tabdat)))) + (if (and (eq? (dboard:commondat-curr-tab-num commondat) 0) + (or (> monitor-modtime *last-monitor-update-time*) + (> (- run-update-time *last-monitor-update-time*) 5))) ;; update every 1/2 minute just in case + (begin + (set! *last-monitor-update-time* run-update-time) ;; monitor-modtime) + (if dashboard:update-servers-table (dashboard:update-servers-table)))) + (if recalc + (begin + (case (dboard:commondat-curr-tab-num commondat) + ((0) + (if dashboard:update-summary-tab (dashboard:update-summary-tab))) + ((1) ;; The runs table is active + (update-rundat tabdat (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat) + (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%") + ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%") + (let ((res '())) + (for-each (lambda (key) + (if (not (equal? key "runname")) + (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f))) + (if val (set! res (cons (list key val) res)))))) + (dboard:tabdat-dbkeys tabdat)) + res)) + (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat))) + ((2) + (dashboard:update-run-summary-tab)) + ((3) + (dashboard:update-new-view-tab)) + (else + (let ((updater (dboard:common-get-tabdat commondat))) + (if updater (updater))))) + (dboard:commondat-please-update-set! commondat #f) + (dboard:tabdat-last-db-update-set! tabdat modtime) + (set! *last-recalc-ended-time* (current-milliseconds)))))))) ;;====================================================================== ;; The heavy lifting starts here ;;====================================================================== @@ -1858,17 +1863,12 @@ (if (file-exists? debugcontrolf) (load debugcontrolf))) (define (main) (common:exit-on-version-changed) - (let* (;; (runs-dat (dboard:tabdat-make-data)) - ;; (runs-sum-dat (dboard:tabdat-make-data)) ;; init (make-d:data))) ;; data for run-summary tab - ;; (new-view-dat (dboard:tabdat-make-data)) ;; (dboard:tabdat-make-data)) ;; init (make-d:data))) - (commondat (dboard:commondat-make))) + (let* ((commondat (dboard:commondat-make))) ;; Move this stuff to db.scm? I'm not sure that is the right thing to do... - ;; (dboard:tabdat-last-db-update-set! tabdat (file-modification-time (dboard:tabdat-dbfpath tabdat))) ;; (conc *toppath* "/db/main.db"))) - ;; (set! *monitor-db-path* (conc (dboard:commondat-dbdir commondat) "/monitor.db")) (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 @@ -1883,11 +1883,11 @@ (debug:print 3 *default-log-port* "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test")) (exit 1))))) ;; ((args:get-arg "-guimonitor") ;; (gui-monitor (dboard:tabdat-dblocal tabdat))) (else - (set! uidat (make-dashboard-buttons commondat)) ;; (dboard:tabdat-dblocal data) + (dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat)) ;; (dboard:tabdat-dblocal data) ;; (dboard:tabdat-numruns tabdat) ;; (dboard:tabdat-num-tests tabdat) ;; (dboard:tabdat-dbkeys tabdat) ;; runs-sum-dat new-view-dat)) (iup:callback-set! *tim*