Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -143,10 +143,11 @@ ((register-run) (apply db:register-run dbstruct params)) ((set-tests-state-status) (apply db:set-tests-state-status dbstruct params)) ((delete-run) (apply db:delete-run dbstruct params)) ((lock/unlock-run) (apply db:lock/unlock-run dbstruct params)) ((update-run-event_time) (apply db:update-run-event_time dbstruct params)) + ((update-run-stats) (apply db:update-run-stats dbstruct params)) ;; STEPS ((teststep-set-status!) (apply db:teststep-set-status! dbstruct params)) ;; TEST DATA @@ -201,10 +202,11 @@ ((test-get-top-process-pid) (apply db:test-get-top-process-pid dbstruct params)) ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params)) ((get-prereqs-not-met) (apply db:get-prereqs-not-met dbstruct params)) ((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params)) ((synchash-get) (apply synchash:server-get dbstruct params)) + ((get-raw-run-stats) (apply db:get-raw-run-stats dbstruct params)) ;; RUNS ((get-run-info) (apply db:get-run-info dbstruct params)) ((get-run-status) (apply db:get-run-status dbstruct params)) ((set-run-status) (apply db:set-run-status dbstruct params)) @@ -216,10 +218,11 @@ ((get-all-run-ids) (db:get-all-run-ids dbstruct)) ((get-prev-run-ids) (apply db:get-prev-run-ids dbstruct params)) ((get-run-ids-matching-target) (apply db:get-run-ids-matching-target dbstruct params)) ((get-runs-by-patt) (apply db:get-runs-by-patt dbstruct params)) ((get-run-name-from-id) (apply db:get-run-name-from-id dbstruct params)) + ((get-main-run-stats) (apply db:get-main-run-stats dbstruct params)) ;; STEPS ((get-steps-data) (apply db:get-steps-data dbstruct params)) ((get-steps-for-test) (apply db:get-steps-for-test dbstruct params)) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -800,36 +800,55 @@ ;; (db:clean-up frundb) (if (eq? run-id 0) (let ((maindb (db:dbdat-get-db (db:get-db fromdb #f)))) (db:sync-tables (db:sync-main-list dbstruct) (db:get-db fromdb #f) mtdb) (set! dead-runs (db:clean-up-maindb (db:get-db fromdb #f))) - ;; Feb 18, 2016: add field last_update to tests - ;; remove this some time after september + ;; + ;; Feb 18, 2016: add field last_update to runs table + ;; + ;; remove all these some time after september 2016 (added in v1.6031 + ;; (handle-exceptions exn (if (string-match ".*duplicate.*" ((condition-property-accessor 'exn 'message) exn)) (debug:print 0 "Column last_update already added to runs table") (db:general-sqlite-error-dump exn "alter table runs ..." run-id "none")) (sqlite3:execute maindb "ALTER TABLE runs ADD COLUMN last_update INTEGER DEFAULT 0")) + ;; these schema changes don't need exception handling (sqlite3:execute maindb "CREATE TRIGGER IF NOT EXISTS update_runs_trigger AFTER UPDATE ON runs FOR EACH ROW BEGIN UPDATE runs SET last_update=(strftime('%s','now')) WHERE id=old.id; END;") + (sqlite3:execute maindb "CREATE TABLE IF NOT EXISTS run_stats ( + id INTEGER PRIMARY KEY, + run_id INTEGER, + state TEXT, + status TEXT, + count INTEGER, + last_update INTEGER DEFAULT (strftime('%s','now')))") + (sqlite3:execute maindb "CREATE TRIGGER IF NOT EXISTS update_run_stats_trigger AFTER UPDATE ON run_stats + FOR EACH ROW + BEGIN + UPDATE run_stats SET last_update=(strftime('%s','now')) + WHERE id=old.id; + END;") ) (begin ;; NB// must sync first to ensure deleted tests get marked as such in megatest.db (db:sync-tables db:sync-tests-only (db:get-db fromdb run-id) mtdb) (db:clean-up-rundb (db:get-db fromdb run-id)) - + ;; ;; Feb 18, 2016: add field last_update to tests - ;; remove this some time after september + ;; + ;; remove this some time after September 2016 (added in version v1.6031 + ;; (handle-exceptions exn (if (string-match ".*duplicate.*" ((condition-property-accessor 'exn 'message) exn)) (debug:print 0 "Column last_update already added to tests table") (db:general-sqlite-error-dump exn "alter table tests ..." #f "none")) @@ -936,15 +955,28 @@ comment TEXT DEFAULT '', fail_count INTEGER DEFAULT 0, pass_count INTEGER DEFAULT 0, last_update INTEGER DEFAULT (strftime('%s','now')), CONSTRAINT runsconstraint UNIQUE (runname" (if havekeys "," "") keystr "));")) - (sqlite3:execute db "CREATE TRIGGER update_runs_trigger AFTER UPDATE ON runs + (sqlite3:execute db "CREATE TRIGGER IF NOT EXISTS update_runs_trigger AFTER UPDATE ON runs FOR EACH ROW BEGIN UPDATE runs SET last_update=(strftime('%s','now')) WHERE id=old.id; + END;") + (sqlite3:execute db "CREATE TABLE IF NOT EXISTS run_stats ( + id INTEGER PRIMARY KEY, + run_id INTEGER, + state TEXT, + status TEXT, + count INTEGER, + last_update INTEGER DEFAULT (strftime('%s','now')))") + (sqlite3:execute db "CREATE TRIGGER IF NOT EXISTS update_run_stats_trigger AFTER UPDATE ON run_stats + FOR EACH ROW + BEGIN + UPDATE run_stats SET last_update=(strftime('%s','now')) + WHERE id=old.id; END;") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_meta ( id INTEGER PRIMARY KEY, testname TEXT DEFAULT '', author TEXT DEFAULT '', @@ -1037,11 +1069,11 @@ pass_count INTEGER DEFAULT 0, archived INTEGER DEFAULT 0, -- 0=no, > 1=archive block id where test data can be found last_update INTEGER DEFAULT (strftime('%s','now')), CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path));") (sqlite3:execute db "CREATE INDEX IF NOT EXISTS tests_index ON tests (run_id, testname, item_path);") - (sqlite3:execute db "CREATE TRIGGER update_tests_trigger AFTER UPDATE ON tests + (sqlite3:execute db "CREATE TRIGGER IF NOT EXISTS update_tests_trigger AFTER UPDATE ON tests FOR EACH ROW BEGIN UPDATE tests SET last_update=(strftime('%s','now')) WHERE id=old.id; END;") @@ -1759,10 +1791,12 @@ qrystr ))) (debug:print-info 11 "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count) (vector header res))) +;; TODO: Switch this to use max(update_time) from each run db? Then if using a server there is no disk traffic (using inmem db) +;; (define (db:get-changed-run-ids since-time) (let* ((dbdir (db:dbfile-path #f)) ;; (configf:lookup *configdat* "setup" "dbdir")) (alldbs (glob (conc dbdir "/[0-9]*.db"))) (changed (filter (lambda (dbfile) (> (file-modification-time dbfile) since-time)) @@ -1862,10 +1896,65 @@ (set! numruns count)) db "SELECT COUNT(id) FROM runs WHERE runname LIKE ? AND state != 'deleted';" runpatt) (debug:print-info 11 "db:get-num-runs END " runpatt) numruns)))) + +;; (sqlite3#fold-row proc3670 init3671 db-or-stmt3672 . params3673)> +;; +(define (db:get-raw-run-stats dbstruct run-id) + (db:with-db + dbstruct + run-id + #f + (lambda (db) + (sqlite3:fold-row + (lambda (res state status count) + (cons (list state status count) res)) + '() + db + "SELECT state,status,count(id) AS count FROM tests WHERE run_id=? AND NOT(uname='n/a' AND item_path='') GROUP BY state,status;;" + run-id)))) + +;; Update run_stats for given run_id +;; input data is a list (state status count) +;; +(define (db:update-run-stats dbstruct run-id stats) + (db:with-db + dbstruct + #f + #f + (lambda (db) + ;; remove previous data + (let* ((stmt1 (sqlite3:prepare db "DELETE FROM run_stats WHERE run_id=? AND state=? AND status=?;")) + (stmt2 (sqlite3:prepare db "INSERT INTO run_stats (run_id,state,status,count) VALUES (?,?,?,?);")) + (res + (sqlite3:with-transaction + db + (lambda () + (for-each + (lambda (dat) + (sqlite3:execute stmt1 run-id (car dat)(cadr dat)) + (apply sqlite3:execute stmt2 run-id dat)) + stats))))) + (sqlite3:finalize! stmt1) + (sqlite3:finalize! stmt2) + res)))) + +(define (db:get-main-run-stats dbstruct run-id) + (db:with-db + dbstruct + #f ;; this data comes from main + #f + (lambda (db) + (sqlite3:fold-row + (lambda (res state status count) + (cons (list state status count) res)) + '() + db + "SELECT state,status,count FROM run_stats WHERE run_id=? AND run_id IN (SELECT id FROM runs WHERE state NOT IN ('DELETED','deleted'));" + run-id)))) (define (db:get-all-run-ids dbstruct) (db:with-db dbstruct #f @@ -3282,11 +3371,11 @@ ;; Tests meta data ;;====================================================================== ;; read the record given a testname (define (db:testmeta-get-record dbstruct testname) - (let ((res #f)) + (let ((res #f)) (db:with-db dbstruct #f #f (lambda (db) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -573,11 +573,11 @@ )) ;; for automated creation of the rollup html file this is a good place... (if (not (equal? item-path "")) (tests:summarize-items run-id test-id test-name #f)) (tests:summarize-test run-id test-id) ;; don't force - just update if no - ) + (rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id))) (mutex-unlock! m) (debug:print 2 "Output from running " fullrunscript ", pid " (launch:einf-pid exit-info) " in work area " work-area ":\n====\n exit code " (launch:einf-exit-code exit-info) "\n" "====\n") (if (not (launch:einf-exit-status exit-info)) (exit 4))))))) Index: multi-dboard.scm ================================================================== --- multi-dboard.scm +++ multi-dboard.scm @@ -254,18 +254,20 @@ ;; (define (areadb:populate-run-info areadat) (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 - (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';"))) + (if maindb + (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 + (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';"))) + (debug:print 0 "ERROR: no main.db found at " (areadb:dbfile-path areadat 0))) areadat)) ;; given an areadat and target/runname patt fill up runs data ;; ;; ?????/ @@ -483,11 +485,11 @@ (used-rows (hash-table-values rows)) (touched (make-hash-table)) ;; (vector row col) ==> true, touched cell (view-type (dboard:get-view-type keys current-path)) (changed #f) (state-statuses (list "PASS" "FAIL" "WARN" "CHECK" "SKIP" "RUNNING" "LAUNCHED"))) - (debug:print 0 "current-matrix=" current-matrix) + ;; (debug:print 0 "current-matrix=" current-matrix) (case view-type ((areas) ;; find row for this area, if not found, create new entry (let* ((curr-rownum (hash-table-ref/default rows area-name #f)) (next-rownum (+ (apply max (cons 0 used-rows)) 1)) (rownum (or curr-rownum next-rownum)) Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -522,10 +522,13 @@ (rmt:general-call 'update-pass-fail-counts run-id test-name test-name test-name)) (define (rmt:top-test-set-per-pf-counts run-id test-name) (rmt:send-receive 'top-test-set-per-pf-counts run-id (list run-id test-name))) +(define (rmt:get-raw-run-stats run-id) + (rmt:send-receive 'get-raw-run-stats run-id (list run-id))) + ;;====================================================================== ;; R U N S ;;====================================================================== (define (rmt:get-run-info run-id) @@ -542,10 +545,13 @@ (rmt:send-receive 'get-run-name-from-id run-id (list run-id))) (define (rmt:delete-run run-id) (rmt:send-receive 'delete-run run-id (list run-id))) +(define (rmt:update-run-stats run-id stats) + (rmt:send-receive 'update-run-stats #f (list run-id stats))) + (define (rmt:delete-old-deleted-test-records) (rmt:send-receive 'delete-old-deleted-test-records #f '())) (define (rmt:get-runs runpatt count offset keypatts) (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts))) @@ -574,10 +580,13 @@ (define (rmt:find-and-mark-incomplete run-id ovr-deadtime) (if (rmt:send-receive 'have-incompletes? run-id (list run-id ovr-deadtime)) (rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime)))) +(define (rmt:get-main-run-stats run-id) + (rmt:send-receive 'get-main-run-stats #f (list run-id))) + ;;====================================================================== ;; M U L T I R U N Q U E R I E S ;;====================================================================== ;; Need to move this to multi-run section and make associated changes Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -1665,11 +1665,12 @@ (loop new-test-dat tal) (loop (car tal)(append tal (list new-test-dat))))) (begin (runs:remove-test-directory new-test-dat mode) ;; 'remove-all) (if (not (null? tal)) - (loop (car tal)(cdr tal)))))))) + (loop (car tal)(cdr tal))))))) + (rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id))) ((set-state-status) (debug:print-info 2 "new state " (car state-status) ", new status " (cadr state-status)) (mt:test-set-state-status-by-id run-id (db:test-get-id test) (car state-status)(cadr state-status) #f) (if (not (null? tal)) (loop (car tal)(cdr tal)))) Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -468,15 +468,15 @@ (debug:print-info 1 "Waiting to update " outputfilename ", another test currently updating it") (thread-sleep! (+ 5 (random 5))) ;; delay between 5 and 10 seconds (loop (common:simple-file-lock lockf)))))))))) (define (tests:generate-html-summary-for-iterated-test run-id test-id test-name outputfilename) - (let ((counts (make-hash-table)) - (statecounts (make-hash-table)) - (outtxt "") - (tot 0) - (testdat (rmt:test-get-records-for-index-file run-id test-name))) + (let ((counts (make-hash-table)) + (statecounts (make-hash-table)) + (outtxt "") + (tot 0) + (testdat (rmt:test-get-records-for-index-file run-id test-name))) (with-output-to-file outputfilename (lambda () (set! outtxt (conc outtxt "Summary: " test-name "

Summary for " test-name "

")) (for-each @@ -529,10 +529,16 @@ (print "" "" outtxt "
ItemStateStatusComment
") ;; (release-dot-lock outputfilename) + ;;(rmt:update-run-stats + ;; run-id + ;; (hash-table-map + ;; state-status-counts + ;; (lambda (key val) + ;; (append key (list val))))) )))) ;; CHECK - WAS THIS ADDED OR REMOVED? MANUAL MERGE WITH API STUFF!!! ;; ;; get a pretty table to summarize steps