Megatest

		(if (and buttondat
			 (hash-table? testsdat-by-name))
		    (let* ((testdat      (let ((matching (hash-table-ref/default testsdat-by-name testname #f)))
					   ;; (filter 
					   ;;   (lambda (x)(equal? (test:test-get-fullname x) testname))
					   ;;     testsdat)))
					   (if (not matching)
					       ;;(vector -1 -1 "" "" "" 0 "" "" 0 "" "" "" 0 "" "")
					       (make-db:test-rec (id -1))
					       ;; (car matching))))
					       matching)))
			   (testname     (db:test-get-testname   testdat))
			   (itempath     (db:test-get-item-path  testdat))
			   (testfullname (test:test-get-fullname testdat))
			   (teststatus   (db:test-get-status     testdat))
			   (teststate    (db:test-get-state      testdat))

;;======================================================================
;; Copyright 2006-2016, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.
;;======================================================================

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

;; dbstruct vector containing all the relevant dbs like main.db, megatest.db, run.db etc

(require-extension (srfi 18) extras tcp) ;; RADT => use of require-extension?
(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64 format dot-locking z3)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:)) ;; RADT => prefix??

(declare (unit db))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))
(declare (uses client))
(declare (uses mt))

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

;;======================================================================
;; 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?
    ;; check for (exn sqlite3) ((condition-property-accessor 'exn 'message) exn)
    (print "err-status: " err-status)
    (debug:print-error 0 *default-log-port* " query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message) exn))
    (print-call-chain (current-error-port))))

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

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

;;RADT => Purpose of dbdat?
;;
(define (db:dbdat-get-db dbdat)
  (if (pair? dbdat)
      (car dbdat)
      dbdat))

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

;; mod-read:
;;     'mod   modified data
;;     'read  read data
;; 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-set-mtime! dbstruct (current-milliseconds))
	    (dbr:dbstruct-set-rtime! dbstruct (current-milliseconds)))
	(dbr:dbstruct-set-inuse! dbstruct #f)
	(mutex-unlock! *rundb-mutex*))))

;; (db:with-db dbstruct run-id sqlite3:exec "select blah from blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
  (let* ((dbdat (if (vector? dbstruct)
		    (db:get-db dbstruct run-id)
		    dbstruct)) ;; cheat, allow for passing in a dbdat
	 (db    (db:dbdat-get-db dbdat))) ;;RADT => dbdat should already be a database, why need this function
    (db:delay-if-busy 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)) ;; RA => Mark timestamp on defstruct RADT => How come 'mod not passed instead of r/w 
       res))))

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

;; (define (db:get-filedb dbstruct run-id)

;; NB// #f => return dbdir only
;;      (was planned to be;  zeroth db with name=main.db)
;;
(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")) ;;main.db is assigned if run-id 0; does it mean main.db same as 1.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) ;;RADT => why not creating fname db if does not exist here 
	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:set-sync db)
  (let ((syncprag (configf:lookup *configdat* "setup" "sychronous")))
    (sqlite3:execute db (conc "PRAGMA synchronous = " (or syncprag 1) ";")))) ;; RADT => advantage of PRAGMA here??

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

		  (dbr:dbstruct-set-refdb!  dbstruct refdb)
		  (db:sync-tables db:sync-tests-only inmem refdb) ;; use inmem as the reference, don't read again from db
		  ;; sync once more to deal with delays?
		  ;; (db:sync-tables db:sync-tests-only db inmem)
		  ;; (db:sync-tables db:sync-tests-only inmem refdb)
		  inmem)))))))

;; This routine creates the db if not already present. It is only called if the db is not already ls opened
;;
(define (db:open-main dbstruct) ;;  (conc *toppath* "/megatest.db") (car *configinfo*))) 
  (let ((mdb (dbr:dbstruct-get-main dbstruct))) ;; RA => Returns the first reference in dbstruct
    (if mdb
	mdb
	(begin
	  (mutex-lock! *rundb-mutex*)
	  (let* ((dbpath       (db:dbfile-path 0))
		 (dbexists     (file-exists? dbpath))
		 (db           (db:lock-create-open dbpath db:initialize-main-db))

  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (let ((res #f))
       (sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
	(lambda (id run-id test-name state status event-time host cpu-load disk-free uname run-dir item-path run-duration final-logf comment short-dir attempt-num archived)
	  ;;             0    1       2      3      4        5       6      7        8     9     10      11          12          13           14         15          16
	  ;;(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final-logf comment short-dir attemptnum archived)))
	  (set! res (cons
	  	(make-db:test-rec id: id run-id: run-id test-name: test-name state: state status: status event-time: event-time
       		host: host cpu-load: cpu-load disk-free: disk-free uname: uname run-dir: run-dir item-path: item-path
       		run-duration: run-duration final-logf: final-logf comment: comment short-dir: short-dir 
       		attempt-num: attempt-num archived: archived )
		       res)))
	db
	(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;")
	test-id)
       res))))

;; Use db:test-get* to access
;; Get test data using test_ids. NB// Only works within a single run!!

			   ;; this test is younger, store it in the hash
			   (hash-table-set! tests-hash full-testname testdat))))
		   results)
		  (if (null? tal)
		      (map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
		      (loop (car tal)(cdr tal))))))))))

;; Function recursively checks if <db>.journal exists; if yes means db busy; call itself after delayed interval
;; 
(define (db:delay-if-busy dbdat #!key (count 6))
  (if (not (configf:lookup *configdat* "server" "delay-on-busy")) ;;RADT => two conditions in a if block?? also understand what config looked up
      (and dbdat (db:dbdat-get-db dbdat))
      (if dbdat
	  (let* ((dbpath (db:dbdat-get-path dbdat))
		 (db     (db:dbdat-get-db   dbdat)) ;; we'll return this so (db:delay--if-busy can be called inline
		 (dbfj   (conc dbpath "-journal")))
	    (if (handle-exceptions
		 exn
		 (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))) ;; RADT => Don't we need to sent a dbstruct here?
		 (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: 1))
		  ((1)
		   (thread-sleep! 6.4)
		   (db:delay-if-busy count: 0))
		  (else
		   (debug:print-info 0 *default-log-port* "delaying db access due to high database load.")
		   (thread-sleep! 12.8))))
	    db) ;; RADT => why does it need to return db, not #t
	  "bogus result from db:delay-if-busy")))

(define (db:test-get-records-for-index-file dbstruct run-id test-name)
  (let ((res '()))
    (db:with-db
     dbstruct
     run-id

  (hash-table-ref/default (dbr:dbstruct-get-locdbs v) run-id #f))

(define (dbr:dbstruct-set-localdb! v run-id db)
  (hash-table-set! (dbr:dbstruct-get-locdbs v) run-id db))

(require-extension typed-records)
(defstruct db:test-rec ((id -1) : number)
					((run-id -1) : number) 
					((test-name "") : string)
					((state "") : string)
					((status "") : string)
					((event-time -1) : number)
					((host "") : string)
					((cpu-load -1) : number)
					((disk-free -1) : number)
					((uname "") : string)
					((run-dir "") : string)
					((item-path "") : string)
					((run-duration -1) : number)
					((final-logf "") : string)
					((comment "") : string)
					((process-id -1) : number)
					((archived -1) : number)
					((short-dir -1) : number)
					((attempt-num -1) : number))

(define (db:qry-gen-alist qrystr listvals)
	(define listqry (string-split qrystr ","))
	(if (null? listqry)
	      '()
	      (let loop ((strhead (car listqry))
			 (strtail (cdr listqry))