Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -58,10 +58,11 @@ get-target ;; register-run get-tests-tags get-test-times get-tests-for-run + get-tests-for-run-state-status get-test-id get-tests-for-runs-mindata get-tests-for-run-mindata get-run-name-from-id get-runs @@ -292,10 +293,11 @@ ((get-run-status) (apply db:get-run-status dbstruct params)) ((get-run-state) (apply db:get-run-state dbstruct params)) ((set-run-status) (apply db:set-run-status dbstruct params)) ((set-run-state-status) (apply db:set-run-state-status dbstruct params)) ((get-tests-for-run) (apply db:get-tests-for-run dbstruct params)) + ((get-tests-for-run-state-status) (apply db:get-tests-for-run-state-status dbstruct params)) ((get-test-id) (apply db:get-test-id dbstruct params)) ((get-tests-for-run-mindata) (apply db:get-tests-for-run-mindata dbstruct params)) ;; ((get-tests-for-runs-mindata) (apply db:get-tests-for-runs-mindata dbstruct params)) ((get-runs) (apply db:get-runs dbstruct params)) ((simple-get-runs) (apply db:simple-get-runs dbstruct params)) Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -438,27 +438,41 @@ ;; ;; this is a two level deep pipeline for the incoming data: ;; sql query data ==> filters ==> data for display ;; (defstruct dboard:rdat + ;; view related items + (runnum 0) ;; which column we are processing, index into runsbynum, we sweep across all these runs then start over + (leftcol 0) ;; number of the leftmost visible column + (toprow 0) ;; topmost visible row + (numcols 24) ;; number of columns visible + (numrows 20) ;; number of rows visible + ;; data from sql db - (keys (rmt:get-keys)) ;; to be removed when targets handling is refactored - (runs (make-sparse-vector)) ;; id => runrec - (targ-runid (make-hash-table)) ;; target/runname => run-id - (tests (make-hash-table)) ;; test[/itempath] => list of test rec - - ;; sql filters - targ-sql-filt - runname-sql-filt - state-sql-filt - status-sql-filt + (keys (rmt:get-keys)) ;; to be removed when targets handling is refactored + (runs (make-sparse-vector)) ;; id => runrec + (runsbynum (make-vector 100 #f)) ;; vector num => runrec + (targ-runid (make-hash-table)) ;; area/target/runname => run-id ;; not sure this will be needed + (tests (make-hash-table)) ;; test[/itempath] => list of test rec + + ;; run sql filters + (targ-sql-filt "%") + (runname-sql-filt "%") + (run-state-sql-filt "%") + (run-status-sql-filt "%") + + ;; test sql filter + (testname-sql-filt "%") + (itempath-sql-filt "%") + (test-state-sql-filt "%") + (test-status-sql-filt "%") ;; other sql related fields - (last-update 0) ;; timestamp of the last update from sql db, set to zero on any field changes + (last-updates (make-sparse-vector 0)) ;; run-id -> timestamp of the last update from sql db, set to zero on any field changes ;; filtered data - (cols (make-sparse-vector)) + (cols (make-sparse-vector)) ;; columnnum => run-id (tests (make-hash-table)) ;; test[/itempath] => (vector columnnum => test rec) ;; various (prev-run-ids '()) ;; push previously looked at runs on this (view-changed #f) @@ -2584,38 +2598,117 @@ ;; simple-run-status-set! procedure (x3814 val3815) ;; simple-run-target procedure (x3786) ;; simple-run-target-set! procedure (x3782 val3783) ;; simple-run? procedure (x3780) + +;;====================================================================== +;; Extracting the data to display for runs +;; +;; This needs to be re-entrant such that it does one column per call +;; on the zeroeth call update runs data +;; on each subsequent call update one run (configurable - could do two, three ... or update until tdelta exceeded +;; on last run reset to zeroeth +;; +;; 1. select with run filters; area, target, runname, runstate, runstatus, starttime, duration +;; - put this information into two data structures: +;; a. hash of area/target/runname => runstruct #< ordernun, id, area, target, runname, state, +;; status, starttime, duration, non-deleted testcount> +;; ordernum reflects order as received from sql query +;; b. sparsevec of id => runstruct +;; 2. for each run in runshash ordered by ordernum do: +;; retrieve data since last update for that run +;; if there is a deleted test - retrieve full data +;; if there are non-deleted tests register this run in the columns sparsevec +;; if this is the zeroeth column regenerate the rows sparsevec +;; if this column is in the visible zone update visible cells +;; +;; Other factors: +;; 1. left index handling: +;; - add test/itempaths to left index as discovered, re-order and +;; update row -> test/itempath mapping on each read run +;;====================================================================== + ;; runs is +;; get ALL runs info +;; update rdat-targ-run-id +;; update rdat-runs ;; -(define (dashboard:update-runs-data data rdat) - (let* ((tb (dboard:rdat-runs-tree rdat))) +(define (dashboard:update-runs-data rdat) + (let* ((tb (dboard:rdat-runs-tree rdat)) + (targ-sql-filt (dboard:rdat-targ-sql-filt rdat)) + (runname-sql-filt (dboard:rdat-runname-sql-filt rdat)) + (state-sql-filt (dboard:rdat-run-state-sql-filt rdat)) + (status-sql-filt (dboard:rdat-run-status-sql-filt rdat)) + ;; Use (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo)) + (data (rmt:simple-get-runs runname-sql-filt #f #f targ-sql-filt #f)) + (numruns (length data))) + ;; store in the runsbynum vector + (dboard:rdat-runsbynum-set! rdat (list->vector data)) ;; update runs id => runrec ;; update targ-runid target/runname => run-id (for-each (lambda (runrec) (let* ((run-id (simple-run-id runrec)) (full-targ-runname (conc (simple-run-target runrec) "/" (simple-run-runname runrec)))) (sparse-vector-set! (dboard:rdat-runs rdat) run-id runrec) (hash-table-set! (dboard:rdat-targ-runid rdat) full-targ-runname run-id) - (tree:add-node tb "Runs" (string-split full-targ-runname "/")) )) - data))) + data) + numruns)) + +;; NOTE: runnum is NOT the run-id, it is a pointer into the runsbynum vector +;; +(define (dashboard:update-run-data runnum rdat) + (let* ((curr-time (current-seconds)) + (runrec (vector-ref (dboard:rdat-runsbynum rdat) runnum)) + (run-id (simple-run-id runrec)) + (last-update (vector-ref (dboard:rdat-last-updates rdat) run-id)) + ;; filters + (testname-sql-filt (dboard:rdat-testname-sql-filt rdat)) + ;; (itempath-sql-filt (dboard:rdat-itempath-sql-filt rdat)) + (test-state-sql-filt (dboard:rdat-test-state-sql-filt rdat)) ;; not used yet + (test-status-sql-filt (dboard:rdat-test-status-sql-filt rdat)) ;; not used yet + (tests (rmt:get-tests-for-run-state-status run-id + testname-sql-filt + last-update ;; last-update + ))) + (debug:print 0 *default-log-port* "Got " (length tests) " tests") + (length tests))) (define (new-runs-updater commondat rdat) - (let* ((last-update (dboard:rdat-last-update rdat)) - (targ-sql-filt (dboard:rdat-targ-sql-filt rdat)) - (runname-sql-filt (dboard:rdat-runname-sql-filt rdat)) - (state-sql-filt (dboard:rdat-state-sql-filt rdat)) - (status-sql-filt (dboard:rdat-status-sql-filt rdat)) - ;; Use (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo)) - (newdata (rmt:simple-get-runs runname-sql-filt #f #f targ-sql-filt last-update))) - (dashboard:update-runs-data newdata rdat) - (dboard:rdat-last-update-set! rdat (- (current-seconds) 10)) + (let* ((runnum (dboard:rdat-runnum rdat))) + (if (eq? runnum 0)(dashboard:update-runs-data rdat)) + + + + + + + ;; (dboard:rdat-last-update-set! rdat (- (current-seconds) 10)) + + + ;; (tree:add-node tb "Runs" (string-split full-targ-runname "/")) + + '())) + +(define (dboard:runs-new-matrix commondat rdat) + (iup:matrix + #:alignment1 "ALEFT" + ;; #:expand "YES" ;; "HORIZONTAL" + #:scrollbar "YES" + #:numcol 10 + #:numlin 20 + #:numcol-visible 5 ;; (min 8) + #:numlin-visible 1 + #:click-cb + (lambda (obj row col status) + (let* ((cell (conc row ":" col))) + #f)) + )) (define (make-runs-view commondat rdat tab-num) ;; register an updater (dboard:commondat-add-updater commondat @@ -2626,24 +2719,12 @@ (iup:vbox (iup:split #:orientation "VERTICAL" ;; "HORIZONTAL" #:value 100 (dboard:runs-tree-new-browser commondat rdat) - (iup:vbox (iup:button "Pushme")) - #;(iup:split - #:value 100 - ;; left most block, including row names - ;; (apply iup:vbox lftlst) - ;; right hand block, including cells - (iup:vbox - #:expand "YES" - ;; the header - (apply iup:hbox (reverse hdrlst)) - (apply iup:hbox (reverse bdylst)) - (dashboard:runs-horizontal-slider runs-dat)))) - ;; controls - )) + (dboard:runs-new-matrix commondat rdat) + ))) (define (make-dashboard-buttons commondat) ;; runs-sum-dat new-view-dat) (let* ((stats-dat (dboard:tabdat-make-data)) (runs-dat (dboard:tabdat-make-data)) (runs2-dat (make-dboard:rdat)) ;; (dboard:tabdat-make-data)) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -2881,11 +2881,11 @@ (vector-ref inrec 5) ;; status -1 "" -1 -1 "" "-" (vector-ref inrec 3) ;; item-path -1 "-" "-")) -(define (db:get-tests-for-run-state-status dbstruct run-id testpatt) +#;(define (db:get-tests-for-run-state-status dbstruct run-id testpatt) (let* ((res '()) (tests-match-qry (tests:match->sqlqry testpatt)) (qry (conc "SELECT id,testname,item_path,state,status FROM tests WHERE run_id=? " (if tests-match-qry (conc " AND (" tests-match-qry ") ") "")))) (debug:print-info 8 *default-log-port* "db:get-tests-for-run qry=" qry) @@ -2897,10 +2897,31 @@ (set! res (cons (vector id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-") res))) db qry run-id))) res)) + +(define (db:get-tests-for-run-state-status dbstruct run-id testpatt #!optional (last-update 0)) + (let* ((res '()) + (tests-match-qry (tests:match->sqlqry testpatt)) + (qry (conc "SELECT id,testname,item_path,state,status,event_time,run_duration FROM tests WHERE run_id=? " + " AND last_update > ? " + (if tests-match-qry (conc " AND (" tests-match-qry ") ") "") + ))) + (debug:print-info 8 *default-log-port* "db:get-tests-for-run qry=" qry) + (db:with-db dbstruct run-id #f + (lambda (db) + (sqlite3:fold-row + (lambda (id testname item-path state status event-time run-duration) + ;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment + (cons (vector id run-id testname state status event-time "" -1 -1 "" "-" item-path run-duration "-" "-") res)) + '() + db + qry + run-id + (or last-update 0)))) + res)) (define (db:get-testinfo-state-status dbstruct run-id test-id) (let ((res #f)) (db:with-db dbstruct run-id #f (lambda (db) Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -557,10 +557,13 @@ (rmt:send-receive 'get-tests-for-run run-id (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals last-update mode))) ;; (begin ;; (debug:print-error 0 *default-log-port* "rmt:get-tests-for-run called with bad run-id=" run-id) ;; (print-call-chain (current-error-port)) ;; '()))) + +(define (rmt:get-tests-for-run-state-status dbstruct run-id testpatt #!optional (last-update 0)) + (rmt:send-receive 'get-tests-for-run-state-status run-id (list run-id testpatt last-update))) ;; get stuff via synchash (define (rmt:synchash-get run-id proc synckey keynum params) (rmt:send-receive 'synchash-get run-id (list run-id proc synckey keynum params)))