Index: multi-dboard.scm ================================================================== --- multi-dboard.scm +++ multi-dboard.scm @@ -7,11 +7,11 @@ ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== -(use format numbers sql-de-lite srfi-1 posix regex regex-case srfi-69 nanomsg srfi-18) +(use format numbers sql-de-lite srfi-1 posix regex regex-case srfi-69 nanomsg srfi-18 call-with-environment-variables) (require-library iup) (import (prefix iup iup:)) (use canvas-draw) (declare (uses margs)) @@ -18,10 +18,11 @@ (declare (uses megatest-version)) (declare (uses gutils)) (declare (uses tree)) (declare (uses configf)) (declare (uses portlogger)) +(declare (uses keys)) (include "common_records.scm") ;; (include "db_records.scm") ;; (include "key_records.scm") @@ -63,10 +64,11 @@ ;; (set! (common:get-remote remote) (string-split (args:get-arg "-host" ":"))) ;; (client:launch)) ;; (client:launch)) (define *runremote* #f) +(define *windows* (make-hash-table)) (debug:setup) (define *tim* (iup:timer)) (define *ord* #f) @@ -241,22 +243,41 @@ db)))) ;; populate the areadat tests info, does NOT fill the tests data itself ;; (define (areadb:populate-run-info areadat) - (let* ((runs (or (areadat-tests areadat) (make-hash-table))) + (let* ((runs (or (areadat-runs areadat) (make-hash-table))) (keys (areadat-run-keys areadat)) (maindb (areadb:open areadat 0))) (query (for-each-row (lambda (row) (let ((id (list-ref row 0)) (dat (apply make-rundat (append row (list #f #f))))) ;; add placeholders for tests and db - (hash-table-set! runs id dat))) - (sql maindb (conc "SELECT id," - (string-intersperse keys "'||/||'") - ",runname,state,status,event_time FROM runs WHERE state != 'DELETED';")))) + (print row) + (hash-table-set! runs id dat)))) + (sql maindb (conc "SELECT id," + (string-intersperse keys "||'/'||") + ",runname,state,status,event_time FROM runs WHERE state != 'DELETED';"))) areadat)) - + +;; initialize and refresh data +;; +(define (dboard:general-updater con port) + (for-each + (lambda (window-id) + (print "Processing for window-id " window-id) + (let* ((window-dat (hash-table-ref *windows* window-id)) + (areas (data-areas window-dat))) + ;; now for each area in the window gather the data + (for-each + (lambda (area-name) + (print "Processing for area-name " area-name) + (let ((area-dat (hash-table-ref areas area-name))) + (print "Processing " area-dat " for area-name " area-name) + (areadb:populate-run-info area-dat))) + (hash-table-keys areas)))) + (hash-table-keys *windows*))) + ;;====================================================================== ;; D A S H B O A R D D B ;;====================================================================== (define (mddb:open-db) @@ -359,21 +380,20 @@ ;;====================================================================== ;; A R E A S ;;====================================================================== (define (dashboard:init-area data area-name apath) - (let* ((mtconffile (conc apath "/megatest.config")) - (mtconf (read-config mtconffile (make-hash-table) #f)) ;; megatest.config + (let* ((mtconf (dboard:read-mtconf apath)) (area-dat (let ((ad (make-areadat area-name ;; area name apath ;; path to area ;; 'http ;; transport mtconf ;; megatest.config (make-hash-table) ;; denoise hash #f ;; client-signature #f ;; remote connections - #f ;; run keys + (keys:config-get-fields mtconf) ;; run keys (make-hash-table) ;; run-id -> (hash of test-ids => dat) (and (file-exists? apath)(file-write-access? apath)) ;; read-only #f #f ))) @@ -403,11 +423,12 @@ #f ;; filters #f ;; the run-id (make-hash-table) ;; run-id -> test-id, for current test id "" ))) - (hash-table-set! (data-areas data) aname dboard-dat) + (hash-table-set! (data-areas data) aname area-dat) ;; dboard-dat) + (hash-table-set! (data-tab-ids data) window-id dboard-dat) (tab-tree-set! dboard-dat tb) (tab-matrix-set! dboard-dat ad) (iup:split #:value 200 tb ad))) @@ -593,10 +614,23 @@ (begin (debug:print-info 0 "Need to create a config but no megatest.config found: " curr-mtcfgdat) #f)))) ;; ) +(define (dboard:read-mtconf apath) + (let* ((mtconffile (conc apath "/megatest.config"))) + (call-with-environment-variables + (list (cons "MT_RUN_AREA_HOME" apath)) + (lambda () + (read-config mtconffile (make-hash-table) #f)) ;; megatest.config + ))) + + +;;====================================================================== +;; G U I S T U F F +;;====================================================================== + ;;; main. Theoretically could have multiple windows (each with a group of tags, thus window-id ;;; (define (dboard:make-window window-id) (let* (;; (window-id 0) (groupn (or (args:get-arg "-group") "default")) @@ -608,10 +642,11 @@ 0 ;; current window id 0 ;; current tab id #f ;; redraw needed for current tab id (make-hash-table) ;; tab-id -> areaname ))) + (hash-table-set! *windows* window-id data) (iup:show (dashboard:main-panel data window-id)) (iup:main-loop))) @@ -624,9 +659,14 @@ (((con port)(dboard:server-start #f))) (let ((portnum (if (string? port)(string->number port) port))) ;; got here, monitor/dashboard was started (mddb:register-dashboard portnum) (thread-start! (make-thread (lambda ()(dboard:server-service con portnum)) "server service")) + (thread-start! (make-thread (lambda () + (let loop () + (dboard:general-updater con portnum) + (thread-sleep! 1) + (loop))) "general updater")) (dboard:make-window 0) (mddb:unregister-dashboard (get-host-name) portnum) (dboard:server-close con port)))