Megatest

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

;;======================================================================
;;  R E C O R D S
;;======================================================================

;; each db entry is a pair ( db . dbfilepath )
(defstruct dbr:dbstruct 
  main
  strdb
  ((path #f)  : string)
  (tmpdb  #f)
  (mtdb   #f)
  ((local #f) : boolean)
  rundb
  (refndb #f))
  inmem
  mtime
  rtime 
  stime
  inuse
  refdb
  ((locdbs (make-hash-table)) : hash-table)
  olddb)

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

(define (db:general-sqlite-error-dump exn stmt . params)
  (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) ;; RADT ... how does this work?

;; 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) 
(define (db:get-db dbstruct . blah) ;;  run-id) 
  (if (sqlite3:database? dbstruct) ;; pass sqlite3 databases on through
      dbstruct
  (or (dbr:dbstruct-tmpdb dbstruct)
      (begin
	(let ((dbdat (if (or (not run-id)
			     (eq? run-id 0))
			 (db:open-main dbstruct)
      (db:open-db dbstruct)))
			 (db:open-rundb dbstruct run-id)
			 )))
	  dbdat))))

;; legacy handling of structure for managing db's. Refactor this into dbr:?
;; ;; legacy handling of structure for managing db's. Refactor this into dbr:?
(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
;; Locks the mutex and depending on 'mod or 'read passed, sets the last timestamp in dbstruct
;;
(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-mtime-set! dbstruct (current-milliseconds))
	    (dbr:dbstruct-rtime-set! dbstruct (current-milliseconds)))
	(dbr:dbstruct-inuse-set! dbstruct #f)
	(mutex-unlock! *rundb-mutex*))))
;; (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-mtime-set! dbstruct (current-milliseconds))
;; 	    (dbr:dbstruct-rtime-set! dbstruct (current-milliseconds)))
;; 	(dbr:dbstruct-inuse-set! dbstruct #f)
;; 	(mutex-unlock! *rundb-mutex*))))

;; (db:with-db dbstruct run-id sqlite3:exec "select blah from blaz;")
;; (db:with-db dbstruct run-id sqlite3:exec "select blah fgrom 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 (dbr:dbstruct? dbstruct)
		    (db:get-db dbstruct run-id)
		    (begin
		      (print-call-chain)
		      (print "db:with-db called with dbdat instead of dbstruct, FIXME!!")
		    dbstruct)) ;; cheat, allow for passing in a dbdat
		      dbstruct))) ;; cheat, allow for passing in a dbdat
	 (db    (db:dbdat-get-db dbdat))) 
    (handle-exceptions
     exn
     (begin
       (debug:print-error 0 *default-log-port* "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))
       ;; (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)

;;     (filedb:get-path db id)))

;; NB// #f => return dbdir only
;;      (was planned to be;  zeroth db with name=main.db)
;; 
;; If run-id is #f return to create and retrieve the path where the db will live.
;;
(define (db:dbfile-path run-id)
  (let* ((dbdir           (db:get-dbdir))
	 (fname           (if run-id
			      (if (eq? run-id 0) "main.db" (conc run-id ".db"))
			      #f)))
(define (db:dbfile-path . junk) ;;  run-id)
  (let* ((dbdir           (common:get-db-tmp-area))) ;; (db:get-dbdir))
;; 	 (fname           (if run-id
;; 			      (if (eq? run-id 0) "main.db" (conc run-id ".db"))
;; 			      #f)))
    (handle-exceptions
     exn
     (begin
       (debug:print-error 0 *default-log-port* "Couldn't create path to " dbdir)
       (exit 1))
     (if (not (directory? dbdir))(create-directory dbdir #t)))
    (if fname
	(conc dbdir "/" fname) 
	dbdir)))
    dbdir)) ;; (if fname
;;	(conc dbdir "/" fname) 
;;	dbdir)))

;; Returns the database location as specified in config file
;;
(define (db:get-dbdir)
  (or (configf:lookup *configdat* "setup" "dbdir")
      (conc (configf:lookup *configdat* "setup" "linktree") "/.db")))
;; (define db:get-dbdir common:get-db-tmp-area)
;;  (or (configf:lookup *configdat* "setup" "dbdir")
;;      (conc (configf:lookup *configdat* "setup" "linktree") "/.db")))
	       
(define (db:set-sync db)
  (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
;; RA => Returns a db handler; sets the lock if opened in writable mode
;;
(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))
  (let* ((parent-dir   (or (pathname-directory fname)(current-directory))) ;; no parent? go local
	 (dir-writable (file-write-access? parent-dir))
	 (file-exists  (file-exists? fname))
	 (file-write   (if file-exists
			   (file-write-access? fname)
			   dir-writable )))
    (if file-write ;; dir-writable
	(let (;; (lock    (obtain-dot-lock fname 1 5 10))

		(initproc db)))
	  ;; (release-dot-lock fname)
	  db)
	(begin
	  (debug:print 2 *default-log-port* "WARNING: opening 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*)))
;; ;; 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-local dbstruct))
	 (rdb    (if local
		     (dbr:dbstruct-localdb dbstruct run-id)
		     (dbr:dbstruct-inmem dbstruct)))) ;; (dbr:dbstruct-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))
;;   (let* ((dbfile       (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
;;          (dbexists     (file-exists? dbfile))
		 (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
;;          (db           (db:lock-create-open dbfile (lambda (db)
						    (lambda (db)
						      (handle-exceptions
						       exn
						       (begin
							 ;; (release-dot-lock dbpath)
							 (if (> attemptnum 2)
							     (debug:print-error 0 *default-log-port* "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
;;                                                      (handle-exceptions
;;                                                       exn
;;                                                       (begin
;;                                                         ;; (release-dot-lock dbpath)
;;                                                         (if (> attemptnum 2)
;;                                                             (debug:print-error 0 *default-log-port* "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))
;;          (olddb        (if *megatest-db*
;;                            *megatest-db* 
;;                            (let ((db (db:open-megatest-db)))
;;                              (set! *megatest-db* db)
;;                              db)))
;;          (write-access (file-write-access? dbfile)))
		 ;; (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-rundb-set!  dbstruct (cons db dbpath))
	    (dbr:dbstruct-inuse-set!  dbstruct #t)
	    (dbr:dbstruct-olddb-set!  dbstruct olddb)
;;     (if (and dbexists (not write-access))
;;         (set! *db-write-access* #f)) ;; only unset so other db's also can use this control
;;     (dbr:dbstruct-rundb-set!  dbstruct (cons db dbfile))
;;     (dbr:dbstruct-inuse-set!  dbstruct #t)
;;     (dbr:dbstruct-olddb-set!  dbstruct olddb)
	    ;; (dbr:dbstruct-run-id-set! dbstruct run-id)
	    (mutex-unlock! *rundb-mutex*)
;;     ;;; (mutex-unlock! *rundb-mutex*) ;;; why did we need a mutex on opening db's?
	    (if local
		(begin
		  (dbr:dbstruct-localdb-set! dbstruct run-id db) ;; (dbr:dbstruct-inmem-set! dbstruct db) ;; direct access ...
		  db)
		(begin
		  (dbr:dbstruct-inmem-set!  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:sync-tables db:sync-tests-only *megatest-db* db)
		  (db:delay-if-busy refdb) ;; dbpath: (db:dbdat-get-path refdb)) ;; What does delaying here achieve? 
		  (dbr:dbstruct-refdb-set!  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)))))))
;;     db))

;; This routine creates the db if not already present. It is only called if the db is not already ls opened
;; This routine creates the db if not already present. It is only called if the db is not already opened
;;
(define (db:open-main dbstruct) ;;  (conc *toppath* "/megatest.db") (car *configinfo*))) 
  (let ((mdb (dbr:dbstruct-main dbstruct))) ;; RA => Returns the first reference in dbstruct
    (if mdb
	mdb
(define (db:open-db dbstruct #!key (areapath #f)) ;;  (conc *toppath* "/megatest.db") (car *configinfo*))) 
  (let ((tmpdb (dbr:dbstruct-tmpdb dbstruct))) ;; RA => Returns the first reference in dbstruct
    (if tmpdb
	tmpdb
	(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))
        ;; (mutex-lock! *rundb-mutex*)
        (let* ((dbpath       (db:dbfile-path)) ;;  0))
               (dbexists     (file-exists? dbpath))
               (tmpdb        (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
               (mtdb         (db:open-megatest-db))
               (refndb       (db:open-megatest-db path: dbpath name: "megatest_ref.db"))
               (write-access (file-write-access? dbpath)))
		 (dbdat        (cons db dbpath)))
	    (if (and dbexists (not write-access))
		(set! *db-write-access* #f))
	    (dbr:dbstruct-main-set!   dbstruct dbdat)
	    (dbr:dbstruct-olddb-set!  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)))))
          (if (and dbexists (not write-access))
              (set! *db-write-access* #f))
          (dbr:dbstruct-mtdb-set!   dbstruct mtdb)
          (dbr:dbstruct-tmpdb-set!  dbstruct tmpdb) ;; olddb is already a (cons db path)
          (dbr:dbstruct-refndb-set! dbstruct refndb)
          ;;	    (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
          tmpdb))))

;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
;; called in http-transport and replicated in rmt.scm for *local* access. 
;;
(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)))
(define (db:setup #!key (areapath #f)) ;;  . junk) ;;  #!key (run-id #f) (local #f))
  (let* (;; (dbdir    (db:dbfile-path)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
         (dbstruct (make-dbr:dbstruct))) ;; ) ;;  path: dbdir local: local)))
    (db:open-db dbstruct areapath: #f)
    dbstruct))

;; open the local db for direct access (no server)
;;
(define (db:open-local-db-handle)
  (or *dbstruct-db*
      (let ((dbstruct (db:setup #f local: #t)))
      (let ((dbstruct (db:setup))) ;;  #f local: #t)))
	(set! *dbstruct-db* dbstruct)
	dbstruct)))
	  
;; Open the classic megatest.db file in toppath
;; Open the classic megatest.db file (defaults to open in toppath)
;;
;;   NOTE: returns a dbdat not a dbstruct!
;;
(define (db:open-megatest-db)
  (let* ((dbpath       (conc *toppath* "/megatest.db"))
(define (db:open-megatest-db #!key (path #f)(name #f))
  (let* ((dbpath       (conc (or path *toppath*) "/" (or name "megatest.db")))
	 (dbexists     (file-exists? dbpath))
	 (db           (db:lock-create-open dbpath
					    (lambda (db)
					      (db:initialize-main-db db)
					      (db:initialize-run-id-db db))))
	 (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-mtime dbstruct))
	(stime  (dbr:dbstruct-stime dbstruct))
	(rundb  (dbr:dbstruct-rundb dbstruct))
	(inmem  (dbr:dbstruct-inmem dbstruct))
	(maindb (dbr:dbstruct-main  dbstruct))
	(refdb  (dbr:dbstruct-refdb dbstruct))
	(olddb  (dbr:dbstruct-olddb dbstruct))
  (let (;; (mtime  (dbr:dbstruct-mtime dbstruct))
	;; (stime  (dbr:dbstruct-stime dbstruct))
	;; (rundb  (dbr:dbstruct-rundb dbstruct))
	;; (inmem  (dbr:dbstruct-inmem dbstruct))
	;; (maindb (dbr:dbstruct-main  dbstruct))
	;; (refdb  (dbr:dbstruct-refdb dbstruct))
        (tmpdb   (dbr:dbstruct-tmpdb dbstruct))
	(mtdb    (dbr:dbstruct-mtdb dbstruct))
        (refndb  (dbr:dbstruct-refndb dbstruct))
	;; (runid  (dbr:dbstruct-run-id dbstruct))
	)
    (debug:print-info 4 *default-log-port* "Syncing for run-id: " run-id)
    ;; (mutex-lock! *http-mutex*)
    (db:sync-tables (db:sync-all-tables-list tmpdb) #f tmpdb refndb mtdb)))
    (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-stime-set! 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 *default-log-port* "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-stime-set! 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))))))
;;    (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-stime-set! 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 *default-log-port* "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-stime-set! 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-main dbstruct)))
    (if maindb
	(begin
	  (sqlite3:finalize! (db:dbdat-get-db maindb))
	  (dbr:dbstruct-main-set! 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-localdb-set! dbstruct run-id #f)
	  (dbr:dbstruct-inmem-set! dbstruct #f)))))
;; (define (db:close-main dbstruct)
;;   (let ((maindb (dbr:dbstruct-main dbstruct)))
;;     (if maindb
;; 	(begin
;; 	  (sqlite3:finalize! (db:dbdat-get-db maindb))
;; 	  (dbr:dbstruct-main-set! 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-localdb-set! dbstruct run-id #f)
;; 	  (dbr:dbstruct-inmem-set! dbstruct #f)))))

;; close all opened run-id dbs
(define (db:close-all dbstruct)
  (if (dbr:dbstruct? dbstruct)
  ;; finalize main.db
  (db:sync-touched dbstruct 0 force-sync: #t)
      (begin
        (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 ((tdb (db:dbdat-get-db (dbr:dbstruct-tmpdb  dbstruct)))
              (mdb (db:dbdat-get-db (dbr:dbstruct-mtdb   dbstruct)))
              (rdb (db:dbdat-get-db (dbr:dbstruct-refndb dbstruct))))
          (if tdb (sqlite3:finalize! tdb))
          (if mdb (sqlite3:finalize! mdb))
          (if rdb (sqlite3:finalize! rdb))))))
  
  (let ((locdbs (dbr:dbstruct-locdbs dbstruct)))
    (if (hash-table? locdbs)
	(for-each (lambda (run-id)
		    (db:close-run-db dbstruct run-id))
		  (hash-table-keys locdbs)))))
;;   (let ((locdbs (dbr:dbstruct-locdbs dbstruct)))
;;     (if (hash-table? locdbs)
;; 	(for-each (lambda (run-id)
;; 		    (db:close-run-db dbstruct run-id))
;; 		  (hash-table-keys locdbs)))))

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

	 '("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)))
(define (db:sync-main-list dbstruct)
  (let ((keys  (db:get-keys dbstruct)))
    (list
     (list "keys"
	   '("id"        #f)
	   '("fieldname" #f)
	   '("fieldtype" #f))
     (list "metadat" '("var" #f) '("val" #f))
     (append (list "runs" 

	   '("description"    #f)
	   '("reviewed"       #f)
	   '("iterated"       #f)
	   '("avg_runtime"    #f)
	   '("avg_disk"       #f)
	   '("tags"           #f)
	   '("jobgroup"       #f)))))

(define (db:sync-all-tables-list dbstruct)
  (append (db:sync-main-list dbstruct)
	  db:sync-tests-only))

;; use bunch of Unix commands to try to break the lock and recreate the db
;;
(define (db:move-and-recreate-db dbdat)
  (let* ((dbpath   (db:dbdat-get-path        dbdat))
	 (dbdir    (pathname-directory       dbpath))
	 (fname    (pathname-strip-directory dbpath))

	 
	 (finalize! db)
	 #t))))))
    
;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) )
;; db's are dbdat's
;;
;; if last-update specified ("field-name" . time-in-seconds)
;;    then sync only records where field-name >= time-in-seconds
;;    IFF field-name exists
;;
(define (db:sync-tables tbls fromdb todb . slave-dbs)
(define (db:sync-tables tbls last-update fromdb todb . slave-dbs)
  (mutex-lock! *db-sync-mutex*)
  (handle-exceptions
   exn
   (begin
     (mutex-unlock! *db-sync-mutex*)
     (debug:print 0 *default-log-port* "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.")
     (print-call-chain (current-error-port))

	   (numrecs     (make-hash-table))
	   (start-time  (current-milliseconds))
	   (tot-count   0))
       (for-each ;; table
	(lambda (tabledat)
	  (let* ((tablename  (car tabledat))
		 (fields     (cdr tabledat))
		 (use-last-update  (if last-update
				       (if (pair? last-update)
					   (member (car last-update)    ;; last-update field name
						   (map car fields))
					   (begin
					     (debug:print 0 *default-log-port* "ERROR: parameter last-update for db:sync-tables must be a pair, received: " last-update) ;; found in fields
					     #f))
				       #f))
		 (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 ";"))
				   " FROM " tablename (if use-last-update ;; apply last-update criteria
							  (conc " " (car last-update) ">=" (cdr last-update))
							  "")
				   ";"))
		 (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))

			fromdat-lst))
		  ))
		  fromdats)
		 (sqlite3:finalize! stmth)))
	     (append (list todb) slave-dbs))))
	tbls)
       (let* ((runtime      (- (current-milliseconds) start-time))
	      (should-print (or (debug:debug-mode 12)
	      (should-print (common:low-noise-print 120 "db sync" (> runtime 500)))) ;; low and high sync times treated as separate.
				(common:low-noise-print 120 "db sync" (> runtime 500))))) ;; low and high sync times treated as separate.
	 (if should-print (debug:print 3 *default-log-port* "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 *default-log-port* (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*)))


(define (db:patch-schema-rundb run-id frundb)
(define (db:patch-schema-rundb frundb)
  ;;
  ;; remove this some time after September 2016 (added in version v1.6031
  ;;
  (for-each
   (lambda (table-name)
     (handle-exceptions
      exn

                               BEGIN 
                                 UPDATE " table-name " SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
                               END;"))
     )
   '("tests" "test_steps" "test_data")))

(define (db:patch-schema-maindb run-id maindb)
(define (db:patch-schema-maindb maindb)
  ;;
  ;; remove all these some time after september 2016 (added in v1.6031
  ;;
  (handle-exceptions
   exn
   (if (string-match ".*duplicate.*" ((condition-property-accessor 'exn 'message) exn))
       (debug:print 0 *default-log-port* "Column last_update already added to runs table")
       (db:general-sqlite-error-dump exn "alter table runs ..." run-id "none"))
       (db:general-sqlite-error-dump exn "alter table runs ..." #f "none"))
   (sqlite3:execute
    maindb
    "ALTER TABLE runs ADD COLUMN last_update INTEGER DEFAULT 0"))
  ;; these schema changes don't need exception handling
  (sqlite3:execute
   maindb
   "CREATE TRIGGER IF NOT EXISTS update_runs_trigger AFTER UPDATE ON runs

                              last_update INTEGER DEFAULT (strftime('%s','now')))")
  (sqlite3:execute maindb "CREATE TRIGGER  IF NOT EXISTS update_run_stats_trigger AFTER UPDATE ON run_stats
                             FOR EACH ROW
                               BEGIN 
                                 UPDATE run_stats SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
                               END;"))

(define *global-db-store* (make-hash-table))

(define (db:get-access-mode)
  (if (args:get-arg "-use-db-cache") 'cached 'rmt))

;; Add db direct
;;
(define (db:dispatch-query access-mode rmt-cmd db-cmd . params)
  (if (eq? access-mode 'cached)
      (print "not doing cached calls right now"))
;;      (apply db:call-with-cached-db db-cmd params)
      (apply rmt-cmd params))
;;)

;; return the target db handle so it can be used
;;
(define (db:cache-for-read-only source target #!key (use-last-update #f))
  (if (and (hash-table-ref/default *global-db-store* target #f)
	   (>= (file-modification-time target)(file-modification-time source)))
      (hash-table-ref *global-db-store* target)
      (let* ((toppath   (launch:setup))
	     (targ-db-last-mod (if (file-exists? target)
				   (file-modification-time target)
				   0))
	     (cache-db  (or (hash-table-ref/default *global-db-store* target #f)
			    (db:open-megatest-db path: target)))
	     (source-db (db:open-megatest-db path: source))
	     (curr-time (current-seconds))
	     (res      '())
	     (last-update (if use-last-update (cons "last_update" targ-db-last-mod) #f)))
	(db:sync-tables (db:sync-main-list source-db) last-update source-db cache-db)
	(db:sync-tables db:sync-tests-only last-update source-db cache-db)
	(hash-table-set! *global-db-store* target cache-db)
	cache-db)))

;; call a proc with a cached db
;;
(define (db:call-with-cached-db proc . params)
  ;; first cache the db in /tmp
  (let* ((cname-part (conc "megatest_cache/" (common:get-testsuite-name)))
	 (fname      (conc  (common:get-area-path-signature) ".db"))
	 (cache-dir  (common:get-create-writeable-dir
		      (list (conc "/tmp/" (current-user-name) "/" cname-part)
			    (conc "/tmp/" (current-user-name) "-" cname-part)
			     (conc "/tmp/" (current-user-name) "_" cname-part))))
	 (megatest-db (conc *toppath* "/megatest.db")))
    ;; (debug:print-info 0 *default-log-port* "Using cache dir " cache-dir)
    (if (not cache-dir)
	(begin
	  (debug:print 0 *default-log-port* "ERROR: Failed to find an area to write the cache db")
	  (exit 1))
	(let* ((th1      (make-thread
			  (lambda ()
			    (if (and (file-exists? megatest-db)
				     (file-write-access? megatest-db))
				(begin
				  (common:sync-to-megatest.db 'timestamps) ;; internally mutexes on *db-local-sync*
				  (debug:print-info 2 *default-log-port* "Done syncing to megatest.db"))))
			  "call-with-cached-db sync-to-megatest.db"))
	       (cache-db (db:cache-for-read-only
			  megatest-db
			  (conc cache-dir "/" fname)
			  use-last-update: #t)))
	  (thread-start! th1)
	  (apply proc cache-db params)
	  ))))

;; 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
;;  'schema       - attempt to apply schema changes
;;
;;  run-ids: '(1 2 3 ...) or #f (for all)
;;
(define (db:multi-db-sync run-ids . options)
  (let* ((toppath  (launch:setup))
	 (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 (not (launch:setup))
      (debug:print 0 *default-log-port* "ERROR: not able to setup up for megatest.")
      (let* ((dbstruct (db:setup))
	     (mtdb     (dbr:dbstruct-mtdb dbstruct))
	     (tmpdb    (dbr:dbstruct-tmpdb dbstruct))
             (refndb   (dbr:dbstruct-refndb dbstruct))
	     (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))))
;; 			   (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))
	;; 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)))
	;; clear out junk records
	;;
	(if (member 'dejunk options)
	    (begin
	      (db:delay-if-busy mtdb) ;; ok to delay on mtdb
	      (db:clean-up mtdb)
	      (db:clean-up tmpdb)
              (db:clean-up refndb)))

    ;; 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)))
	;; 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 *default-log-port* "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-rundb dbstruct)))))
	   run-ids)))
	;; sync runs, test_meta etc.
	;;
	(if (member 'old2new options)
	    ;; (begin
	    (db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb tmpdb refndb))
			      ;; (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 *default-log-port* "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-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 (if run-ids 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  '()))
          ;; first fix schema if needed
          (map
           (lambda (th)
             (thread-join! th))
           (map
            (lambda (run-id)
              (thread-start! 
               (make-thread
                (lambda ()
                  (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
                         (frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
                    (if (eq? run-id 0)
                        (let ((maindb  (db:dbdat-get-db (db:get-db fromdb #f))))
                          (db:patch-schema-maindb run-id maindb))
                        (db:patch-schema-rundb run-id frundb)))
                  (set! count (+ count 1))
                  (debug:print 0 *default-log-port* "Finished patching schema for " (if (eq? run-id 0) " main.db " (conc run-id ".db")) ", " count " of " total)))))
            all-run-ids))
          ;; Then sync and fix db's
          (set! count 0)
          (process-fork
	;; 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)
	    (db:sync-tables (db:sync-all-tables-list dbstruct) #f tmpdb refndb mtdb))

        (if (member 'fixschema options)
            (begin
              (db:patch-schema-maindb (db:dbdat-get-db mtdb))
              (db:patch-schema-maindb (db:dbdat-get-db tmpdb))
              (db:patch-schema-maindb (db:dbdat-get-db refndb))
              (db:patch-schema-rundb  (db:dbdat-get-db mtdb))
              (db:patch-schema-rundb  (db:dbdat-get-db tmpdb))
              (db:patch-schema-rundb  (db:dbdat-get-db refndb))))
              
	;; (let* ((maindb      (make-dbr:dbstruct path: toppath local: #t))
	;; 	   (src-run-ids (if run-ids 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  '()))
	;;   ;; first fix schema if needed
	;;   (map
	;;    (lambda (th)
	;; 	 (thread-join! th))
	;;    (map
	;; 	(lambda (run-id)
	;; 	  (thread-start! 
	;; 	   (make-thread
	;; 	    (lambda ()
	;; 	      (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
;;                    (if (member 'schema options)
	;; 		(if (eq? run-id 0)
	;; 		    (let ((maindb  (db:dbdat-get-db (db:get-db fromdb #f))))
	;; 		      (db:patch-schema-maindb run-id maindb))
	;; 		    (db:patch-schema-rundb run-id frundb)))
	;; 	      (set! count (+ count 1))
	;; 	      (debug:print 0 *default-log-port* "Finished patching schema for " (if (eq? run-id 0) " main.db " (conc run-id ".db")) ", " count " of " total)))))
	;; 	all-run-ids))
	;;   ;; Then sync and fix db's
	;;   (set! count 0)
	;;   (process-fork
           (lambda ()
             (map
              (lambda (th)
                (thread-join! th))
              (map
               (lambda (run-id)
                 (thread-start! 
                  (make-thread
                   (lambda ()
                     (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
                            (frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
                       (if (eq? run-id 0)
                           (let ((maindb  (db:dbdat-get-db (db:get-db fromdb #f))))
                             (db:sync-tables (db:sync-main-list dbstruct) (db:get-db fromdb #f) mtdb)
                             (set! dead-runs (db:clean-up-maindb (db:get-db fromdb #f))))
                           (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)))))
                     (set! count (+ count 1))
                     (debug:print 0 *default-log-port* "Finished clean up of "
                                  (if (eq? run-id 0)
                                      " main.db " (conc run-id ".db")) ", " count " of " total)))))
               all-run-ids))))
	;;    (lambda ()
	;; 	 (map
	;; 	  (lambda (th)
	;; 	    (thread-join! th))
	;; 	  (map
	;; 	   (lambda (run-id)
	;; 	     (thread-start! 
	;; 	      (make-thread
	;; 	       (lambda ()
	;; 		 (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
	;; 			(frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
	;; 		   (if (eq? run-id 0)
	;; 		       (let ((maindb  (db:dbdat-get-db (db:get-db fromdb #f))))
;;                             (db:sync-tables (db:sync-main-list dbstruct) #f (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 #f (db:get-db fromdb run-id) mtdb)
	;; 			 (db:clean-up-rundb (db:get-db fromdb run-id)))))
	;; 		 (set! count (+ count 1))
	;; 		 (debug:print 0 *default-log-port* "Finished clean up of "
	;; 			      (if (eq? run-id 0)
	;; 				  " main.db " (conc run-id ".db")) ", " count " of " total)))))
	;; 	   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 *default-log-port* "Removing database file for deleted run " fullname)
				(delete-file fullname)))))
		      dead-runs))))

    ;; (db:close-all dbstruct)
    ;; (sqlite3:finalize! mdb)
    ))
	;; 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 *default-log-port* "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 *default-log-port* "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

    
    ;; 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)
    ;; (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 *default-log-port* "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)
    ;; (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))))

    
    ;; 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)
    ;; (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 *default-log-port* "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)
    ;; (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 *default-log-port* "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 dbdat)
    ;; (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 *default-log-port* "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)
    ;; (db:delay-if-busy dbdat)
    (for-each
     (lambda (toptest)
       (let ((test-name (list-ref toptest 3)))
;;	     (run-id    (list-ref toptest 5)))
	 (db:top-test-set-per-pf-counts dbstruct run-id test-name)))
     toplevels)))

;; BUG: Probably broken - does not explicitly use run-id in the query
;;
(define (db:top-test-set-per-pf-counts dbstruct run-id test-name)
  (db:general-call (db:get-db dbstruct run-id) 'top-test-set-per-pf-counts (list test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name))) 
 
		     
;; Clean out old junk and vacuum the database
;;
;; Ultimately do something like this:

	       ;; 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)
    ;; (db:delay-if-busy dbdat)
    (sqlite3:with-transaction 
     db
     (lambda ()
       (sqlite3:for-each-row (lambda (tot)
			       (debug:print-info 0 *default-log-port* "Records count before clean: " tot))
			     count-stmt)
       (map sqlite3:execute statements)
       (sqlite3:for-each-row (lambda (tot)
			       (debug:print-info 0 *default-log-port* "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)
    ;; (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:

		(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)
    ;; (db:delay-if-busy dbdat)
    (sqlite3:with-transaction 
     db
     (lambda ()
       (sqlite3:for-each-row (lambda (tot)
			       (debug:print-info 0 *default-log-port* "Records count before clean: " tot))
			     count-stmt)
       (map sqlite3:execute statements)
       (sqlite3:for-each-row (lambda (tot)
			       (debug:print-info 0 *default-log-port* "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)
    ;; (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:

		)))
	 (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)
    ;; (db:delay-if-busy dbdat)
    (sqlite3:with-transaction 
     db
     (lambda ()
       (sqlite3:for-each-row (lambda (tot)
			       (debug:print-info 0 *default-log-port* "Records count before clean: " tot))
			     count-stmt)
       (map sqlite3:execute statements)
       (sqlite3:for-each-row (lambda (tot)
			       (debug:print-info 0 *default-log-port* "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)
    ;; (db:delay-if-busy dbdat)
    (sqlite3:execute db "VACUUM;")
    dead-runs))

;;======================================================================
;; M E T A   G E T   A N D   S E T   V A R S
;;======================================================================

	 (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 *default-log-port* "keys: " keys " allvals: " allvals " keyvals: " keyvals " key=?str is " key=?str)
    (debug:print 2 *default-log-port* "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 dbdat)
	  ;; (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)
	  ;; (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 *default-log-port* "qry: " qry) 
		   qry)
		 qryvals)
	  (db:delay-if-busy dbdat)
	  ;; (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-error 0 *default-log-port* "Called without all necessary keys")
	  #f))))

;; replace header and keystr with a call to runs:get-std-run-fields

		   )))
    (debug:print-info 11 *default-log-port* "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count)
    (vector header res)))

;; TODO: Switch this to use max(update_time) from each run db? Then if using a server there is no disk traffic (using inmem db)
;;
(define (db:get-changed-run-ids since-time)
  (let* ((dbdir      (db:dbfile-path #f)) ;; (configf:lookup *configdat* "setup" "dbdir"))
  (let* ((dbdir      (db:dbfile-path)) ;; (configf:lookup *configdat* "setup" "dbdir"))
	 (alldbs     (glob (conc dbdir "/[0-9]*.db")))
	 (changed    (filter (lambda (dbfile)
			       (> (file-modification-time dbfile) since-time))
			     alldbs)))
    (delete-duplicates
     (map (lambda (dbfile)
	    (let* ((res (string-match ".*\\/(\\d)*\\.db" dbfile)))

  (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)
    ;; (db:delay-if-busy dbdat)
    (sqlite3:for-each-row
     (lambda (run-id runname)
       (set! runs-info (cons (list run-id runname) runs-info)))
     db
     "SELECT id,runname FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;") ;; If you change this to the more logical ASC please adjust calls to db:get-run-stats
    ;; for each run get stats data
    (for-each

	 (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 *default-log-port* "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr)
    (db:delay-if-busy dbdat)
    ;; (db:delay-if-busy dbdat)
    (sqlite3:for-each-row
     (lambda (a . x)
       (set! res (apply vector a x)))
     db 
     (conc "SELECT " keystr " FROM runs WHERE id=? AND state != 'deleted';")
     run-id)
    (debug:print-info 11 *default-log-port* "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr)

;; does not (obviously!) removed dependent data. But why not!!?
(define (db:delete-run dbstruct run-id)
  ;; 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 rdbdat)
    ;; (db:delay-if-busy rdbdat)
    (sqlite3:execute rdb "UPDATE tests SET state='DELETED',comment='';")
    (sqlite3:execute rdb "DELETE FROM test_steps;")
    (sqlite3:execute rdb "DELETE FROM test_data;")
    (db:delay-if-busy dbdat)
    ;; (db:delay-if-busy dbdat)
    (sqlite3:execute db "UPDATE runs SET state='deleted',comment='' WHERE id=?;" run-id)))

(define (db:update-run-event_time dbstruct run-id)
  (db:with-db
   dbstruct
   #f
   #t

       (sqlite3:execute db "INSERT INTO access_log (user,accessed,args) VALUES(?,strftime('%s','now'),?);"
			user (conc newlockval " " run-id))
       (debug:print-info 1 *default-log-port* "" newlockval " run number " 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)
    ;; (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 dbstruct run-id)
  (let ((res "n/a"))
    (db:with-db

  (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=?;")))
	 (db:delay-if-busy dbdat)
	 ;; (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)
    (reverse res)))

;; get key vals for a given run-id
(define (db:get-key-vals 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=?;")))
	 (db:delay-if-busy dbdat)
	 ;; (db:delay-if-busy dbdat)
	 (sqlite3:for-each-row 
	  (lambda (key-val)
	    (set! res (cons key-val res)))
	  db qry run-id)))
     keys)
    (let ((final-res (reverse res)))
      (hash-table-set! *keyvals* run-id final-res)

  (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 dbstruct)
  (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

      (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))))

;; NEW BEHAVIOR: Count tests running in only one run!
;; NEW BEHAVIOR: Count tests running in all runs!
;;
(define (db:get-count-tests-running dbstruct run-id)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)

(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 ((testnames '()))
	;; get the testnames
	(db:delay-if-busy dbdat)
	;; (db:delay-if-busy dbdat)
	(sqlite3:for-each-row
	 (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?

  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (db:first-result-default
      db
      "SELECT id FROM tests WHERE testname=? AND item_path=?;"
      "SELECT id FROM tests WHERE testname=? AND item_path=? AND run_id=?;"
      #f ;; the default
      testname item-path))))
      testname item-path run-id))))

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

;; 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)
    ;; (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 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=?;")

	  ;;                 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)
(define (db:get-test-info dbstruct run-id test-name 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)
	(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE testname=? AND item_path=? AND run_id=?;")
	test-name item-path run-id)
       res))))

(define (db:test-get-rundir-from-test-id dbstruct run-id test-id)
  (db:with-db
   dbstruct
   run-id
   #f

;;    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 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)
    ;; (db:delay-if-busy dbdat)
    (sqlite3:for-each-row
     (lambda (fcount pcount)
       (set! fail-count fcount)
       (set! pass-count pcount))
     db 
     "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;"

			 ((>)  (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 *default-log-port* "AFTER2: category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
	 (db:delay-if-busy dbdat)
	 ;; (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)))
     csvlist)))

;; This routine moved from tdb.scm, tdb:read-test-data
;;
(define (db:read-test-data dbstruct run-id test-id categorypatt)
  (let* ((dbdat      (db:get-db dbstruct run-id))
	 (db         (db:dbdat-get-db dbdat))
	 (res '()))
    (db:delay-if-busy dbdat)
    ;; (db:delay-if-busy dbdat)
    (sqlite3:for-each-row 
     (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)))
     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)
    (reverse res)))

    (if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
	(db:general-call dbdat 'set-test-start-time (list test-id)))
    (if msg
	(db:general-call dbdat 'state-status-msg (list state status msg test-id))
	(db:general-call dbdat 'state-status     (list state status test-id)))
     (mt:process-triggers run-id test-id state status)))

;; state is the priority rollup of all states
;; status is the priority rollup of all completed states
;;
;; if test-name is an integer work off that instead of test-name test-path
;;
(define (db:set-state-status-and-roll-up-items dbstruct run-id test-name item-path state status comment)
  ;; establish info on incoming test followed by info on top level test
  (let* ((db           (db:dbdat-get-db (dbr:dbstruct-tmpdb dbstruct)))
	 (testdat      (if (number? test-name)
			   (db:get-test-info-by-id dbstruct run-id test-name)
			   (db:get-test-info       dbstruct run-id test-name item-path)))
	 (test-id      (db:test-get-id testdat))
	 (test-name    (if (number? test-name)
			   (db:test-get-testname testdat)
			   test-name))
	 (item-path    (db:test-get-item-path testdat))
         (tl-testdat   (db:get-test-info dbstruct run-id test-name ""))
         (tl-test-id   (db:test-get-id tl-testdat)))
    (sqlite3:with-transaction
     db
     (lambda ()
       (db:test-set-state-status-by-id dbstruct run-id test-id state status comment)
       (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item
	   (let* ((all-curr-states   (common:special-sort
				      (delete-duplicates
				       (let ((states (db:get-all-item-states db run-id test-name)))
					 (if state (cons state states) states)))
				      *common:std-states* >))
		  (all-curr-statuses (common:special-sort
				      (delete-duplicates
				       (let ((statuses (db:get-all-item-statuses db run-id test-name)))
					 (if (member state *common:ended-states*) ;; '("COMPLETED" "ARCHIVED"))
					     (cons (if (member state *common:badly-ended-states*)
						       "FAIL"
						       status)
						   statuses)
					     statuses)))
				      *common:std-statuses* >))
		  (newstate          (if (null? all-curr-states) "NOT_STARTED" (car all-curr-states)))
		  (newstatus         (if (null? all-curr-statuses) "n/a" (car all-curr-statuses))))
	     (print "Setting toplevel to: " newstate "/" newstatus)
	     (db:test-set-state-status-by-id dbstruct run-id tl-test-id newstate newstatus #f)))))))
        
(define db:roll-up-pass-fail-counts db:set-state-status-and-roll-up-items)

;; call with state = #f to roll up with out accounting for state/status of this item
;;
(define (db:roll-up-pass-fail-counts dbstruct run-id test-name item-path state status)
  (if (not (equal? item-path ""))
      (let ((dbdat (db:get-db dbstruct run-id)))
	;;	(db    (db:dbdat-get-db dbdat)))
	(db:general-call dbdat 'update-pass-fail-counts (list test-name test-name test-name))
	(db:top-test-set-per-pf-counts dbstruct run-id test-name))))
  
;;     (case (string->symbol status)
;;       ((RUNNING)  (db:general-call dbdat 'top-test-set-running (list test-name)))
;;       ((LAUNCHED) (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name)))
;;       ((ABORT INCOMPLETE) (db:general-call dbdat 'top-test-set (list status test-name))))
    
;;     (if (or (not state)
;; 	    (not (equal? item-path "")))
;; 	;; just do a rollup
;; 	(begin
;; 	  (db:top-test-set-per-pf-counts dbdat run-id test-name)
;; 	  #f)
;; 	(begin
;; 	  ;; NOTE: No else clause needed for this case
;; 	  (case (string->symbol status)
;; 	    ((RUNNING)  (db:general-call dbdat 'top-test-set-running (list test-name)))
;; 	    ((LAUNCHED) (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name)))
;; 	    ((ABORT INCOMPLETE) (db:general-call dbdat 'top-test-set (list status test-name))))
;; 	  #f)
;; 	)))
;;    (define (db:roll-up-pass-fail-counts dbstruct run-id test-name item-path state status)
;;      (if (not (equal? item-path "")) ;; if asked to do this for a specific item then do an incremental update
;;          (let* ((dbdat         (db:get-db dbstruct run-id))
;;                 (toptestdat    (db:get-test-info dbstruct run-id test-name item-path))
;;                 (currtopstate  (db:test-get-state toptestdat))
;;                 (currtopstatus (db:test-get-status toptestdat))
;;                 (nextss        (common:apply-state-status currtopstate currtopstatus state status))
;;                 (newtopstate   (car nextss))  ;; #f or a symbol
;;                 (newtopstatus  (cdr nextss))) ;; #f or a symbol
;;            (if (not newtopstate) ;; need to calculate it
;;                
;;            ;; We rely on the toplevel to track status as state varies. I.e. preserve an ABORT
;;            
;;                 
;;    	;;	(db    (db:dbdat-get-db dbdat)))
;;    	(db:general-call dbdat 'update-pass-fail-counts (list test-name test-name test-name))
;;    	(db:top-test-set-per-pf-counts dbstruct run-id test-name))))
;;      
;;    ;;     (case (string->symbol status)
;;    ;;       ((RUNNING)  (db:general-call dbdat 'top-test-set-running (list test-name)))
;;    ;;       ((LAUNCHED) (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name)))
;;    ;;       ((ABORT INCOMPLETE) (db:general-call dbdat 'top-test-set (list status test-name))))
;;        
;;    ;;     (if (or (not state)
;;    ;; 	    (not (equal? item-path "")))
;;    ;; 	;; just do a rollup
;;    ;; 	(begin
;;    ;; 	  (db:top-test-set-per-pf-counts dbdat run-id test-name)
;;    ;; 	  #f)
;;    ;; 	(begin
;;    ;; 	  ;; NOTE: No else clause needed for this case
;;    ;; 	  (case (string->symbol status)
;;    ;; 	    ((RUNNING)  (db:general-call dbdat 'top-test-set-running (list test-name)))
;;    ;; 	    ((LAUNCHED) (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name)))
;;    ;; 	    ((ABORT INCOMPLETE) (db:general-call dbdat 'top-test-set (list status test-name))))
;;    ;; 	  #f)
;;    ;; 	)))

(define (db:get-all-item-states db run-id test-name)
  (sqlite3:map-row 
   (lambda (a) a)
   db
   "SELECT DISTINCT state FROM tests WHERE item_path != '' AND state != 'DELETED' AND run_id=? AND testname=?"
   run-id test-name))

(define (db:get-all-item-statuses db run-id test-name)
  (sqlite3:map-row 
   (lambda (a) a)
   db
   "SELECT DISTINCT status FROM tests WHERE item_path != '' AND state != 'DELETED' AND state='COMPLETED' AND run_id=? AND testname=?"
   run-id test-name))

(define (db:test-get-logfile-info dbstruct run-id test-name)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (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 *default-log-port* "Found path: " path)
	      (debug:print 2 *default-log-port* "No such path: " path))) ;; )
	db
	"SELECT rundir,final_logf FROM tests WHERE testname=? AND item_path='';"
	"SELECT rundir,final_logf FROM tests WHERE testname=? AND item_path='' AND run_id=?;"
	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 
;;======================================================================

                                      (SELECT status FROM tests WHERE id=?) NOT IN ('WARN','FAIL')
                                    THEN 'PASS'
                                    ELSE status
                                    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=?;")
	'(test-set-rundir-shortdir "UPDATE tests SET rundir=?,shortdir=? WHERE testname=? AND item_path=?;")    ;; BROKEN!!! NEEDS run-id
	'(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=?;") ;; DONE
	'(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-pass-fail-counts "UPDATE tests 
             SET fail_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('FAIL','CHECK','INCOMPLETE','ABORT')),
                 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
             WHERE testname=? AND item_path='' AND run_id=?;") ;; DONE  ;; BROKEN!!! NEEDS run-id
	'(top-test-set          "UPDATE tests SET state=? WHERE testname=? AND item_path='';") ;; DONE   ;; BROKEN!!! NEEDS run-id
	'(top-test-set-running  "UPDATE tests SET state='RUNNING' WHERE testname=? AND item_path='';") ;; DONE   ;; BROKEN!!! NEEDS run-id


	;; Might be the following top-test-set-per-pf-counts query could be better based off of something like this:
	;;
	;; select state,status,count(state) from tests where run_id=59 AND testname='runfirst' group by state,status;
	;;
	'(top-test-set-per-pf-counts "UPDATE tests

                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state = 'COMPLETED'
                                              AND status = 'PASS') > 0 THEN 'PASS'
                                  WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' 
                                  ELSE 'UNKNOWN' END
                       WHERE testname=? AND item_path='';") ;; DONE
                       WHERE testname=? AND item_path='';") ;; DONE  ;; BROKEN!!! NEEDS run-id

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

(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))))
    (db:delay-if-busy dbdat)
    ;; (db:delay-if-busy dbdat)
    (apply sqlite3:execute (db:dbdat-get-db dbdat) query params)
    #t))

;; get a summary of state and status counts to calculate a rollup
;;
;; NOTE: takes a db, not a dbstruct
;;

	 (db      (db:dbdat-get-db dbdat))
	 (keys    (db:get-keys db))
	 (selstr  (string-intersperse keys ","))
	 (qrystr  (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND "))
	 (keyvals #f)
	 (tests-hash (make-hash-table)))
    ;; first look up the key values from the run selected by run-id
    (db:delay-if-busy dbdat)
    ;; (db:delay-if-busy dbdat)
    (sqlite3:for-each-row 
     (lambda (a . b)
       (set! keyvals (cons a b)))
     db
     (conc "SELECT " selstr " FROM runs WHERE id=? ORDER BY event_time DESC;") run-id)
    (if (not keyvals)
	'()