Megatest

;;  PURPOSE.
;;======================================================================

;;======================================================================
;; Database access
;;======================================================================

(require-extension (srfi 18) extras tcp) ;;  rpc)
(require-extension (srfi 18) extras tcp)
;; (import (prefix rpc rpc:))

(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64 format dot-locking z3)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))

;; Note, try to remove this dependency 
;; (use zmq)

(declare (unit db))
(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")

(define *rundb-mutex* (make-mutex)) ;; prevent problems opening/closing rundb's
(define *number-of-writes* 0)
(define *number-non-write-queries* 0)
;; timestamp type (val1 val2 ...)
;; type: meta-info, step
(define *incoming-writes*      '())
(define *completed-writes*   (make-hash-table))
(define *incoming-last-time* (current-seconds))
(define *incoming-mutex*     (make-mutex))
(define *completed-mutex*    (make-mutex))
(define *cache-on* #f)

;;======================================================================
;; SQLITE3 HELPERS
;;======================================================================

;; convert to -inline
(define (db:first-result-default db stmt default . params)
  (handle-exceptions
   exn
   (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
     ;; check for (exn sqlite3) ((condition-property-accessor 'exn 'message) exn)
     (if (eq? err-status 'done)
	 default
	 (begin
	   (debug:print 0 "ERROR:  query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message) exn))
	   (print-call-chain (current-error-port))
	   default)))
   (apply sqlite3:first-result db stmt params)))

;; Get/open a database
;;    if run-id => get run specific db
;;    if #f     => get main db
;;    if db already open - return inmem
;;    if db not open, open inmem, rundb and sync then return inmem
;;    inuse gets set automatically for rundb's
;;
(define (db:get-db dbstruct run-id)
  (if (sqlite3:database? dbstruct) ;; pass sqlite3 databases on through
      dbstruct
      (begin
	(let ((dbdat (if (or (not run-id)
			     (eq? run-id 0))
			 (db:open-main dbstruct)
			 (db:open-rundb dbstruct run-id)
			 )))
	  dbdat))))

(define (db:dbdat-get-db dbdat)
  (if (pair? dbdat)
      (car dbdat)
      dbdat))

(define (db:dbdat-get-path dbdat)
  (if (pair? dbdat)
      (cdr dbdat)
      #f))

;; mod-read:
;;     'mod   modified data
;;     'read  read data
;;
(define (db:done-with dbstruct run-id mod-read)
  (if (not (sqlite3:database? dbstruct))
      (begin
	(mutex-lock! *rundb-mutex*)
	(if (eq? mod-read 'mod)
	    (dbr:dbstruct-set-mtime! dbstruct (current-milliseconds))
	    (dbr:dbstruct-set-rtime! dbstruct (current-milliseconds)))
	(dbr:dbstruct-set-inuse! dbstruct #f)
	(mutex-unlock! *rundb-mutex*))))

;; (db:with-db dbstruct run-id sqlite3:exec "select blah from blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
  (let* ((dbdat (if (vector? dbstruct)
		    (db:get-db dbstruct run-id)
		    dbstruct)) ;; cheat, allow for passing in a dbdat
	 (db    (db:dbdat-get-db dbdat)))
    (db:delay-if-busy dbdat)
    (handle-exceptions
     exn
     (begin
       (debug:print 0 "ERROR: sqlite3 issue in db:with-db, dbstruct=" dbstruct ", run-id=" run-id ", proc=" proc ", params=" params " error: " ((condition-property-accessor 'exn 'message) exn))
       (print-call-chain (current-error-port)))
     (let ((res (apply proc db params)))
       (if (vector? dbstruct)(db:done-with dbstruct run-id r/w))
       res))))

;;======================================================================
;; K E E P   F I L E D B   I N   dbstruct
;;======================================================================

;; (define (db:get-filedb dbstruct run-id)
;;   (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)))b
;;     (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)))

;; NB// #f => return dbdir only
;;      (was planned to be;  zeroth db with name=main.db)
;;
(define (db:dbfile-path run-id)
  (let* ((dbdir           (or (configf:lookup *configdat* "setup" "dbdir")
			      (conc (configf:lookup *configdat* "setup" "linktree") "/.db")))
	 (fname           (if run-id
			      (if (eq? run-id 0) "main.db" (conc run-id ".db"))
			      #f)))
    (handle-exceptions
     exn
     (begin
       (debug:print 0 "ERROR: Couldn't create path to " dbdir)
       (exit 1))
     (if (not (directory? dbdir))(create-directory dbdir #t)))
    (if fname
	(conc dbdir "/" fname)
	dbdir)))
	       
(define (db:set-sync db)
  (let* ((syncval  (config-lookup *configdat* "setup"     "synchronous"))
	 (val      (cond   ;; 0 | OFF | 1 | NORMAL | 2 | FULL;
		    ((not syncval) #f)
		    ((string->number syncval)
		     (let ((val (string->number syncval)))
		       (if (member val '(0 1 2)) val #f)))
  (let ((syncprag (configf:lookup *configdat* "setup" "sychronous")))
    (sqlite3:execute db (conc "PRAGMA synchronous = " (or syncprag 1) ";"))))

;; open an sql database inside a file lock
;;
;; returns: db existed-prior-to-opening
;;
(define (db:lock-create-open fname initproc)
  (if (file-exists? fname)
      (let ((db (sqlite3:open-database fname)))
	(sqlite3:set-busy-handler! db (make-busy-timeout 136000))
	(db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = 0;")
	db)
      (let* ((parent-dir   (pathname-directory fname))
	     (dir-writable (file-write-access? parent-dir)))
	(if dir-writable
	    (let ((exists  (file-exists? fname))
		  (lock    (obtain-dot-lock fname 1 5 10))
		  (db      (sqlite3:open-database fname)))
	      (sqlite3:set-busy-handler! db (make-busy-timeout 136000))
	      (db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = 0;")
	      (if (not exists)(initproc db))
		    ((string-match (regexp "yes" #t) syncval) 1)
		    ((string-match (regexp "no"  #t) syncval) 0)
		    ((string-match (regexp "(off|normal|full)" #t) syncval) syncval)
		    (else 
		     (debug:print 0 "ERROR: synchronous must be 0,1,2,OFF,NORMAL or FULL, you provided: " syncval)
		     #f))))
    (if val
	      (release-dot-lock fname)
	      db)
	    (begin
	      (debug:print 0 "ERROR: no such db in non-writable dir " fname)
	      (sqlite3:open-database fname))))))

;; This routine creates the db. It is only called if the db is not already opened
;; 
(define (db:open-rundb dbstruct run-id #!key (attemptnum 0)(do-not-open #f)) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let* ((local  (dbr:dbstruct-get-local dbstruct))
	 (rdb    (if local
		     (dbr:dbstruct-get-localdb dbstruct run-id)
		     (dbr:dbstruct-get-inmem dbstruct)))) ;; (dbr:dbstruct-get-runrec dbstruct run-id 'inmem)))
    (if (or rdb
	    do-not-open)
	rdb
	(begin
	  (mutex-lock! *rundb-mutex*)
	  (let* ((dbpath       (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
		 (dbexists     (file-exists? dbpath))
		 (inmem        (if local #f (db:open-inmem-db)))
		 (refdb        (if local #f (db:open-inmem-db)))
		 (db           (db:lock-create-open dbpath ;; this is the database physically on disk
						    (lambda (db)
						      (handle-exceptions
						       exn
						       (begin
							 (release-dot-lock dbpath)
							 (if (> attemptnum 2)
	  (debug:print-info 9 "db:set-sync, setting pragma synchronous to " val)
	  (sqlite3:execute db (conc "PRAGMA synchronous = '" val "';"))))))

(define (open-db) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (if (not *toppath*)
							     (debug:print 0 "ERROR: tried twice, cannot create/initialize db for run-id " run-id ", at path " dbpath)
							     (db:open-rundb dbstruct run-id attemptnum (+ attemptnum 1))))
						       (db:initialize-run-id-db db)
						       (sqlite3:execute 
							db
							"INSERT OR IGNORE INTO tests (id,run_id,testname,event_time,item_path,state,status) VALUES (?,?,'bogustest',strftime('%s','now'),'nowherepath','DELETED','n/a');"
							(* run-id 30000) ;; allow for up to 30k tests per run
							run-id)
						       ;; do a dummy query to test that the table exists and the db is truly readable
						       (sqlite3:execute db "SELECT * FROM tests WHERE id=?;" (* run-id 30000))
						       )))) ;; add strings db to rundb, not in use yet
		 ;;   )) ;; (sqlite3:open-database dbpath))
		 (olddb        (if *megatest-db*
				   *megatest-db* 
				   (let ((db (db:open-megatest-db)))
				     (set! *megatest-db* db)
				     db)))
		 (write-access (file-write-access? dbpath))
		 ;; (handler      (make-busy-timeout 136000))
		 )
	    (if (and dbexists (not write-access))
		(set! *db-write-access* #f)) ;; only unset so other db's also can use this control
	    (dbr:dbstruct-set-rundb!  dbstruct (cons db dbpath))
	    (dbr:dbstruct-set-inuse!  dbstruct #t)
	    (dbr:dbstruct-set-olddb!  dbstruct olddb)
	    ;; (dbr:dbstruct-set-run-id! dbstruct run-id)
	    (mutex-unlock! *rundb-mutex*)
	    (if local
		(begin
		  (dbr:dbstruct-set-localdb! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! dbstruct db) ;; direct access ...
		  db)
		(begin
		  (dbr:dbstruct-set-inmem!  dbstruct inmem)
		  ;; dec 14, 2014 - keep deleted records available. hunch is that they are needed for id placeholders
		  ;; (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED';") ;; they just slow us down in this context
		  (db:sync-tables db:sync-tests-only db inmem)
		  (db:delay-if-busy refdb) ;; dbpath: (db:dbdat-get-path refdb)) ;; What does delaying here achieve? 
		  (dbr:dbstruct-set-refdb!  dbstruct refdb)
		  (db:sync-tables db:sync-tests-only inmem refdb) ;; use inmem as the reference, don't read again from db
		  ;; sync once more to deal with delays?
		  ;; (db:sync-tables db:sync-tests-only db inmem)
		  ;; (db:sync-tables db:sync-tests-only inmem refdb)
		  inmem)))))))

;; This routine creates the db. It is only called if the db is not already ls opened
;;
(define (db:open-main dbstruct) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let ((mdb (dbr:dbstruct-get-main dbstruct)))
    (if mdb
      (if (not (launch:setup-for-run))
	  (begin
	    (debug:print 0 "ERROR: Attempted to open db when not in megatest area. Exiting.")
	    (exit))))
  (let* ((dbpath       (conc *toppath* "/megatest.db")) ;; fname)
	mdb
	(begin
	  (mutex-lock! *rundb-mutex*)
	  (let* ((dbpath       (db:dbfile-path 0))
		 (dbexists     (file-exists? dbpath))
		 (db           (db:lock-create-open dbpath db:initialize-main-db))
		 (olddb        (db:open-megatest-db))
		 (write-access (file-write-access? dbpath))
		 (dbdat        (cons db dbpath)))
	    (if (and dbexists (not write-access))
		(set! *db-write-access* #f))
	    (dbr:dbstruct-set-main!   dbstruct dbdat)
	    (dbr:dbstruct-set-olddb!  dbstruct olddb) ;; olddb is already a (cons db path)
	    (mutex-unlock! *rundb-mutex*)
	    (if (and (not dbexists)
		     *db-write-access*) ;; did not have a prior db and do have write access
		(db:multi-db-sync #f 'old2new))  ;; migrate data from megatest.db automatically
	    dbdat)))))

;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
(define (db:setup run-id #!key (local #f))
  (let* ((dbdir    (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
	 (dbstruct (make-dbr:dbstruct path: dbdir local: local)))
    dbstruct))

;; Open the classic megatest.db file in toppath
;;
(define (db:open-megatest-db)
  (let* ((dbpath       (conc *toppath* "/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))))
	 (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"))
					      6000)))) ;; NB// this is in milliseconds. 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))
    (if write-access (sqlite3:set-busy-handler! db handler))
    (if (not dbexists)
	(db:initialize db))
    ;; Moving db:set-sync to a call in run.scm - it is a persistent value and only needs to be set once
    ;; (db:set-sync db)
    (sqlite3:execute db "PRAGMA synchronous = 0;")
    db))
	 (write-access (file-write-access? dbpath)))
    (if (and dbexists (not write-access))
	(set! *db-write-access* #f))
    (cons db dbpath)))

;; sync run to disk if touched
;;
(define (db:sync-touched dbstruct run-id #!key (force-sync #f))
  (let ((mtime  (dbr:dbstruct-get-mtime dbstruct))
	(stime  (dbr:dbstruct-get-stime dbstruct))
	(rundb  (dbr:dbstruct-get-rundb dbstruct))
	(inmem  (dbr:dbstruct-get-inmem dbstruct))
	(maindb (dbr:dbstruct-get-main  dbstruct))
	(refdb  (dbr:dbstruct-get-refdb dbstruct))
	(olddb  (dbr:dbstruct-get-olddb dbstruct))
	;; (runid  (dbr:dbstruct-get-run-id dbstruct))
	)
    (debug:print-info 4 "Syncing for run-id: " run-id)
    ;; (mutex-lock! *http-mutex*)
    (if (eq? run-id 0)
	;; runid equal to 0 is main.db
	(if maindb
	    (if (or (not (number? mtime))
		    (not (number? stime))
		    (> mtime stime)
		    force-sync)
		(begin
		  (db:delay-if-busy maindb)
		  (db:delay-if-busy olddb)
		  (let ((num-synced (db:sync-tables (db:sync-main-list maindb) maindb olddb)))
		    (dbr:dbstruct-set-stime! dbstruct (current-milliseconds))
		    num-synced)
		  0))
	    (begin
	      ;; this can occur when using local access (i.e. not in a server)
	      ;; need a flag to turn it off.
	      ;;
	      (debug:print 3 "WARNING: call to sync main.db to megatest.db but main not initialized")
	      0))
	;; any other runid is a run
	(if (or (not (number? mtime))
		(not (number? stime))
		(> mtime stime)
		force-sync)
	    (begin
	      (db:delay-if-busy rundb)
	      (db:delay-if-busy olddb)
	      (dbr:dbstruct-set-stime! dbstruct (current-milliseconds))
	      (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb olddb)))
		;; (mutex-unlock! *http-mutex*)
		num-synced)
	      (begin
		;; (mutex-unlock! *http-mutex*)
		0))))))

(define (db:close-main dbstruct)
  (let ((maindb (dbr:dbstruct-get-main dbstruct)))
    (if maindb
	(begin
	  (sqlite3:finalize! (db:dbdat-get-db maindb))
	  (dbr:dbstruct-set-main! dbstruct #f)))))

(define (db:close-run-db dbstruct run-id)
  (let ((rdb (db:open-rundb dbstruct run-id do-not-open: #t)))
    (if (and rdb
	     (sqlite3:database? rdb))
	(begin
	  (sqlite3:finalize! rdb)
	  (dbr:dbstruct-set-localdb! dbstruct run-id #f)
	  (dbr:dbstruct-set-inmem! dbstruct #f)))))

;; close all opened run-id dbs
(define (db:close-all dbstruct)
  ;; finalize main.db
  (db:sync-touched dbstruct 0 force-sync: #t)
  ;;(common:db-block-further-queries)
  ;; (mutex-lock! *db-sync-mutex*) ;; with this perhaps it isn't necessary to use the block-further-queries mechanism?

  (db:close-main dbstruct)
  
  (let ((locdbs (dbr:dbstruct-get-locdbs dbstruct)))
    (if (hash-table? locdbs)
	(for-each (lambda (run-id)
		    (db:close-run-db dbstruct run-id))
		  (hash-table-keys locdbs))))

  ;; (let* ((local (dbr:dbstruct-get-local dbstruct))
  ;;        (rundb (db:dbdat-get-db (dbr:dbstruct-get-rundb dbstruct))))
  ;;   (if local
  ;;       (for-each
  ;;        (lambda (dbdat)
  ;;          (let ((db (db:dbdat-get-db dbdat)))
  ;;            (if (sqlite3:database? db)
  ;;       	 (begin
  ;;       	   (sqlite3:interrupt! db)
  ;;       	   (sqlite3:finalize! db #t)))))
  ;;        ;; TODO: Come back to this and rework to delete from hashtable when finalized
  ;;        (hash-table-values (dbr:dbstruct-get-locdbs dbstruct))))
  ;;   (thread-sleep! 3)
  ;;   (if (and rundb
  ;;            (sqlite3:database? rundb))
  ;;       (handle-exceptions
  ;;        exn
  ;;        (begin 
  ;;          (debug:print 0 "WARNING: database files may not have been closed correctly. Consider running -cleanup-db")
  ;;          (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
  ;;          (debug:print 0 " db: " rundb)
  ;;          (print-call-chain (current-error-port))
  ;;          #f)
  ;;        (sqlite3:interrupt! rundb)
  ;;        (sqlite3:finalize! rundb #t))))
  ;; ;; (mutex-unlock! *db-sync-mutex*)
  )

(define (db:open-inmem-db)
  (let* ((db      (sqlite3:open-database ":memory:"))
	 (handler (make-busy-timeout 3600)))
    (sqlite3:set-busy-handler! db handler)
    (db:initialize-run-id-db db)
    (cons db #f)))

;; just tests, test_steps and test_data tables
(define db:sync-tests-only
  (list
   ;; (list "strs"
   ;;       '("id"             #f)
   ;;       '("str"            #f))
   (list "tests" 
	 '("id"             #f)
	 '("run_id"         #f)
	 '("testname"       #f)
	 '("host"           #f)
	 '("cpuload"        #f)
	 '("diskfree"       #f)
	 '("uname"          #f)
	 '("rundir"         #f)
	 '("shortdir"       #f)
	 '("item_path"      #f)
	 '("state"          #f)
	 '("status"         #f)
	 '("attemptnum"     #f)
	 '("final_logf"     #f)
	 '("logdat"         #f)
	 '("run_duration"   #f)
	 '("comment"        #f)
	 '("event_time"     #f)
	 '("fail_count"     #f)
	 '("pass_count"     #f)
	 '("archived"       #f))
  (list "test_steps"
	 '("id"             #f)
	 '("test_id"        #f)
	 '("stepname"       #f)
	 '("state"          #f)
	 '("status"         #f)
	 '("event_time"     #f)
	 '("comment"        #f)
	 '("logfile"        #f))
   (list "test_data"
	 '("id"             #f)
	 '("test_id"        #f)
	 '("category"       #f)
	 '("variable"       #f)
	 '("value"          #f)
	 '("expected"       #f)
	 '("tol"            #f)
	 '("units"          #f)
	 '("comment"        #f)
	 '("status"         #f)
	 '("type"           #f))))

;; needs db to get keys, this is for syncing all tables
;;
(define (db:sync-main-list db)
  (let ((keys  (db:get-keys db)))
    (list
     (list "keys"
	   '("id"        #f)
	   '("fieldname" #f)
	   '("fieldtype" #f))
     (list "metadat" '("var" #f) '("val" #f))
     (append (list "runs" 
		   '("id"  #f))
	     (map (lambda (k)(list k #f))
		  (append keys
			  (list "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count"))))
     (list "test_meta"
	   '("id"             #f)
	   '("testname"       #f)
	   '("owner"          #f)
	   '("description"    #f)
	   '("reviewed"       #f)
	   '("iterated"       #f)
	   '("avg_runtime"    #f)
	   '("avg_disk"       #f)
	   '("tags"           #f)
	   '("jobgroup"       #f)))))
    
;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) )
;; db's are dbdat's
;;
(define (db:sync-tables tbls fromdb todb . slave-dbs)
  (mutex-lock! *db-sync-mutex*)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.")
     (print-call-chain (current-error-port))
     (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
     (print "exn=" (condition->list exn))
     (debug:print 0 " status:  " ((condition-property-accessor 'sqlite3 'status) exn))
     (debug:print 0 " src db:  " (db:dbdat-get-path fromdb))
     (for-each (lambda (dbdat)
		 (debug:print 0 " dbpath:  " (db:dbdat-get-path dbdat)))
	       (cons todb slave-dbs))
     (if *server-run* ;; we are inside a server, throw a sync-failed error
	 (signal (make-composite-condition
		 (make-property-condition 'sync-failed 'message "db:sync-tables failed in a server context.")))))

	 ;; (set! *time-to-exit* #t) ;; let watch dog know that it is time to die.
	 ;; (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "shutting-down")
	 ;; (portlogger:open-run-close portlogger:set-port port "released")
	 ;; (exit 1)))
   (cond
    ((not fromdb) (debug:print 3 "WARNING: db:sync-tables called with fromdb missing") -1)
    ((not todb)   (debug:print 3 "WARNING: db:sync-tables called with todb missing") -2)
    ((not (sqlite3:database? (db:dbdat-get-db fromdb)))
     (debug:print 0 "ERROR: db:sync-tables called with fromdb not a database " fromdb) -3)
    ((not (sqlite3:database? (db:dbdat-get-db todb)))
     (debug:print 0 "ERROR: db:sync-tables called with todb not a database " todb) -4)
    (else
     (let ((stmts       (make-hash-table)) ;; table-field => stmt
	   (all-stmts   '())              ;; ( ( stmt1 value1 ) ( stml2 value2 ))
	   (numrecs     (make-hash-table))
	   (start-time  (current-milliseconds))
	   (tot-count   0))
       (for-each ;; table
	(lambda (tabledat)
	  (let* ((tablename  (car tabledat))
		 (fields     (cdr tabledat))
		 (num-fields (length fields))
		 (field->num (make-hash-table))
		 (num->field (apply vector (map car fields)))
		 (full-sel   (conc "SELECT " (string-intersperse (map car fields) ",") 
				   " FROM " tablename ";"))
		 (full-ins   (conc "INSERT OR REPLACE INTO " tablename " ( " (string-intersperse (map car fields) ",") " ) "
				   " VALUES ( " (string-intersperse (make-list num-fields "?") ",") " );"))
		 (fromdat    '())
		 (fromdats   '())
		 (totrecords 0)
		 (batch-len  (string->number (or (configf:lookup *configdat* "sync" "batchsize") "10")))
		 (todat      (make-hash-table))
		 (count      0))

	    ;; set up the field->num table
	    (for-each
	     (lambda (field)
	       (hash-table-set! field->num field count)
	       (set! count (+ count 1)))
	     fields)

	    ;; read the source table
	    (sqlite3:for-each-row
	     (lambda (a . b)
	       (set! fromdat (cons (apply vector a b) fromdat))
	       (if (> (length fromdat) batch-len)
		   (begin
		     (set! fromdats (cons fromdat fromdats))
		     (set! fromdat  '())
		     (set! totrecords (+ totrecords 1)))))
	     (db:dbdat-get-db fromdb)
	     full-sel)
	    
	    ;; tack on remaining records in fromdat
	    (if (not (null? fromdat))
		(set! fromdats (cons fromdat fromdats)))

	    (debug:print-info 2 "found " totrecords " records to sync")

	    ;; read the target table
	    (sqlite3:for-each-row
	     (lambda (a . b)
	       (hash-table-set! todat a (apply vector a b)))
	     (db:dbdat-get-db todb)
	     full-sel)

	    ;; first pass implementation, just insert all changed rows
	    (for-each 
	     (lambda (targdb)
	       (let* ((db     (db:dbdat-get-db targdb))
		      (stmth  (sqlite3:prepare db full-ins)))
		 ;; (db:delay-if-busy targdb) ;; NO WAITING
		 (for-each
		  (lambda (fromdat-lst)
		    (sqlite3:with-transaction
		     db
		     (lambda ()
		       (for-each ;; 
			(lambda (fromrow)
			  (let* ((a    (vector-ref fromrow 0))
				 (curr (hash-table-ref/default todat a #f))
				 (same #t))
			    (let loop ((i 0))
			      (if (or (not curr)
				      (not (equal? (vector-ref fromrow i)(vector-ref curr i))))
				  (set! same #f))
			      (if (and same
				       (< i (- num-fields 1)))
				  (loop (+ i 1))))
			    (if (not same)
				(begin
				  (apply sqlite3:execute stmth (vector->list fromrow))
				  (hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0)))))))
			fromdat-lst))
		  ))
		  fromdats)
		 (sqlite3:finalize! stmth)))
	     (append (list todb) slave-dbs))))
	tbls)
       (let* ((runtime      (- (current-milliseconds) start-time))
	      (should-print (common:low-noise-print 30 "db sync" (> runtime 500)))) ;; low and high sync times treated as separate.
	 (if should-print (debug:print 0 "INFO: db sync, total run time " runtime " ms"))
	 (for-each 
	  (lambda (dat)
	    (let ((tblname (car dat))
		  (count   (cdr dat)))
	      (set! tot-count (+ tot-count count))
	      (if (> count 0)
		  (if should-print (debug:print 0 (format #f "    ~10a ~5a" tblname count))))))
	  (sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
       tot-count)))
   (mutex-unlock! *db-sync-mutex*)))

;; options:
;;
;;  'killservers  - kills all servers
;;  'dejunk       - removes junk records
;;  'adj-testids  - move test-ids into correct ranges
;;  'old2new      - sync megatest.db records to .db/{main,1,2 ...}.db
;;  'new2old      - sync .db/{main,1,2,3 ...}.db to megatest.db
;;  'closeall     - close all opened dbs
;;
;;  run-ids: '(1 2 3 ...) or #f (for all)
;;
(define (db:multi-db-sync run-ids . options)
  (let* ((toppath  (launch:setup-for-run))
	 (dbstruct (if toppath (make-dbr:dbstruct path: toppath) #f))
	 (mtdb     (if toppath (db:open-megatest-db)))
	 (allow-cleanup (if run-ids #f #t))
	 (run-ids  (if run-ids 
		       run-ids
		       (if toppath (begin
				     (db:delay-if-busy mtdb)
				     (db:get-all-run-ids mtdb)))))
	 (tdbdat  (tasks:open-db))
	 (servers (tasks:get-all-servers (db:delay-if-busy tdbdat))))
    
    ;; kill servers
    (if (member 'killservers options)
	(for-each
	 (lambda (server)
	   (tasks:server-delete-record (db:delay-if-busy tdbdat) (vector-ref server 0) "dbmigration")
	   (tasks:kill-server (vector-ref server 2)(vector-ref server 1)))
	 servers))

    ;; clear out junk records
    ;;
    (if (member 'dejunk options)
	(begin
	  (db:delay-if-busy mtdb)
	  (db:clean-up mtdb)))

    ;; adjust test-ids to fit into proper range
    ;;
    (if (member 'adj-testids options)
	(begin
	  (db:delay-if-busy mtdb)
	  (db:prep-megatest.db-for-migration mtdb)))

    ;; sync runs, test_meta etc.
    ;;
    (if (member 'old2new options)
	(begin
	  (db:sync-tables (db:sync-main-list mtdb) mtdb (db:get-db dbstruct #f))
	  (for-each 
	   (lambda (run-id)
	     (db:delay-if-busy mtdb)
	     (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id))
		   (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t) #f)))
	       (debug:print 0 "INFO: Propagating " (length testrecs) " records for run-id=" run-id " to run specific db")
	       (db:replace-test-records dbstruct run-id testrecs)
	       (sqlite3:finalize! (db:dbdat-get-db (dbr:dbstruct-get-rundb dbstruct)))))
	   run-ids)))

    ;; now ensure all newdb data are synced to megatest.db
    ;; do not use the run-ids list passed in to the function
    ;;
    (if (member 'new2old options)
	(let* ((maindb      (make-dbr:dbstruct path: toppath local: #t))
	       (src-run-ids (db:get-all-run-ids (db:dbdat-get-db (db:get-db maindb 0))))
	       (all-run-ids (sort (delete-duplicates (cons 0 src-run-ids)) <))
	       (count       1)
	       (total       (length all-run-ids))
	       (dead-runs  '()))
	  (for-each
	   (lambda (run-id)
	     (debug:print 0 "Processing run " (if (eq? run-id 0) " main.db " run-id) ", " count " of " total)
	     (set! count (+ count 1))
	     (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
		    (frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
	       ;; (db:delay-if-busy frundb)
	       ;; (db:delay-if-busy mtdb)
	       ;; (db:clean-up frundb)
	       (if (eq? run-id 0)
		   (begin
		     (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))))
		   (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))
		     ))))
	   all-run-ids)
	  ;; removed deleted runs
	  (let ((dbdir (tasks:get-task-db-path)))
	    (for-each (lambda (run-id)
			(let ((fullname (conc dbdir "/" run-id ".db")))
			  (if (file-exists? fullname)
			      (begin
				(debug:print 0 "Removing database file for deleted run " fullname)
				(delete-file fullname)))))
		      dead-runs))))
    ;; (db:close-all dbstruct)
    ;; (sqlite3:finalize! mdb)
    ))

;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling  proc idb . params)
  (debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
  (if (or *db-write-access*
	  (not (member proc *db:all-write-procs*)))
      (let* ((db   (cond
		    ((sqlite3:database? idb) idb)
		    ((not idb)               (open-db))
		    ((procedure? idb)       (idb))
		    (else   	            (open-db))))
      (let* ((db (cond
		  ((pair? idb)                 (db:dbdat-get-db idb))
		  ((sqlite3:database? idb)     idb)
		  ((not idb)                   (debug:print 0 "ERROR: cannot open-run-close with #f anymore"))
		  ((procedure? idb)            (idb))
		  (else   	               (debug:print 0 "ERROR: cannot open-run-close with #f anymore"))))
	     (res #f))
	(set! res (apply proc db params))
	(if (not idb)(sqlite3:finalize! db))
	(if (not idb)(sqlite3:finalize! dbstruct))
	(debug:print-info 11 "open-run-close-no-exception-handling END" )
	res)
      #f))

(define (open-run-close-exception-handling proc idb . params)
  (handle-exceptions
   exn
   (let ((sleep-time (random 30))
	 (err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
     (case err-status
       ((busy)
	(thread-sleep! sleep-time))
       (else
	(debug:print 0 "EXCEPTION: database probably overloaded or unreadable.")
	(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
	(print "exn=" (condition->list exn))
	(debug:print 0 " status:  " ((condition-property-accessor 'sqlite3 'status) exn))
	(print-call-chain)
	(print-call-chain (current-error-port))
	(thread-sleep! sleep-time)
	(debug:print-info 0 "trying db call one more time....this may never recover, if necessary kill process " (current-process-id) " on host " (get-host-name) " to clean up")))
     (apply open-run-close-exception-handling proc idb params))
   (apply open-run-close-no-exception-handling proc idb params)))

;; (define open-run-close open-run-close-exception-handling)
;; (define open-run-close 
(define open-run-close open-run-close-exception-handling)

		;;	   open-run-close-no-exception-handling
(define *global-delta* 0)
(define *last-global-delta-printed* 0)

;;			   open-run-close-exception-handling)
(define (open-run-close-measure  proc idb . params)
  (debug:print-info 11 "open-run-close-measure START, idb=" idb ", params=" params)
  (let* ((start-ms (current-milliseconds))
	 (db       (if idb idb (open-db)))
         (throttle (string->number (config-lookup *configdat* "setup" "throttle"))))
    ;; (db:set-sync db)
;;)
    (set! res      (apply proc db params))
    (if (not idb)(sqlite3:finalize! db))
    ;; scale by 10, average with current value.
    (set! *global-delta* (/ (+ *global-delta* (* (- (current-milliseconds) start-ms)
						 (if throttle throttle 0.01)))
			    2))
    (if (> (abs (- *last-global-delta-printed* *global-delta*)) 0.08) ;; don't print all the time, only if it changes a bit
	(begin
	  (debug:print-info 1 "launch throttle factor=" *global-delta*)
	  (set! *last-global-delta-printed* *global-delta*)))
    (debug:print-info 11 "open-run-close-measure END" )
    res))

(define (db:initialize db)
(define (db:initialize-main-db dbdat)
  (debug:print-info 11 "db:initialize START")
  (let* ((configdat (car *configinfo*))  ;; tut tut, global warning...
	 (keys     (keys:config-get-fields configdat))
	 (havekeys (> (length keys) 0))
	 (keystr   (keys->keystr keys))
	 (fieldstr (keys->key/field keys)))
	 (fieldstr (keys->key/field keys))
	 (db       (db:dbdat-get-db dbdat)))
    (for-each (lambda (key)
		(let ((keyn key))
		  (if (member (string-downcase keyn)
			      (list "runname" "state" "status" "owner" "event_time" "comment" "fail_count"
				    "pass_count"))
		      (begin
			(print "ERROR: your key cannot be named " keyn " as this conflicts with the same named field in the runs table")
			(print "ERROR: your key cannot be named " keyn " as this conflicts with the same named field in the runs table, you must remove your megatest.db and <linktree>/.db before trying again.")
			(system (conc "rm -f " dbpath))
			(exit 1)))))
	      keys)
    ;; (sqlite3:execute db "PRAGMA synchronous = OFF;")
    (db:set-sync db)
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS keys (id INTEGER PRIMARY KEY, fieldname TEXT, fieldtype TEXT, CONSTRAINT keyconstraint UNIQUE (fieldname));")
    (for-each (lambda (key)
		(sqlite3:execute db "INSERT INTO keys (fieldname,fieldtype) VALUES (?,?);" key "TEXT"))
	      keys)
    (sqlite3:execute db (conc 
			 "CREATE TABLE IF NOT EXISTS runs (id INTEGER PRIMARY KEY, " 
			 fieldstr (if havekeys "," "")
    (sqlite3:with-transaction
     db
     (lambda ()
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS keys (id INTEGER PRIMARY KEY, fieldname TEXT, fieldtype TEXT, CONSTRAINT keyconstraint UNIQUE (fieldname));")
       (for-each (lambda (key)
		   (sqlite3:execute db "INSERT OR REPLACE INTO keys (fieldname,fieldtype) VALUES (?,?);" key "TEXT"))
		 keys)
       (sqlite3:execute db (conc 
			    "CREATE TABLE IF NOT EXISTS runs (id INTEGER PRIMARY KEY, \n			 " 
			    fieldstr (if havekeys "," "") "
			 "runname TEXT,"
			 "state TEXT DEFAULT '',"
			 "status TEXT DEFAULT '',"
			 "owner TEXT DEFAULT '',"
			 "event_time TIMESTAMP,"
			 "comment TEXT DEFAULT '',"
			 "fail_count INTEGER DEFAULT 0,"
			 "pass_count INTEGER DEFAULT 0,"
			 "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,
                     host       TEXT DEFAULT 'n/a',
			 runname    TEXT DEFAULT 'norun',
                     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',
			 state      TEXT DEFAULT '',
			 status     TEXT DEFAULT '',
                     attemptnum INTEGER DEFAULT 0,
                     final_logf TEXT DEFAULT 'logs/final.log',
			 owner      TEXT DEFAULT '',
                     logdat     BLOB, 
                     run_duration INTEGER DEFAULT 0,
                     comment    TEXT DEFAULT '',
			 event_time TIMESTAMP DEFAULT (strftime('%s','now')),
			 comment    TEXT DEFAULT '',
                     event_time TIMESTAMP,
                     fail_count INTEGER DEFAULT 0,
                     pass_count INTEGER DEFAULT 0,
			 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)
			 CONSTRAINT runsconstraint UNIQUE (runname" (if havekeys "," "") keystr "));"))
          );")
    (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,
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_meta (
                                     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 '',
                                     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));")
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS tasks_queue (id INTEGER PRIMARY KEY,
                                action TEXT DEFAULT '',
                                owner TEXT,
                                state TEXT DEFAULT 'new',
                                target TEXT DEFAULT '',
                                name TEXT DEFAULT '',
                                testpatt TEXT DEFAULT '',
                                keylock TEXT,
                                params TEXT,
                                creation_time TIMESTAMP DEFAULT (strftime('%s','now')),
                                execution_time TIMESTAMP);")
       ;; archive disk areas, cached info from [archive-disks]
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS archive_disks (
                                id INTEGER PRIMARY KEY,
                                archive_area_name TEXT,
                                disk_path TEXT,
                                last_df INTEGER DEFAULT -1,
                                last_df_time TIMESTAMP DEFAULT (strftime('%s','now')),
                                creation_time TIMESTAMP DEFAULT (strftime('%','now')));")
       ;; individual bup (or tar) data chunks
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS archive_blocks (
                                id INTEGER PRIMARY KEY,
                                archive_disk_id INTEGER,
                                disk_path TEXT,
                                last_du INTEGER DEFAULT -1,
                                last_du_time TIMESTAMP DEFAULT (strftime('%s','now')),
                                creation_time TIMESTAMP DEFAULT (strftime('%','now')));")
       ;; tests allocated to what chunks. reusing a chunk for a test/item_path is very efficient
       ;; NB// the per run/test recording of where the archive is stored is done in the test
       ;;      record. 
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS archive_allocations (
                                id INTEGER PRIMARY KEY,
                                archive_block_id INTEGER,
                                testname TEXT,
                                item_path TEXT,
                                creation_time TIMESTAMP DEFAULT (strftime('%','now')));")
       ;; move this clean up call somewhere else
       (sqlite3:execute db "DELETE FROM tasks_queue WHERE state='done' AND creation_time < ?;" (- (current-seconds)(* 24 60 60))) ;; remove older than 24 hrs
       (sqlite3:execute db (conc "CREATE INDEX IF NOT EXISTS runs_index ON runs (runname" (if havekeys "," "") keystr ");"))
       ;; (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 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);")
       ;; 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" megatest-version)
       (debug:print-info 11 "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,
                     diskfree     INTEGER   DEFAULT -1,
                     uname        TEXT      DEFAULT 'n/a', 
                     rundir       TEXT      DEFAULT '/tmp/badname',
                     shortdir     TEXT      DEFAULT '/tmp/badname',
                     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       TEXT      DEFAULT '', 
                     run_duration INTEGER   DEFAULT 0,
                     comment      TEXT      DEFAULT '',
                     event_time   TIMESTAMP DEFAULT (strftime('%s','now')),
                     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
                        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 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 test_data 
     ;;                               (id          INTEGER PRIMARY KEY,
     ;;                                      reviewed    TIMESTAMP DEFAULT (strftime('%s','now')),
     ;;                                      iterated    TEXT DEFAULT '',
     ;;                                      avg_runtime REAL DEFAULT -1,
     ;;                                      avg_disk    REAL DEFAULT -1,
     ;;                                      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,
     (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")
     ;; Why use FULL here? This data is not that critical
     ;; (sqlite3:execute db "PRAGMA synchronous = FULL;")
     (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_rundat (
    ))

                              id           INTEGER PRIMARY KEY,
;;======================================================================
;; T E S T   S P E C I F I C   D B 
                              test_id      INTEGER,
;;======================================================================

;; Create the sqlite db for the individual test(s)
(define (open-test-db work-area) 
                              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 (
                              id           INTEGER PRIMARY KEY,
                              test_id      INTEGER,
  (debug:print-info 11 "open-test-db " work-area)
  (if (and work-area 
	   (directory? work-area)
	   (file-read-access? work-area))
      (let* ((dbpath    (conc work-area "/testdat.db"))
                              state        TEXT DEFAULT 'new',
                              status       TEXT DEFAULT 'n/a',
                              archive_type TEXT DEFAULT 'bup',
                              du           INTEGER,
	     (tdb-writeable (file-write-access? dbpath))
	     (dbexists  (file-exists? dbpath))
	     (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
					       (string->number (args:get-arg "-override-timeout"))
					       136000))))
	(handle-exceptions
                              archive_path TEXT);")))
  db)
	 exn
	 (begin

	   (debug:print 2 "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
			((condition-property-accessor 'exn 'message) exn))
	   (set! db (sqlite3:open-database ":memory:"))) ;; open an in-memory db to allow readonly access 
	 (set! db (sqlite3:open-database dbpath)))
;;======================================================================
;; A R C H I V E S
;;======================================================================

	(if *db-write-access* (sqlite3:set-busy-handler! db handler))
	(if (not dbexists)
	    (begin
	      ;; Why use FULL here? This data is not that critical
	      ;; (sqlite3:execute db "PRAGMA synchronous = FULL;")
	      (debug:print-info 11 "Initialized test database " dbpath)
	      (db:testdb-initialize db)))
	;; (sqlite3:execute db "PRAGMA synchronous = 0;")
;; dneeded is minimum space needed, scan for existing archives that 
;; are on disks with adequate space and already have this test/itempath
;; archived
;;
(define (db:archive-get-allocations dbstruct testname itempath dneeded)
  (let* ((dbdat        (db:get-db dbstruct #f)) ;; archive tables are in main.db
	 (db           (db:dbdat-get-db dbdat))
	 (res          '())
	 (blocks       '())) ;; a block is an archive chunck that can be added too if there is space
    (sqlite3:for-each-row
	(debug:print-info 11 "open-test-db END (sucessful)" work-area)
	;; now let's test that everything is correct
	(handle-exceptions
	 exn
     (lambda (id archive-disk-id disk-path last-du last-du-time)
       (set! res (cons (vector id archive-disk-id disk-path last-du last-du-time) res)))
	 (begin
	   (debug:print 0 "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
			((condition-property-accessor 'exn 'message) exn))
	   #f)
	 ;; Is there a cheaper single line operation that will check for existance of a table
	 ;; and raise an exception ?
	 (sqlite3:execute db "SELECT id FROM test_data LIMIT 1;"))
	db)
      (begin
     db
     "SELECT b.id,b.archive_disk_id,b.disk_path,b.last_du,b.last_du_time FROM archive_blocks AS b
        INNER JOIN archive_allocations AS a ON a.archive_block_id=b.id
        WHERE a.testname=? AND a.item_path=?;" 
     testname itempath)
    ;; Now res has list of candidate paths, look in archive_disks for candidate with potential free space
    (if (null? res)
	'()
	(sqlite3:for-each-row
	 (lambda (id archive-area-name disk-path last-df last-df-time)
	   (set! blocks (cons (vector id archive-area-name disk-path last-df last-df-time) blocks)))
	 db 
	 (conc
	  "SELECT d.id,d.archive_area_name,disk_path,last_df,last_df_time FROM archive_disks AS d
             INNER JOIN archive_blocks AS b ON d.id=b.archive_disk_id
             WHERE b.id IN (" (string-intersperse (map conc res) ",") ") AND
         last_df > ?;")
	 dneeded))
    blocks))
    
;; returns id of the record, register a disk allocated to archiving and record it's last known
;; available space
;;
(define (db:archive-register-disk dbstruct bdisk-name bdisk-path df)
  (let* ((dbdat        (db:get-db dbstruct #f)) ;; archive tables are in main.db
	 (db           (db:dbdat-get-db dbdat))
	 (res          #f))
    (sqlite3:for-each-row
     (lambda (id)
       (set! res id))
     db
     "SELECT id FROM archive_disks WHERE archive_area_name=? AND disk_path=?;"
     bdisk-name bdisk-path)
    (if res ;; record exists, update df and return id
	(begin
	(debug:print-info 11 "open-test-db END (unsucessful)" work-area)
	#f)))
	  (sqlite3:execute db "UPDATE archive_disks SET last_df=?,last_df_time=(strftime('%s','now'))
                                  WHERE archive_area_name=? AND disk_path=?;"
			   df bdisk-name bdisk-path)
	  res)
	(begin
	  (sqlite3:execute
	   db
	   "INSERT OR REPLACE INTO archive_disks (archive_area_name,disk_path,last_df)
                VALUES (?,?,?);"
	   bdisk-name bdisk-path df)
	  (db:archive-register-disk dbstruct bdisk-name bdisk-path df)))))

;; find and open the testdat.db file for an existing test
(define (db:open-test-db-by-test-id db test-id #!key (work-area #f))
  (let* ((test-path (if work-area
			work-area
			(cdb:remote-run db:test-get-rundir-from-test-id db test-id))))
    (debug:print 3 "TEST PATH: " test-path)
    (open-test-db test-path)))
;; record an archive path created on a given archive disk (identified by it's bdisk-id)
;; if path starts with / then it is full, otherwise it is relative to the archive disk
;; preference is to store the relative path.
;;
(define (db:archive-register-block-name dbstruct bdisk-id archive-path #!key (du #f))
  (let* ((dbdat        (db:get-db dbstruct #f)) ;; archive tables are in main.db
	 (db           (db:dbdat-get-db dbdat))
	 (res          #f))
    ;; first look to see if this path is already registered
    (sqlite3:for-each-row
     (lambda (id)
       (set! res id))
     db
     "SELECT id FROM archive_blocks WHERE archive_disk_id=? AND disk_path=?;"
     bdisk-id archive-path)
    (if res ;; record exists, update du if applicable and return res
	(begin
	  (if du (sqlite3:exectute db "UPDATE archive_blocks SET last_du=?,last_du_time=(strftime('%s','now'))
                                          WHERE archive_disk_id=? AND disk_path=?;"
				   bdisk-id archive-path du))
	  res)
	(begin
	  (sqlite3:execute db "INSERT OR REPLACE INTO archive_blocks (archive_disk_id,disk_path,last_du)
                                                        VALUES (?,?,?);"
			   bdisk-id archive-path (or du 0))
	  (db:archive-register-block-name dbstruct bdisk-id archive-path du: du)))))

(define (db:testdb-initialize db)
  (debug:print 11 "db:testdb-initialize START")
  (for-each
   (lambda (sqlcmd)
     (sqlite3:execute db sqlcmd))

;; The "archived" field in tests is overloaded; 0 = not archived, > 0 archived in block with given id
;;
(define (db:test-set-archive-block-id dbstruct run-id test-id archive-block-id)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (sqlite3:execute db "UPDATE tests SET archived=? WHERE id=?;"
   (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,
		      archive-block-id test-id))))
              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, 
 
;; Look up the archive block info given a block-id
;;
(define (db:test-get-archive-block-info dbstruct archive-block-id)
  (db:with-db
   dbstruct
   #f
   #f
   (lambda (db)
              state TEXT DEFAULT 'NOT_STARTED', 
              status TEXT DEFAULT 'n/a',
     (let ((res #f))
              event_time TIMESTAMP,
              comment TEXT DEFAULT '',
              logfile TEXT DEFAULT '',
              CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));"
	 ;; test_meta can be used for handing commands to the test
       (sqlite3:for-each-row 
	;;        0         1           2        3          4           5
	(lambda (id archive-disk-id disk-path last-du last-du-time creation-time)
	  (set! res (vector id archive-disk-id disk-path last-du last-du-time creation-time)))
	 ;; e.g. KILLREQ
	 ;;      the ackstate is set to 1 once the command has been completed
	db
	"SELECT id,archive_disk_id,disk_path,last_du,last_du_time,creation_time FROM archive_blocks WHERE id=?;"
	 "CREATE TABLE IF NOT EXISTS test_meta (
              id INTEGER PRIMARY KEY,
              var TEXT,
              val TEXT,
              ackstate INTEGER DEFAULT 0,
              CONSTRAINT metadat_constraint UNIQUE (var));"))
  (debug:print 11 "db:testdb-initialize END"))
	archive-block-id)
       res))))

;; (define (db:archive-allocate-testsuite/area-to-block block-id testsuite-name areakey)
;;   (let* ((dbdat        (db:get-db dbstruct #f)) ;; archive tables are in main.db
;; 	 (db           (db:dbdat-get-db dbdat))
;; 	 (res          '())
;; 	 (blocks       '())) ;; a block is an archive chunck that can be added too if there is space
;;     (sqlite3:for-each-row  #f)

;;======================================================================
;; L O G G I N G    D B 
;;======================================================================

(define (open-logging-db) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let* ((dbpath    (conc (if *toppath* (conc *toppath* "/") "") "logging.db")) ;; fname)
	 (dbexists  (file-exists? dbpath))
	 (db        (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
	 (db        (sqlite3:open-database dbpath))
	 (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
					   (string->number (args:get-arg "-override-timeout"))
					   136000)))) ;; 136000)))
    (sqlite3:set-busy-handler! db handler)
    (if (not dbexists)
	(begin
	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS log (id INTEGER PRIMARY KEY,event_time TIMESTAMP DEFAULT (strftime('%s','now')),logline TEXT,pwd TEXT,cmdline TEXT,pid INTEGER);")
	  (sqlite3:execute db (conc "PRAGMA synchronous = 0;"))))
	  (db:set-sync db) ;; (sqlite3:execute db (conc "PRAGMA synchronous = 0;"))
	  ))
    db))

(define (db:log-local-event . loglst)
  (let ((logline (apply conc loglst)))
    ;; (pwd     (current-directory))
    ;; (cmdline (string-intersperse (argv) " "))
    ;; (pid     (current-process-id)))
    (db:log-event logline)))

(define (db:log-event logline)
  (let ((db (open-logging-db)))
    (sqlite3:execute db "INSERT INTO log (logline,pwd,cmdline,pid) VALUES (?,?,?,?);"
		     logline
		     (current-directory)
		     (string-intersperse (argv) " ")
		     (current-process-id))
    (sqlite3:finalize! db)
    logline))

;;======================================================================
;; TODO:
;; D B   U T I L S
;;   put deltas into an assoc list with version numbers
;;   apply all from last to current
;;======================================================================
(define (patch-db db)
  (handle-exceptions
   exn
   (begin
     (print "Exception: " exn)
     (print "ERROR: Possible out of date schema, attempting to add table metadata...")
     (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER, var TEXT, val TEXT,
                                 CONSTRAINT metadat_constraint UNIQUE (var));")
     (if (not (db:get-var db "MEGATEST_VERSION"))
	 (db:set-var db "MEGATEST_VERSION" 1.17)))
   (let ((mver (db:get-var db "MEGATEST_VERSION"))
	 (test-meta-def "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 '',
                                CONSTRAINT test_meta_constraint UNIQUE (testname));"))
     (print "Current schema version: " mver " current megatest version: " megatest-version)
     (cond
      ((not mver)
       (print "Adding megatest-version to metadata") ;; Need to recreate the table
       (sqlite3:execute db "DROP TABLE IF EXISTS metadat;")
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER, var TEXT, val TEXT,
                                  CONSTRAINT metadat_constraint UNIQUE (var));")
       (db:set-var db "MEGATEST_VERSION" 1.17)
       (patch-db))
      ((< mver 1.21)
       (sqlite3:execute db "DROP TABLE IF EXISTS metadat;")
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER, var TEXT, val TEXT,
                                  CONSTRAINT metadat_constraint UNIQUE (var));")
       (db:set-var db "MEGATEST_VERSION" 1.21) ;; set before, just in case the changes are already applied
       (sqlite3:execute db test-meta-def)
					;(for-each 
					; (lambda (stmt)
					;   (sqlite3:execute db stmt))
					; (list 
					;  "ALTER TABLE tests ADD COLUMN first_err TEXT;"
					;  "ALTER TABLE tests ADD COLUMN first_warn TEXT;"
					;  ))
       (patch-db))
      ((< mver 1.24)
       (db:set-var db "MEGATEST_VERSION" 1.24)
       (sqlite3:execute db "DROP TABLE IF EXISTS test_data;")
       (sqlite3:execute db "DROP TABLE IF EXISTS test_meta;")
       (sqlite3:execute db test-meta-def)
       (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',
                              CONSTRAINT test_data UNIQUE (test_id,category,variable));")
       (print "WARNING: Table test_data and test_meta were recreated. Please do megatest -update-meta")
       (patch-db))
      ((< mver 1.27)
       (db:set-var db "MEGATEST_VERSION" 1.27)
       (sqlite3:execute db "ALTER TABLE test_data ADD COLUMN type TEXT DEFAULT '';")
       (patch-db))
      ((< mver 1.29)
       (db:set-var db "MEGATEST_VERSION" 1.29)
       (sqlite3:execute db "ALTER TABLE test_steps ADD COLUMN logfile TEXT DEFAULT '';")
       (sqlite3:execute db "ALTER TABLE tests ADD COLUMN shortdir TEXT DEFAULT '';"))
      ((< mver 1.36)
       (db:set-var db "MEGATEST_VERSION" 1.36)
       (sqlite3:execute db "ALTER TABLE test_meta ADD COLUMN jobgroup TEXT DEFAULT 'default';"))
      ((< mver 1.37)
       (db:set-var db "MEGATEST_VERSION" 1.37)
       (sqlite3:execute db "ALTER TABLE tests ADD COLUMN archived INTEGER DEFAULT 0;")) 
      ((< mver megatest-version)
       (db:set-var db "MEGATEST_VERSION" megatest-version))))))

;;======================================================================
;; M A I N T E N A N C E
;;======================================================================

(define (db:have-incompletes? dbstruct run-id ovr-deadtime)
  (let* ((dbdat        (db:get-db dbstruct run-id))
	 (db           (db:dbdat-get-db dbdat))
	 (incompleted '())
	 (oldlaunched '())
	 (toplevels   '())
	 (deadtime-str (configf:lookup *configdat* "setup" "deadtime"))
	 (deadtime     (if (and deadtime-str
				(string->number deadtime-str))
			   (string->number deadtime-str)
			   7200))) ;; two hours
    (if (number? ovr-deadtime)(set! deadtime ovr-deadtime))
    
    ;; in RUNNING or REMOTEHOSTSTART for more than 10 minutes
    ;;
    ;; HOWEVER: this code in run:test seems to work fine
    ;;              (> (- (current-seconds)(+ (db:test-get-event_time testdat)
    ;;                     (db:test-get-run_duration testdat)))
    ;;                    600) 
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row 
     (lambda (test-id run-dir uname testname item-path)
       (if (and (equal? uname "n/a")
		(equal? item-path "")) ;; this is a toplevel test
	   ;; what to do with toplevel? call rollup?
	   (begin
	     (set! toplevels   (cons (list test-id run-dir uname testname item-path run-id) toplevels))
	     (debug:print-info 0 "Found old toplevel test in RUNNING state, test-id=" test-id))
	   (set! incompleted (cons (list test-id run-dir uname testname item-path run-id) incompleted))))
     db
     "SELECT id,rundir,uname,testname,item_path FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > (run_duration + ?) AND state IN ('RUNNING','REMOTEHOSTSTART');"
     run-id deadtime)

    ;; in LAUNCHED for more than one day. Could be long due to job queues TODO/BUG: Need override for this in config
    ;;
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row
     (lambda (test-id run-dir uname testname item-path)
       (if (and (equal? uname "n/a")
		(equal? item-path "")) ;; this is a toplevel test
	   ;; what to do with toplevel? call rollup?
	   (set! toplevels   (cons (list test-id run-dir uname testname item-path run-id) toplevels))
	   (set! oldlaunched (cons (list test-id run-dir uname testname item-path run-id) oldlaunched))))
     db
     "SELECT id,rundir,uname,testname,item_path FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > 86400 AND state IN ('LAUNCHED');"
     run-id)
    
    (debug:print-info 18 "Found " (length oldlaunched) " old LAUNCHED items, " (length toplevels) " old LAUNCHED toplevel tests and " (length incompleted) " tests marked RUNNING but apparently dead.")
    (if (and (null? incompleted)
	     (null? oldlaunched)
	     (null? toplevels))
	#f
	#t)))

;;  select end_time-now from
;;      (select testname,item_path,event_time+run_duration as
;;                          end_time,strftime('%s','now') as now from tests where state in
;;      ('RUNNING','REMOTEHOSTSTART','LAUNCED'));

(define (db:find-and-mark-incomplete db #!key (ovr-deadtime #f))
  (let* ((incompleted '())
(define (db:find-and-mark-incomplete dbstruct run-id ovr-deadtime)
  (let* ((dbdat        (db:get-db dbstruct run-id))
	 (db           (db:dbdat-get-db dbdat))
	 (incompleted '())
	 (oldlaunched '())
	 (toplevels   '())
	 (deadtime-str (configf:lookup *configdat* "setup" "deadtime"))
	 (deadtime     (if (and deadtime-str
				(string->number deadtime-str))
			   (string->number deadtime-str)
			   7200)) ;; two hours
			   7200))) ;; two hours
	 (run-ids      (db:get-run-ids db))) ;; iterate over runs to divy up the calls
    (if (number? ovr-deadtime)(set! deadtime ovr-deadtime))
    (for-each
     (lambda (run-id)

       ;; in RUNNING or REMOTEHOSTSTART for more than 10 minutes
       ;;
    
    ;; in RUNNING or REMOTEHOSTSTART for more than 10 minutes
    ;;
       ;; THIS CANNOT WORK. The run_duration is not updated in the central db due to performance concerns.
       ;;                   The testdat.db file must be consulted.
       ;;
       ;; HOWEVER: this code in run:test seems to work fine
       ;;              (> (- (current-seconds)(+ (db:test-get-event_time testdat)
       ;;                     (db:test-get-run_duration testdat)))
       ;;                    600) 
       (db:delay-if-busy)
       (sqlite3:for-each-row 
	(lambda (test-id run-dir uname testname item-path)
	  (if (and (equal? uname "n/a")
		   (equal? item-path "")) ;; this is a toplevel test
	      ;; what to do with toplevel? call rollup?
	      (begin
		(set! toplevels   (cons (list test-id run-dir uname testname item-path run-id) toplevels))
		(debug:print-info 0 "Found old toplevel test in RUNNING state, test-id=" test-id))
	      (set! incompleted (cons (list test-id run-dir uname testname item-path run-id) incompleted))))
	db
	"SELECT id,rundir,uname,testname,item_path FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > 600 AND state IN ('RUNNING','REMOTEHOSTSTART');"
	run-id)
    ;; HOWEVER: this code in run:test seems to work fine
    ;;              (> (- (current-seconds)(+ (db:test-get-event_time testdat)
    ;;                     (db:test-get-run_duration testdat)))
    ;;                    600) 
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row 
     (lambda (test-id run-dir uname testname item-path)
       (if (and (equal? uname "n/a")
		(equal? item-path "")) ;; this is a toplevel test
	   ;; what to do with toplevel? call rollup?
	   (begin
	     (set! toplevels   (cons (list test-id run-dir uname testname item-path run-id) toplevels))
	     (debug:print-info 0 "Found old toplevel test in RUNNING state, test-id=" test-id))
	   (set! incompleted (cons (list test-id run-dir uname testname item-path run-id) incompleted))))
     db
     "SELECT id,rundir,uname,testname,item_path FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > (run_duration + ?) AND state IN ('RUNNING','REMOTEHOSTSTART');"
     run-id deadtime)

       ;; in LAUNCHED for more than one day. Could be long due to job queues TODO/BUG: Need override for this in config
       ;;
       (db:delay-if-busy)
       (sqlite3:for-each-row
	(lambda (test-id run-dir uname testname item-path)
	  (if (and (equal? uname "n/a")
		   (equal? item-path "")) ;; this is a toplevel test
	      ;; what to do with toplevel? call rollup?
	      (set! toplevels   (cons (list test-id run-dir uname testname item-path run-id) toplevels))
	      (set! oldlaunched (cons (list test-id run-dir uname testname item-path run-id) oldlaunched))))
	db
	"SELECT id,rundir,uname,testname,item_path FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > 86400 AND state IN ('LAUNCHED');"
	run-id))
     run-ids)
    
    ;; in LAUNCHED for more than one day. Could be long due to job queues TODO/BUG: Need override for this in config
    ;;
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row
     (lambda (test-id run-dir uname testname item-path)
       (if (and (equal? uname "n/a")
		(equal? item-path "")) ;; this is a toplevel test
	   ;; what to do with toplevel? call rollup?
	   (set! toplevels   (cons (list test-id run-dir uname testname item-path run-id) toplevels))
	   (set! oldlaunched (cons (list test-id run-dir uname testname item-path run-id) oldlaunched))))
     db
     "SELECT id,rundir,uname,testname,item_path FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > 86400 AND state IN ('LAUNCHED');"
     run-id)
    
    (debug:print-info 18 "Found " (length oldlaunched) " old LAUNCHED items, " (length toplevels) " old LAUNCHED toplevel tests and " (length incompleted) " tests marked RUNNING but apparently dead.")

    ;; These are defunct tests, do not do all the overhead of set-state-status. Force them to INCOMPLETE.
    ;;
    (db:delay-if-busy)
    (let* ((min-incompleted (filter (lambda (x)
				     (let* ((testpath (cadr x))
					    (tdatpath (conc testpath "/testdat.db"))
					    (dbexists (file-exists? tdatpath)))
				       (or (not dbexists) ;; if no file then something wrong - mark as incomplete
					   (> (- (current-seconds)(file-modification-time tdatpath)) 600)))) ;; no change in 10 minutes to testdat.db - she's dead Jim
				   incompleted))
	  (min-incompleted-ids (map car min-incompleted))
	  (all-ids             (append min-incompleted-ids (map car oldlaunched))))
    (db:delay-if-busy dbdat)
    (let* (;; (min-incompleted (filter (lambda (x)
	   ;;      		      (let* ((testpath (cadr x))
	   ;;      			     (tdatpath (conc testpath "/testdat.db"))
	   ;;      			     (dbexists (file-exists? tdatpath)))
	   ;;      			(or (not dbexists) ;; if no file then something wrong - mark as incomplete
	   ;;      			    (> (- (current-seconds)(file-modification-time tdatpath)) 600)))) ;; no change in 10 minutes to testdat.db - she's dead Jim
	   ;;      		    incompleted))
	   (min-incompleted-ids (map car incompleted)) ;; do 'em all
	   (all-ids             (append min-incompleted-ids (map car oldlaunched))))
      (if (> (length all-ids) 0)
	  (begin
	    (debug:print 0 "WARNING: Marking test(s); " (string-intersperse (map conc all-ids) ", ") " as INCOMPLETE")
	    (sqlite3:execute 
	     db
	     (conc "UPDATE tests SET state='INCOMPLETE' WHERE id IN (" 
		   (string-intersperse (map conc all-ids) ",")
		   ");")))))

    ;; Now do rollups for the toplevel tests
    ;;
    (db:delay-if-busy dbdat)
    (for-each
     (lambda (toptest)
       (let ((test-name (list-ref toptest 3))
	     (run-id    (list-ref toptest 5)))
	 (cdb:top-test-set-per-pf-counts *runremote* run-id test-name)))
       (let ((test-name (list-ref toptest 3)))
;;	     (run-id    (list-ref toptest 5)))
	  (db:general-call db 'top-test-set-per-pf-counts (list test-name run-id test-name test-name test-name)))) ;; (list run-id test-name))))
     toplevels)))
		     
;; Clean out old junk and vacuum the database
;;
;; Ultimately do something like this:
;;
;; 1. Look at test records either deleted or part of deleted run:
;;    a. If test dir exists, set the the test to state='UNKNOWN', Set the run to 'unknown'
;;    b. If test dir gone, delete the test record
;; 2. Look at run records
;;    a. If have tests that are not deleted, set state='unknown'
;;    b. ....
;;
(define (db:clean-up db)
  (let ((count-stmt (sqlite3:prepare db "SELECT (SELECT count(id) FROM tests)+(SELECT count(id) FROM runs);"))
(define (db:clean-up dbdat)
  ;; (debug:print 0 "WARNING: db clean up not fully ported to v1.60, cleanup action will be on megatest.db")
  (let* ((db         (db:dbdat-get-db dbdat))
	 (count-stmt (sqlite3:prepare db "SELECT (SELECT count(id) FROM tests)+(SELECT count(id) FROM runs);"))
	(statements
	 (map (lambda (stmt)
		(sqlite3:prepare db stmt))
	      (list
	       ;; delete all tests that belong to runs that are 'deleted'
	       "DELETE FROM tests WHERE run_id in (SELECT id FROM runs WHERE state='deleted');"
	       ;; delete all tests that are 'DELETED'
	       "DELETE FROM tests WHERE state='DELETED';"
	       ;; delete all tests that have no run
	       "DELETE FROM tests WHERE run_id NOT IN (SELECT DISTINCT id FROM runs);"
	       ;; delete all runs that are state='deleted'
	       "DELETE FROM runs WHERE state='deleted';"
	       ;; delete empty runs
	       "DELETE FROM runs WHERE id NOT IN (SELECT DISTINCT r.id FROM runs AS r INNER JOIN tests AS t ON t.run_id=r.id);"
	       ))))
    (db:delay-if-busy dbdat)
    (sqlite3:with-transaction 
     db
     (lambda ()
       (sqlite3:for-each-row (lambda (tot)
			       (debug:print-info 0 "Records count before clean: " tot))
			     count-stmt)
       (map sqlite3:execute statements)
       (sqlite3:for-each-row (lambda (tot)
			       (debug:print-info 0 "Records count after  clean: " tot))
			     count-stmt)))
    (map sqlite3:finalize! statements)
    (sqlite3:finalize! count-stmt)
    ;; (db:find-and-mark-incomplete db)
    (db:delay-if-busy dbdat)
    (sqlite3:execute db "VACUUM;")))

;; Clean out old junk and vacuum the database
;;
;; Ultimately do something like this:
;;
;; 1. Look at test records either deleted or part of deleted run:
;;    a. If test dir exists, set the the test to state='UNKNOWN', Set the run to 'unknown'
;;    b. If test dir gone, delete the test record
;; 2. Look at run records
;;    a. If have tests that are not deleted, set state='unknown'
;;    b. ....
;;
(define (db:clean-up-rundb dbdat)
  ;; (debug:print 0 "WARNING: db clean up not fully ported to v1.60, cleanup action will be on megatest.db")
  (let* ((db         (db:dbdat-get-db dbdat))
	 (count-stmt (sqlite3:prepare db "SELECT (SELECT count(id) FROM tests);"))
	(statements
	 (map (lambda (stmt)
		(sqlite3:prepare db stmt))
	      (list
	       ;; delete all tests that belong to runs that are 'deleted'
	       ;; (conc "DELETE FROM tests WHERE run_id NOT IN (" (string-intersperse (map conc valid-runs) ",") ");")
	       ;; delete all tests that are 'DELETED'
	       "DELETE FROM tests WHERE state='DELETED';"
	       ))))
    (db:delay-if-busy dbdat)
    (sqlite3:with-transaction 
     db
     (lambda ()
       (sqlite3:for-each-row (lambda (tot)
			       (debug:print-info 0 "Records count before clean: " tot))
			     count-stmt)
       (map sqlite3:execute statements)
       (sqlite3:for-each-row (lambda (tot)
			       (debug:print-info 0 "Records count after  clean: " tot))
			     count-stmt)))
    (map sqlite3:finalize! statements)
    (sqlite3:finalize! count-stmt)
    ;; (db:find-and-mark-incomplete db)
    (db:delay-if-busy dbdat)
    (sqlite3:execute db "VACUUM;")))

;; Clean out old junk and vacuum the database
;;
;; Ultimately do something like this:
;;
;; 1. Look at test records either deleted or part of deleted run:
;;    a. If test dir exists, set the the test to state='UNKNOWN', Set the run to 'unknown'
;;    b. If test dir gone, delete the test record
;; 2. Look at run records
;;    a. If have tests that are not deleted, set state='unknown'
;;    b. ....
;;
(define (db:clean-up-maindb dbdat)
  ;; (debug:print 0 "WARNING: db clean up not fully ported to v1.60, cleanup action will be on megatest.db")
  (let* ((db         (db:dbdat-get-db dbdat))
	 (count-stmt (sqlite3:prepare db "SELECT (SELECT count(id) FROM runs);"))
	 (statements
	  (map (lambda (stmt)
		 (sqlite3:prepare db stmt))
	       (list
		;; delete all tests that belong to runs that are 'deleted'
		;; (conc "DELETE FROM tests WHERE run_id NOT IN (" (string-intersperse (map conc valid-runs) ",") ");")
		;; delete all tests that are 'DELETED'
		"DELETE FROM runs WHERE state='deleted';"
		)))
	 (dead-runs '()))
    (sqlite3:for-each-row
     (lambda (run-id)
       (set! dead-runs (cons run-id dead-runs)))
       db
       "SELECT id FROM runs WHERE state='deleted';")
    (db:delay-if-busy dbdat)
    (sqlite3:with-transaction 
     db
     (lambda ()
       (sqlite3:for-each-row (lambda (tot)
			       (debug:print-info 0 "Records count before clean: " tot))
			     count-stmt)
       (map sqlite3:execute statements)
       (sqlite3:for-each-row (lambda (tot)
			       (debug:print-info 0 "Records count after  clean: " tot))
			     count-stmt)))
    (map sqlite3:finalize! statements)
    (sqlite3:finalize! count-stmt)
    (db:find-and-mark-incomplete db)
    (sqlite3:execute db "VACUUM;")))
    ;; (db:find-and-mark-incomplete db)
    (db:delay-if-busy dbdat)
    (sqlite3:execute db "VACUUM;")
    dead-runs))

;;======================================================================
;; meta get and set vars
;; M E T A   G E T   A N D   S E T   V A R S
;;======================================================================

;; returns number if string->number is successful, string otherwise
;; also updates *global-delta*
;;
;; Operates on megatestdb
;;
(define (db:get-var db var)
(define (db:get-var dbstruct var)
  (debug:print-info 11 "db:get-var START " var)
  (let* ((start-ms (current-milliseconds))
         (throttle (let ((t  (config-lookup *configdat* "setup" "throttle")))
		     (if t (string->number t) t)))
	 (res      #f))
	 (res      #f)
	 (dbdat    (db:get-db dbstruct #f))
	 (db       (db:dbdat-get-db dbdat)))
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row
     (lambda (val)
       (set! res val))
     db
     db "SELECT val FROM metadat WHERE var=?;" var)
     "SELECT val FROM metadat WHERE var=?;" var)
    ;; convert to number if can
    (if (string? res)
	(let ((valnum (string->number res)))
	  (if valnum (set! res valnum))))
    ;; scale by 10, average with current value.
    (set! *global-delta* (/ (+ *global-delta* (* (- (current-milliseconds) start-ms)
						 (if throttle throttle 0.01)))
			    2))
    (if (> (abs (- *last-global-delta-printed* *global-delta*)) 0.08) ;; don't print all the time, only if it changes a bit
	(begin
	  (debug:print-info 4 "launch throttle factor=" *global-delta*)
	  (set! *last-global-delta-printed* *global-delta*)))
    (debug:print-info 11 "db:get-var END " var " val=" res)
    res))

(define (db:set-var db var val)
  (debug:print-info 11 "db:set-var START " var " " val)
  (db:delay-if-busy)
  (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val)
(define (db:set-var dbstruct var val)
  (let ((dbdat (db:get-db dbstruct #f))
	(db    (db:dbdat-get-db dbdat)))
    (db:delay-if-busy dbdat)
    (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val)))
  (debug:print-info 11 "db:set-var END " var " " val))

(define (db:del-var db var)
(define (db:del-var dbstruct var)
  (debug:print-info 11 "db:del-var START " var)
  (db:delay-if-busy)
  (sqlite3:execute db "DELETE FROM metadat WHERE var=?;" var)
  ;; (db:delay-if-busy)
  (db:with-db dbstruct #f #t 
	      (lambda (db)
		(sqlite3:execute db "DELETE FROM metadat WHERE var=?;" var))))
  (debug:print-info 11 "db:del-var END " var))

;; use a global for some primitive caching, it is just silly to
;; re-read the db over and over again for the keys since they never
;; change

;; why get the keys from the db? why not get from the *configdat*
;; using keys:config-get-fields?

(define (db:get-keys db)
(define (db:get-keys dbstruct)
  (if *db-keys* *db-keys* 
      (let ((res '()))
	(db:with-db dbstruct #f #f
		    (lambda (db)
	(sqlite3:for-each-row 
	 (lambda (key)
	   (set! res (cons key res)))
	 db
	 "SELECT fieldname FROM keys ORDER BY id DESC;")
		      (sqlite3:for-each-row 
		       (lambda (key)
			 (set! res (cons key res)))
		       db
		       "SELECT fieldname FROM keys ORDER BY id DESC;")))
	(set! *db-keys* res)
	res)))

;; 
;; look up values in a header/data structure
(define (db:get-value-by-header row header field)
  (debug:print-info 4 "db:get-value-by-header row: " row " header: " header " field: " field)
  (if (null? header) #f
      (let loop ((hed (car header))
		 (tal (cdr header))
		 (n   0))
	(if (equal? hed field)
	    (vector-ref row n)
	    (if (null? tal) #f (loop (car tal)(cdr tal)(+ n 1)))))))

;; Accessors for the header/data structure
;; get rows and header from 
(define (db:get-header vec)(vector-ref vec 0))
(define (db:get-rows   vec)(vector-ref vec 1))

;;======================================================================
;;  R U N S
;;======================================================================

(define (db:get-run-name-from-id db run-id)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (runname)
       (set! res runname))
     db
     "SELECT runname FROM runs WHERE id=?;"
     run-id)
    res))
(define (db:get-run-name-from-id dbstruct run-id)
  (db:with-db 
   dbstruct
   #f ;; this is for the main runs db
   #f ;; does not modify db
   (lambda (db)
     (let ((res #f))
       (sqlite3:for-each-row
	(lambda (runname)
	  (set! res runname))
	db
	"SELECT runname FROM runs WHERE id=?;"
	run-id)
       res))))

(define (db:get-run-key-val db run-id key)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (val)
       (set! res val))
     db 
     (conc "SELECT " key " FROM runs WHERE id=?;")
     run-id)
    res))
(define (db:get-run-key-val dbstruct run-id key)
  (db:with-db
   dbstruct
   #f
   #f
   (lambda (db)
     (let ((res #f))
       (sqlite3:for-each-row
	(lambda (val)
	  (set! res val))
	db
	(conc "SELECT " key " FROM runs WHERE id=?;")
	run-id)
       res))))

;; keys list to key1,key2,key3 ...
(define (runs:get-std-run-fields keys remfields)
  (let* ((header    (append keys remfields))
	 (keystr    (conc (keys->keystr keys) ","
			  (string-intersperse remfields ","))))
    (list keystr header)))

				 (conc fieldname " " wildtype " '" patt "'")))
			     (if (null? patts)
				 '("")
				 patts))
			comparator)))


;; register a test run with the db
(define (db:register-run db keyvals runname state status user)
;; register a test run with the db, this accesses the main.db and does NOT
;; use server api
;;
(define (db:register-run dbstruct keyvals runname state status user)
  (debug:print 3 "runs:register-run runname: " runname " state: " state " status: " status " user: " user)
  (let* ((keys      (map car keyvals))
  (let* ((dbdat     (db:get-db dbstruct #f))
	 (db        (db:dbdat-get-db dbdat))
	 (keys      (map car keyvals))
	 (keystr    (keys->keystr keys))	 
	 (comma     (if (> (length keys) 0) "," ""))
	 (andstr    (if (> (length keys) 0) " AND " ""))
	 (valslots  (keys->valslots keys)) ;; ?,?,? ...
	 (allvals   (append (list runname state status user) (map cadr keyvals)))
	 (qryvals   (append (list runname) (map cadr keyvals)))
	 (key=?str  (string-intersperse (map (lambda (k)(conc k "=?")) keys) " AND ")))
    (debug:print 3 "keys: " keys " allvals: " allvals " keyvals: " keyvals " key=?str is " key=?str)
    (debug:print 2 "NOTE: using target " (string-intersperse (map cadr keyvals) "/") " for this run")
    (if (and runname (null? (filter (lambda (x)(not x)) keyvals))) ;; there must be a better way to "apply and"
	(let ((res #f))
	  (db:delay-if-busy)
	  (db:delay-if-busy dbdat)
	  (apply sqlite3:execute db (conc "INSERT OR IGNORE INTO runs (runname,state,status,owner,event_time" comma keystr ") VALUES (?,?,?,?,strftime('%s','now')" comma valslots ");")
		 allvals)
	  (db:delay-if-busy dbdat)
	  (apply sqlite3:for-each-row 
		 (lambda (id)
		   (set! res id))
		 db
		 (let ((qry (conc "SELECT id FROM runs WHERE (runname=? " andstr key=?str ");")))
					;(debug:print 4 "qry: " qry) 
		   qry)
		 qryvals)
	  (db:delay-if-busy)
	  (db:delay-if-busy dbdat)
	  (sqlite3:execute db "UPDATE runs SET state=?,status=?,event_time=strftime('%s','now') WHERE id=? AND state='deleted';" state status res)
	  res) 
	(begin
	  (debug:print 0 "ERROR: Called without all necessary keys")
	  #f))))


;; replace header and keystr with a call to runs:get-std-run-fields
;;
;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
;; runpatts: patt1,patt2 ...
;;
(define (db:get-runs db runpatt count offset keypatts)
(define (db:get-runs dbstruct runpatt count offset keypatts)
  (let* ((res       '())
	 (keys       (db:get-keys db))
	 (keys       (db:get-keys dbstruct))
	 (runpattstr (db:patt->like "runname" runpatt))
	 (remfields  (list "id" "runname" "state" "status" "owner" "event_time"))
	 (header     (append keys remfields))
	 (keystr     (conc (keys->keystr keys) ","
		           (string-intersperse remfields ",")))
			   (string-intersperse remfields ",")))
	 (qrystr     (conc "SELECT " keystr " FROM runs WHERE (" runpattstr ") " ;; runname LIKE ? "
		           ;; Generate: " AND x LIKE 'keypatt' ..."
		           (if (null? keypatts) ""
		               (conc " AND "
			   ;; Generate: " AND x LIKE 'keypatt' ..."
			   (if (null? keypatts) ""
			       (conc " AND "
				     (string-join 
				      (map (lambda (keypatt)
					     (let ((key  (car keypatt))
						   (patt (cadr keypatt)))
					       (db:patt->like key patt)))
					   keypatts)
				      " AND ")))
		           " AND state != 'deleted' ORDER BY event_time DESC "
		           (if (number? count)
		               (conc " LIMIT " count)
		               "")
		           (if (number? offset)
		               (conc " OFFSET " offset)
		               ""))))
			   " AND state != 'deleted' ORDER BY event_time DESC "
			   (if (number? count)
			       (conc " LIMIT " count)
			       "")
			   (if (number? offset)
			       (conc " OFFSET " offset)
			       ""))))
    (debug:print-info 11 "db:get-runs START qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count)
    (db:with-db dbstruct #f #f
		(lambda (db)		
    (sqlite3:for-each-row
     (lambda (a . x)
       (set! res (cons (apply vector a x) res)))
     db
     qrystr
     )
		  (sqlite3:for-each-row
		   (lambda (a . x)
		     (set! res (cons (apply vector a x) res)))
		   db
		   qrystr
		   )))
    (debug:print-info 11 "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count)
    (vector header res)))

;; db:get-runs-by-patt
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;;  to extract info from the structure returned
;;
;; NOTE: THIS IS COMPLETELY UNFINISHED. IT GOES WITH rmt:get-get-paths-matching-keynames
;;
(define (db:get-run-ids-matching dbstruct keynames target res)
;; (define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit) ;; test-name)
  (let* ((tmp      (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time")))
	 (keystr   (car tmp))
	 (header   (cadr tmp))
	 (res     '())
	 (key-patt "")
	 (runwildtype (if (substring-index "%" runnamepatt) "like" "glob"))
	 (qry-str  #f)
	 (keyvals  (if targpatt (keys:target->keyval keys targpatt) '())))
    (for-each (lambda (keyval)
		(let* ((key    (car keyval))
		       (patt   (cadr keyval))
		       (fulkey (conc ":" key))
		       (wildtype (if (substring-index "%" patt) "like" "glob")))
		  (if patt
		      (set! key-patt (conc key-patt " AND " key " " wildtype " '" patt "'"))
		      (begin
			(debug:print 0 "ERROR: searching for runs with no pattern set for " fulkey)
			(exit 6)))))
	      keyvals)
    (set! qry-str (conc "SELECT " keystr " FROM runs WHERE state != 'deleted' AND runname " runwildtype " ? " key-patt " ORDER BY event_time "
			(if limit  (conc " LIMIT " limit)   "")
			(if offset (conc " OFFSET " offset) "")
			";"))
    (debug:print-info 4 "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
    (db:with-db dbstruct #f #f ;; reads db, does not write to it.
		(lambda (db)
		  (sqlite3:for-each-row
		   (lambda (a . r)
		     (set! res (cons (list->vector (cons a r)) res)))
		   (db:get-db dbstruct #f)
		   qry-str
		   runnamepatt)))
    (vector header res)))

;; Get all targets from the db
;;
(define (db:get-targets db)
(define (db:get-targets dbstruct)
  (let* ((res       '())
	 (keys       (db:get-keys db))
	 (keys       (db:get-keys dbstruct))
	 (header     keys) ;; (map key:get-fieldname keys))
	 (keystr     (keys->keystr keys))
	 (qrystr     (conc "SELECT " keystr " FROM runs;"))
	 (qrystr     (conc "SELECT " keystr " FROM runs WHERE state != 'deleted';"))
	 (seen       (make-hash-table)))
    (db:with-db
     dbstruct
     #f
     #f
     (lambda (db)
    (sqlite3:for-each-row
     (lambda (a . x)
       (let ((targ (cons a x)))
	 (if (not (hash-table-ref/default seen targ #f))
	     (begin
	       (hash-table-set! seen targ #t)
	       (set! res (cons (apply vector targ) res))))))
     db
     qrystr)
    (debug:print-info 11 "db:get-targets END qrystr: " qrystr )
    (vector header res)))
       (sqlite3:for-each-row
	(lambda (a . x)
	  (let ((targ (cons a x)))
	    (if (not (hash-table-ref/default seen targ #f))
		(begin
		  (hash-table-set! seen targ #t)
		  (set! res (cons (apply vector targ) res))))))
	db
	qrystr)
       (debug:print-info 11 "db:get-targets END qrystr: " qrystr )
       (vector header res)))))

;; just get count of runs
(define (db:get-num-runs db runpatt)
  (let ((numruns 0))
    (debug:print-info 11 "db:get-num-runs START " runpatt)
    (sqlite3:for-each-row 
     (lambda (count)
       (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))
(define (db:get-num-runs dbstruct runpatt)
  (db:with-db
   dbstruct
   #f
   #f
   (lambda (db)
     (let ((numruns 0))
       (debug:print-info 11 "db:get-num-runs START " runpatt)
       (sqlite3:for-each-row 
	(lambda (count)
	  (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))))

(define (db:get-all-run-ids dbstruct)
  (db:with-db
   dbstruct
   #f
   #f
   (lambda (db)
     (let ((run-ids '()))
       (sqlite3:for-each-row
	(lambda (run-id)
	  (set! run-ids (cons run-id run-ids)))
	db
	"SELECT id FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;")
    (reverse run-ids)))))

;; get some basic run stats
;;
;; ( (runname (( state  count ) ... ))
;;   (   ...  
(define (db:get-run-stats db)
  (let ((totals       (make-hash-table))
	(res          '()))
(define (db:get-run-stats dbstruct)
  (let* ((dbdat        (db:get-db dbstruct #f))
	 (db           (db:dbdat-get-db dbdat))
	 (totals       (make-hash-table))
	 (curr         (make-hash-table))
	 (res          '())
	 (runs-info    '()))
    ;; First get all the runname/run-ids
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row
     (lambda (runname state count)
     (lambda (run-id runname)
       (let* ((stateparts (string-split state "|"))
	      (newstate   (conc (car stateparts) "\n" (cadr stateparts))))
	 (hash-table-set! totals newstate (+ (hash-table-ref/default totals newstate 0) count))
	 (set! res (cons (list runname newstate count) res))))
       (set! runs-info (cons (list run-id runname) runs-info)))
     db
     "SELECT runname,t.state||'|'||t.status AS s,count(t.id) FROM runs AS r INNER JOIN tests AS t ON r.id=t.run_id GROUP BY s,runname ORDER BY r.event_time,s DESC;" )
    ;; (set! res (reverse res))
     "SELECT id,runname FROM runs WHERE state != 'deleted';")
    ;; for each run get stats data
    (for-each
     (lambda (run-info)
       ;; get the net state/status counts for this run
       (let* ((run-id   (car  run-info))
	      (run-name (cadr run-info)))
	 (db:with-db
	  dbstruct
	  run-id
	  #f
	  (lambda (db)
	    (sqlite3:for-each-row
	     (lambda (state status count)
	       (let ((netstate (if (equal? state "COMPLETED") status state)))
		 (if (string? netstate)
		     (begin
		       (hash-table-set! totals netstate (+ (hash-table-ref/default totals netstate 0) count))
		       (hash-table-set! curr   netstate (+ (hash-table-ref/default curr   netstate 0) count))))))
	     db
	     "SELECT state,status,count(id) FROM tests AS t GROUP BY state,status ORDER BY state,status DESC;")
	    ;; add the per run counts to res
	    (for-each (lambda (state)
			(set! res (cons (list run-name state (hash-table-ref curr state)) res)))
		      (sort (hash-table-keys curr) string>=))
	    (set! curr (make-hash-table))))))
     runs-info)
    (for-each (lambda (state)
		(set! res (cons (list "Totals" state (hash-table-ref totals state)) res)))
	      (sort (hash-table-keys totals) string>=))
    res))

;; db:get-runs-by-patt
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db-get-value-by-header (db:get-header runinfo)(db:get-row runinfo))
;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;;  to extract info from the structure returned
;;
(define (db:get-runs-by-patt db keys runnamepatt targpatt offset limit) ;; test-name)
(define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit) ;; test-name)
  (let* ((tmp      (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time")))
	 (keystr   (car tmp))
	 (header   (cadr tmp))
	 (res     '())
	 (key-patt "")
	 (runwildtype (if (substring-index "%" runnamepatt) "like" "glob"))
	 (qry-str  #f)
	 (keyvals  (if targpatt (keys:target->keyval keys targpatt) '())))
    (for-each (lambda (keyval)
		(let* ((key    (car keyval))
		       (patt   (cadr keyval))
		       (fulkey (conc ":" key))
		       (wildtype (if (substring-index "%" patt) "like" "glob")))
		  (if patt
		      (set! key-patt (conc key-patt " AND " key " " wildtype " '" patt "'"))
		      (begin
			(debug:print 0 "ERROR: searching for runs with no pattern set for " fulkey)
			(exit 6)))))
	      keyvals)
    (set! qry-str (conc "SELECT " keystr " FROM runs WHERE state != 'deleted' AND runname " runwildtype " ? " key-patt " ORDER BY event_time"
    (set! qry-str (conc "SELECT " keystr " FROM runs WHERE state != 'deleted' AND runname " runwildtype " ? " key-patt " ORDER BY event_time "
			(if limit  (conc " LIMIT " limit)   "")
			(if offset (conc " OFFSET " offset) "")
			";"))
    (debug:print-info 4 "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
    (db:with-db dbstruct #f #f ;; reads db, does not write to it.
		(lambda (db)
    (sqlite3:for-each-row 
     (lambda (a . r)
       (set! res (cons (list->vector (cons a r)) res)))
     db 
     qry-str
     runnamepatt)
		  (sqlite3:for-each-row
		   (lambda (a . r)
		     (set! res (cons (list->vector (cons a r)) res)))
		   db
		   qry-str
		   runnamepatt)))
    (vector header res)))

;; use (get-value-by-header (db:get-header runinfo)(db:get-row runinfo))
(define (db:get-run-info db run-id)
;; use (get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
(define (db:get-run-info dbstruct run-id)
  ;;(if (hash-table-ref/default *run-info-cache* run-id #f)
  ;;    (hash-table-ref *run-info-cache* run-id)
  (let* ((dbdat     (db:get-db dbstruct #f))
	 (db        (db:dbdat-get-db dbdat))
  (let* ((res      #f)
	 (keys      (db:get-keys db))
	 (res       (vector #f #f #f #f))
	 (keys      (db:get-keys dbstruct))
	 (remfields (list "id" "runname" "state" "status" "owner" "event_time"))
	 (header    (append keys remfields))
	 (keystr    (conc (keys->keystr keys) ","
			  (string-intersperse remfields ","))))
    (debug:print-info 11 "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr)
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row
     (lambda (a . x)
       (set! res (apply vector a x)))
     db
     db 
     (conc "SELECT " keystr " FROM runs WHERE id=? AND state != 'deleted';")
     run-id)
    (debug:print-info 11 "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr)
    (let ((finalres (vector header res)))
      ;; (hash-table-set! *run-info-cache* run-id finalres)
      finalres)))

(define (db:set-comment-for-run db run-id comment)
(define (db:set-comment-for-run dbstruct run-id comment)
  (debug:print-info 11 "db:set-comment-for-run START run-id: " run-id " comment: " comment)
  (db:delay-if-busy)
  (sqlite3:execute db "UPDATE runs SET comment=? WHERE id=?;" comment run-id)
  (debug:print-info 11 "db:set-comment-for-run END run-id: " run-id " comment: " comment))
  (db:with-db
   dbstruct
   #f
   #f
   (lambda (db)
     (sqlite3:execute db "UPDATE runs SET comment=? WHERE id=?;" comment ;; (sdb:qry 'getid comment)
		      run-id))))

;; does not (obviously!) removed dependent data. But why not!!?
(define (db:delete-run db run-id)
(define (db:delete-run dbstruct run-id)
  (common:clear-caches) ;; don't trust caches after doing any deletion
  ;; First set any related tests to DELETED
  (let* ((rdbdat (db:get-db dbstruct run-id))
	 (rdb    (db:dbdat-get-db rdbdat))
	 (dbdat  (db:get-db dbstruct #f))
	 (db     (db:dbdat-get-db dbdat)))
  (db:delay-if-busy)
  (let ((stmt1 (sqlite3:prepare db "UPDATE tests SET state='DELETED',comment='' WHERE run_id=?;"))
    (db:delay-if-busy rdbdat)
    (sqlite3:execute rdb "UPDATE tests SET state='DELETED',comment='';")
	(stmt2 (sqlite3:prepare db "UPDATE runs SET state='deleted',comment='' WHERE id=?;")))
    (sqlite3:with-transaction
     db (lambda ()
	  (sqlite3:execute stmt1 run-id)
	  (sqlite3:execute stmt2 run-id)))
    (sqlite3:execute rdb "DELETE FROM test_steps;")
    (sqlite3:execute rdb "DELETE FROM test_data;")
    (sqlite3:finalize! stmt1)
    (sqlite3:finalize! stmt2)))
;;  (sqlite3:execute db "DELETE FROM runs WHERE id=?;" run-id))
    (db:delay-if-busy dbdat)
    (sqlite3:execute db "UPDATE runs SET state='deleted',comment='' WHERE id=?;" run-id)))

(define (db:update-run-event_time db run-id)
(define (db:update-run-event_time dbstruct run-id)
  (debug:print-info 11 "db:update-run-event_time START run-id: " run-id)
  (db:delay-if-busy)
  (sqlite3:execute db "UPDATE runs SET event_time=strftime('%s','now') WHERE id=?;" run-id)
  (debug:print-info 11 "db:update-run-event_time END run-id: " run-id)) 

(define (db:lock/unlock-run db run-id lock unlock user)
  (let ((newlockval (if lock "locked"
			(if unlock
			    "unlocked"
			    "locked")))) ;; semi-failsafe
  (db:with-db
   dbstruct
   #f
   #t
   (lambda (db)
     (sqlite3:execute db "UPDATE runs SET event_time=strftime('%s','now') WHERE id=?;" run-id))))

(define (db:lock/unlock-run dbstruct run-id lock unlock user)
  (db:with-db
   dbstruct
   #f
   #t
   (lambda (db)
     (let ((newlockval (if lock "locked"
			   (if unlock
			       "unlocked"
			       "locked")))) ;; semi-failsafe
    (db:delay-if-busy)
    (sqlite3:execute db "UPDATE runs SET state=? WHERE id=?;" newlockval run-id)
    (sqlite3:execute db "INSERT INTO access_log (user,accessed,args) VALUES(?,strftime('%s','now'),?);"
		     user (conc newlockval " " run-id))
    (debug:print-info 1 "" newlockval " run number " run-id)))
       (sqlite3:execute db "UPDATE runs SET state=? WHERE id=?;" newlockval run-id)
       (sqlite3:execute db "INSERT INTO access_log (user,accessed,args) VALUES(?,strftime('%s','now'),?);"
			user (conc newlockval " " run-id))
       (debug:print-info 1 "" newlockval " run number " run-id)))))

(define (db:set-run-status db run-id status #!key (msg #f))
  (db:delay-if-busy)
  (if msg
      (sqlite3:execute db "UPDATE runs SET status=?,comment=? WHERE id=?;" status msg run-id)
      (sqlite3:execute db "UPDATE runs SET status=? WHERE id=?;" status run-id)))
(define (db:set-run-status dbstruct run-id status msg)
  (let* ((dbdat (db:get-db dbstruct #f))
	 (db    (db:dbdat-get-db dbdat)))
    (db:delay-if-busy dbdat)
    (if msg
	(sqlite3:execute db "UPDATE runs SET status=?,comment=? WHERE id=?;" status msg run-id)
	(sqlite3:execute db "UPDATE runs SET status=? WHERE id=?;" status run-id))))

(define (db:get-run-status db run-id)
(define (db:get-run-status dbstruct run-id)
  (let ((res "n/a"))
    (db:with-db
     dbstruct
     #f
     #f
     (lambda (db)
    (sqlite3:for-each-row 
     (lambda (status)
       (set! res status))
     db 
     "SELECT status FROM runs WHERE id=?;" 
     run-id)
    res))
       (sqlite3:for-each-row 
	(lambda (status)
	  (set! res status))
	db
	"SELECT status FROM runs WHERE id=?;" 
	run-id)
       res))))

(define (db:get-run-ids db)
  (let ((res '()))
    (sqlite3:for-each-row
     (lambda (id)
       (set! res (cons id res)))
     db 
     "SELECT id FROM runs;")))

;;======================================================================
;; K E Y S
;;======================================================================

;; get key val pairs for a given run-id
;; ( (FIELDNAME1 keyval1) (FIELDNAME2 keyval2) ... )
(define (db:get-key-val-pairs db run-id)
  (let* ((keys (db:get-keys db))
	 (res  '()))
    (debug:print-info 11 "db:get-key-val-pairs START keys: " keys " run-id: " run-id)
(define (db:get-key-val-pairs dbstruct run-id)
  (let* ((keys (db:get-keys dbstruct))
	 (res  '())
	 (dbdat  (db:get-db dbstruct #f))
	 (db     (db:dbdat-get-db dbdat)))
    (for-each 
     (lambda (key)
       (let ((qry (conc "SELECT " key " FROM runs WHERE id=?;")))
	 ;; (debug:print 0 "qry: " qry)
	 (db:delay-if-busy dbdat)
	 (sqlite3:for-each-row 
	  (lambda (key-val)
	    (set! res (cons (list key key-val) res)))
	  db qry run-id)))
     keys)
    (debug:print-info 11 "db:get-key-val-pairs END keys: " keys " run-id: " run-id)
    (reverse res)))

;; get key vals for a given run-id
(define (db:get-key-vals db run-id)
(define (db:get-key-vals dbstruct run-id)
  (let ((mykeyvals (hash-table-ref/default *keyvals* run-id #f)))
    (if mykeyvals 
	mykeyvals
	(let* ((keys (db:get-keys db))
	       (res  '()))
  (let* ((keys (db:get-keys dbstruct))
	 (res  '())
	  (debug:print-info 11 "db:get-key-vals START keys: " keys " run-id: " run-id)
	  (for-each 
	   (lambda (key)
	     (let ((qry (conc "SELECT " key " FROM runs WHERE id=?;")))
	 (dbdat  (db:get-db dbstruct #f))
	 (db     (db:dbdat-get-db dbdat)))
    (for-each 
     (lambda (key)
       (let ((qry (conc "SELECT " key " FROM runs WHERE id=?;")))
	       ;; (debug:print 0 "qry: " qry)
	       (sqlite3:for-each-row 
		(lambda (key-val)
		  (set! res (cons key-val res)))
		db qry run-id)))
	   keys)
	 (db:delay-if-busy dbdat)
	 (sqlite3:for-each-row 
	  (lambda (key-val)
	    (set! res (cons key-val res)))
	  db qry run-id)))
     keys)
	  (debug:print-info 11 "db:get-key-vals END keys: " keys " run-id: " run-id)
	  (let ((final-res (reverse res)))
	    (hash-table-set! *keyvals* run-id final-res)
	    final-res)))))
    (let ((final-res (reverse res)))
      (hash-table-set! *keyvals* run-id final-res)
      final-res)))

;; The target is keyval1/keyval2..., cached in *target* as it is used often
(define (db:get-target db run-id)
(define (db:get-target dbstruct run-id)
  (let ((mytarg (hash-table-ref/default *target* run-id #f)))
    (if mytarg
	mytarg
	(let* ((keyvals (db:get-key-vals db run-id))
	       (thekey  (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")))
  (let* ((keyvals (db:get-key-vals dbstruct run-id))
	 (thekey  (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")))
	  (hash-table-set! *target* run-id thekey)
	  thekey))))
    thekey))

;; Get run-ids for runs with same target but different runnames and NOT run-id
;;
(define (db:get-prev-run-ids dbstruct run-id)
  (let* ((keyvals (rmt:get-key-val-pairs run-id))
	 (kvalues (map cadr keyvals))
	 (keys    (rmt:get-keys))
	 (qrystr  (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND ")))
    (let ((prev-run-ids '()))
      (db:with-db dbstruct #f #f ;; #f means work with the zeroth db - i.e. the runs db
       (lambda (db)
	 (apply sqlite3:for-each-row
		(lambda (id)
		  (set! prev-run-ids (cons id prev-run-ids)))
		db
		(conc "SELECT id FROM runs WHERE " qrystr " AND state != 'deleted' AND id != ?;") (append kvalues (list run-id)))))
      prev-run-ids)))

;;======================================================================
;;  T E S T S
;;======================================================================

;; 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* ((qryvalstr       (case qryvals
			    ((shortlist) "id,run_id,testname,item_path,state,status")
			    ((#f)        "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment")
			    (else        qryvals)))
	 (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
					" NOT IN ('"
					" IN ('") 
				    (string-intersperse states   "','")
				    "')")))
	 (statuses-qry    (if (null? statuses)
			      #f
			      (conc " status "
				    (if not-in 
					" NOT IN ('"
					" IN ('") 
				    (string-intersperse statuses "','")
				    "')")))
	 (states-statuses-qry 
	  (cond 
	   ((and states-qry statuses-qry)
	    (conc " AND ( " states-qry " AND " statuses-qry " ) "))
	   (states-qry  
	    (conc " AND " states-qry))
	   (statuses-qry 
	    (conc " AND " statuses-qry))
	   (else "")))
	 (tests-match-qry (tests:match->sqlqry testpatt))
	 (qry             (conc "SELECT " qryvalstr
				" FROM tests WHERE run_id=? AND state != 'DELETED' "
				states-statuses-qry
				(if tests-match-qry (conc " AND (" tests-match-qry ") ") "")
				(case sort-by
				  ((rundir)      " ORDER BY length(rundir) ")
				  ((testname)    (conc " ORDER BY testname " (if sort-order (conc sort-order ",") "") " item_path "))
				  ((statestatus) (conc " ORDER BY state " (if  sort-order (conc sort-order ",") "") " status "))
				  ((event_time)  " ORDER BY event_time ")
				  (else          (if (string? sort-by)
						     (conc " ORDER BY " sort-by)
						     "")))
				(if sort-order sort-order "")
				(if limit  (conc " LIMIT " limit)   "")
				(if offset (conc " OFFSET " offset) "")
				";"
				)))
    (debug:print-info 8 "db:get-tests-for-run qry=" qry)
    (sqlite3:for-each-row 
     (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
       (set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
     db 
     qry
     run-id
     )
    (case qryvals
      ((shortlist)(map db:test-short-record->norm res))
      ((#f)       res)
      (else       res))))
(define (db:get-tests-for-run dbstruct run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals)
  (if (not (number? run-id))
      (begin ;; no need to treat this as an error by default
	(debug:print 4 "WARNING: call to db:get-tests-for-run with bad run-id=" run-id)
	;; (print-call-chain (current-error-port))
	'())
      (let* ((qryvalstr       (case qryvals
				((shortlist) "id,run_id,testname,item_path,state,status")
				((#f)        db:test-record-qry-selector) ;; "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment")
				(else        qryvals)))
	     (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
					    " NOT IN ('"
					    " IN ('") 
					(string-intersperse states   "','")
					"')")))
	     (statuses-qry    (if (null? statuses)
				  #f
				  (conc " status "
					(if not-in 
					    " NOT IN ('"
					    " IN ('") 
					(string-intersperse statuses "','")
					"')")))
	     (states-statuses-qry 
	      (cond 
	       ((and states-qry statuses-qry)
		(conc " AND ( " states-qry " AND " statuses-qry " ) "))
	       (states-qry  
		(conc " AND " states-qry))
	       (statuses-qry 
		(conc " AND " statuses-qry))
	       (else "")))
	     (tests-match-qry (tests:match->sqlqry testpatt))
	     (qry             (conc "SELECT " qryvalstr
				    " FROM tests WHERE run_id=? AND state != 'DELETED' "
				    states-statuses-qry
				    (if tests-match-qry (conc " AND (" tests-match-qry ") ") "")
				    (case sort-by
				      ((rundir)      " ORDER BY length(rundir) ")
				      ((testname)    (conc " ORDER BY testname " (if sort-order (conc sort-order ",") "") " item_path "))
				      ((statestatus) (conc " ORDER BY state " (if  sort-order (conc sort-order ",") "") " status "))
				      ((event_time)  " ORDER BY event_time ")
				      (else          (if (string? sort-by)
							 (conc " ORDER BY " sort-by " ")
							 " ")))
				    (if sort-order sort-order " ")
				    (if limit  (conc " LIMIT " limit)   " ")
				    (if offset (conc " OFFSET " offset) " ")
				    ";"
				    )))
	(debug:print-info 8 "db:get-tests-for-run run-id=" run-id ", qry=" qry)
	(db:with-db dbstruct run-id #f
		    (lambda (db)
		      (sqlite3:for-each-row 
		       (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
			 (set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
		       db
		       qry
		       run-id
		       )))
	(case qryvals
	  ((shortlist)(map db:test-short-record->norm res))
	  ((#f)       res)
	  (else       res)))))

(define (db:test-short-record->norm inrec)
  ;;  "id,run_id,testname,item_path,state,status"
  ;;  "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
  (vector (vector-ref inrec 0) ;; id
	  (vector-ref inrec 1) ;; run_id
	  (vector-ref inrec 2) ;; testname
	  (vector-ref inrec 4) ;; state
	  (vector-ref inrec 5) ;; status
	  -1 "" -1 -1 "" "-" 
	  (vector-ref inrec 3) ;; item-path
	  -1 "-" "-"))


(define (db:get-tests-for-run-state-status db run-id testpatt)
  (let ((res            '())
	(tests-match-qry (tests:match->sqlqry testpatt)))
    (sqlite3:for-each-row
     (lambda (id testname item-path state status)
       ;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
       (set! res (cons (vector id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-") res)))
     db 
(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 "db:get-tests-for-run qry=" qry)
    (db:with-db dbstruct run-id #f
		(lambda (db)
		  (sqlite3:for-each-row
		   (lambda (id testname item-path state status)
		     ;;                      id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
		     (set! res (cons (vector id run-id testname state status -1         ""     -1      -1       ""    "-"  item-path -1           "-"         "-") res)))
		   db 
     (conc "SELECT id,testname,item_path,state,status FROM tests WHERE run_id=? " 
	   (if tests-match-qry (conc " AND (" tests-match-qry ") ") ""))
     run-id)
		   qry
		   run-id)))
    res))

(define (db:get-testinfo-state-status db test-id)
(define (db:get-testinfo-state-status dbstruct run-id test-id)
  (let ((res            #f))
    (db:with-db dbstruct run-id #f
		(lambda (db)
    (sqlite3:for-each-row
     (lambda (run-id testname item-path state status)
       ;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
       (set! res (vector test-id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-")))
     db 
     "SELECT run_id,testname,item_path,state,status FROM tests WHERE id=?;" 
     test-id)
		  (sqlite3:for-each-row
		   (lambda (run-id testname item-path state status)
		     ;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
		     (set! res (vector test-id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-")))
		   db 
		   "SELECT run_id,testname,item_path,state,status FROM tests WHERE id=?;" 
		   test-id)))
    res))

;; get a useful subset of the tests data (used in dashboard
;; use db:mintests-get-{id ,run_id,testname ...}
;; 
(define (db:get-tests-for-runs-mindata db run-ids testpatt states status not-in)
  (db:get-tests-for-runs db run-ids testpatt states status not-in: not-in qryvals: "id,run_id,testname,state,status,event_time,item_path"))

(define (db:get-tests-for-runs-mindata dbstruct run-ids testpatt states statuses not-in)
  (debug:print 0 "ERROR: BROKN!")
  ;; (db:get-tests-for-runs dbstruct run-ids testpatt states statuses not-in: not-in qryvals: "id,run_id,testname,state,status,event_time,item_path"))
)

;; get a useful subset of the tests data (used in dashboard
;;
(define (db:get-tests-for-run-mindata dbstruct run-id testpatt states statuses not-in)
  (db:get-tests-for-run dbstruct run-id testpatt states statuses #f #f not-in #f #f "id,run_id,testname,state,status,event_time,item_path"))
;; NB // This is get tests for "runs" (note the plural!!)

;; do not use.
;;
;; 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
;; run-ids is a list of run-ids or a single number or #f for all runs
(define (db:get-tests-for-runs db run-ids testpatt states statuses 
(define (db:get-tests-for-runs dbstruct run-ids testpatt states statuses #!key (not-in #f)(qryvals #f))
			       #!key (not-in #t)
			       (sort-by #f)
  ;; (db:delay-if-busy)
			       (qryvals "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment")) ;; 'rundir 'event_time
  (let* ((res '())
  (let ((res '()))
	 ;; if states or statuses are null then assume match all when not-in is false
	 (states-qry      (if (null? states) 
			      #f
    (for-each 
			      (conc " state "  
				    (if not-in "NOT" "") 
				    " IN ('" 
     (lambda (run-id)
       (set! res (append 
				    (string-intersperse states   "','")
				    "')")))
	 (statuses-qry    (if (null? statuses)
		  res 
			      #f
			      (conc " status "
				    (if not-in "NOT" "") 
		  (db:get-tests-for-run dbstruct run-id testpatt states statuses #f #f not-in #f #f qryvals))))
				    " IN ('" 
				    (string-intersperse statuses "','")
				    "')")))
	 (tests-match-qry (tests:match->sqlqry testpatt))
	 (qry             (conc "SELECT " qryvals 
				" FROM tests WHERE state != 'DELETED' "
				(if run-ids
				    (if (list? run-ids)
     (if run-ids
	 run-ids
					(conc "AND run_id IN (" (string-intersperse (map conc run-ids) ",") ") ")
					(conc "AND run_id=" run-ids " "))
	 (db:get-all-run-ids dbstruct)))
				    " ") ;; #f => run-ids don't filter on run-ids
				(if states-qry   (conc " AND " states-qry)   "")
				(if statuses-qry (conc " AND " statuses-qry) "")
				(if tests-match-qry (conc " AND (" tests-match-qry ") ") "")
				(case sort-by
				  ((rundir)     " ORDER BY length(rundir) DESC;")
				  ((event_time) " ORDER BY event_time ASC;")
				  (else         ";"))
				)))
    (debug:print-info 8 "db:get-tests-for-runs qry=" qry)
    (sqlite3:for-each-row 
     (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
       (set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
     db 
     qry
     )
    res))

;; this one is a bit broken BUG FIXME
(define (db:delete-test-step-records db test-id #!key (work-area #f))
  ;; Breaking it into two queries for better file access interleaving
  (let* ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area)))
    ;; test db's can go away - must check every time
    (if (sqlite3:database? tdb)
	(begin
	  (sqlite3:execute tdb "DELETE FROM test_steps;")
	  (sqlite3:execute tdb "DELETE FROM test_data;")
	  (sqlite3:finalize! tdb)))))

;; 
;; Convert calling routines to get list of run-ids and loop, do not use the get-tests-for-runs
;;
(define (db:delete-test-records db tdb test-id #!key (force #f))
  (common:clear-caches)
  (db:delay-if-busy)
  (if tdb 
      (begin
	(sqlite3:execute tdb "DELETE FROM test_steps;")
	(sqlite3:execute tdb "DELETE FROM test_data;")))
  ;; (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id))
  (if db 
      (begin
	(sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" test-id)
	(sqlite3:execute db "DELETE FROM test_data  WHERE test_id=?;" test-id)
	(if force
	    (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id)
	    (sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id)))))

(define (db:delete-tests-for-run db run-id)
(define (db:delete-test-records dbstruct run-id test-id)
  (common:clear-caches)
  (db:delay-if-busy)
  (sqlite3:execute db "DELETE FROM tests WHERE run_id=?;" run-id))
  (let* ((dbdat (db:get-db dbstruct run-id))
	 (db    (db:dbdat-get-db dbdat)))
    (db:general-call dbdat 'delete-test-step-records (list test-id))
    ;; (db:delay-if-busy)
    (db:general-call dbdat 'delete-test-data-records (list test-id))
    (sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id)))

(define (db:delete-old-deleted-test-records db)
(define (db:delete-old-deleted-test-records dbstruct)
  (common:clear-caches)
  (let ((targtime (- (current-seconds)(* 30 24 60 60)))) ;; one month in the past
    (db:delay-if-busy)
    (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED' AND event_time<?;" targtime)))
  (let ((run-ids  (db:get-all-run-ids dbstruct))
	(targtime (- (current-seconds)(* 30 24 60 60)))) ;; one month in the past
    (for-each
     (lambda (run-id)
       (db:with-db
	dbstruct
	run-id
	#t
	(lambda (db)
	  (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED' AND event_time<?;" targtime))))
     run-ids)))

;; set tests with state currstate and status currstatus to newstate and newstatus
;; use currstate = #f and or currstatus = #f to apply to any state or status respectively
;; WARNING: SQL injection risk. NB// See new but not yet used "faster" version below
;;
		;;  AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")))
		;;(debug:print 0 "QRY: " qry)
		;; (db:delay-if-busy)

(define (db:set-tests-state-status db run-id testnames currstate currstatus newstate newstatus)
(define (db:set-tests-state-status dbstruct run-id testnames currstate currstatus newstate newstatus)
  (for-each (lambda (testname)
	      (let ((qry (conc "UPDATE tests SET state=?,status=? WHERE "
			       (if currstate  (conc "state='" currstate "' AND ") "")
			       (if currstatus (conc "status='" currstatus "' AND ") "")
			       " run_id=? AND testname=? AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")))
			       " run_id=? AND testname LIKE ?;")))
		;;(debug:print 0 "QRY: " qry)
		(db:delay-if-busy)
		(db:with-db
		(sqlite3:execute db qry run-id newstate newstatus testname testname)))
	    testnames))

		 dbstruct
		 run-id
(define (cdb:delete-tests-in-state serverdat run-id state)
  (common:clear-caches)
  (cdb:client-call serverdat 'delete-tests-in-state #t *default-numtries* run-id state))

		 #t
(define (cdb:tests-update-cpuload-diskfree serverdat test-id cpuload diskfree)
  (cdb:client-call serverdat 'update-cpuload-diskfree #t *default-numtries* cpuload diskfree test-id))

		 (lambda (db)
(define (cdb:tests-update-run-duration serverdat test-id minutes)
  (cdb:client-call serverdat 'update-run-duration #t *default-numtries* minutes test-id))

(define (cdb:tests-update-uname-host serverdat test-id uname hostname)
		   (sqlite3:execute db qry newstate newstatus run-id testname)))))
	    testnames))
  (cdb:client-call serverdat 'update-uname-host #t *default-numtries* uname hostname test-id))

;; speed up for common cases with a little logic
;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id
;;
(define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment)
  (db:delay-if-busy)
  (cond
   ((and newstate newstatus newcomment)
    (sqlite3:execute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus newcomment test-id))
   ((and newstate newstatus)
    (sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id))
   (else
    (if newstate   (sqlite3:execute db "UPDATE tests SET state=?   WHERE id=?;" newstate   test-id))
    (if newstatus  (sqlite3:execute db "UPDATE tests SET status=?  WHERE id=?;" newstatus  test-id))
    (if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment test-id))))
  (mt:process-triggers test-id newstate newstatus))
(define (db:test-set-state-status-by-id dbstruct run-id test-id newstate newstatus newcomment)
  (db:with-db
   dbstruct
   run-id
   #t
   (lambda (db)
     (cond
      ((and newstate newstatus newcomment)
       (sqlite3:execute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus newcomment ;; (sdb:qry 'getid newcomment)
			test-id))
      ((and newstate newstatus)
       (sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id))
      (else
       (if newstate   (sqlite3:execute db "UPDATE tests SET state=?   WHERE id=?;" newstate   test-id))
       (if newstatus  (sqlite3:execute db "UPDATE tests SET status=?  WHERE id=?;" newstatus  test-id))
       (if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment ;; (sdb:qry 'getid newcomment)
				       test-id))))
     (mt:process-triggers run-id test-id newstate newstatus))))

;; Never used, but should be?
;; NEW BEHAVIOR: Count tests running in only one run!
(define (db:test-set-state-status-by-run-id-testname db run-id test-name item-path status state)
  (db:delay-if-busy)
  (sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;" 
 		   state status run-id test-name item-path))

(define (db:get-count-tests-running db)
;;
(define (db:get-count-tests-running dbstruct run-id)
  (let ((res 0))
    (sqlite3:for-each-row
     (lambda (count)
       (set! res count))
     db
     "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id NOT IN (SELECT id FROM runs WHERE state='deleted') AND NOT (uname = 'n/a' AND item_path = '');")
    res))
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (sqlite3:first-result 
      db
      ;; WARNING BUG EDIT ME - merged from v1.55 - not sure what is right here ...
      ;; AND run_id NOT IN (SELECT id FROM runs WHERE state='deleted')
      "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND NOT (uname = 'n/a' AND item_path = '');"
      ;; "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=?;" 
      ))))

;; override states to count with list of strings.
;; NEW BEHAVIOR: Count tests running in only one run!
;;
(define (db:get-count-tests-running-for-run-id db run-id states)
  (let ((res 0)
	(sqrystr (conc "SELECT count(id) FROM tests WHERE state in ('"
		       (if states
			   (string-intersperse states "','")
(define (db:get-count-tests-actually-running dbstruct run-id)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (sqlite3:first-result
      db
      ;; WARNING BUG EDIT ME - merged from v1.55 - not sure what is right here ...
      ;; "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id NOT IN (SELECT id FROM runs WHERE state='deleted') AND NOT (uname = 'n/a' AND item_path = '');")
      "SELECT count(id) FROM tests WHERE state in ('RUNNING','REMOTEHOSTSTART') AND run_id=?;" 
      run-id)))) ;; NOT IN (SELECT id FROM runs WHERE state='deleted');")

			   "RUNNING','LAUNCHED','REMOTEHOSTSTART")
		       "') AND run_id=? AND NOT (uname = 'n/a' AND item_path = '');")))
    (sqlite3:for-each-row
     (lambda (count)
;; NEW BEHAVIOR: Look only at single run with run-id
;; 
;; (define (db:get-running-stats dbstruct run-id)
(define (db:get-count-tests-running-for-run-id dbstruct run-id)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
       (set! res count))  ;; select * from tests where run_id=1 and uname = 'n/a' and item_path='';
     db
     (sqlite3:first-result
      db
     sqrystr run-id)
     ;; "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=? AND NOT (uname = 'n/a' AND item_path = '');" run-id)
      "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=? AND NOT (uname = 'n/a' AND item_path = '');" run-id))))
    res))

;; For a given testname how many items are running? Used to determine
;; probability for regenerating html
;; 
(define (db:get-running-stats db)
(define (db:get-count-tests-running-for-testname dbstruct run-id testname)
  (let ((res '()))
    (sqlite3:for-each-row
     (lambda (state count)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
       (set! res (cons (list state count) res)))
     db
     "SELECT state,count(id) FROM tests GROUP BY state ORDER BY id DESC;")
     (sqlite3:first-result
      db
      "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=? AND NOT (uname = 'n/a' AND item_path = '') AND testname=?;" run-id testname))))
    res))

(define (db:get-count-tests-running-in-jobgroup db jobgroup)
(define (db:get-count-tests-running-in-jobgroup dbstruct run-id jobgroup)
  (let* ((dbdat (db:get-db dbstruct #f))
	 (db    (db:dbdat-get-db dbdat)))
  (if (not jobgroup)
      0 ;; 
      (let ((res 0))
      (let ((testnames '()))
	;; get the testnames
	(db:delay-if-busy dbdat)
	(sqlite3:for-each-row
	 (lambda (count)
	   (set! res count))
	 (lambda (testname)
	   (set! testnames (cons testname testnames)))
	 db
	 "SELECT testname FROM test_meta WHERE jobgroup=?"
	 jobgroup)
	;; get the jobcount NB// EXTEND THIS TO OPPERATE OVER ALL RUNS?
	(if (not (null? testnames))
	    (db:with-db
	     dbstruct
	     run-id
	     #f
	     (lambda (db)
	       (sqlite3:first-result
		db
	 "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART')
             AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?)
             AND NOT (uname = 'n/a' AND item_path = '');"
		(conc "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND testname in ('"
		      (string-intersperse testnames "','")
		      "') AND NOT (uname = 'n/a' AND item_path='');")) ;; should this include the (uname = 'n/a' ...) ???
	       0)))))))
             ;; DEBUG FIXME - need to merge this v.155 query correctly   
             ;; AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?)
             ;; AND NOT (uname = 'n/a' AND item_path = '');"
	 jobgroup)
	res)))

;; done with run when:
;;   0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING
(define (db:estimated-tests-remaining db run-id)
  (let ((res 0))
    (sqlite3:for-each-row
     (lambda (count)
       (set! res count))
(define (db:estimated-tests-remaining dbstruct run-id)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (sqlite3:first-result
     db ;; NB// KILLREQ means the jobs is still probably running
     "SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING','KILLREQ') AND run_id=?;" run-id)
      db
      "SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING','KILLREQ');"))))
    res))

;; map run-id, testname item-path to test-id
(define (db:get-test-id-cached db run-id testname item-path)
  (let* ((test-key (conc run-id "-" testname "-" item-path))
	 (res      (hash-table-ref/default *test-ids* test-key #f)))
    (if res 
	res
	(begin
	  (sqlite3:for-each-row
	   (lambda (id) ;;  run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment )
(define (db:get-test-id dbstruct run-id testname item-path)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (db:first-result-default
      db
      "SELECT id FROM tests WHERE testname=? AND item_path=?;"
      #f ;; the default
      testname item-path))))

;; overload the unused attemptnum field for the process id of the runscript or 
;; ezsteps step script in progress
;;
(define (db:test-set-top-process-pid dbstruct run-id test-id pid)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (sqlite3:execute db "UPDATE tests SET attemptnum=? WHERE id=?;"
		      pid test-id))))

	     (set! res id)) ;; (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment )))
	   db 
	   "SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?;"
	   run-id testname item-path)
	  (hash-table-set! *test-ids* test-key res)
	  res))))
(define (db:test-get-top-process-pid dbstruct run-id test-id)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (db:first-result-default 
      db
      "SELECT attemptnum FROM tests WHERE id=?;"
      #f
      test-id))))

(define db:test-record-fields '("id"           "run_id"        "testname"  "state"      "status"      "event_time"
				"host"         "cpuload"       "diskfree"  "uname"      "rundir"      "item_path"
                                "run_duration" "final_logf"    "comment"   "shortdir"   "attemptnum"  "archived"))

;; fields *must* be a non-empty list
;;
(define (db:field->number fieldname fields)
  (if (null? fields)
      #f
      (let loop ((hed  (car fields))
		 (tal  (cdr fields))
		 (indx 0))
	(if (equal? fieldname hed)
	    indx
	    (if (null? tal)
		#f
		(loop (car tal)(cdr tal)(+ indx 1)))))))

(define db:test-record-qry-selector (string-intersperse db:test-record-fields ","))

;; map run-id, testname item-path to test-id
(define (db:get-test-id-not-cached db run-id testname item-path)
  (let* ((res #f))

;; NOTE: Use db:test-get* to access records
;; NOTE: This needs rundir decoding? Decide, decode here or where used? For the moment decode where used.
(define (db:get-all-tests-info-by-run-id dbstruct run-id)
  (let* ((dbdat (if (vector? dbstruct)
		    (db:get-db dbstruct run-id)
		    dbstruct)) ;; still settling on when to use dbstruct or dbdat
	 (db    (db:dbdat-get-db dbdat))
	 (res '()))
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row
     (lambda (id) ;;  run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment )
       (set! res id)) ;; (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment )))
     db 
     "SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?;"
     run-id testname item-path)
     (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum archived)
       ;;                 0    1       2      3      4        5       6      7        8     9     10      11          12          13       14     15        16
       (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum archived)
		       res)))
     db
     (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE state != 'DELETED' AND run_id=?;")
     run-id)
    res))

(define db:get-test-id db:get-test-id-not-cached)

;; given a test-info record, patch in the latest data from the testdat.db file
;; found in the test run directory
;;
;; NOT USED
(define (db:replace-test-records dbstruct run-id testrecs)
  (db:with-db dbstruct run-id #t 
	      (lambda (db)
		(let* ((qmarks (string-intersperse (make-list (length db:test-record-fields) "?") ","))
		       (qrystr (conc "INSERT OR REPLACE INTO tests (" db:test-record-qry-selector ") VALUES (" qmarks ");"))
		       (qry    (sqlite3:prepare db qrystr)))
		  (debug:print 0 "INFO: migrating test records for run with id " run-id)
		  (sqlite3:with-transaction
		   db
		   (lambda ()
		     (for-each 
		      (lambda (rec)
			;; (debug:print 0 "INFO: Inserting values: " (string-intersperse (map conc (vector->list rec)) ",") "\n")
			(apply sqlite3:execute qry (vector->list rec)))
		      testrecs)))
		  (sqlite3:finalize! qry)))))

;; map a test-id into the proper range
;;
(define (db:patch-tdb-data-into-test-info db test-id res #!key (work-area #f))
  (let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area)))
    ;; get state and status from megatest.db in real time
(define (db:adj-test-id mtdb min-test-id test-id)
  (if (>= test-id min-test-id)
      test-id
    ;; other fields that perhaps should be updated:
    ;;   fail_count
      (let loop ((new-id min-test-id))
	(let ((test-id-found #f))
    ;;   pass_count
    ;;   final_logf
    (sqlite3:for-each-row
     (lambda (state status final_logf)
       (db:test-set-state!        res state)
	  (sqlite3:for-each-row 
	   (lambda (id)
	     (set! test-id-found id))
       (db:test-set-status!       res status)
       (db:test-set-final_logf!   res final_logf))
     db
     "SELECT state,status,final_logf FROM tests WHERE id=?;"
     test-id)
    (if tdb
	(begin
	  (sqlite3:for-each-row
	   (lambda (update_time cpuload disk_free run_duration)
	     (db:test-set-cpuload!      res cpuload)
	     (db:test-set-diskfree!     res disk_free)
	     (db:test-set-run_duration! res run_duration))
	   tdb
	   (db:dbdat-get-db mtdb)
	   "SELECT id FROM tests WHERE id=?;"
	   new-id)
	  ;; if test-id-found then need to try again
	  (if test-id-found
	      (loop (+ new-id 1))
	      (begin
		(debug:print-info 0 "New test id " new-id " selected for test with id " test-id)
		(sqlite3:execute mtdb "UPDATE tests SET id=? WHERE id=?;" new-id test-id)))))))

;; move test ids into the 30k * run_id range
;;
(define (db:prep-megatest.db-adj-test-ids mtdb run-id testrecs)
  (debug:print-info 0 "Adjusting test ids in megatest.db for run " run-id)
  (let ((min-test-id (* run-id 30000)))
    (for-each 
     (lambda (testrec)
       (let* ((test-id (vector-ref testrec (db:field->number "id" db:test-record-fields))))
	 (db:adj-test-id (db:dbdat-get-db mtdb) min-test-id test-id)))
     testrecs)))
	
	   "SELECT update_time,cpuload,diskfree,run_duration FROM test_rundat ORDER BY id DESC LIMIT 1;")
	  (sqlite3:finalize! tdb))
	;; if the test db is not found what to do?
	;; 1. set state to DELETED
	;; 2. set status to n/a
	(begin
	  (db:test-set-state!  res "NOT_STARTED")
	  (db:test-set-status! res "n/a")))))

;; 1. move test ids into the 30k * run_id range
;; 2. move step ids into the 30k * run_id range
;;
(define (db:prep-megatest.db-for-migration mtdb)
  (let* ((run-ids (db:get-all-run-ids mtdb)))
    (for-each 
     (lambda (run-id)
       (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)))
	 (db:prep-megatest.db-adj-test-ids (db:dbdat-get-db mtdb) run-id testrecs)))
     run-ids)))

;; Get test data using test_id
(define (db:get-test-info-by-id dbstruct run-id test-id)
  (db:with-db
   dbstruct
   run-id
(define *last-test-cache-delete* (current-seconds))

(define (db:clean-all-caches)
  (set! *test-info* (make-hash-table))
  (set! *test-id-cache* (make-hash-table)))
   #f
   (lambda (db)
     (let ((res #f))
       (sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
	(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived)
	  ;;             0    1       2      3      4        5       6      7        8     9     10      11          12          13           14         15          16
	  (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived)))
	db
	(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;")
	test-id)
       res))))

;; Use db:test-get* to access
;; Get test data using test_ids. NB// Only works within a single run!!
;;
;; Get test data using test_id
(define (db:get-test-info-by-id db test-id)
  (if (not test-id)
      (begin
(define (db:get-test-info-by-ids dbstruct run-id test-ids)
  (db:with-db
   dbstruct
   run-id
	(debug:print-info 4 "db:get-test-info-by-id called with test-id=" test-id)
	#f)
      (let ((res #f))
	(sqlite3:for-each-row
	 (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)
	   ;;                 0    1       2      3      4        5       6      7        8     9     10      11          12          13       14
	   (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)))
	 db 
	 "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id=?;"
	 test-id)
	res)))

;; Use db:test-get* to access
   #f
   (lambda (db)
     (let ((res '()))
       (sqlite3:for-each-row
	(lambda (a . b)
	  ;;                 0    1       2      3      4        5       6      7        8     9     10      11          12          13       14
	  (set! res (cons (apply vector a b) res)))
	db
	(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id in ("
	      (string-intersperse (map conc test-ids) ",") ");"))
       res))))

(define (db:get-test-info dbstruct run-id testname item-path)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (let ((res #f))
       (sqlite3:for-each-row
	(lambda (a . b)
	  (set! res (apply vector a b)))
	db
	(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE testname=? AND item_path=?;")
	test-name item-path)
       res))))

(define (db:test-get-rundir-from-test-id dbstruct run-id test-id)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (db:first-result-default
      db
      "SELECT rundir FROM tests WHERE id=?;"
      #f ;; default result
      test-id))))

;;======================================================================
;; S T E P S
;;======================================================================

(define (db:teststep-set-status! dbstruct run-id test-id teststep-name state-in status-in comment logfile)
  (db:with-db
   dbstruct
   run-id
   #t
   (lambda (db)
     (sqlite3:execute 
      db
      "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);"
      test-id teststep-name state-in status-in (current-seconds)
      (if comment comment "")
      (if logfile logfile "")))))
   
;; db-get-test-steps-for-run
;;
;; Get test data using test_ids
(define (db:get-test-info-by-ids db test-ids)
  (if (null? test-ids)
      (begin
(define (db:get-steps-for-test dbstruct run-id test-id)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (let* ((res '()))
       (sqlite3:for-each-row 
	(lambda (id test-id stepname state status event-time logfile)
	  (set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res)))
	db
	"SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE status != 'DELETED' AND test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
	test-id)
       (reverse res)))))

	(debug:print-info 4 "db:get-test-info-by-ids called with test-ids=" test-ids)
	'())
      (let ((res '()))
	(sqlite3:for-each-row
	 (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)
(define (db:get-steps-data dbstruct run-id test-id)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (let ((res '()))
       (sqlite3:for-each-row 
	(lambda (id test-id stepname state status event-time logfile)
	   ;;                 0    1       2      3      4        5       6      7        8     9     10      11          12          13       14
	   (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)
	  (set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res)))
			   res)))
	 db 
	 (conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id in ("
	       (string-intersperse (map conc test-ids) ",") ");"))
	res)))
	db
	"SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE status != 'DELETED' AND test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
	test-id)
       (reverse res)))))

(define (db:get-test-info db run-id testname item-path)
  (db:get-test-info-by-id db (db:get-test-id db run-id testname item-path)))
;;======================================================================
;; T E S T  D A T A 
;;======================================================================

;; WARNING: Do NOT call this for the parent test on an iterated test
;; Roll up test_data pass/fail results
;; look at the test_data status field, 
;;    if all are pass (any case) and the test status is PASS or NULL or '' then set test status to PASS.
;;    if one or more are fail (any case) then set test status to PASS, non "pass" or "fail" are ignored
(define (db:test-set-comment db test-id comment)
  (db:delay-if-busy)
  (sqlite3:execute 
   db
(define (db:test-data-rollup dbstruct run-id test-id status)
  (let* ((dbdat      (db:get-db dbstruct run-id))
	 (db         (db:dbdat-get-db dbdat))
	 (fail-count 0)
	 (pass-count 0))
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row
     (lambda (fcount pcount)
       (set! fail-count fcount)
       (set! pass-count pcount))
     db 
   "UPDATE tests SET comment=? WHERE id=?;"
   comment test-id))

     "SELECT (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'fail') AS fail_count,
             (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'pass') AS pass_count;"
     test-id test-id)
    ;; Now rollup the counts to the central megatest.db
(define (cdb:test-set-rundir! serverdat run-id test-name item-path rundir)
  (cdb:client-call serverdat 'test-set-rundir #t *default-numtries* rundir run-id test-name item-path))
    (db:general-call dbdat 'pass-fail-counts (list pass-count fail-count test-id))
    ;; if the test is not FAIL then set status based on the fail and pass counts.
    (db:general-call dbdat 'test_data-pf-rollup (list test-id test-id test-id test-id))))

(define (cdb:test-set-rundir-by-test-id serverdat test-id rundir)
(define (db:csv->test-data dbstruct run-id test-id csvdata)
  (cdb:client-call serverdat 'test-set-rundir-by-test-id #t *default-numtries* rundir test-id))

  (debug:print 4 "test-id " test-id ", csvdata: " csvdata)
  (let* ((dbdat   (db:get-db dbstruct run-id))
	 (db      (db:dbdat-get-db dbdat))
	 (csvlist (csv->list (make-csv-reader
			      (open-input-string csvdata)
			      '((strip-leading-whitespace? #t)
				(strip-trailing-whitespace? #t)))))) ;; (csv->list csvdata)))
    (for-each 
     (lambda (csvrow)
       (let* ((padded-row  (take (append csvrow (list #f #f #f #f #f #f #f #f #f)) 9))
	      (category    (list-ref padded-row 0))
	      (variable    (list-ref padded-row 1))
	      (value       (any->number-if-possible (list-ref padded-row 2)))
	      (expected    (any->number-if-possible (list-ref padded-row 3)))
	      (tol         (any->number-if-possible (list-ref padded-row 4))) ;; >, <, >=, <=, or a number
	      (units       (list-ref padded-row 5))
	      (comment     (list-ref padded-row 6))
	      (status      (let ((s (list-ref padded-row 7)))
			     (if (and (string? s)(or (string-match (regexp "^\\s*$") s)
						     (string-match (regexp "^n/a$") s)))
				 #f
				 s))) ;; if specified on the input then use, else calculate
	      (type        (list-ref padded-row 8)))
	 ;; look up expected,tol,units from previous best fit test if they are all either #f or ''
	 (debug:print 4 "BEFORE: category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment " type: " type)
	 
(define (db:test-get-rundir-from-test-id db test-id)
  (let ((res #f)) ;; (hash-table-ref/default *test-paths* test-id #f)))
    ;; (if res
    ;;     res
    ;;     (begin
	 (if (and (or (not expected)(equal? expected ""))
		  (or (not tol)     (equal? expected ""))
		  (or (not units)   (equal? expected "")))
    (sqlite3:for-each-row
     (lambda (tpath)
       (set! res tpath))
	     (let-values (((new-expected new-tol new-units)(tdb:get-prev-tol-for-test tdb test-id category variable)))
			 (set! expected new-expected)
     db 
     "SELECT rundir FROM tests WHERE id=?;"
     test-id)
    ;; (hash-table-set! *test-paths* test-id res)
    res)) ;; ))

(define (cdb:test-set-log! serverdat test-id logf)
			 (set! tol      new-tol)
			 (set! units    new-units)))
	 
	 (debug:print 4 "AFTER:  category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
	 ;; calculate status if NOT specified
	 (if (and (not status)(number? expected)(number? value)) ;; need expected and value to be numbers
	     (if (number? tol) ;; if tol is a number then we do the standard comparison
		 (let* ((max-val (+ expected tol))
			(min-val (- expected tol))
			(result  (and (>=  value min-val)(<= value max-val))))
		   (debug:print 4 "max-val: " max-val " min-val: " min-val " result: " result)
		   (set! status (if result "pass" "fail")))
		 (set! status ;; NB// need to assess each one (i.e. not return operator since need to act if not valid op.
		       (case (string->symbol tol) ;; tol should be >, <, >=, <=
			 ((>)  (if (>  value expected) "pass" "fail"))
			 ((<)  (if (<  value expected) "pass" "fail"))
			 ((>=) (if (>= value expected) "pass" "fail"))
			 ((<=) (if (<= value expected) "pass" "fail"))
			 (else (conc "ERROR: bad tol comparator " tol))))))
	 (debug:print 4 "AFTER2: category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
	 (db:delay-if-busy dbdat)
	 (sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status,type) VALUES (?,?,?,?,?,?,?,?,?,?);"
			  test-id category variable value expected tol units (if comment comment "") status type)))
  (if (string? logf)(cdb:client-call serverdat 'test-set-log #f *default-numtries* logf test-id)))
     csvlist)))

;;======================================================================
;; Misc. test related queries
;;======================================================================

;; MUST BE CALLED local!
(define (db:test-get-paths-matching db keynames target fnamepatt #!key (res '()))
  ;; BUG: Move the values derived from args to parameters and push to megatest.scm
  (let* ((testpatt   (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%"))
	 (statepatt  (or (args:get-arg "-state")   (args:get-arg ":state")    "%"))
	 (statuspatt (or (args:get-arg "-status")  (args:get-arg ":status")   "%"))
	 (runname    (or (args:get-arg "-runname") (args:get-arg ":runname")  "%"))
	 (paths-from-db (cdb:remote-run db:test-get-paths-matching-keynames-target-new db keynames target res
					testpatt:   testpatt
					statepatt:  statepatt
					statuspatt: statuspatt
					runname:    runname)))
    (if fnamepatt
	(apply append 
	       (map (lambda (p)
		      (if (directory-exists? p)
			  (glob (conc p "/" fnamepatt))
			  '()))
		    paths-from-db))
	paths-from-db)))

(define (db:get-run-ids-matching-target dbstruct keynames target res runname testpatt statepatt statuspatt)
(define (db:test-get-paths-matching-keynames-target db keynames target res 
						    #!key
						    (testpatt   "%")
						    (statepatt  "%")
						    (statuspatt "%")
						    (runname    "%"))
  (let* ((keystr (string-intersperse 
  (let* ((dbdat    (db:get-db dbstruct #f))
		  (map (lambda (key val)
			 (conc "r." key " like '" val "'"))
		       keynames 
		       (string-split target "/"))
		  " AND "))
	 (testqry (tests:match->sqlqry testpatt))
	 (qrystr (conc "SELECT t.rundir FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id WHERE "
		       keystr " AND r.runname LIKE '" runname "' AND " testqry
		       " AND t.state LIKE '" statepatt "' AND t.status LIKE '" statuspatt 
		       "' ORDER BY t.event_time ASC;")))
    (sqlite3:for-each-row 
     (lambda (p)
       (set! res (cons p res)))
     db 
     qrystr)
    res))

	 (db       (db:dbdat-get-db dbdat))
(define (db:test-get-paths-matching-keynames-target-new db keynames target res 
							#!key
							(testpatt   "%")
							(statepatt  "%")
							(statuspatt "%")
							(runname    "%"))
  (let* ((row-ids '())
	 (row-ids '())
	 (keystr (string-intersperse 
		  (map (lambda (key val)
			 (conc key " like '" val "'"))
		       keynames 
		       (string-split target "/"))
		  " AND "))
	 (testqry (tests:match->sqlqry testpatt))
	 (runsqry (sqlite3:prepare db (conc "SELECT id FROM runs WHERE " keystr " AND runname LIKE '" runname "';")))
	 ;; (testqry (tests:match->sqlqry testpatt))
	 (runsqry (sqlite3:prepare db (conc "SELECT id FROM runs WHERE " keystr " AND runname LIKE '" runname "';"))))
	 (tstsqry (sqlite3:prepare db (conc "SELECT rundir FROM tests WHERE run_id=? AND " testqry " AND state LIKE '" statepatt "' AND status LIKE '" statuspatt "' ORDER BY event_time ASC;"))))
    ;; (debug:print 8 "db:test-get-paths-matching-keynames-target-new\n  runsqry=" runsqry "\n  tstsqry=" testqry)
    (sqlite3:for-each-row
     (lambda (rid)
       (set! row-ids (cons rid row-ids)))
     runsqry)
    (for-each (lambda (rid)
		(sqlite3:for-each-row 
		 (lambda (p)
		   (set! res (cons p res)))
		 tstsqry rid))
	      row-ids)
    (sqlite3:finalize! tstsqry)
    (sqlite3:finalize! runsqry)
    res))
    row-ids))

;; look through tests from matching runs for a file
(define (db:test-get-first-path-matching db keynames target fname)
  ;; [refpaths] is the section where references to other megatest databases are stored
  (let ((mt-paths (configf:get-section "refpaths"))
	(res       (db:test-get-paths-matching db keynames target fname)))
(define (db:test-get-paths-matching-keynames-target-new dbstruct run-id keynames target res testpatt statepatt statuspatt runname)
    (let loop ((pathdat (if (null? paths) #f (car mt-paths)))
	       (tal     (if (null? paths) '()(cdr mt-paths))))
      (if (not (null? res))
	  (car res) ;; return first found
	  (if path
	      (let* ((db     (open-db path: (cadr pathdat)))
  (let* ((testqry (tests:match->sqlqry testpatt))
		     (newres (db:test-get-paths-matching db keynames target fname)))
		(debug:print-info 4 "Trying " (car pathdat) " at " (cadr pathdat))
		(sqlite3:finalize! db)
		(if (not (null? newres))
		    (car newres)
		    (if (null? tal)
			#f
			(loop (car tal)(cdr tal))))))))))

	 (tstsqry (conc "SELECT rundir FROM tests WHERE " testqry " AND state LIKE '" statepatt "' AND status LIKE '" statuspatt "' ORDER BY event_time ASC;")))
(define (db:test-toplevel-num-items db run-id testname)
  (let ((res 0))
    (sqlite3:for-each-row
     (lambda (num-items)
    (db:with-db
       (set! res num-items))
     db
     dbstruct
     "SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND state NOT IN ('DELETED');"
     run-id
     #f
     (lambda (db)
       (sqlite3:for-each-row 
	(lambda (p)
	  (set! res (cons p res)))
	db
	tstsqry)
       res))))

(define (db:test-toplevel-num-items dbstruct run-id testname)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (let ((res 0))
       (sqlite3:for-each-row
	(lambda (num-items)
	  (set! res num-items))
	db
	"SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND state NOT IN ('DELETED');"
	run-id
     testname)
    res))
	testname)
       res))))

;;======================================================================
;; QUEUE UP META, TEST STATUS AND STEPS REMOTE ACCESS
;;======================================================================

;; NOTE: Can remove the regex and base64 encoding for zmq
(define (db:obj->string obj)
  (case *transport-type*
    ((fs) obj)
    ((http)
(define (db:obj->string obj #!key (transport 'http))
  (case transport
    ;; ((fs) obj)
    ((http fs)
     (string-substitute
      (regexp "=") "_"
      (base64:base64-encode (with-output-to-string (lambda ()(serialize obj))))
      (base64:base64-encode 
       (z3:encode-buffer
	(with-output-to-string
	  (lambda ()(serialize obj)))))
      #t))
    ((zmq)(with-output-to-string (lambda ()(serialize obj))))
    ((zmq nmsg)(with-output-to-string (lambda ()(serialize obj))))
    (else obj)))

(define (db:string->obj msg)
  (case *transport-type*
    ((fs) msg)
    ((http)
(define (db:string->obj msg #!key (transport 'http))
  (case transport
    ;; ((fs) msg)
    ((http fs)
     (if (string? msg)
	 (with-input-from-string 
	     (z3:decode-buffer
	     (base64:base64-decode
	      (string-substitute 
	       (regexp "_") "=" msg #t))
	      (base64:base64-decode
	       (string-substitute 
		(regexp "_") "=" msg #t)))
	   (lambda ()(deserialize)))
	 (begin
	   (debug:print 0 "ERROR: reception failed. Received " msg " but cannot translate it.")
	 (vector #f #f #f))) ;; crude reply for when things go awry
    ((zmq)(with-input-from-string msg (lambda ()(deserialize))))
	   msg))) ;; crude reply for when things go awry
    ((zmq nmsg)(with-input-from-string msg (lambda ()(deserialize))))
    (else msg)))

(define (cdb:use-non-blocking-mode proc)
(define (db:test-set-status-state dbstruct run-id test-id status state msg)
  (set! *client-non-blocking-mode* #t)
  (let ((res (proc)))
  (let ((dbdat  (db:get-db dbstruct run-id)))
    (set! *client-non-blocking-mode* #f)
    res))

    (if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
;; params = 'target cached remparams
;;
;; make-vector-record cdb packet client-sig qtype immediate query-sig params qtime
;;
;; cdb:client-call is the unified interface to all the transports. It dispatches the
;;                 query to a server routine (e.g. server:client-send-recieve) that 
;;                 transports the data to the server where it is passed to db:process-queue-item
;;                 which either returns the data to the calling server routine or 
;;                 directly calls the returning procedure (e.g. zmq).
;;
(define (cdb:client-call serverdat qtype immediate numretries . params)
  (debug:print-info 11 "cdb:client-call serverdat=" serverdat ", qtype=" qtype ", immediate=" immediate ", numretries=" numretries ", params=" params)
  (case *transport-type* 
    ((fs)
     (let ((packet (vector "na" qtype immediate "na" params 0)))
       (fs:process-queue-item packet)))
    ((http)
     (let* ((client-sig  (client:get-signature))
	    (query-sig   (message-digest-string (md5-primitive) (conc qtype immediate params)))
	    (zdat        (db:obj->string (vector client-sig qtype immediate query-sig params (current-seconds))))) ;; (with-output-to-string (lambda ()(serialize params))))
       (debug:print-info 11 "zdat=" zdat)
       (let* ((res  #f)
	      (rawdat      (http-transport:client-send-receive serverdat zdat))
	      (tmp         #f))
	 (debug:print-info 11 "Sent " zdat ", received " rawdat)
	 (if rawdat
	(db:general-call dbdat 'set-test-start-time (list test-id)))
    (if msg
	     (begin
	       (set! tmp (db:string->obj rawdat))
	       (vector-ref tmp 2))
	     (begin
	       (debug:print 0 "ERROR: Communication with the server failed. Exiting if possible")
	       (exit 1))))))
	(db:general-call dbdat 'state-status-msg (list state status msg test-id))
	(db:general-call dbdat 'state-status     (list state status test-id)))))
    ((zmq)
     (handle-exceptions
      exn
      (begin
	(debug:print-info 0 "cdb:client-call timeout or error. Trying again in 5 seconds")
	(thread-sleep! 5) 
	(if (> numretries 0)(apply cdb:client-call serverdat qtype immediate (- numretries 1) params)))
      (let* ((push-socket (vector-ref serverdat 0))
	     (sub-socket  (vector-ref serverdat 1))
	     (client-sig  (client:get-signature))
	     (query-sig   (message-digest-string (md5-primitive) (conc qtype immediate params)))
	     (zdat        (db:obj->string (vector client-sig qtype immediate query-sig params (current-seconds)))) ;; (with-output-to-string (lambda ()(serialize params))))
	     (res  #f)
	     (send-receive (lambda ()
			     (debug:print-info 11 "sending message")
			     (send-message push-socket zdat)
			     (debug:print-info 11 "message sent")
			     (let loop ()
			       ;; get the sender info
			       ;; this should match (client:get-signature)
			       ;; we will need to process "all" messages here some day
			       (receive-message* sub-socket)
			       ;; now get the actual message
			       (let ((myres (db:string->obj (receive-message* sub-socket))))
				 (if (equal? query-sig (vector-ref myres 1))
				     (set! res (vector-ref myres 2))
				     (loop)))))))
	;; (timeout (lambda ()
	;;     	(let loop ((n numretries))
	;;     	  (thread-sleep! 15)
	;;     	  (if (not res)
	;;     	      (if (> numretries 0)
	;;     		  (begin
	;;     		    (debug:print 2 "WARNING: no reply to query " params ", trying resend")
	;;     		    (debug:print-info 11 "re-sending message")
	;;     		    (send-message push-socket zdat)
	;;     		    (debug:print-info 11 "message re-sent")
	;;     		    (loop (- n 1)))
	;;     		  ;; (apply cdb:client-call *runremote* qtype immediate (- numretries 1) params))
	;;     		  (begin
	;;     		    (debug:print 0 "ERROR: cdb:client-call timed out " params ", exiting.")
	;;     		    (exit 5))))))))
	(debug:print-info 11 "Starting threads")
	(let ((th1 (make-thread send-receive "send receive"))
	      ;; (th2 (make-thread timeout      "timeout"))
	      )
	  (thread-start! th1)
	  ;; (thread-start! th2)

(define (db:roll-up-pass-fail-counts dbstruct run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
	   (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP" "LAUNCHED")))
      (let ((dbdat (db:get-db dbstruct run-id)))
	(db:general-call dbdat 'update-pass-fail-counts (list test-name test-name test-name))
	(if (equal? status "RUNNING")
	    (db:general-call dbdat 'top-test-set-running (list test-name))
	    (if (equal? status "LAUNCHED")
	  (thread-join!  th1)
	  (debug:print-info 11 "cdb:client-call returning res=" res)
		(db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name))
	  res))))))

		(db:general-call dbdat 'top-test-set-per-pf-counts (list test-name run-id test-name test-name test-name))))
	#f)
      #f))
(define (cdb:set-verbosity serverdat val)
  (cdb:client-call serverdat 'set-verbosity #f *default-numtries* val))

(define (cdb:login serverdat keyval signature)
  (cdb:client-call serverdat 'login #t *default-numtries* keyval megatest-version signature))

(define (cdb:logout serverdat keyval signature)
  (cdb:client-call serverdat 'logout #t *default-numtries* keyval signature))

(define (cdb:num-clients serverdat)
  (cdb:client-call serverdat 'numclients #t *default-numtries*))

;; I think this would be more efficient if executed on client side FIXME???
(define (cdb:test-set-status-state serverdat test-id status state msg)
  (if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
      (cdb:client-call serverdat 'set-test-start-time #t *default-numtries* test-id))
  (if msg
      (cdb:client-call serverdat 'state-status-msg #t *default-numtries* state status msg test-id)
      (cdb:client-call serverdat 'state-status #t *default-numtries* state status test-id))) ;; run-id test-name item-path minutes cpuload diskfree tmpfree) 

(define (cdb:test-rollup-test_data-pass-fail serverdat test-id)
  (cdb:client-call serverdat 'test_data-pf-rollup #t *default-numtries* test-id test-id test-id test-id))

(define (cdb:pass-fail-counts serverdat test-id fail-count pass-count)
  (cdb:client-call serverdat 'pass-fail-counts #t *default-numtries* fail-count pass-count test-id))

(define (cdb:tests-register-test serverdat run-id test-name item-path)
  (cdb:client-call serverdat 'register-test #t *default-numtries* run-id test-name item-path))

;; more transactioned calls, these for roll-up-pass-fail stuff
(define (cdb:update-pass-fail-counts serverdat run-id test-name)
  (cdb:client-call serverdat 'update-fail-pass-counts #t *default-numtries* run-id test-name run-id test-name run-id test-name))

(define (cdb:top-test-set-running serverdat run-id test-name)
  (cdb:client-call serverdat 'top-test-set-running #t *default-numtries* run-id test-name))

(define (cdb:top-test-set-per-pf-counts serverdat run-id test-name)
  (cdb:client-call serverdat 'top-test-set-per-pf-counts #t *default-numtries* run-id test-name run-id test-name run-id test-name run-id test-name))

;;=

(define (cdb:flush-queue serverdat)
  (cdb:client-call serverdat 'flush #f *default-numtries*))

(define (cdb:kill-server serverdat pid)
  (cdb:client-call serverdat 'killserver #t *default-numtries* pid))

(define (cdb:roll-up-pass-fail-counts serverdat run-id test-name item-path status)
  (cdb:client-call serverdat 'immediate #f *default-numtries* open-run-close db:roll-up-pass-fail-counts #f run-id test-name item-path status))

(define (db:test-get-logfile-info dbstruct run-id test-name)
(define (cdb:get-test-info serverdat run-id test-name item-path)
  (cdb:client-call serverdat 'immediate #f *default-numtries* open-run-close db:get-test-info #f run-id test-name item-path))

  (db:with-db
(define (cdb:get-test-info-by-id serverdat test-id)
  (let ((test-dat (cdb:client-call serverdat 'immediate #f *default-numtries* open-run-close db:get-test-info-by-id #f test-id)))
    (hash-table-set! *test-info* test-id (vector (current-seconds) test-dat)) ;; cached for use where up-to-date info is not needed
    test-dat))

   dbstruct
;; db should be db open proc or #f
(define (cdb:remote-run proc db . params)
  (if (or *db-write-access*
	  (not (member proc *db:all-write-procs*)))
      (handle-exceptions
       exn
   run-id
       (let ((sleep-time (random 20))
	     (err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
	 (case err-status
	   ((busy)(thread-sleep! 4))
	   (else
	    (debug:print 0 "WARNING: possible problem with call to cdb:remote-run, database may be read-only and locked, waiting and trying again ...")
	    (thread-sleep! sleep-time)))
	 (apply cdb:remote-run proc db params))
       (apply cdb:client-call *runremote* 'immediate #f *default-numtries* open-run-close proc #f params))
      (begin
	(debug:print 0 "ERROR: Attempt to access read-only database")
	#f)))

   #f
   (lambda (db)
(define (db:test-get-logfile-info db run-id test-name)
  (let ((res #f))
    (sqlite3:for-each-row 
     (lambda (path final_logf)
       (set! logf final_logf)
       (set! res (list path final_logf))
       (if (directory? path)
	   (debug:print 2 "Found path: " path)
	   (debug:print 2 "No such path: " path)))
     db
     "SELECT rundir,final_logf FROM tests WHERE run_id=? AND testname=? AND item_path='';"
     run-id test-name)
    res))
     (let ((res #f))
       (sqlite3:for-each-row 
	(lambda (path final_logf)
	  ;; (let ((path       (sdb:qry 'getstr path-id))
	  ;;       (final_logf (sdb:qry 'getstr final_logf-id)))
	  (set! logf final_logf)
	  (set! res (list path final_logf))
	  (if (directory? path)
	      (debug:print 2 "Found path: " path)
	      (debug:print 2 "No such path: " path))) ;; )
	db
	"SELECT rundir,final_logf FROM tests WHERE testname=? AND item_path='';"
	test-name)
       res))))

;;======================================================================
;; A G R E G A T E D   T R A N S A C T I O N   D B   W R I T E S 
;;======================================================================

(define db:queries 
  (list '(update-run-duration     "UPDATE tests SET run_duration=? WHERE id=?;")

	;; TESTS
  (list '(register-test          "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');")
	'(register-test          "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');")
	;; Test state and status
	'(set-test-state         "UPDATE tests SET state=?   WHERE id=?;")
	'(set-test-status        "UPDATE tests SET state=?   WHERE id=?;")
	'(state-status           "UPDATE tests SET state=?,status=? WHERE id=?;")
	'(state-status-msg       "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;")
	'(state-status           "UPDATE tests SET state=?,status=? WHERE id=?;") ;; DONE
	'(state-status-msg       "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;") ;; DONE
	;; Test comment
	'(set-test-comment       "UPDATE tests SET comment=? WHERE id=?;")
	'(set-test-start-time    "UPDATE tests SET event_time=strftime('%s','now') WHERE id=?;")
	'(pass-fail-counts       "UPDATE tests SET fail_count=?,pass_count=? WHERE id=?;")
	'(set-test-start-time    "UPDATE tests SET event_time=strftime('%s','now') WHERE id=?;") ;; DONE
	'(pass-fail-counts       "UPDATE tests SET pass_count=?,fail_count=? WHERE id=?;")
	;; test_data-pf-rollup is used to set a tests PASS/FAIL based on the pass/fail info from the steps
	'(test_data-pf-rollup    "UPDATE tests
                                    SET status=CASE WHEN (SELECT fail_count FROM tests WHERE id=?) > 0 
                                      THEN 'FAIL'
                                    WHEN (SELECT pass_count FROM tests WHERE id=?) > 0 AND 
                                      (SELECT status FROM tests WHERE id=?) NOT IN ('WARN','FAIL')
                                    THEN 'PASS'
                                    ELSE status
                                    END WHERE id=?;")
	'(test-set-log            "UPDATE tests SET final_logf=? WHERE id=?;")
	'(test-set-rundir-by-test-id "UPDATE tests SET rundir=? WHERE id=?")
	'(test-set-rundir         "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;")
	'(delete-tests-in-state   "DELETE FROM tests WHERE state=? AND run_id=?;")
                                    END WHERE id=?;") ;; DONE
	'(test-set-log            "UPDATE tests SET final_logf=? WHERE id=?;")      ;; DONE
	;; '(test-set-rundir-by-test-id "UPDATE tests SET rundir=? WHERE id=?")        ;; DONE
	;; '(test-set-rundir         "UPDATE tests SET rundir=? AND testname=? AND item_path=?;") ;; DONE
	'(test-set-rundir-shortdir "UPDATE tests SET rundir=?,shortdir=? WHERE testname=? AND item_path=?;")
	'(delete-tests-in-state   ;; "DELETE FROM tests WHERE state=?;")                  ;; DONE
	  "UPDATE tests SET state='DELETED' WHERE state=?")
	'(tests:test-set-toplog   "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
	'(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;")
	'(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;") ;; DONE
	'(update-run-duration     "UPDATE tests SET run_duration=? WHERE id=?;")
	'(update-uname-host       "UPDATE tests SET uname=?,host=? WHERE id=?;")
	'(update-uname-host       "UPDATE tests SET uname=?,host=? WHERE id=?;")       ;; DONE
	'(update-test-state       "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
	'(update-test-status      "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
	;; stuff for roll-up-pass-fail-counts
	'(update-fail-pass-counts "UPDATE tests 
             SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('FAIL','CHECK')),
                 pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED'))
             WHERE run_id=? AND testname=? AND item_path='';")
	'(top-test-set-running  "UPDATE tests SET state='RUNNING' WHERE run_id=? AND testname=? AND item_path='';")
	'(update-pass-fail-counts "UPDATE tests 
             SET fail_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('FAIL','CHECK')),
                 pass_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED'))
             WHERE testname=? AND item_path='';") ;; DONE
	'(top-test-set          "UPDATE tests SET state=? WHERE testname=? AND item_path='';") ;; DONE
	'(top-test-set-running  "UPDATE tests SET state='RUNNING' WHERE testname=? AND item_path='';") ;; DONE
	'(top-test-set-per-pf-counts "UPDATE tests
                       SET state=CASE 
                                   WHEN (SELECT count(id) FROM tests 
                                                WHERE run_id=? AND testname=?
                                                WHERE testname=?
                                                     AND item_path != '' 
                                                     AND status NOT IN ('TEN_STRIKES','BLOCKED')
                                                     AND state in ('RUNNING','NOT_STARTED','LAUNCHED','REMOTEHOSTSTART')) > 0 THEN 'RUNNING'
                                   ELSE 'COMPLETED' END,
                            status=CASE 
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE run_id=? AND testname=?
                                              AND item_path != ''
                                              AND state IN ('NOT_STARTED','BLOCKED')) > 0 THEN 'FAIL'
                                  WHEN fail_count > 0 THEN 'FAIL' 
                                  WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' 
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE run_id=? AND testname=?
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND status = 'SKIP') > 0 THEN 'SKIP'
                                  ELSE 'UNKNOWN' END
                       WHERE run_id=? AND testname=? AND item_path='';")
                       WHERE testname=? AND item_path='';") ;; DONE

	;; STEPS
	'(delete-test-step-records "UPDATE test_steps SET status='DELETED' WHERE test_id=?;")
	'(delete-test-data-records "UPDATE test_data  SET status='DELETED' WHERE test_id=?;") ;; using status since no state field
	))

(define (db:lookup-query qry-name)
  (let ((q (alist-ref qry-name db:queries)))
    (if q (car q) #f)))

;; do not run these as part of the transaction
(define db:special-queries   '(rollup-tests-pass-fail
			       ;; db:roll-up-pass-fail-counts  ;; WHY NOT!?
			       login
			       immediate
			       flush
			       sync
			       set-verbosity
			       killserver
			       ))

(define (db:login dbstruct calling-path calling-version run-id client-signature)
  (cond 
;; not used, intended to indicate to run in calling process
   ((not (equal? calling-path *toppath*))
(define db:run-local-queries '()) ;; rollup-tests-pass-fail))
    (list #f "Login failed due to mismatch paths: " calling-path ", " *toppath*))
   ((not (equal? *run-id* run-id))
    (list #f "Login failed due to mismatch run-id: " run-id ", " *run-id*))
   ((not (equal? megatest-version calling-version))
    (list #f "Login failed due to mismatch megatest version: " calling-version ", " megatest-version))
   (else
    (hash-table-set! *logged-in-clients* client-signature (current-seconds))
    '(#t "successful login"))))

(define (db:process-cached-writes db)
  (let ((queries    (make-hash-table))
	(data       #f))
(define (db:general-call dbdat stmtname params)
  (let ((query (let ((q (alist-ref (if (string? stmtname)
				       (string->symbol stmtname)
				       stmtname)
				   db:queries)))
 		 (if q (car q) #f))))
    (mutex-lock! *incoming-mutex*)
    ;; data is a list of query packets <vector qry-sig query params
    (db:delay-if-busy dbdat)
    (apply sqlite3:execute (db:dbdat-get-db dbdat) query params)
    (set! data (reverse *incoming-writes*)) ;;  (sort ... (lambda (a b)(< (vector-ref a 1)(vector-ref b 1)))))
    (set! *server:last-write-flush* (current-milliseconds))
    (set! *incoming-writes* '())
    (mutex-unlock! *incoming-mutex*)
    (if (> (length data) 0)
	;; Process if we have data
	(begin
	  (debug:print-info 7 "Writing cached data " data)
	  
	  ;; Prepare the needed sql statements
	  ;;
    #t)) ;; BUG or Sillyness, why do I return #t instead of the query result?

;; get the previous records for when these tests were run where all keys match but runname
;; NB// Merge this with test:get-previous-test-run-records? This one looks for all matching tests
;; can use wildcards. Also can likely be factored in with get test paths?
;;
;; Run this remotely!!
;;
	  (for-each (lambda (request-item)
		      (let ((stmt-key (vector-ref request-item 0))
			    (query    (vector-ref request-item 1)))
			(hash-table-set! queries stmt-key (sqlite3:prepare db query))))
		    data)
	  
(define (db:get-matching-previous-test-run-records dbstruct run-id test-name item-path)
  (let* ((dbdat   (db:get-db dbstruct #f))
	 (db      (db:dbdat-get-db dbdat))
	 (keys    (db:get-keys db))
	 (selstr  (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ","))
	 (qrystr  (string-intersperse (map (lambda (x)(conc (vector-ref x 0) "=?")) keys) " AND "))
	 (keyvals #f)
	 (tests-hash (make-hash-table)))
	  ;; No outer loop needed. Single loop for write items only. Reads trigger flush of queue
	  ;; and then are executed.
	  (sqlite3:with-transaction 
	   db
    ;; first look up the key values from the run selected by run-id
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row 
     (lambda (a . b)
       (set! keyvals (cons a b)))
     db
	   (lambda ()
	     (for-each
	      (lambda (hed)
		(let* ((params   (vector-ref hed 2))
		       (stmt-key (vector-ref hed 0))
		       (stmt     (hash-table-ref/default queries stmt-key #f)))
		  (if stmt
		      (begin
			(db:delay-if-busy)
			(apply sqlite3:execute stmt params))
		      (debug:print 0 "ERROR: Problem Executing " stmt-key " for " params))))
	      data)))
	  
     (conc "SELECT " selstr " FROM runs WHERE id=? ORDER BY event_time DESC;") run-id)
	  ;; let all the waiting calls know all is done
	  (mutex-lock! *completed-mutex*)
	  (for-each (lambda (item)
		      (let ((qry-sig (cdb:packet-get-client-sig item)))
			(debug:print-info 7 "Registering query " qry-sig " as done")
			(hash-table-set! *completed-writes* qry-sig #t)))
		    data)
	  (mutex-unlock! *completed-mutex*)
	  
	  ;; Finalize the statements. Should this be done inside the mutex above?
	  ;; I think sqlite3 mutexes will keep the data safe
	  (for-each (lambda (stmt-key)
		      (sqlite3:finalize! (hash-table-ref queries stmt-key)))
		    (hash-table-keys queries))
	  
	  ;; Do a little record keeping
	  (let ((cache-size (length data)))
	    (if (> cache-size *max-cache-size*)
		(set! *max-cache-size* cache-size)))
    (if (not keyvals)
	'()
	(let ((prev-run-ids '()))
	  (apply sqlite3:for-each-row
		 (lambda (id)
		   (set! prev-run-ids (cons id prev-run-ids)))
	  #t)
	#f)))

(define *db:process-queue-mutex* (make-mutex))

(define *number-of-writes*         0)
(define *writes-total-delay*       0)
(define *total-non-write-delay*    0)
(define *number-non-write-queries* 0)

;; The queue is a list of vectors where the zeroth slot indicates the type of query to
;; apply and the second slot is the time of the query and the third entry is a list of 
;; values to be applied
		 db
		 (conc "SELECT id FROM runs WHERE " qrystr " AND id != ?;") (append keyvals (list run-id)))
	  ;; collect all matching tests for the runs then
	  ;; extract the most recent test and return that.
	  (debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals 
		       ", previous run ids found: " prev-run-ids)
	  (if (null? prev-run-ids) '()  ;; no previous runs? return null
	      (let loop ((hed (car prev-run-ids))
			 (tal (cdr prev-run-ids)))
		(let ((results (db:get-tests-for-run dbstruct run-id hed (conc test-name "/" item-path) '() '() #f #f #f #f #f #f)))
		  (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name 
;;
(define (db:queue-write-and-wait db qry-sig query params)
  (let ((queue-len  0)
	(res        #f)
	(got-it     #f)
	(qry-pkt    (vector qry-sig query params))
	(start-time (current-milliseconds))
	(timeout    (+ 10 (current-seconds)))) ;; set the time out to 10 secs in future

    ;; Put the item in the queue *incoming-writes* 
    (mutex-lock! *incoming-mutex*)
			       ", item-path " item-path " results: " (intersperse results "\n"))
		  ;; Keep only the youngest of any test/item combination
		  (for-each 
		   (lambda (testdat)
		     (let* ((full-testname (conc (db:test-get-testname testdat) "/" (db:test-get-item-path testdat)))
			    (stored-test   (hash-table-ref/default tests-hash full-testname #f)))
		       (if (or (not stored-test)
			       (and stored-test
				    (> (db:test-get-event_time testdat)(db:test-get-event_time stored-test))))
			   ;; this test is younger, store it in the hash
			   (hash-table-set! tests-hash full-testname testdat))))
		   results)
		  (if (null? tal)
		      (map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
		      (loop (car tal)(cdr tal))))))))))
    (set! *incoming-writes* (cons qry-pkt *incoming-writes*))
    (set! queue-len (length *incoming-writes*))
    (mutex-unlock! *incoming-mutex*)

    (debug:print-info 7 "Current write queue length is " queue-len)

(define (db:delay-if-busy dbdat #!key (count 6))
    ;; poll for the write to complete, timeout after 10 seconds
    ;; periodic flushing of the queue is taken care of by 
    ;; db:flush-queue
    (let loop ()
  (if (not (configf:lookup *configdat* "server" "delay-on-busy"))
      (and dbdat (db:dbdat-get-db dbdat))
      (if dbdat
	  (let* ((dbpath (db:dbdat-get-path dbdat))
      (thread-sleep! 0.001)
      (mutex-lock! *completed-mutex*)
      (if (hash-table-ref/default *completed-writes* qry-sig #f)
	  (begin
		 (db     (db:dbdat-get-db   dbdat)) ;; we'll return this so (db:delay--if-busy can be called inline
		 (dbfj   (conc dbpath "-journal")))
	    (if (handle-exceptions
		 exn
	    (hash-table-delete! *completed-writes* qry-sig)
	    (set! got-it #t)))
      (mutex-unlock! *completed-mutex*)
      (if (and (not got-it)
	       (< (current-seconds) timeout))
	  (begin
	    (thread-sleep! 0.01)
		 (begin
		   (debug:print-info 0 "WARNING: failed to test for existance of " dbfj)
		   (thread-sleep! 1)
	    (loop))))
    (set! *number-of-writes*   (+ *number-of-writes*   1))
    (set! *writes-total-delay* (+ *writes-total-delay* (- (current-milliseconds) start-time)))
    got-it))

(define (db:delay-if-busy #!key (count 6))
		   (db:delay-if-busy count (- count 1)))
  (let ((dbfj (conc *toppath* "/megatest.db-journal")))
    (if (file-exists? dbfj)
	(case count
	  ((6)
	   (thread-sleep! 0.2)
	   (db:delay-if-busy count: 5))
	  ((5)
	   (thread-sleep! 0.4)
	   (db:delay-if-busy count: 4))
	  ((4)
	   (thread-sleep! 0.8)
	   (db:delay-if-busy count: 3))
	  ((3)
	   (thread-sleep! 1.6)
	   (db:delay-if-busy count: 2))
	  ((2)
	   (thread-sleep! 3.2)
	   (db:delay-if-busy count: 1))
	  ((1)
	   (thread-sleep! 6.4)
	   (db:delay-if-busy count: 0))
	  (else
	   (debug:print-info 0 "delaying db access due to high database load.")
	   (thread-sleep! 12.8))))))

		 (file-exists? dbfj))
		(case count
		  ((6)
		   (thread-sleep! 0.2)
		   (db:delay-if-busy count: 5))
		  ((5)
		   (thread-sleep! 0.4)
		   (db:delay-if-busy count: 4))
		  ((4)
		   (thread-sleep! 0.8)
		   (db:delay-if-busy count: 3))
		  ((3)
		   (thread-sleep! 1.6)
		   (db:delay-if-busy count: 2))
		  ((2)
		   (thread-sleep! 3.2)
		   (db:delay-if-busy count: 1))
		  ((1)
		   (thread-sleep! 6.4)
		   (db:delay-if-busy count: 0))
		  (else
		   (debug:print-info 0 "delaying db access due to high database load.")
		   (thread-sleep! 12.8))))
	    db)
(define (db:process-queue-item db item)
  (let* ((stmt-key       (cdb:packet-get-qtype item))
	 (qry-sig        (cdb:packet-get-query-sig item))
	 (return-address (cdb:packet-get-client-sig item))
	 (params         (cdb:packet-get-params item))
	 (query          (let ((q (alist-ref stmt-key db:queries)))
			   (if q (car q) #f))))
    (debug:print-info 11 "Special queries/requests stmt-key=" stmt-key ", return-address=" return-address ", query=" query ", params=" params)
    (if query
	;; hand queries off to the write queue
	(let ((response (case *transport-type*
			  ((http)
			   (debug:print-info 7 "Queuing item " item " for wrapped write")
			   (db:queue-write-and-wait db qry-sig query params))
			  (else 
			   (let* ((remtries 10)
				  (proc     #f))
			     (set! proc (lambda (remtries)
					  (if (> remtries 0)
					      (handle-exceptions
					       exn
					       (let ((sleep-time (random 30))
						     (err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
						 (case err-status
						   ((busy)
						    (thread-sleep! sleep-time)
						    (proc 10)) ;; we never give up on busy
						   (else
						    (debug:print 0 "EXCEPTION: database probably overloaded or unreadable.")
						    (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
						    (debug:print 0 " status:  " ((condition-property-accessor 'sqlite3 'status)  exn))
						    (print-call-chain)
						    (debug:print 0 "Sleeping for " sleep-time)
						    (thread-sleep! sleep-time)
						    (debug:print-info 0 "trying db call one more time....this may never recover, if necessary kill process " (current-process-id) " on host " (get-host-name) " to clean up")
						    (proc (- remtries 1)))))
					       (begin
						 (db:delay-if-busy)
	  "bogus result from db:delay-if-busy")))
						 (apply sqlite3:execute db query params)))
					      (debug:print 0 "ERROR: too many attempts to access db were made and no sucess. query: "
							   query ", params: " params))))
			     (proc remtries))
			   #t))))
	  (debug:print-info 7 "Received " response " from wrapped write")
	  (server:reply return-address qry-sig response response))
	;; otherwise if appropriate flush the queue (this is a read or complex query)
	(begin
	  (cond
	   ((member stmt-key db:special-queries)
	    (let ((starttime (current-milliseconds)))
	      (debug:print-info 9 "Handling special statement " stmt-key)
	      (case stmt-key
		((immediate)
		 ;; This is a read or mixed read-write query, must clear the cache
		 (case *transport-type*
		   ((http)
		    (mutex-lock! *db:process-queue-mutex*)
		    (db:process-cached-writes db)
		    (mutex-unlock! *db:process-queue-mutex*)))
		 (let* ((proc      (car params))
			(remparams (cdr params))
			;; we are being handed a procedure so call it
			;; (debug:print-info 11 "Running (apply " proc " " remparams ")")
			(result (server:reply return-address qry-sig #t (apply proc remparams))))
		   (set! *total-non-write-delay* (+ *total-non-write-delay* (- (current-milliseconds) starttime))) 
		   (set! *number-non-write-queries* (+ *number-non-write-queries* 1))
		   result))
		((login)
		 (if (< (length params) 3) ;; should get toppath, version and signature
		     (server:reply return-address qry-sig '(#f "login failed due to missing params")) ;; missing params
		     (let ((calling-path (car   params))
			   (calling-vers (cadr  params))
			   (client-key   (caddr params)))
		       (if (and (equal? calling-path *toppath*)
				(equal? megatest-version calling-vers))
			   (begin
			     (hash-table-set! *logged-in-clients* client-key (current-seconds))
			     (server:reply return-address qry-sig #t '(#t "successful login")))      ;; path matches - pass! Should vet the caller at this time ...
			   (server:reply return-address qry-sig #f (list #f (conc "Login failed due to mismatch paths: " calling-path ", " *toppath*)))))))
		((flush sync)
		 (server:reply return-address qry-sig #t 1)) ;; (length data)))
		((set-verbosity)
		 (set! *verbosity* (car params))
		 (server:reply return-address qry-sig #t (list #t *verbosity*)))
		((killserver)
		 (let ((hostname (car  *runremote*))
		       (port     (cadr *runremote*))
		       (pid      (car params)))
		   (debug:print 0 "WARNING: Server on " hostname ":" port " going down by user request!")
		   (debug:print-info 1 "current pid=" (current-process-id))
		   (open-run-close tasks:server-deregister tasks:open-db 
				   hostname
				   port: port)
		   (set! *server-run* #f)
		   (thread-sleep! 3)
		   (process-signal pid signal/kill)
		   (server:reply return-address qry-sig #t '(#t "exit process started"))))
		(else ;; not a command, i.e. is a query
		 (debug:print 0 "ERROR: Unrecognised query/command " stmt-key)
		 (server:reply return-address qry-sig #f 'failed)))))
	   (else
	    (debug:print-info 11 "Executing " stmt-key " for " params)
	    (db:delay-if-busy)
	    (apply sqlite3:execute (hash-table-ref queries stmt-key) params)
	    (server:reply return-address qry-sig #t #t)))))))

(define (db:test-get-records-for-index-file db run-id test-name)
(define (db:test-get-records-for-index-file dbstruct run-id test-name)
  (let ((res '()))
    (db:with-db
     dbstruct
     run-id
     #f
     (lambda (db)
    (sqlite3:for-each-row 
     (lambda (id itempath state status run_duration logf comment)
       (set! res (cons (vector id itempath state status run_duration logf comment) res)))
     db
     "SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname=? AND item_path != '';"
     run-id test-name)
    res))
       (sqlite3:for-each-row 
	(lambda (id itempath state status run_duration logf comment)
	  (set! res (cons (vector id itempath state status run_duration logf comment) res)))
	db
	"SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE testname=? AND item_path != '';"
	test-name)
       res))))

;;======================================================================
;; Tests meta data
;;======================================================================

;; read the record given a testname
(define (db:testmeta-get-record db testname)
(define (db:testmeta-get-record dbstruct testname)
  (let ((res #f))
    (db:with-db
     dbstruct
     #f
     #f
     (lambda (db)
    (sqlite3:for-each-row
     (lambda (id testname author owner description reviewed iterated avg_runtime avg_disk tags jobgroup)
       (set! res (vector id testname author owner description reviewed iterated avg_runtime avg_disk tags jobgroup)))
     db "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta WHERE testname=?;"
     testname)
    res))
       (sqlite3:for-each-row
	(lambda (id testname author owner description reviewed iterated avg_runtime avg_disk tags jobgroup)
	  (set! res (vector id testname author owner description reviewed iterated avg_runtime avg_disk tags jobgroup)))
	db
	"SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta WHERE testname=?;"
	testname)
       res))))

;; create a new record for a given testname
(define (db:testmeta-add-record db testname)
  (db:delay-if-busy)
  (sqlite3:execute db "INSERT OR IGNORE INTO test_meta (testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags) VALUES (?,'','','','','','','','');" testname))
(define (db:testmeta-add-record dbstruct testname)
  (db:with-db dbstruct #f #f 
	      (lambda (db)
		(sqlite3:execute 
		 db
		 "INSERT OR IGNORE INTO test_meta (testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags) VALUES (?,'','','','','','','','');" testname))))

;; update one of the testmeta fields
(define (db:testmeta-update-field db testname field value)
(define (db:testmeta-update-field dbstruct testname field value)
  (db:delay-if-busy)
  (sqlite3:execute db (conc "UPDATE test_meta SET " field "=? WHERE testname=?;") value testname))

  (db:with-db dbstruct #f #f 
;;======================================================================
;; T E S T   D A T A 
;;======================================================================

(define (db:csv->test-data db test-id csvdata #!key (work-area #f))
  (debug:print 4 "test-id " test-id ", csvdata: " csvdata)
  (let ((tdb     (db:open-test-db-by-test-id db test-id work-area: work-area)))
    (if (sqlite3:database? tdb)
	(let ((csvlist (csv->list (make-csv-reader
				   (open-input-string csvdata)
				   '((strip-leading-whitespace? #t)
				     (strip-trailing-whitespace? #t)) )))) ;; (csv->list csvdata)))
	  (for-each 
	   (lambda (csvrow)
	      (lambda (db)
	     (let* ((padded-row  (take (append csvrow (list #f #f #f #f #f #f #f #f #f)) 9))
		    (category    (list-ref padded-row 0))
		    (variable    (list-ref padded-row 1))
		    (value       (any->number-if-possible (list-ref padded-row 2)))
		    (expected    (any->number-if-possible (list-ref padded-row 3)))
		    (tol         (any->number-if-possible (list-ref padded-row 4))) ;; >, <, >=, <=, or a number
		    (units       (list-ref padded-row 5))
		    (comment     (list-ref padded-row 6))
		    (status      (let ((s (list-ref padded-row 7)))
				   (if (and (string? s)(or (string-match (regexp "^\\s*$") s)
							   (string-match (regexp "^n/a$") s)))
				       #f
				       s))) ;; if specified on the input then use, else calculate
		    (type        (list-ref padded-row 8)))
	       ;; look up expected,tol,units from previous best fit test if they are all either #f or ''
	       (debug:print 4 "BEFORE: category: " category " variable: " variable " value: " value 
			    ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment " type: " type)

	       (if (and (or (not expected)(equal? expected ""))
			(or (not tol)     (equal? expected ""))
			(or (not units)   (equal? expected "")))
		   (let-values (((new-expected new-tol new-units)(db:get-prev-tol-for-test db test-id category variable)))
			       (set! expected new-expected)
			       (set! tol      new-tol)
			       (set! units    new-units)))

	       (debug:print 4 "AFTER:  category: " category " variable: " variable " value: " value 
			    ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
	       ;; calculate status if NOT specified
	       (if (and (not status)(number? expected)(number? value)) ;; need expected and value to be numbers
		   (if (number? tol) ;; if tol is a number then we do the standard comparison
		       (let* ((max-val (+ expected tol))
			      (min-val (- expected tol))
			      (result  (and (>=  value min-val)(<= value max-val))))
			 (debug:print 4 "max-val: " max-val " min-val: " min-val " result: " result)
			 (set! status (if result "pass" "fail")))
		       (set! status ;; NB// need to assess each one (i.e. not return operator since need to act if not valid op.
			     (case (string->symbol tol) ;; tol should be >, <, >=, <=
			       ((>)  (if (>  value expected) "pass" "fail"))
			       ((<)  (if (<  value expected) "pass" "fail"))
			       ((>=) (if (>= value expected) "pass" "fail"))
			       ((<=) (if (<= value expected) "pass" "fail"))
			       (else (conc "ERROR: bad tol comparator " tol))))))
	       (debug:print 4 "AFTER2: category: " category " variable: " variable " value: " value 
			    ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
	       (sqlite3:execute tdb "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status,type) VALUES (?,?,?,?,?,?,?,?,?,?);"
				test-id category variable value expected tol units (if comment comment "") status type)))
	   csvlist)
	  (sqlite3:finalize! tdb)))))

;; get a list of test_data records matching categorypatt
(define (db:read-test-data db test-id categorypatt #!key (work-area #f))
  (let ((tdb  (db:open-test-db-by-test-id db test-id work-area: work-area)))
    (if (sqlite3:database? tdb)
	(let ((res '()))
	  (sqlite3:for-each-row 
		(sqlite3:execute 
	   (lambda (id test_id category variable value expected tol units comment status type)
	     (set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
	   tdb
		 db
	   "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
	  (sqlite3:finalize! tdb)
	  (reverse res))
	'())))

		 (conc "UPDATE test_meta SET " field "=? WHERE testname=?;") value testname))))
;; NOTE: Run this local with #f for db !!!
(define (db:load-test-data db test-id #!key (work-area #f))
  (let loop ((lin (read-line)))
    (if (not (eof-object? lin))
	(begin
	  (debug:print 4 lin)
	  (db:csv->test-data db test-id lin work-area: work-area)
	  (loop (read-line)))))
  ;; roll up the current results.
  ;; FIXME: Add the status to 
  (db:test-data-rollup db test-id #f work-area: work-area))

;; WARNING: Do NOT call this for the parent test on an iterated test
;; Roll up test_data pass/fail results
;; look at the test_data status field, 
;;    if all are pass (any case) and the test status is PASS or NULL or '' then set test status to PASS.
;;    if one or more are fail (any case) then set test status to PASS, non "pass" or "fail" are ignored
(define (db:test-data-rollup db test-id status #!key (work-area #f))
  (let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))
	(fail-count 0)
	(pass-count 0))
    (if (sqlite3:database? tdb)
	(begin
	  (sqlite3:for-each-row
	   (lambda (fcount pcount)
	     (set! fail-count fcount)
	     (set! pass-count pcount))
	   tdb 
	   "SELECT (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'fail') AS fail_count,
                   (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'pass') AS pass_count;"
	   test-id test-id)
	  (sqlite3:finalize! tdb)

	  ;; Now rollup the counts to the central megatest.db
	  (cdb:pass-fail-counts *runremote* test-id fail-count pass-count)
	  ;; (sqlite3:execute db "UPDATE tests SET fail_count=?,pass_count=? WHERE id=?;" 
	  ;;                     fail-count pass-count test-id)

	  ;; The flush is not needed with the transaction based write agregation enabled. Remove these commented lines
	  ;; next time you read this!
	  ;;
	  ;; (cdb:flush-queue *runremote*)
	  ;; (thread-sleep! 1) ;; play nice with the queue by ensuring the rollup is at least 10ms later than the set
	  
	  ;; if the test is not FAIL then set status based on the fail and pass counts.
	  (cdb:test-rollup-test_data-pass-fail *runremote* test-id)
	  ;; (sqlite3:execute
	  ;;  db   ;;; NOTE: Should this be WARN,FAIL? A WARN is not a FAIL????? BUG FIXME
	  ;;  "UPDATE tests
	  ;;             SET status=CASE WHEN (SELECT fail_count FROM tests WHERE id=?) > 0 
	  ;;                THEN 'FAIL'
	  ;;             WHEN (SELECT pass_count FROM tests WHERE id=?) > 0 AND 
	  ;;                  (SELECT status FROM tests WHERE id=?) NOT IN ('WARN','FAIL')
	  ;;             THEN 'PASS'
	  ;;             ELSE status
	  ;;         END WHERE id=?;"
	  ;;  test-id test-id test-id test-id)
	  ))))

(define (db:get-prev-tol-for-test db test-id category variable)
  ;; Finish me?
  (values #f #f #f))

;;======================================================================
;; S T E P S 
;;======================================================================

(define (db:step-get-time-as-string vec)
  (seconds->time-string (db:step-get-event_time vec)))

;; db-get-test-steps-for-run
(define (db:get-steps-for-test db test-id #!key (work-area #f))
  (let* ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))
	 (res '()))
    (if (sqlite3:database? tdb)
	(handle-exceptions
	 exn
	 (begin
	   (debug:print 0 "ERROR: error on access to testdat for test with id " test-id)
	   '())
	 (begin
	   (sqlite3:for-each-row 
	    (lambda (id test-id stepname state status event-time logfile)
	      (set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res)))
	    tdb
	    "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
	    test-id)
	   (sqlite3:finalize! tdb)
	   (reverse res)))
	'())))

;; get a pretty table to summarize steps
;;
(define (db:get-steps-table db test-id #!key (work-area #f))
(define (db:testmeta-get-all dbstruct)
  (let ((steps   (db:get-steps-for-test db test-id work-area: work-area)))
    ;; organise the steps for better readability
    (let ((res (make-hash-table)))
      (for-each 
       (lambda (step)
  (db:with-db dbstruct #f #f 
	      (lambda (db)
	 (debug:print 6 "step=" step)
	 (let ((record (hash-table-ref/default 
			res 
			(db:step-get-stepname step) 
			;;        stepname                start end status Duration  Logfile 
			(vector (db:step-get-stepname step) ""   "" ""     ""        ""))))
	   (debug:print 6 "record(before) = " record 
			"\nid:       " (db:step-get-id step)
			"\nstepname: " (db:step-get-stepname step)
			"\nstate:    " (db:step-get-state step)
			"\nstatus:   " (db:step-get-status step)
			"\ntime:     " (db:step-get-event_time step))
	   (case (string->symbol (db:step-get-state step))
	     ((start)(vector-set! record 1 (db:step-get-event_time step))
	      (vector-set! record 3 (if (equal? (vector-ref record 3) "")
					(db:step-get-status step)))
	      (if (> (string-length (db:step-get-logfile step))
		     0)
		  (vector-set! record 5 (db:step-get-logfile step))))
	     ((end)  
	      (vector-set! record 2 (any->number (db:step-get-event_time step)))
	      (vector-set! record 3 (db:step-get-status step))
	      (vector-set! record 4 (let ((startt (any->number (vector-ref record 1)))
					  (endt   (any->number (vector-ref record 2))))
				      (debug:print 4 "record[1]=" (vector-ref record 1) 
						   ", startt=" startt ", endt=" endt
						   ", get-status: " (db:step-get-status step))
				      (if (and (number? startt)(number? endt))
					  (seconds->hr-min-sec (- endt startt)) "-1")))
	      (if (> (string-length (db:step-get-logfile step))
		     0)
		  (vector-set! record 5 (db:step-get-logfile step))))
	     (else
	      (vector-set! record 2 (db:step-get-state step))
	      (vector-set! record 3 (db:step-get-status step))
	      (vector-set! record 4 (db:step-get-event_time step))))
	   (hash-table-set! res (db:step-get-stepname step) record)
	   (debug:print 6 "record(after)  = " record 
			"\nid:       " (db:step-get-id step)
			"\nstepname: " (db:step-get-stepname step)
			"\nstate:    " (db:step-get-state step)
			"\nstatus:   " (db:step-get-status step)
			"\ntime:     " (db:step-get-event_time step))))
       ;; (else   (vector-set! record 1 (db:step-get-event_time step)))
       (sort steps (lambda (a b)
		     (cond
		      ((<   (db:step-get-event_time a)(db:step-get-event_time b)) #t)
		      ((eq? (db:step-get-event_time a)(db:step-get-event_time b)) 
		       (<   (db:step-get-id a)        (db:step-get-id b)))
		      (else #f)))))
      res)))

;; get a pretty table to summarize steps
;;
(define (db:get-steps-table-list db test-id #!key (work-area #f))
  (let ((steps   (db:get-steps-for-test db test-id work-area: work-area)))
    ;; organise the steps for better readability
    (let ((res (make-hash-table)))
      (for-each 
       (lambda (step)
		(let ((res '()))
		  (sqlite3:for-each-row
		   (lambda (a . b)
	 (debug:print 6 "step=" step)
	 (let ((record (hash-table-ref/default 
			res 
			(db:step-get-stepname step) 
			;;        stepname                start end status    
			(vector (db:step-get-stepname step) ""   "" ""     "" ""))))
	   (debug:print 6 "record(before) = " record 
			"\nid:       " (db:step-get-id step)
			"\nstepname: " (db:step-get-stepname step)
			"\nstate:    " (db:step-get-state step)
			"\nstatus:   " (db:step-get-status step)
			"\ntime:     " (db:step-get-event_time step))
	   (case (string->symbol (db:step-get-state step))
	     ((start)(vector-set! record 1 (db:step-get-event_time step))
	      (vector-set! record 3 (if (equal? (vector-ref record 3) "")
					(db:step-get-status step)))
	      (if (> (string-length (db:step-get-logfile step))
		     0)
		  (vector-set! record 5 (db:step-get-logfile step))))
	     ((end)  
	      (vector-set! record 2 (any->number (db:step-get-event_time step)))
	      (vector-set! record 3 (db:step-get-status step))
	      (vector-set! record 4 (let ((startt (any->number (vector-ref record 1)))
					  (endt   (any->number (vector-ref record 2))))
				      (debug:print 4 "record[1]=" (vector-ref record 1) 
						   ", startt=" startt ", endt=" endt
						   ", get-status: " (db:step-get-status step))
				      (if (and (number? startt)(number? endt))
					  (seconds->hr-min-sec (- endt startt)) "-1")))
	      (if (> (string-length (db:step-get-logfile step))
		     0)
		  (vector-set! record 5 (db:step-get-logfile step))))
	     (else
	      (vector-set! record 2 (db:step-get-state step))
	      (vector-set! record 3 (db:step-get-status step))
	      (vector-set! record 4 (db:step-get-event_time step))))
	   (hash-table-set! res (db:step-get-stepname step) record)
		     (set! res (cons (apply vector a b) res)))
	   (debug:print 6 "record(after)  = " record 
			"\nid:       " (db:step-get-id step)
			"\nstepname: " (db:step-get-stepname step)
			"\nstate:    " (db:step-get-state step)
			"\nstatus:   " (db:step-get-status step)
			"\ntime:     " (db:step-get-event_time step))))
       ;; (else   (vector-set! record 1 (db:step-get-event_time step)))
       (sort steps (lambda (a b)
		     (cond
		   db
		      ((<   (db:step-get-event_time a)(db:step-get-event_time b)) #t)
		      ((eq? (db:step-get-event_time a)(db:step-get-event_time b)) 
		       (<   (db:step-get-id a)        (db:step-get-id b)))
		      (else #f)))))
      res)))
		   "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta;")
		  res))))

(define (db:get-compressed-steps test-id #!key (work-area #f)(tdb #f))
  (if (or (not work-area)
	  (file-exists? (conc work-area "/testdat.db")))
      (let* ((comprsteps (open-run-close db:get-steps-table tdb test-id work-area: work-area)))
	(map (lambda (x)
	       ;; take advantage of the \n on time->string
	       (vector
		(vector-ref x 0)
		(let ((s (vector-ref x 1)))
		  (if (number? s)(seconds->time-string s) s))
		(let ((s (vector-ref x 2)))
		  (if (number? s)(seconds->time-string s) s))
		(vector-ref x 3)    ;; status
		(vector-ref x 4)
		(vector-ref x 5)))  ;; time delta
	     (sort (hash-table-values comprsteps)
		   (lambda (a b)
		     (let ((time-a (vector-ref a 1))
			   (time-b (vector-ref b 1)))
		       (if (and (number? time-a)(number? time-b))
			   (if (< time-a time-b)
			       #t
			       (if (eq? time-a time-b)
				   (string<? (conc (vector-ref a 2))
					     (conc (vector-ref b 2)))
				   #f))
			   (string<? (conc time-a)(conc time-b))))))))
      '()))

;;======================================================================
;; M I S C   M A N A G E M E N T   I T E M S 
;;======================================================================

;; A routine to map itempaths using a itemmap
(define (db:compare-itempaths patha pathb itemmap)
  (debug:print-info 3 "ITEMMAP is " itemmap)
  (debug:print-info 6 "ITEMMAP is " itemmap)
  (if itemmap
      (let* ((mapparts    (string-split itemmap))
	     (pattern     (car mapparts))
	     (replacement (if (> (length mapparts) 1) (cadr mapparts) "")))
	(if replacement
	    (equal? (string-substitute pattern replacement patha)
		    (string-substitute pattern replacement pathb))
	    (equal? (string-substitute pattern "" patha)
		    (string-substitute pattern "" pathb))))
      (equal? patha pathb)))

;; the new prereqs calculation, looks also at itempath if specified
;; all prereqs must be met:
;;    if prereq test with itempath='' is COMPLETED and PASS, WARN, CHECK, or WAIVED then prereq is met
;;    if prereq test with itempath=ref-item-path and COMPLETED with PASS, WARN, CHECK, or WAIVED then prereq is met
;;
;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED)
;;       mode 'toplevel means that tests must be COMPLETED only
;;       mode 'itemmatch or 'itemwait means that tests items must be COMPLETED and (PASS|WARN|WAIVED|CHECK) [[ NB// NOT IMPLEMENTED YET ]]
;; 
;; (define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode)
(define (db:get-prereqs-not-met run-id waitons ref-item-path #!key (mode '(normal))(itemmap #f))
(define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path #!key (mode '(normal))(itemmap #f))
  (if (or (not waitons)
	  (null? waitons))
      '()
      (let* ((unmet-pre-reqs '())
	     (result         '()))
	(for-each 
	 (lambda (waitontest-name)
	   ;; by getting the tests with matching name we are looking only at the matching test 
	   ;; and related sub items
	   ;; next should be using mt:get-tests-for-run?
	   (let ((tests             (cdb:remote-run db:get-tests-for-run-state-status #f run-id waitontest-name)) ;; (mt:get-tests-for-run run-id waitontest-name '() '()))
	   (let ((tests             (db:get-tests-for-run-state-status dbstruct run-id waitontest-name))
		 (ever-seen         #f)
		 (parent-waiton-met #f)
		 (item-waiton-met   #f))
	     (for-each 
	      (lambda (test)
		;; (if (equal? waitontest-name (db:test-get-testname test)) ;; by defintion this had better be true ...
		(let* ((state             (db:test-get-state test))

	     ;; if the test is not found then clearly the waiton is not met...
	     ;; (if (not ever-seen)(set! result (cons waitontest-name result)))))
	     (if (not ever-seen)
		 (set! result (append (if (null? tests)(list waitontest-name) tests) result)))))
	 waitons)
	(delete-duplicates result))))

(define (db:teststep-set-status! db test-id teststep-name state-in status-in comment logfile #!key (work-area #f))
  ;;                 db:open-test-db-by-test-id does cdb:remote-run
  (let* ((tdb       (db:open-test-db-by-test-id db test-id work-area: work-area))
	 (state     (items:check-valid-items "state" state-in))
	 (status    (items:check-valid-items "status" status-in)))
    (if (or (not state)(not status))
	(debug:print 3 "WARNING: Invalid " (if status "status" "state")
		     " value \"" (if status state-in status-in) "\", update your validvalues section in megatest.config"))
    (if (sqlite3:database? tdb)
	(begin
	  (sqlite3:execute 
	   tdb
	   "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);"
	   test-id teststep-name state-in status-in (current-seconds) (if comment comment "") (if logfile logfile ""))
	  (sqlite3:finalize! tdb)
	  #t)
	#f)))

;;======================================================================
;; Extract ods file from the db
;;======================================================================

;; NOT REWRITTEN YET!!!!!

;; runspatt is a comma delimited list of run patterns
;; keypatt-alist must contain *all* keys with an associated pattern: '( ("KEY1" "%") .. )
(define (db:extract-ods-file db outputfile keypatt-alist runspatt pathmod)
(define (db:extract-ods-file dbstruct outputfile keypatt-alist runspatt pathmod)
  (let* ((keysstr  (string-intersperse (map car keypatt-alist) ","))
	 (keyqry   (string-intersperse (map (lambda (p)(conc (car p) " LIKE ? ")) keypatt-alist) " AND "))
	 (numkeys  (length keypatt-alist))
	 (test-ids '())
	 (windows  (and pathmod (substring-index "\\" pathmod)))
	 (tempdir  (conc "/tmp/" (current-user-name) "/" runspatt "_" (random 10000) "_" (current-process-id)))
	 (runsheader (append (list "Run Id" "Runname") ; 0 1

    ;; brutal clean up
    (system "rm -rf tempdir")))

;; (db:extract-ods-file db "outputfile.ods" '(("sysname" "%")("fsname" "%")("datapath" "%")) "%")

;; This is a list of all procs that write to the db
;;
(define *db:all-write-procs*
  (list 
   db:set-var 
   db:del-var
   db:register-run
   db:set-comment-for-run
   db:delete-run
   db:update-run-event_time
   db:lock/unlock-run 
   db:delete-test-step-records
   db:delete-test-records
   db:delete-tests-for-run
   db:delete-old-deleted-test-records
   db:set-tests-state-status
   db:test-set-state-status-by-id
   db:test-set-state-status-by-run-id-testname
;; (define *db:all-write-procs*
;;   (list 
;;    db:set-var 
;;    db:del-var
;;    db:register-run
;;    db:set-comment-for-run
;;    db:delete-run
;;    db:update-run-event_time
;;    db:lock/unlock-run 
;;    db:delete-test-step-records
;;    db:delete-test-records
;;    db:delete-tests-for-run
;;    db:delete-old-deleted-test-records
;;    db:set-tests-state-status
;;    db:test-set-state-status-by-id
;;    db:test-set-state-status-by-run-id-testname
   db:test-set-comment
   db:testmeta-add-record
   db:csv->test-data
;;    db:testmeta-add-record
;;    db:csv->test-data
   db:test-data-rollup
   db:teststep-set-status! ))
;;    ))