Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -176,43 +176,20 @@ (sqlite3:execute db "CREATE TABLE IF NOT EXISTS tests (id INTEGER PRIMARY KEY, run_id INTEGER, testname TEXT, - host TEXT DEFAULT 'n/a', - cpuload REAL DEFAULT -1, - diskfree INTEGER DEFAULT -1, - uname TEXT DEFAULT 'n/a', - rundir TEXT DEFAULT 'n/a', - shortdir TEXT DEFAULT '', item_path TEXT DEFAULT '', - state TEXT DEFAULT 'NOT_STARTED', - status TEXT DEFAULT 'FAIL', - attemptnum INTEGER DEFAULT 0, - final_logf TEXT DEFAULT 'logs/final.log', - logdat BLOB, - run_duration INTEGER DEFAULT 0, - comment TEXT DEFAULT '', + rundir_id INTEGER DEFAULT -1, + linkdir_id INTEGER DEFAULT -1, event_time TIMESTAMP, fail_count INTEGER DEFAULT 0, pass_count INTEGER DEFAULT 0, archived INTEGER DEFAULT 0, -- 0=no, 1=in progress, 2=yes CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path) );") (sqlite3:execute db "CREATE INDEX tests_index ON tests (run_id, testname, item_path);") - (sqlite3:execute db "CREATE VIEW runs_tests AS SELECT * FROM runs INNER JOIN tests ON runs.id=tests.run_id;") - (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', - event_time TIMESTAMP, - comment TEXT DEFAULT '', - logfile TEXT DEFAULT '', - CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));") - (sqlite3:execute db "CREATE TABLE IF NOT EXISTS extradat (id INTEGER PRIMARY KEY, run_id INTEGER, key TEXT, val TEXT);") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER PRIMARY KEY, var TEXT, val TEXT, 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);") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_meta (id INTEGER PRIMARY KEY, testname TEXT DEFAULT '', @@ -224,26 +201,13 @@ avg_runtime REAL, avg_disk REAL, tags TEXT DEFAULT '', jobgroup TEXT DEFAULT 'default', CONSTRAINT test_meta_constraint UNIQUE (testname));") - (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, - tol REAL, - units TEXT, - comment TEXT DEFAULT '', - status TEXT DEFAULT 'n/a', - type TEXT DEFAULT '', - CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));") ;; Must do this *after* running patch db !! No more. (db:set-var db "MEGATEST_VERSION" megatest-version) - (debug:print-info 11 "db:initialize END") - )) + (debug:print-info 11 "db:initialize END"))) ;;====================================================================== ;; T E S T S P E C I F I C D B ;;====================================================================== @@ -300,39 +264,62 @@ (debug:print 11 "db:testdb-initialize START") (for-each (lambda (sqlcmd) (sqlite3:execute db sqlcmd)) (list "CREATE TABLE IF NOT EXISTS test_rundat ( - id INTEGER PRIMARY KEY, - update_time TIMESTAMP, - cpuload INTEGER DEFAULT -1, - diskfree INTEGER DEFAULT -1, - diskusage INTGER DEFAULT -1, + id INTEGER PRIMARY KEY, + update_time TIMESTAMP, + cpuload INTEGER DEFAULT -1, + diskfree INTEGER DEFAULT -1, + diskusage INTGER DEFAULT -1, run_duration INTEGER DEFAULT 0);" "CREATE TABLE IF NOT EXISTS test_data ( - id INTEGER PRIMARY KEY, - test_id INTEGER, - category TEXT DEFAULT '', - variable TEXT, - value REAL, - expected REAL, - tol REAL, - units TEXT, - comment TEXT DEFAULT '', - status TEXT DEFAULT 'n/a', - type TEXT DEFAULT '', + id INTEGER PRIMARY KEY, + test_id INTEGER, + category TEXT DEFAULT '', + variable TEXT, + value REAL, + expected REAL, + tol REAL, + units TEXT, + comment TEXT DEFAULT '', + status TEXT DEFAULT 'n/a', + type TEXT DEFAULT '', CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));" "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', - event_time TIMESTAMP, - comment TEXT DEFAULT '', - logfile TEXT DEFAULT '', + id INTEGER PRIMARY KEY, + test_id INTEGER, + stepname TEXT, + state TEXT DEFAULT 'NOT_STARTED', + status TEXT DEFAULT 'n/a', + event_time TIMESTAMP, + comment TEXT DEFAULT '', + logfile TEXT DEFAULT '', CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));" + "CREATE TABLE IF NOT EXISTS test_megatest ( + id INTEGER PRIMARY KEY, + run_id INTEGER, + testname TEXT, + host TEXT DEFAULT 'n/a', + cpuload REAL DEFAULT -1, + diskfree INTEGER DEFAULT -1, + uname TEXT DEFAULT 'n/a', + rundir TEXT DEFAULT 'n/a', + shortdir TEXT DEFAULT '', + item_path TEXT DEFAULT '', + state TEXT DEFAULT 'NOT_STARTED', + status TEXT DEFAULT 'FAIL', + attemptnum INTEGER DEFAULT 0, + final_logf TEXT DEFAULT 'logs/final.log', + logdat BLOB, + run_duration INTEGER DEFAULT 0, + comment TEXT DEFAULT '', + event_time TIMESTAMP, + fail_count INTEGER DEFAULT 0, + pass_count INTEGER DEFAULT 0, + archived INTEGER DEFAULT 0, -- 0=no, 1=in progress, 2=yes + CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path));" ;; test_meta can be used for handing commands to the test ;; e.g. KILLREQ ;; the ackstate is set to 1 once the command has been completed "CREATE TABLE IF NOT EXISTS test_meta ( id INTEGER PRIMARY KEY, @@ -961,19 +948,39 @@ thekey)))) ;;====================================================================== ;; T E S T S ;;====================================================================== + +;; Get minimal list of tests data from central db +;; +;; fields are: id, run_id, testname, item_path, rundir_id, linkdir_id, event_time, fail_count, pass_count +;; +(define (db:get-central-test-data-for-run-id db run-id testpatt) + (let ((res '()) + (tests-match-qry (tests:match->sqlqry testpatt))) + (sqlite3:for-each-row + (lambda (a . b) + (set! res (cons (apply vector a b)) res)) + db + (conc + "SELECT id,run_id,testname,item_path,rundir_id,linkdir_id,event_time,fail_count,pass_count WHERE run_id=? " + (if tests-match-query (conc " AND " tests-match-qry) "") + ";")) + (reverse res))) + ;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN ;; i.e. these lists define what to NOT show. ;; states and statuses are required to be lists, empty is ok ;; not-in #t = above behaviour, #f = must match (define (db:get-tests-for-run db run-id testpatt states statuses offset limit not-in sort-by sort-order #!key - (qryvals #f) - ) + (qryvals #f)) + (let* ((tests (db:get-central-test-data-for-run-id db run-id testpatt)) + (res '())) + (let* ((qryvals (if qryvals qryvals "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment")) (res '()) ;; if states or statuses are null then assume match all when not-in is false (states-qry (if (null? states) #f ADDED testdb.scm Index: testdb.scm ================================================================== --- /dev/null +++ testdb.scm @@ -0,0 +1,142 @@ +;;====================================================================== +;; Copyright 2006-2013, Matthew Welland. +;; +;; This program is made available under the GNU GPL version 2.0 or +;; greater. See the accompanying file COPYING for details. +;; +;; This program is distributed WITHOUT ANY WARRANTY; without even the +;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +;; PURPOSE. +;;====================================================================== + +;;====================================================================== +;; Test Database access +;;====================================================================== + +(require-extension (srfi 18) extras) + +(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64) +(import (prefix sqlite3 sqlite3:)) +(import (prefix base64 base64:)) + +;; Note, try to remove this dependency +;; (use zmq) + +(declare (unit testdb)) +(declare (uses common)) +(declare (uses keys)) +(declare (uses ods)) +(declare (uses fs-transport)) +(declare (uses client)) +(declare (uses mt)) + +(include "common_records.scm") +(include "db_records.scm") +(include "key_records.scm") +(include "run_records.scm") + +;;====================================================================== +;; Functions to access test db files with some caching of handles +;;====================================================================== + +(define (db:get-db dbstruct run-id) + (let ((db (if run-id + (hash-table-ref/default (vector-ref dbstruct 1) run-id #f) + (vector-ref dbstruct 0)))) + (if db + db + (let ((db (open-db run-id))) + (if run-id + (hash-table-set! (vector-ref dbstruct 1) run-id db) + (vector-set! dbstruct 0 db)) + db)))) + +;;====================================================================== +;; K E E P F I L E D B I N dbstruct +;;====================================================================== + +(define (db:get-filedb dbstruct) + (let ((db (vector-ref dbstruct 2))) + (if db + db + (let ((fdb (filedb:open-db (conc *toplevel* "/db/files.db")))) + (vector-set! dbstruct 2 fdb) + fdb)))) + +;; Can also be used to save arbitrary strings +;; +(define (db:save-path dbstruct path) + (let ((fdb (db:get-filedb dbstruct))) + (filedb:register-path fdb path))) + +;; Use to get a path. To get an arbitrary string see next define +;; +(define (db:get-path dbstruct id) + (let ((fdb (db:get-filedb dbstruct))) + (filedb:get-path db id))) + +;;====================================================================== +;; +;; U S E F I L E D B T O S T O R E S T R I N G S +;; +;; N O T E ! ! T H I S C L O B B E R S M U L T I P L E //// T O / +;; +;; Replace with something proper! +;; +;;====================================================================== + +;; Use to save a stored string, pad with _ to deal with trimming the prepending of / +;; +(define (db:save-string dbstruct str) + (let ((fdb (db:get-filedb dbstruct))) + (filedb:register-path fdb (conc "_" str)))) + +;; Use to get a stored string +;; +(define (db:get-string dbstruct id) + (let ((fdb (db:get-filedb dbstruct))) + (string-drop (filedb:get-path fdb id) 2))) + +;; This routine creates the db. It is only called if the db is not already opened +;; +(define (open-db dbstruct test-id) ;; (conc *toppath* "/megatest.db") (car *configinfo*))) + (if (not *toppath*) + (if (not (setup-for-run)) + (begin + (debug:print 0 "ERROR: Attempted to open db when not in megatest area. Exiting.") + (exit)))) + + +REWORKING open-db + + + (let* ((test-rec (db:test-id->record test-id)) + (dbpath (conc (db:test-get-test-path test-rec) "/testdat.db")) + + + (dbexists (file-exists? dbpath)) + (write-access (file-write-access? dbpath)) + (db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath)) + (handler (make-busy-timeout (if (args:get-arg "-override-timeout") + (string->number (args:get-arg "-override-timeout")) + 136000)))) ;; 136000))) ;; 136000 = 2.2 minutes + (if (and dbexists + (not write-access)) + (set! *db-write-access* write-access)) ;; only unset so other db's also can use this control + (debug:print-info 11 "open-db, dbpath=" dbpath " argv=" (argv)) + (sqlite3:set-busy-handler! db handler) + (if (not dbexists) + (if (not run-id) ;; do the megatest.db + (db:initialize-megatest-db db) + (db:initialize-run-id-db db run-id))) + (sqlite3:execute db "PRAGMA synchronous = 0;") + db)) + +;; close all opened run-id dbs +(define (db:close-all-db) + (for-each + (lambda (db) + (finalize! db)) + (hash-table-values (vector-ref *open-dbs* 1))) + (finalize! (vector-ref *open-dbs* 0))) +