Megatest

;;     (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 . junk) ;;  run-id)
  (let* ((dbdir           (common:get-db-tmp-area)))
(define db:dbfile-path common:get-db-tmp-area)
    (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)))
    dbdir))

(define (db:set-sync db)
  (let ((syncprag (configf:lookup *configdat* "setup" "sychronous")))
    (sqlite3:execute db (conc "PRAGMA synchronous = " (or syncprag 0) ";")))) 

;; 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-open-mutex* (make-mutex))

(define (db:lock-create-open fname initproc)
  (let* ((parent-dir   (or (pathname-directory fname)(current-directory))) ;; no parent? go local
         (raw-fname    (pathname-file fname))
	 (dir-writable (file-write-access? parent-dir))
	 (file-exists  (file-exists? fname))
	 (file-exists  (common:file-exists? fname))
	 (file-write   (if file-exists
			   (file-write-access? fname)
			   dir-writable )))
    ;;(mutex-lock! *db-open-mutex*) ;; tried this mutex, not clear it helped.
    (if file-write ;; dir-writable
	(condition-case
         (let* ((lockfname   (conc fname ".lock"))
                (readyfname  (conc parent-dir "/.ready-" raw-fname))
                (readyexists (file-exists? readyfname)))
                (readyexists (common:file-exists? readyfname)))
           (if (not readyexists)
               (common:simple-file-lock-and-wait lockfname))
           (let ((db      (sqlite3:open-database fname)))
             (sqlite3:set-busy-handler! db (make-busy-timeout 136000))
             (sqlite3:execute db "PRAGMA synchronous = 0;")
             (if (not file-exists)
                 (begin
                   (if (and (configf:lookup *configdat* "setup" "use-wal")
                            (string-match "^/tmp/.*" fname)) ;; this is a file in /tmp
                       (sqlite3:execute db "PRAGMA journal_mode=WAL;")
                       (print "Creating " fname " in NON-WAL mode."))
                       (debug:print 2 *default-log-port* "Creating " fname " in NON-WAL mode."))
                   (initproc db)))
             (if (not readyexists)
                 (begin
                   (common:simple-file-release-lock lockfname)
                   (with-output-to-file
                       readyfname
                     (lambda ()

;; ;; 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* ((dbfile       (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
;;          (dbexists     (file-exists? dbfile))
;;          (dbexists     (common:file-exists? dbfile))
;;          (db           (db:lock-create-open dbfile (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)

;;     (dbr:dbstruct-olddb-set!  dbstruct olddb)
;;     ;;; (mutex-unlock! *rundb-mutex*) ;;; why did we need a mutex on opening db's?
;;     (db:sync-tables db:sync-tests-only *megatest-db* db)
;;     db))

;; This routine creates the db if not already present. It is only called if the db is not already opened
;;
(define (db:open-db dbstruct #!key (areapath #f)) ;; TODO: actually use areapath
(define (db:open-db dbstruct #!key (areapath #f)(do-sync #t)) ;; TODO: actually use areapath
  (let ((tmpdb-stack (dbr:dbstruct-dbstack dbstruct))) ;; RA => Returns the first reference in dbstruct
    (if (stack? tmpdb-stack)
	(db:get-db tmpdb-stack) ;; get previously opened db (will create new db handle if all in the stack are already used
        (let* ((dbpath       (db:dbfile-path ))      ;; path to tmp db area
               (dbexists     (file-exists? dbpath))
               (dbexists     (common:file-exists? dbpath))
	       (tmpdbfname   (conc dbpath "/megatest.db"))
	       (dbfexists    (file-exists? tmpdbfname))  ;; (conc dbpath "/megatest.db")))
               (mtdbexists   (file-exists? (conc *toppath* "/megatest.db")))
	       (dbfexists    (common:file-exists? tmpdbfname))  ;; (conc dbpath "/megatest.db")))
               (mtdbexists   (common:file-exists? (conc *toppath* "/megatest.db")))
               
               (mtdb         (db:open-megatest-db))
               (mtdbpath     (db:dbdat-get-path mtdb))
               (tmpdb        (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
               (refndb       (db:open-megatest-db path: dbpath name: "megatest_ref.db"))
               (write-access (file-write-access? mtdbpath))
	       (mtdbmodtime  (if mtdbexists (common:lazy-sqlite-db-modification-time mtdbpath)   #f))

                (dbr:dbstruct-read-only-set! dbstruct #t)))
          (dbr:dbstruct-mtdb-set!   dbstruct mtdb)
          (dbr:dbstruct-tmpdb-set!  dbstruct tmpdb)
          (dbr:dbstruct-dbstack-set! dbstruct (make-stack)) ;; BB: why a stack?  Why would the number of db's be indeterminate?  Is this a legacy of 1.db 2.db .. ?
          (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb) ;; olddb is already a (cons db path)
          (dbr:dbstruct-refndb-set! dbstruct refndb)
          ;;	    (mutex-unlock! *rundb-mutex*)
          (if (or (not dbfexists)
                  (and modtimedelta
                       (> modtimedelta 10))) ;; if db in tmp is over ten seconds older than the file in MTRA then do a sync back
          (if (and  (or (not dbfexists)
			(and modtimedelta
			     (> modtimedelta 10))) ;; if db in tmp is over ten seconds older than the file in MTRA then do a sync back
		    do-sync)
	      (begin
		(debug:print 4 *default-log-port* "filling db " (db:dbdat-get-path tmpdb) " with data \n    from " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta)
		(db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb refndb tmpdb)
                (debug:print-info 13 *default-log-port* "db:sync-all-tables-list done.")
                )
	      (debug:print 4 *default-log-port* " db, " (db:dbdat-get-path tmpdb) " already exists or fresh enough, not propogating data from\n     " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta) )
	  ;; (db:multi-db-sync dbstruct '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 #!key (areapath #f))
(define (db:setup do-sync #!key (areapath #f))
  ;;

  (cond
   (*dbstruct-db* *dbstruct-db*);; TODO: when multiple areas are supported, this optimization will be a hazard
   (else ;;(common:on-homehost?)
    (debug:print-info 13 *default-log-port* "db:setup entered (first time, not cached.)")
    (let* ((dbstruct (make-dbr:dbstruct)))
      (when (not *toppath*)
        (debug:print-info 13 *default-log-port* "in db:setup, *toppath* not set; calling launch:setup")
        (launch:setup areapath: areapath))
      (debug:print-info 13 *default-log-port* "Begin db:open-db")
      (db:open-db dbstruct areapath: areapath)
      (db:open-db dbstruct areapath: areapath do-sync: do-sync)
      (debug:print-info 13 *default-log-port* "Done db:open-db")
      (set! *dbstruct-db* dbstruct)
      ;;(debug:print-info 13 *default-log-port* "new dbstruct = "(dbr:dbstruct->alist dbstruct))
      dbstruct))))
   ;; (else
   ;;  (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost))
   ;;  (exit 1))))

;; Open the classic megatest.db file (defaults to open in toppath)
;;
;;   NOTE: returns a dbdat not a dbstruct!
;;
(define (db:open-megatest-db #!key (path #f)(name #f))
  (let* ((dbdir        (or path *toppath*))
         (dbpath       (conc  dbdir "/" (or name "megatest.db")))
	 (dbexists     (file-exists? dbpath))
	 (dbexists     (common: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)))
    (debug:print-info 13 *default-log-port* "db:open-megatest-db "dbpath)

      (mutex-unlock! *db-multi-sync-mutex*)
      (db:sync-tables (db:sync-all-tables-list dbstruct) update_info tmpdb refndb mtdb))
    (mutex-lock! *db-multi-sync-mutex*)
    (set! *db-last-sync* start-t)
    (set! *db-last-access* start-t)
    (mutex-unlock! *db-multi-sync-mutex*)
    (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb)))

(define (db:safely-close-sqlite3-db db #!key (try-num 3))
  (if (<= try-num 0)
      #f
      (handle-exceptions
	  exn
	  (begin
	    (thread-sleep! 3)
	    (sqlite3:interrupt! db)
	    (db:safely-close-sqlite3-db db try-num: (- try-num 1)))
	(if (sqlite3:database? db)
	    (begin
	      (sqlite3:finalize! db)
	      #t)
	    #f))))

;; close all opened run-id dbs
(define (db:close-all dbstruct)
  (if (dbr:dbstruct? dbstruct)
      (handle-exceptions
	  exn
	  (begin
	    (debug:print 0 *default-log-port* "WARNING: Finalizing failed, "  ((condition-property-accessor 'exn 'message) exn))
	    (print-call-chain *default-log-port*))
	;; (db:sync-touched dbstruct 0 force-sync: #t) ;; NO. Do not do this here. Instead we rely on a server to be started when there are writes, even if the server itself is not going to be used as a server.
        (let ((tdbs (map db:dbdat-get-db 
                         (stack->list (dbr:dbstruct-dbstack dbstruct))))
              (mdb (db:dbdat-get-db (dbr:dbstruct-mtdb   dbstruct)))
              (rdb (db:dbdat-get-db (dbr:dbstruct-refndb dbstruct))))
          (map (lambda (db)
		 (db:safely-close-sqlite3-db db))
		 (if (sqlite3:database? db)
		     (sqlite3:finalize! db)))
;; 		 (if (sqlite3:database? db)
;; 		     (sqlite3:finalize! db)))
	       tdbs)
          (if (sqlite3:database? mdb) (sqlite3:finalize! mdb))
          (if (sqlite3:database? rdb) (sqlite3:finalize! rdb))))))
          (db:safely-close-sqlite3-db mdb)     ;; (if (sqlite3:database? mdb) (sqlite3:finalize! mdb))
          (db:safely-close-sqlite3-db rdb))))) ;; (if (sqlite3:database? 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)))))

	 (fname    (pathname-strip-directory dbpath))
	 (fnamejnl (conc fname "-journal"))
	 (tmpname  (conc fname "." (current-process-id)))
	 (tmpjnl   (conc fnamejnl "." (current-process-id))))
    (debug:print-error 0 *default-log-port* "" fname " appears corrupted. Making backup \"old/" fname "\"")
    (system (conc "cd " dbdir ";mkdir -p old;cat " fname " > old/" tmpname))
    (system (conc "rm -f " dbpath))
    (if (file-exists? fnamejnl)
    (if (common:file-exists? fnamejnl)
	(begin
	  (debug:print-error 0 *default-log-port* "" fnamejnl " found, moving it to old dir as " tmpjnl)
	  (system (conc "cd " dbdir ";mkdir -p old;cat " fnamejnl " > old/" tmpjnl))
	  (system (conc "rm -f " dbdir "/" fnamejnl))))
    ;; attempt to recreate database
    (system (conc "cd " dbdir ";sqlite3 old/" tmpname " .dump | sqlite3 " fname))))
    

(define (db:sync-tables tbls last-update fromdb todb . slave-dbs)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.")
     (print-call-chain (current-error-port))
     (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
     (print "exn=" (condition->list exn))
     (debug:print 5 *default-log-port* "exn=" (condition->list exn))
     (debug:print 0 *default-log-port* " status:  " ((condition-property-accessor 'sqlite3 'status) exn))
     (debug:print 0 *default-log-port* " src db:  " (db:dbdat-get-path fromdb))
     (for-each (lambda (dbdat)
		 (let ((dbpath (db:dbdat-get-path dbdat)))
		   (debug:print 0 *default-log-port* " dbpath:  " dbpath)
		   (if (not (db:repair-db dbdat))
		       (begin

     (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))
		 (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))
	  (let* ((tablename        (car tabledat))
		 (fields           (cdr tabledat))
		 (has-last-update  (member "last_update" fields))
		 (use-last-update  (cond
				    ((and has-last-update
					  (member "last_update" fields))
				     #t) ;; if given a number, just use it for all fields
				    ((number? last-update) #f) ;; if not matched first entry then ignore last-update for this table
				    ((and (pair? last-update)
					  (member (car last-update)    ;; last-update field name
						  (map car fields))) #t)
				    (last-update
				     (debug:print 0 *default-log-port* "ERROR: parameter last-update for db:sync-tables must be a pair or a number, received: " last-update) ;; found in fields
				     #f)
				    (else
				     #f)))
		 (last-update-value (if use-last-update ;; no need to check for has-last-update - it is already accounted for
					(if (number? last-update)
					    last-update
					    (cdr last-update))
					#f))
		 (last-update-field (if use-last-update
					(if (number? last-update)
					    "last_update"
					    (car last-update))
					#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 (if use-last-update ;; apply last-update criteria
							  (conc " " (car last-update) ">=" (cdr last-update))
							  (conc " WHERE " last-update-field " >= " last-update-value)
							  "")
				   ";"))
		 (full-ins   (conc "INSERT OR REPLACE INTO " tablename " ( " (string-intersperse (map car fields) ",") " ) "
				   " VALUES ( " (string-intersperse (make-list num-fields "?") ",") " );"))
		 (fromdat    '())
		 (fromdats   '())
		 (totrecords 0)

  (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 (db:adj-target db)
  (let ((fields    (configf:get-section *configdat* "fields"))
	(field-num 0))
    ;; because we will be refreshing the keys table it is best to clear it here
    (sqlite3:execute db "DELETE FROM keys;")
    (for-each
     (lambda (field)
       (let ((column (car field))
	     (spec   (cadr field)))
	 (handle-exceptions
	  exn
	  (if (string-match ".*duplicate.*" ((condition-property-accessor 'exn 'message) exn))
	      (debug:print 0 *default-log-port* "Target field " column " already exists in the runs table")
	      (db:general-sqlite-error-dump exn "alter table runs ..." #f "none"))
	  ;; Add the column if needed
	  (sqlite3:execute
	   db
	   (conc "ALTER TABLE runs ADD COLUMN " column " " spec)))
	 ;; correct the entry in the keys column
	 (sqlite3:execute
	  db
	  "INSERT INTO keys (id,fieldname,fieldtype) VALUES (?,?,?);"
	  field-num column spec)
	 ;; fill in blanks (not allowed as it would be part of the path
	 (sqlite3:execute
	  db
	  (conc "UPDATE runs SET " column "='x' WHERE " column "='';"))
	 (set! field-num (+ field-num 1))))
     fields)))
  
(define *global-db-store* (make-hash-table))

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

;; Add db direct
;;

;; 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)
	     (targ-db-last-mod (if (common: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)
	  ))))
;; ;; 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 (common:file-exists? megatest-db)
;; 				     (file-write-access? megatest-db))
;; 				(begin
;; 				  (db:sync-to-megatest.db dbstruct '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 to /tmp/.../megatest.db and /tmp/.../megatest_ref.db
;;  'new2old      - sync /tmp/.../megatest.db to megatest.db and /tmp/.../megatest_ref.db (and update data_synced)
;;  '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 dbstruct . options)
  (if (not (launch:setup))
      (debug:print 0 *default-log-port* "ERROR: not able to setup up for megatest.")
      (let* ((mtdb     (dbr:dbstruct-mtdb dbstruct))
	     (tmpdb    (db:get-db dbstruct))
             (refndb   (dbr:dbstruct-refndb dbstruct))
	     (allow-cleanup #t) ;; (if run-ids #f #t))
	     (servers (server:get-list *toppath*)) ;; (tasks:get-all-servers (db:delay-if-busy tdbdat)))
	     (data-synced 0)) ;; count of changed records (I hope)
  ;; (if (not (launch:setup))
  ;;    (debug:print 0 *default-log-port* "ERROR: not able to setup up for megatest.")
  (let* ((mtdb     (dbr:dbstruct-mtdb dbstruct))
	 (tmpdb    (db:get-db dbstruct))
	 (refndb   (dbr:dbstruct-refndb dbstruct))
	 (allow-cleanup #t) ;; (if run-ids #f #t))
	 (servers (server:get-list *toppath*)) ;; (tasks:get-all-servers (db:delay-if-busy tdbdat)))
	 (data-synced 0)) ;; count of changed records (I hope)
    
    (for-each
     (lambda (option)
       
       (case option
	;; kill servers
	(if (member 'killservers options)
	    (for-each
	     (lambda (server)
	       (match-let (((mod-time host port start-time pid) server))
		 (if (and host pid)
		     (tasks:kill-server host pid))))
	     servers))

	;; clear out junk records
	;;
	(if (member 'dejunk options)
	 ;; kill servers
	 ((killservers)
	  (for-each
	   (lambda (server)
	     (match-let (((mod-time host port start-time pid) server))
	       (if (and host pid)
		   (tasks:kill-server host pid))))
	   servers))
	 
	 ;; clear out junk records
	 ;;
	 ((dejunk)
	    (begin
	      (db:delay-if-busy mtdb) ;; ok to delay on mtdb
	      (db:clean-up mtdb)
	      (db:clean-up tmpdb)
              (db:clean-up refndb)))
	  (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)))

	;; sync runs, test_meta etc.
	;;
	(if (member 'old2new options)
	 ;; sync runs, test_meta etc.
	 ;;
	 ((old2new)
	    ;; (begin
            (set! data-synced
                  (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb tmpdb refndb)
                     data-synced)))
	  (set! data-synced
	    (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb tmpdb refndb)
	       data-synced)))
			      ;; (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)
	    (set! data-synced
		  (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f tmpdb refndb mtdb)
		      data-synced)))
	 
	 ;; now ensure all newdb data are synced to megatest.db
	 ;; do not use the run-ids list passed in to the function
	 ;;
	 ((new2old)
	  (set! data-synced
	    (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f tmpdb refndb mtdb)
	       data-synced)))



        (if (member 'schema options)
	 ((adj-target)
	  (db:adj-target (db:dbdat-get-db mtdb))
	  (db:adj-target (db:dbdat-get-db tmpdb))
	  (db:adj-target (db:dbdat-get-db refndb)))
	 
	 ((schema)
            (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))
	  (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))))
       
       (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb))
	;; 	   (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  '()))
     options)
	;;   ;; first fix schema if needed
	;;   (map
	;;    (lambda (th)
	;; 	 (thread-join! th))
	;;    (map
    data-synced))

(define (db:tmp->megatest.db-sync dbstruct last-update)
  (let* ((mtdb        (dbr:dbstruct-mtdb dbstruct))
	;; 	(lambda (run-id)
	;; 	  (thread-start! 
	;; 	   (make-thread
	;; 	    (lambda ()
	;; 	      (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
;;                    (if (member 'schema options)
	 (tmpdb       (db:get-db dbstruct))
	 (refndb      (dbr:dbstruct-refndb dbstruct)))
    (db:sync-tables (db:sync-all-tables-list dbstruct) last-update tmpdb refndb mtdb)))

	;; 		(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))
;;;; run-ids
	;;   ;; Then sync and fix db's
	;;   (set! count 0)
;;    if #f use *db-local-sync* : or 'local-sync-flags
	;;   (process-fork
	;;    (lambda ()
;;    if #t use timestamps      : or 'timestamps
	;; 	 (map
	;; 	  (lambda (th)
	;; 	    (thread-join! th))
(define (db:sync-to-megatest.db dbstruct #!key (no-sync-db #f)) 
  (let* ((start-time         (current-seconds))
	;; 	  (map
	;; 	   (lambda (run-id)
	;; 	     (thread-start! 
	;; 	      (make-thread
	;; 	       (lambda ()
	 (last-update        (if no-sync-db
	;; 		 (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
	;; 			(frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
				 (db:no-sync-get/default no-sync-db "LAST_UPDATE" 0)
				 0)) ;; (or (db:get-var dbstruct "LAST_UPDATE") 0))
	;; 		   (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)
	 (sync-needed        (> (- start-time last-update) 6))
	 (res                (if sync-needed ;; don't sync if a sync already occurred in the past 6 seconds
	;; 			 (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)
				 (begin
				   (if no-sync-db
				       (db:no-sync-set no-sync-db "LAST_UPDATE" start-time))
				   (db:tmp->megatest.db-sync dbstruct last-update))
				 0))
	 (sync-time           (- (current-seconds) start-time)))
	;; 			 (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)
      (debug:print-info 3 *default-log-port* "Sync of newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
      (if (common:low-noise-print 30 "sync new to old")
          (if sync-needed
	;; 				  " main.db " (conc run-id ".db")) ", " count " of " total)))))
	;; 	   all-run-ids))))

              (debug:print-info 0 *default-log-port* "Sync of " res " records from newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
	;; 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)
              (debug:print-info 0 *default-log-port* "No sync needed, last updated " (- start-time last-update) " seconds ago")))
;; 		      (delete-file fullname)))))
;; 	    dead-runs))))
      res))
;; 
	;; (db:close-all dbstruct)
	;; (sqlite3:finalize! mdb)
        (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb)
	data-synced)))

;; 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)
  (print "I don't work anymore. open-run-close-no-exception-handling needs fixing or removing...")
  (exit)
  (if (or *db-write-access*

	 (err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
     (case err-status
       ((busy)
	(thread-sleep! sleep-time))
       (else
	(debug:print 0 *default-log-port* "EXCEPTION: database probably overloaded or unreadable.")
	(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
	(print "exn=" (condition->list exn))
	(debug:print 5 *default-log-port* "exn=" (condition->list exn))
	(debug:print 0 *default-log-port* " status:  " ((condition-property-accessor 'sqlite3 'status) exn))
	(print-call-chain (current-error-port))
	(thread-sleep! sleep-time)
	(debug:print-info 0 *default-log-port* "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 
(define open-run-close open-run-close-exception-handling)
		;;	   open-run-close-no-exception-handling
;;			   open-run-close-exception-handling)
;;)

(define (db:initialize-main-db dbdat)
  (when (not *configinfo*)
           (launch:setup)) ;; added because Elena was getting stack dump because *configinfo* below was #f.
  (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:make-key/field-string configdat))
	 (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"))
				    "pass_count" "contour"))
		      (begin
			(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.")
			(exit 1)))))
	      keys)
    (sqlite3:with-transaction
     db
     (lambda ()

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

(define (open-logging-db)
  (let* ((dbpath    (conc (if *toppath* (conc *toppath* "/") "") "logging.db")) ;; fname)
	 (dbexists  (file-exists? dbpath))
	 (dbexists  (common:file-exists? 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

       ;; These are defunct tests, do not do all the overhead of set-state-status. Force them to INCOMPLETE.
       ;;
       ;; (db:delay-if-busy dbdat)
       (let* (;; (min-incompleted (filter (lambda (x)
              ;;      		      (let* ((testpath (cadr x))
              ;;      			     (tdatpath (conc testpath "/testdat.db"))
              ;;      			     (dbexists (file-exists? tdatpath)))
              ;;      			     (dbexists (common: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

	      (lambda (db)
		(sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val))))

(define (db:del-var dbstruct var)
  (db:with-db dbstruct #f #t 
	      (lambda (db)
		(sqlite3:execute db "DELETE FROM metadat WHERE var=?;" var))))

;;======================================================================
;; no-sync.db - small bits of data to be shared between servers
;;======================================================================

(define (db:open-no-sync-db)
  (let* ((dbpath (db:dbfile-path))
	 (dbname (conc dbpath "/no-sync.db"))
	 (db     (sqlite3:open-database dbname)))
    (sqlite3:set-busy-handler! db (make-busy-timeout 136000))
    (sqlite3:execute db "PRAGMA synchronous = 0;")
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS no_sync_metadat (var TEXT,val TEXT, CONSTRAINT no_sync_metadat_constraint UNIQUE (var));")
    db))

;; if we are not a server create a db handle. this is not finalized
;; so watch for problems. I'm still not clear if it is needed to manually
;; finalize sqlite3 dbs with the sqlite3 egg.
;;
(define (db:no-sync-db db-in)
  (if db-in
      db-in
      (let ((db (db:open-no-sync-db)))
	(set! *no-sync-db* db)
	db)))

(define (db:no-sync-set db var val)
  (sqlite3:execute (db:no-sync-db db) "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES (?,?);" var val))

(define (db:no-sync-del! db var)
  (sqlite3:execute (db:no-sync-db db) "DELETE FROM no_sync_metadat WHERE var=?;" var))

(define (db:no-sync-get/default db var default)
  (let ((res default))
    (sqlite3:for-each-row
     (lambda (val)
       (set! res val))
     (db:no-sync-db db)
     "SELECT val FROM no_sync_metadat WHERE var=?;"
     var)
    (if res
        (let ((newres (if (string? res)
			  (string->number res)
			  #f)))
          (if newres
              newres
              res))
        res)))

(define (db:no-sync-close-db db)
  (db:safely-close-sqlite3-db db))

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

	res)))

;; look up values in a header/data structure
(define (db:get-value-by-header row header field)
  (if (or (null? header) (not row))
      #f
      (let loop ((hed (car header))
		 (tal (cdr header))
		 (n   0))
	(if (equal? hed field)
	    (vector-ref row n)
                 (tal (cdr header))
                 (n   0))
        (if (equal? hed field)
            (handle-exceptions
             exn
             (begin
               (debug:print 0 *default-log-port* "WARNING: attempt to read non-existant field, row=" row " header=" header " field=" field)
               #f)
             (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))

			     0                                              ;; 2 ;; Tolerance
			     "n/a"					    ;; 3 ;; Units
			     (configf:lookup dat entry-name "message")      ;; 4 ;; Comment
			     (configf:lookup dat entry-name "exit-status")  ;; 5 ;; Status
			     "logpro"                                       ;; 6 ;; Type
			     ))))
	   (let* ((value     (or (configf:lookup dat entry-name "measured")  "n/a"))
		  (expected  (or (configf:lookup dat entry-name "expected")  "n/a"))
		  (tolerance (or (configf:lookup dat entry-name "tolerance") "n/a"))
		  (expected  (or (configf:lookup dat entry-name "expected")  0.0))
		  (tolerance (or (configf:lookup dat entry-name "tolerance") 0.0))
		  (comment   (or (configf:lookup dat entry-name "comment")
				 (configf:lookup dat entry-name "desc")      "n/a"))
		  (status    (or (configf:lookup dat entry-name "status")    "n/a"))
		  (type      (or (configf:lookup dat entry-name "expected")  "n/a")))
	     (set! res (append
			res  
			(list (list stepname

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

;; This routine moved from tdb.scm, tdb:read-test-data
;;
(define (db:read-test-data* dbstruct run-id test-id categorypatt varpatt)
  (let* ((res '()))
    (db:with-db
     dbstruct #f #f
     (lambda (db)
       (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 ? AND variable LIKE ? ORDER BY category,variable;" test-id categorypatt varpatt)
       (reverse res)))))


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

(define (db:get-run-ids-matching-target dbstruct keynames target res runname testpatt statepatt statuspatt)
  (db:with-db

;; state is the priority rollup of all states
;; status is the priority rollup of all completed statesfu
;;
;; 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
  ;; BBnote - for mode itemwait, linkage between upstream test & matching item status is propagated to run queue in db:prereqs-not-met
  
  (let* ((testdat      (if (number? test-name)
			   (db:get-test-info-by-id dbstruct run-id test-name) ;; test-name is actually a test-id
			   (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   (if tl-testdat
         (tl-test-id   (db:test-get-id tl-testdat)))
			   (db:test-get-id tl-testdat)
			   #f)))
    (if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
	(db:general-call dbstruct 'set-test-start-time (list test-id)))
    (mutex-lock! *db-transaction-mutex*)
    (db:with-db
     dbstruct #f #f
     (lambda (db)
       (let ((tr-res

                                                                                      *common:not-started-ok-statuses*))))
								  state-status-counts)))
                            ;; (non-completes        (filter (lambda (x)
                            ;;                                 (not (equal? (dbr:counts-state x) "COMPLETED")))
                            ;;                               state-status-counts))
                            (all-curr-states      (common:special-sort  ;; worst -> best (sort of)
                                                   (delete-duplicates
                                                    (if (not (equal? state "DELETED"))
                                                    (cons state (map dbr:counts-state state-status-counts)))
                                                        (cons state (map dbr:counts-state state-status-counts))
                                                        (map dbr:counts-state state-status-counts)))
                                                   *common:std-states* >))
                            (all-curr-statuses    (common:special-sort  ;; worst -> best
                                                   (delete-duplicates
                                                    (if (not (equal? state "DELETED"))
                                                    (cons status (map dbr:counts-status state-status-counts)))
                                                        (cons status (map dbr:counts-status state-status-counts))
                                                        (map dbr:counts-status state-status-counts)))
                                                   *common:std-statuses* >))
			    (non-completes     (filter (lambda (x)
							 (not (equal? x "COMPLETED")))
						       all-curr-states))
			    (num-non-completes (length non-completes))
                            
                            (newstate          (cond
						((> running 0)
						 "RUNNING") ;; anything running, call the situation running
						((> bad-not-started 0)  ;; we have an ugly situation, it is completed in the sense we cannot do more.
						 "COMPLETED") 
						((> (length non-completes) 0) ;;
						((> num-non-completes 0) ;;
						 (car non-completes))  ;;  (remove (lambda (x)(equal? "COMPLETED" x)) all-curr-states)))
                                                ;; only rollup DELETED if all DELETED
						(else
						 (car all-curr-states))))
			                       ;; (if (> running 0)
                                               ;;     "RUNNING"
                                               ;;     (if (> bad-not-started 0)
                                               ;;         "COMPLETED"
                                               ;;         (car all-curr-states))))
                            (newstatus            (if (> bad-not-started 0)
                                                      "CHECK"
                            (newstatus            (if (or (> bad-not-started 0)
							  (and (equal? newstate "NOT_STARTED")
							       (> num-non-completes 0)))
						      "STARTED"
                                                      (car all-curr-statuses))))
                       ;; (print "bad-not-supported: " bad-not-support " all-curr-states: " all-curr-states " all-curr-statuses: " all-curr-states)
                       ;;      " newstate: " newstate " newstatus: " newstatus)
                       ;; NB// Pass the db so it is part of the transaction
                       (if tl-test-id
                       (db:test-set-state-status db run-id tl-test-id newstate newstatus #f)))))))
			   (db:test-set-state-status db run-id tl-test-id newstate newstatus #f))))))))
         (mutex-unlock! *db-transaction-mutex*)
         (if (and test-id state status (equal? status "AUTO")) 
             (db:test-data-rollup dbstruct run-id test-id status))
         tr-res)))))

;; BBnote: db:get-all-state-status-counts-for-test returns dbr:counts object aggregating state and status of items of a given test, *not including rollup state/status*
(define (db:get-all-state-status-counts-for-test dbstruct run-id test-name item-path)
  (db:with-db
   dbstruct #f #f
   (lambda (db)
     (sqlite3:map-row
      (lambda (state status count)
	(make-dbr:counts state: state status: status count: count))

		 (dbfj   (conc dbpath "-journal")))
	    (if (handle-exceptions
		 exn
		 (begin
		   (debug:print-info 0 *default-log-port* "WARNING: failed to test for existance of " dbfj)
		   (thread-sleep! 1)
		   (db:delay-if-busy count (- count 1))) 
		 (file-exists? dbfj))
		 (common: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))

;; 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 ]]
;;       mode 'exclusive means this test/item cannot run if the same test/item is LAUNCHED,REMOTEHOSTSTART or RUNNING
;; 
;; (define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode)
(define (db:get-prereqs-not-met dbstruct run-id waitons ref-test-name ref-item-path mode itemmaps) ;; #!key (mode '(normal))(itemmap #f))
  ;; BBnote - rollup of an itemized test's overall state/status done in db:set-state-status-and-roll-up-items
  (append
   (if (member 'exclusive mode)
       (let ((running-tests (db:get-tests-for-run dbstruct
						  #f  ;; run-id of #f means for all runs. 
						  (if (string=? ref-item-path "")   ;; testpatt
						      ref-test-name
						      (conc ref-test-name "/" ref-item-path))

	    ;; and related sub items
	    ;; next should be using mt:get-tests-for-run?
	    (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)
	       (lambda (test) ;; BB- this is the upstream test
		 ;; (if (equal? waitontest-name (db:test-get-testname test)) ;; by defintion this had better be true ...
		 (let* ((state             (db:test-get-state test))
			(status            (db:test-get-status test))
			(item-path         (db:test-get-item-path test))
			(item-path         (db:test-get-item-path test)) ;; BB- this is the upstream itempath
			(is-completed      (equal? state "COMPLETED"))
			(is-running        (equal? state "RUNNING"))
			(is-killed         (equal? state "KILLED"))
			(is-ok             (member status '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))
			;;                                       testname-b    path-a    path-b
			(same-itempath     (db:compare-itempaths ref-test-name item-path ref-item-path itemmaps))) ;; (equal? ref-item-path item-path)))
		   (set! ever-seen #t)

		     (set! parent-waiton-met #t))
		    ;; For itemwait mode IFF the previous matching item is good the set parent-waiton-met
		    ((and (not (null? (lset-intersection eq? mode '(itemmatch itemwait)))) ;; how is that different from (member mode '(itemmatch itemwait)) ?????
			  ;; (not (equal? item-path "")) ;; this applies to both top level (to allow launching of next batch) and items
			  same-itempath)
		     (if (and is-completed is-ok)
			 (set! item-waiton-met #t))
		     (if (and (equal? item-path "")
			      (or is-completed is-running));; this is the parent, set it to run if completed or running
		     (if (and (equal? item-path "") ;; if upstream rollup test is completed, parent-waiton-met is set
			      (or is-completed is-running));; this is the parent, set it to run if completed or running ;; BB1
			 (set! parent-waiton-met #t)))
		    ;; normal checking of parent items, any parent or parent item not ok blocks running
		    ((and is-completed
			  (or is-ok 
			      (member 'toplevel mode))              ;; toplevel does not block on FAIL
			  (and is-ok (member 'itemmatch mode))) ;; itemmatch blocks on not ok
		     (set! item-waiton-met #t)))))

								      (append res (list (vector-ref vb (+ i 2))))))))
					       (runname   (vector-ref vb 1))
					       (testname  (vector-ref vb (+  2 numkeys)))
					       (item-path (vector-ref vb (+  3 numkeys)))
					       (final-log (vector-ref vb (+  7 numkeys)))
					       (run-dir   (vector-ref vb (+ 18 numkeys)))
					       (log-fpath (conc run-dir "/"  final-log))) ;; (string-intersperse keyvals "/") "/" testname "/" item-path "/"
					  (debug:print 4 *default-log-port* "log: " log-fpath " exists: " (file-exists? log-fpath))
					  (vector-set! vb (+ 7 numkeys) (if (file-exists? log-fpath)
					  (debug:print 4 *default-log-port* "log: " log-fpath " exists: " (common:file-exists? log-fpath))
					  (vector-set! vb (+ 7 numkeys) (if (common:file-exists? log-fpath)
									    (let ((newpath (conc pathmod "/"
												 (string-intersperse keyvals "/")
												 "/" runname "/" testname "/"
												 (if (string=? item-path "") "" (conc "/" item-path))
												 final-log)))
									      ;; for now throw away newpath and use the log-fpath conc'd with pathmod
									      (set! newpath (conc pathmod log-fpath))