@@ -53,10 +53,11 @@ Usage: dashboard [options] -h : this help -test run-id,test-id : control test identified by testid -skip-version-check : skip the version check + -use-db-cache : access database via cache Misc -rows R : set number of rows -cols C : set number of columns ")) @@ -81,11 +82,11 @@ "-use-server" "-guimonitor" "-main" "-v" "-q" - "-use-local" + "-use-db-cache" "-skip-version-check" ) args:arg-hash 0)) @@ -103,10 +104,19 @@ ;; (if (not (launch:setup)) (begin (print "Failed to find megatest.config, exiting") (exit 1))) + +;; create a watch dog to move changes from lt/.db/*.db to megatest.db +;; +(if (file-write-access? (conc *toppath* "/megatest.db")) + (thread-start! (make-thread common:watchdog "Watchdog thread")) + (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 goes here ;; (defstruct dboard:commondat ((curr-tab-num 0) : number) @@ -248,10 +258,11 @@ ((status-ignore-hash (make-hash-table)) : hash-table) ;; hash of STATUS => #t/#f (target #f) (test-patts #f) ;; db info to file the .db files for the area + (access-mode (db:get-access-mode)) ;; use cached db or not (dbdir #f) (dbfpath #f) (dbkeys #f) ((last-db-update (make-hash-table)) : hash-table) ;; last db file timestamp (monitor-db-path #f) ;; where to find monitor.db @@ -303,13 +314,13 @@ (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-keys-set! tabdat (db:dispatch-query (db:get-access-mode) rmt:get-keys db:get-keys)) (dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname"))) - (dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs "%")) + (dboard:tabdat-tot-runs-set! tabdat (db:dispatch-query (db:get-access-mode) rmt:get-num-runs db:get-num-runs "%")) ) ;; RADT => Matrix defstruct addition (defstruct dboard:graph-dat ((id #f) : string) @@ -478,11 +489,12 @@ ;; gets all the tests for run-id that match testnamepatt and key-vals, merges them ;; ;; NOTE: Yes, this is used ;; (define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals) - (let* ((num-to-get + (let* ((access-mode (dboard:tabdat-access-mode tabdat)) + (num-to-get (let ((num-tests-from-config (configf:lookup *configdat* "setup" "num-tests-to-get"))) (if num-tests-from-config (begin (BB> "override num-tests 100 -> "num-tests-from-config) (string->number num-tests-from-config)) @@ -515,21 +527,22 @@ (db-pth (conc db-dir "/" run-id ".db"))) (dboard:rundat-db-path-set! run-dat db-pth) db-pth))) (tmptests (if (or do-not-use-db-file-timestamps (>= (common:lazy-modification-time db-path) last-update)) - (rmt:get-tests-for-run run-id testnamepatt states statuses ;; run-id testpatt states statuses - (dboard:rundat-run-data-offset run-dat) - num-to-get - (dboard:tabdat-hide-not-hide tabdat) ;; no-in - sort-by ;; sort-by - sort-order ;; sort-order - #f ;; 'shortlist ;; qrytype - (if (dboard:tabdat-filters-changed tabdat) - 0 - last-update) ;; last-update - *dashboard-mode*) ;; use dashboard mode + (db:dispatch-query access-mode rmt:get-tests-for-run db:get-tests-for-run + run-id testnamepatt states statuses ;; run-id testpatt states statuses + (dboard:rundat-run-data-offset run-dat) + num-to-get + (dboard:tabdat-hide-not-hide tabdat) ;; no-in + sort-by ;; sort-by + sort-order ;; sort-order + #f ;; 'shortlist ;; qrytype + (if (dboard:tabdat-filters-changed tabdat) + 0 + last-update) ;; last-update + *dashboard-mode*) ;; use dashboard mode '())) (use-new (dboard:tabdat-hide-not-hide tabdat)) (tests-ht (if (dboard:tabdat-filters-changed tabdat) (let ((ht (make-hash-table))) (dboard:rundat-tests-set! run-dat ht) @@ -591,15 +604,18 @@ ;; ;; create a virtual table of all the tests ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) ;; (define (update-rundat tabdat runnamepatt numruns testnamepatt keypatts) - (let* ((keys (rmt:get-keys)) + (let* ((access-mode (dboard:tabdat-access-mode tabdat)) + (keys (db:dispatch-query access-mode rmt:get-keys db:get-keys)) (last-runs-update (dboard:tabdat-last-runs-update tabdat)) - (allruns (rmt:get-runs runnamepatt numruns (dboard:tabdat-start-run-offset tabdat) keypatts)) + (allruns (db:dispatch-query access-mode rmt:get-runs db:get-runs + runnamepatt numruns (dboard:tabdat-start-run-offset tabdat) keypatts)) ;;(allruns-tree (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f)) - (allruns-tree (rmt:get-runs-by-patt keys "%" #f #f #f #f last-runs-update));;'("id" "runname") + (allruns-tree (db:dispatch-query access-mode rmt:get-runs-by-patt db:get-runs-by-patt + keys "%" #f #f #f #f last-runs-update));;'("id" "runname") (header (db:get-header allruns)) (runs (db:get-rows allruns)) ;; RA => Filtered as per runpatt selected (runs-tree (db:get-rows allruns-tree)) ;; RA => Returns complete list of runs (start-time (current-seconds)) (runs-hash (let ((ht (make-hash-table))) @@ -624,11 +640,11 @@ (res '()) (maxtests 0)) (let* ((run-id (db:get-value-by-header run header "id")) (run-struct (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f)) (last-update (if run-struct (dboard:rundat-last-update run-struct) 0)) - (key-vals (rmt:get-key-vals run-id)) + (key-vals (rmt:get-key-vals run-id)) ;; (db:dispatch-query (db:get-access-mode) rmt:get-key-vals db:get-key-vals run-id)) (tests-ht (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals)) ;; GET RID OF dboard:get-tests-dat - it is superceded by dboard:get-tests-for-run-duplicate ;; dboard:get-tests-for-run-duplicate - returns a hash table ;; (dboard:get-tests-dat tabdat run-id last-update)) (all-test-ids (hash-table-keys tests-ht)) @@ -1004,11 +1020,11 @@ newval)))))) (define (dashboard:update-target-selector tabdat #!key (action-proc #f)) (let* ((runconf-targs (common:get-runconfig-targets)) (key-lbs (dboard:tabdat-key-listboxes tabdat)) - (db-target-dat (rmt:get-targets)) + (db-target-dat (db:dispatch-query (db:get-access-mode) rmt:get-targets db:get-targets)) (header (vector-ref db-target-dat 0)) (db-targets (vector-ref db-target-dat 1)) (munge-target (lambda (x) ;; create a target vector from a string. Pad with na if needed. (list->vector (take (append (string-split x "/") @@ -1177,11 +1193,11 @@ ;; used by run-controls ;; (define (dashboard:update-tree-selector tabdat #!key (action-proc #f)) (let* ((tb (dboard:tabdat-runs-tree tabdat)) (runconf-targs (common:get-runconfig-targets)) - (db-target-dat (rmt:get-targets)) + (db-target-dat (db:dispatch-query (db:get-access-mode) rmt:get-targets db:get-targets)) (header (vector-ref db-target-dat 0)) (db-targets (vector-ref db-target-dat 1)) (munge-target (lambda (x) ;; create a target vector from a string. Pad with na if needed. (take (append (string-split x "/") (make-list (length header) "na")) @@ -1469,11 +1485,13 @@ (if (not (null? path)) (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) path #f) #f)) (define (dboard:get-tests-dat tabdat run-id last-update) - (let* ((tdat (if run-id (rmt:get-tests-for-run run-id + (let* ((access-mode (dboard:tabdat-access-mode tabdat)) + (tdat (if run-id (db:dispatch-query access-mode rmt:get-tests-for-run db:get-tests-for-run + run-id (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%") (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)) ;; '() (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)) ;; '() #f #f ;; offset limit (dboard:tabdat-hide-not-hide tabdat) ;; not-in @@ -1500,20 +1518,22 @@ (if (and res (> (length res) 1)) (cadr res) #f))) (define (dboard:update-tree tabdat runs-hash runs-header tb) - (let* ((run-ids (sort (filter number? (hash-table-keys runs-hash)) + (let* ((access-mode (dboard:tabdat-access-mode tabdat)) + (run-ids (sort (filter number? (hash-table-keys runs-hash)) (lambda (a b) (let* ((record-a (hash-table-ref runs-hash a)) (record-b (hash-table-ref runs-hash b)) (time-a (db:get-value-by-header record-a runs-header "event_time")) (time-b (db:get-value-by-header record-b runs-header "event_time"))) (< time-a time-b))))) (changed #f) (last-runs-update (dboard:tabdat-last-runs-update tabdat)) - (runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update))) + (runs-dat (db:dispatch-query access-mode rmt:get-runs-by-patt db:get-runs-by-patt + (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update))) (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2)) (for-each (lambda (run-id) (let* ((run-record (hash-table-ref/default runs-hash run-id #f)) (key-vals (map (lambda (key)(db:get-value-by-header run-record runs-header key)) (dboard:tabdat-keys tabdat))) @@ -1551,11 +1571,11 @@ (else #f))))))) (define (dashboard:run-id->tests-mindat run-id tabdat runs-hash) (let* ((run (hash-table-ref/default runs-hash run-id #f)) - (key-vals (rmt:get-key-vals run-id)) + (key-vals (rmt:get-key-vals run-id)) ;; (db:dispatch-query (db:get-access-mode) rmt:get-key-vals db:get-key-vals run-id)) (testnamepatt (or (dboard:tabdat-test-patts tabdat) "%/%")) (tests-ht (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals)) (tests-dat (dashboard:tests-ht->tests-dat tests-ht)) (tests-mindat (dcommon:minimize-test-data tests-dat))) ;; reduces data for display (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2)) @@ -1577,12 +1597,14 @@ hide-clean: hide-clean) #f))) (define (dashboard:get-runs-hash tabdat) - (let* ((last-runs-update 0);;(dboard:tabdat-last-runs-update tabdat)) - (runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)) + (let* ((access-mode (dboard:tabdat-access-mode tabdat)) + (last-runs-update 0);;(dboard:tabdat-last-runs-update tabdat)) + (runs-dat (db:dispatch-query access-mode rmt:get-runs-by-patt db:get-runs-by-patt + (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)) (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records (runs (vector-ref runs-dat 1)) (run-id (dboard:tabdat-curr-run-id tabdat)) (runs-hash (let ((ht (make-hash-table))) (for-each (lambda (run) @@ -1594,11 +1616,13 @@ (define (dashboard:runs-summary-updater commondat tabdat tb cell-lookup run-matrix) (if (dashboard:database-changed? commondat tabdat context-key: 'runs-summary-rundat) (dashboard:do-update-rundat tabdat)) (dboard:runs-summary-control-panel-updater tabdat) (let* ((last-runs-update (dboard:tabdat-last-runs-update tabdat)) - (runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)) + (runs-dat (db:dispatch-query (dboard:tabdat-access-mode tabdat) + rmt:get-runs-by-patt db:get-runs-by-patt + (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)) (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records (runs (vector-ref runs-dat 1)) (run-id (dboard:tabdat-curr-run-id tabdat)) (runs-hash (dashboard:get-runs-hash tabdat)) ;; (runs-hash (let ((ht (make-hash-table))) @@ -1821,21 +1845,22 @@ (loop (cdr buttons-left) (cdr modes-left)))))) (define (dboard:runs-summary-xor-labels-updater tabdat) (let ((source-runname-label (dboard:tabdat-runs-summary-source-runname-label tabdat)) (dest-runname-label (dboard:tabdat-runs-summary-dest-runname-label tabdat)) - (mode (dboard:tabdat-runs-summary-mode tabdat))) + (mode (dboard:tabdat-runs-summary-mode tabdat)) + (access-mode (db:get-access-mode))) (when (and source-runname-label dest-runname-label) (case mode ((xor-two-runs xor-two-runs-hide-clean) (let* ((curr-run-id (dboard:tabdat-curr-run-id tabdat)) (prev-run-id (dboard:tabdat-prev-run-id tabdat)) (curr-runname (if curr-run-id - (rmt:get-run-name-from-id curr-run-id) + (db:dispatch-query access-mode rmt:get-run-name-from-id db:get-run-name-from-id curr-run-id) "None")) (prev-runname (if prev-run-id - (rmt:get-run-name-from-id prev-run-id) + (db:dispatch-query access-mode rmt:get-run-name-from-id db:get-run-name-from-id prev-run-id) "None"))) (iup:attribute-set! source-runname-label "TITLE" (conc " SRC: "prev-runname" ")) (iup:attribute-set! dest-runname-label "TITLE" (conc "DEST: "curr-runname" ")))) (else (iup:attribute-set! source-runname-label "TITLE" "") @@ -1935,27 +1960,29 @@ ;; (let* ((modkeys (iup:global "MODKEYSTATE"))) ;; (BB> "modkeys="modkeys)) (BB> "click-cb: obj="obj" lin="lin" col="col" status="status) ;; status is corrupted on Brandon's home machine. will have to wait until after shutdown to see if it is still broken in PDX SLES - (let* ((toolpath (car (argv))) + (let* ((access-mode (db:get-access-mode)) + (toolpath (car (argv))) (key (conc lin ":" col)) (test-id (hash-table-ref/default cell-lookup key -1)) (run-id (dboard:tabdat-curr-run-id tabdat)) - (run-info (rmt:get-run-info run-id)) - (target (rmt:get-target run-id)) + (run-info (db:dispatch-query access-mode rmt:get-run-info db:get-run-info run-id)) + (target (db:dispatch-query access-mode rmt:get-target db:get-target run-id)) (runname (db:get-value-by-header (db:get-rows run-info) (db:get-header run-info) "runname")) (test-name (db:test-get-testname (rmt:get-test-info-by-id run-id test-id))) - (testpatt (let ((tlast (rmt:tasks-get-last target runname))) + (testpatt (let ((tlast (db:dispatch-query access-mode rmt:tasks-get-last tasks:get-last target runname))) (if tlast (let ((tpatt (tasks:task-get-testpatt tlast))) (if (member tpatt '("0" 0)) ;; known bad historical value - remove in 2017 "%" tpatt)) "%"))) - (item-path (db:test-get-item-path (rmt:get-test-info-by-id run-id test-id))) + (test-info (db:dispatch-query access-mode rmt:get-test-info-by-id db:get-test-info-by-id run-id test-id)) + (item-path (db:test-get-item-path test-info)) (item-test-path (conc test-name "/" (if (equal? item-path "") "%" item-path))) (status-chars (char-set->list (string->char-set status))) (testpanel-cmd (conc toolpath " -test " (dboard:tabdat-curr-run-id tabdat) "," test-id " &"))) @@ -2409,27 +2436,30 @@ #:button-cb (lambda (obj a pressed x y btn . rem) ;; (print "pressed= " pressed " x= " x " y= " y " rem=" rem " btn=" btn " string? " (string? btn)) (if (substring-index "3" btn) (if (eq? pressed 1) - (let* ((toolpath (car (argv))) + (let* ((access-mode (db:get-access-mode)) + (toolpath (car (argv))) (buttndat (hash-table-ref (dboard:tabdat-buttondat runs-dat) button-key)) (test-id (db:test-get-id (vector-ref buttndat 3))) (run-id (db:test-get-run_id (vector-ref buttndat 3))) - (run-info (rmt:get-run-info run-id)) - (target (rmt:get-target run-id)) + (run-info (db:dispatch-query access-mode rmt:get-run-info db:get-run-info run-id)) + (target (db:dispatch-query access-mode rmt:get-target db:get-target run-id)) (runname (db:get-value-by-header (db:get-rows run-info) (db:get-header run-info) "runname")) - (test-name (db:test-get-testname (rmt:get-test-info-by-id run-id test-id))) - (testpatt (let ((tlast (rmt:tasks-get-last target runname))) + (test-info (db:dispatch-query access-mode rmt:get-test-info-by-id db:get-test-info-by-id run-id test-id)) + (test-name (db:test-get-testname test-info)) + (testpatt (let ((tlast (db:dispatch-query access-mode rmt:tasks-get-last tasks:get-last target runname))) (if tlast (let ((tpatt (tasks:task-get-testpatt tlast))) (if (member tpatt '("0" 0)) ;; known bad historical value - remove in 2017 "%" tpatt)) "%"))) - (item-path (db:test-get-item-path (rmt:get-test-info-by-id run-id test-id))) + ;; Why are we getting the test-info over again? run-id and test-id are the same right? + (item-path (db:test-get-item-path test-info)) ;; (db:dispatch-query access-mode rmt:get-test-info-by-id db:get-test-info-by-id run-id test-id))) (item-test-path (conc test-name "/" (if (equal? item-path "") "%" item-path)))) (iup:show (dashboard:popup-menu run-id test-id target runname test-name testpatt item-test-path) ;; popup-menu #:x 'mouse @@ -2705,12 +2735,15 @@ (db:test-get-event_time (hash-table-ref testsdat (car b)))))))))) ;; run times tab data updater ;; (define (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num) - (let* ((last-runs-update (dboard:tabdat-last-runs-update tabdat)) - (runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)) + (let* ((access-mode (dboard:tabdat-access-mode tabdat)) + (last-runs-update (dboard:tabdat-last-runs-update tabdat)) + (runs-dat (db:dispatch-query access-mode + rmt:get-runs-by-patt db:get-runs-by-patt + (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)) (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records (runs-hash (let ((ht (make-hash-table))) (for-each (lambda (run) (hash-table-set! ht (db:get-value-by-header run runs-header "id") run)) (vector-ref runs-dat 1))