Index: cgisetup/models/pgdb.scm ================================================================== --- cgisetup/models/pgdb.scm +++ cgisetup/models/pgdb.scm @@ -167,11 +167,11 @@ "SELECT t.id,t.run_id,t.test_name,t.item_path,t.state,t.status,t.host,t.cpuload,t.diskfree,t.uname,t.rundir,t.final_logf,t.run_duration,t.comment,t.event_time,t.archived, r.id,r.target,r.ttype_id,r.run_name,r.state,r.status,r.owner,r.event_time,r.comment FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id WHERE r.target LIKE ?;" target-patt)) -(define (pgdb:get-stats-given-target dbh ttype-id target-patt) +(define (pgdb:get-stats-given-type-target dbh ttype-id target-patt) (dbi:get-rows dbh ;; "SELECT COUNT(t.id),t.status,r.target FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id ;; WHERE t.state='COMPLETED' AND ttype_id=? AND r.target LIKE ? GROUP BY r.target,t.status;" "SELECT r.target,COUNT(*) AS total, @@ -179,10 +179,23 @@ SUM(CASE WHEN t.status='FAIL' THEN 1 ELSE 0 END) AS fail, SUM(CASE WHEN t.status IN ('PASS','FAIL') THEN 0 ELSE 1 END) AS other FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id WHERE t.state='COMPLETED' AND ttype_id=? AND r.target LIKE ? GROUP BY r.target;" ttype-id target-patt)) + +(define (pgdb:get-stats-given-target dbh target-patt) + (dbi:get-rows + dbh + ;; "SELECT COUNT(t.id),t.status,r.target FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id + ;; WHERE t.state='COMPLETED' AND ttype_id=? AND r.target LIKE ? GROUP BY r.target,t.status;" + "SELECT r.target,COUNT(*) AS total, + SUM(CASE WHEN t.status='PASS' THEN 1 ELSE 0 END) AS pass, + SUM(CASE WHEN t.status='FAIL' THEN 1 ELSE 0 END) AS fail, + SUM(CASE WHEN t.status IN ('PASS','FAIL') THEN 0 ELSE 1 END) AS other + FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id + WHERE t.state='COMPLETED' AND r.target LIKE ? GROUP BY r.target;" + target-patt)) (define (pgdb:get-target-types dbh) (dbi:get-rows dbh "SELECT id,target_spec FROM ttype;")) ;; Index: cgisetup/pages/home_view.scm ================================================================== --- cgisetup/pages/home_view.scm +++ cgisetup/pages/home_view.scm @@ -10,11 +10,11 @@ ;;====================================================================== (define (pages:home session db shared) (let* ((dbh (s:db)) (ttypes (pgdb:get-target-types dbh)) - (selected (string->number (or (s:get "target-type") "0"))) + (selected (string->number (or (s:get "target-type") "-1"))) (curr-trec (filter (lambda (x)(eq? selected (vector-ref x 0))) ttypes)) (curr-ttype (if (and selected (not (null? curr-trec))) (vector-ref (car curr-trec) 1) #f)) (all-parts (if curr-ttype (append (string-split curr-ttype "/") '("runname" "testname")) '())) @@ -21,29 +21,34 @@ (tfilter (or (s:get "target-filter") "%")) (targets (pgdb:get-targets-of-type dbh selected tfilter)) ;; (target (s:session-var-get "target")) ;; (target-patt (or target "%")) (row-or-col (string-split (or (s:get "row-or-col") "") ",")) - (all-data (if selected (pgdb:get-stats-given-target dbh selected tfilter) - '())) + (all-data (if (and selected + (not (eq? selected -1))) + (pgdb:get-stats-given-type-target dbh selected tfilter) + (pgdb:get-stats-given-target dbh tfilter) + )) ;; (all-data (pgdb:get-tests dbh tfilter)) (ordered-data (pgdb:coalesce-runs dbh all-data all-parts row-or-col 0))) (s:div 'class "col_12" (s:fieldset "Area type and target filter" (s:form - 'action "home.filter" 'method "get" + 'action "home.filter" 'method "post" (s:div 'class "col_12" (s:div 'class "col_6" (s:select (map (lambda (x) - (let ((tt-id (vector-ref x 0)) - (ttype (vector-ref x 1))) - (if (eq? tt-id selected) - (list ttype tt-id ttype #t) - (list ttype tt-id ttype #f)))) - ttypes) + (if x + (let ((tt-id (vector-ref x 0)) + (ttype (vector-ref x 1))) + (if (eq? tt-id selected) + (list ttype tt-id ttype #t) + (list ttype tt-id ttype #f))) + (list "all" -1 "all" (eq? selected -1)))) + (cons #f ttypes)) 'name 'target-type)) (s:div 'class "col_4" (s:input-preserve 'name "tfilter" 'placeholder "Filter targets")) (s:div 'class "col_2" (s:input 'type "submit" 'name "set-filter-vals" 'value "Submit"))) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -299,16 +299,16 @@ (if (stack? tmpdb-stack) (db:get-db tmpdb-stack) ;; get previously opened db (will create new db handle if all in the stack are already used (let* ((dbpath (db:dbfile-path )) ;; path to tmp db area (dbexists (file-exists? dbpath)) (tmpdbfname (conc dbpath "/megatest.db")) - (dbfexists (file-exists? tmpdbfname)) ;; (conc dbpath "/megatest.db"))) - (tmpdb (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db)) + (dbfexists (file-exists? tmpdbfname)) ;; (conc dbpath "/megatest.db"))) (mtdbexists (file-exists? (conc *toppath* "/megatest.db"))) + (mtdb (db:open-megatest-db)) (mtdbpath (db:dbdat-get-path mtdb)) - + (tmpdb (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db)) (refndb (db:open-megatest-db path: dbpath name: "megatest_ref.db")) (write-access (file-write-access? mtdbpath)) (mtdbmodtime (if mtdbexists (common:lazy-sqlite-db-modification-time mtdbpath) #f)) (tmpdbmodtime (if dbfexists (common:lazy-sqlite-db-modification-time tmpdbfname) #f)) (modtimedelta (and mtdbmodtime tmpdbmodtime (- mtdbmodtime tmpdbmodtime)))) @@ -370,11 +370,12 @@ (dbpath (conc dbdir "/" (or name "megatest.db"))) (dbexists (file-exists? dbpath)) (db (db:lock-create-open dbpath (lambda (db) (db:initialize-main-db db) - (db:initialize-run-id-db db)))) + ;;(db:initialize-run-id-db db) + ))) (write-access (file-write-access? dbpath))) (debug:print-info 13 *default-log-port* "db:open-megatest-db "dbpath) (if (and dbexists (not write-access)) (set! *db-write-access* #f)) (cons db dbpath))) @@ -1200,21 +1201,21 @@ CONSTRAINT metadat_constraint UNIQUE (var));") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS access_log (id INTEGER PRIMARY KEY, user TEXT, accessed TIMESTAMP, args TEXT);") ;; Must do this *after* running patch db !! No more. ;; cannot use db:set-var since it will deadlock, hardwire the code here (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" "MEGATEST_VERSION" (common:version-signature)) - (debug:print-info 11 *default-log-port* "db:initialize END"))))) - -;;====================================================================== -;; R U N S P E C I F I C D B -;;====================================================================== - -(define (db:initialize-run-id-db db) - (sqlite3:with-transaction - db - (lambda () - (sqlite3:execute db "CREATE TABLE IF NOT EXISTS tests + (debug:print-info 11 *default-log-port* "db:initialize END") ;; )))) + + ;;====================================================================== + ;; R U N S P E C I F I C D B + ;;====================================================================== + + ;; (define (db:initialize-run-id-db db) + ;; (sqlite3:with-transaction + ;; db + ;; (lambda () + (sqlite3:execute db "CREATE TABLE IF NOT EXISTS tests (id INTEGER PRIMARY KEY, run_id INTEGER DEFAULT -1, testname TEXT DEFAULT 'noname', host TEXT DEFAULT 'n/a', cpuload REAL DEFAULT -1, @@ -1234,18 +1235,18 @@ fail_count INTEGER DEFAULT 0, 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, uname);") - (sqlite3:execute db "CREATE TRIGGER IF NOT EXISTS update_tests_trigger AFTER UPDATE ON tests + (sqlite3:execute db "CREATE INDEX IF NOT EXISTS tests_index ON tests (run_id, testname, item_path, uname);") + (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;") - (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_steps + (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_steps (id INTEGER PRIMARY KEY, test_id INTEGER, stepname TEXT, state TEXT DEFAULT 'NOT_STARTED', status TEXT DEFAULT 'n/a', @@ -1252,18 +1253,18 @@ event_time TIMESTAMP, comment TEXT DEFAULT '', logfile TEXT DEFAULT '', last_update INTEGER DEFAULT (strftime('%s','now')), CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));") - (sqlite3:execute db "CREATE INDEX IF NOT EXISTS teststeps_index ON tests (run_id, testname, item_path);") - (sqlite3:execute db "CREATE TRIGGER IF NOT EXISTS update_teststeps_trigger AFTER UPDATE ON test_steps + (sqlite3:execute db "CREATE INDEX IF NOT EXISTS teststeps_index ON tests (run_id, testname, item_path);") + (sqlite3:execute db "CREATE TRIGGER IF NOT EXISTS update_teststeps_trigger AFTER UPDATE ON test_steps FOR EACH ROW BEGIN UPDATE test_steps SET last_update=(strftime('%s','now')) WHERE id=old.id; END;") - (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data (id INTEGER PRIMARY KEY, + (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data (id INTEGER PRIMARY KEY, test_id INTEGER, category TEXT DEFAULT '', variable TEXT, value REAL, expected REAL, @@ -1272,34 +1273,34 @@ comment TEXT DEFAULT '', status TEXT DEFAULT 'n/a', type TEXT DEFAULT '', last_update INTEGER DEFAULT (strftime('%s','now')), CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));") - (sqlite3:execute db "CREATE INDEX IF NOT EXISTS test_data_index ON test_data (test_id);") - (sqlite3:execute db "CREATE TRIGGER IF NOT EXISTS update_test_data_trigger AFTER UPDATE ON test_data + (sqlite3:execute db "CREATE INDEX IF NOT EXISTS test_data_index ON test_data (test_id);") + (sqlite3:execute db "CREATE TRIGGER IF NOT EXISTS update_test_data_trigger AFTER UPDATE ON test_data FOR EACH ROW BEGIN UPDATE test_data SET last_update=(strftime('%s','now')) WHERE id=old.id; END;") - (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_rundat ( + (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_rundat ( id INTEGER PRIMARY KEY, test_id INTEGER, update_time TIMESTAMP, cpuload INTEGER DEFAULT -1, diskfree INTEGER DEFAULT -1, diskusage INTGER DEFAULT -1, run_duration INTEGER DEFAULT 0);") - (sqlite3:execute db "CREATE TABLE IF NOT EXISTS archives ( + (sqlite3:execute db "CREATE TABLE IF NOT EXISTS archives ( id INTEGER PRIMARY KEY, test_id INTEGER, state TEXT DEFAULT 'new', status TEXT DEFAULT 'n/a', archive_type TEXT DEFAULT 'bup', du INTEGER, archive_path TEXT);"))) - db) + db)) ;;====================================================================== ;; A R C H I V E S ;;====================================================================== Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -806,12 +806,14 @@ *toppath*) (let ((res (launch:setup-body force: force areapath: areapath))) (mutex-unlock! *launch-setup-mutex*) res))) -(define (launch:setup-body #!key (force #f) (areapath #f)) - (if (and (eq? *configstatus* 'fulldata) *toppath*) ;; no need to reprocess +(define (launch:setup-body #!key (force-reread #f) (areapath #f)) + (if (and (eq? *configstatus* 'fulldata) + *toppath* + (not force-reread)) ;; no need to reprocess *toppath* ;; return toppath (let* ((use-cache (common:use-cache?)) (toppath (or *toppath* areapath (getenv "MT_RUN_AREA_HOME"))) ;; preserve toppath (runname (common:args-get-runname)) (target (common:args-get-target))