Megatest

			 "CONSTRAINT runsconstraint UNIQUE (runname" (if havekeys "," "") keystr "));"))
    (sqlite3:execute db (conc "CREATE INDEX runs_index ON runs (runname" (if havekeys "," "") keystr ");"))
    (sqlite3:execute db 
		     "CREATE TABLE IF NOT EXISTS tests 
                    (id INTEGER PRIMARY KEY,
                     run_id     INTEGER,
                     testname   TEXT,






                     item_path  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 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 '',
                                     author      TEXT DEFAULT '',
                                     owner       TEXT DEFAULT '',
                                     description TEXT DEFAULT '',
                                     reviewed    TIMESTAMP,
                                     iterated    TEXT DEFAULT '',
                                     avg_runtime REAL,
                                     avg_disk    REAL,
                                     tags        TEXT DEFAULT '',
                                     jobgroup    TEXT DEFAULT 'default',
                                CONSTRAINT test_meta_constraint UNIQUE (testname));")












    ;; Must do this *after* running patch db !! No more. 
    (db:set-var db "MEGATEST_VERSION" megatest-version)
    (debug:print-info 11 "db:initialize END")))


;;======================================================================
;; T E S T   S P E C I F I C   D B 
;;======================================================================

;; Create the sqlite db for the individual test(s)
(define (open-test-db work-area) 

(define (db:testdb-initialize db)
  (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,
              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 '',
              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 '',
              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,
              var TEXT,
              val TEXT,

	       (thekey  (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")))
	  (hash-table-set! *target* run-id thekey)
	  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))
  (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
			      (conc " state "  
				    (if not-in

;;======================================================================
;; 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)))