Megatest

    ((test-data-rollup)             (apply db:test-data-rollup dbstruct params))
    ((csv->test-data)               (apply db:csv->test-data dbstruct params))
    ((get-steps-data)               (apply db:get-steps-data dbstruct params))

    ;; MISC
    ((login)                        (apply db:login dbstruct params))
    ((general-call)                 (let ((stmtname   (car params))
					  (run-id     (cadr params))
					  (realparams (cddr params)))
				      (db:with-db dbstruct run-id #t ;; these are all for modifying the db
						  (lambda (db)
						    (db:general-call db stmtname realparams)))))
    ((sync-inmem->db)               (db:sync-back))
    ((kill-server)
     (db:sync-tables (db:tbls *inmemdb*) *inmemdb* *db*)  ;; (db:sync-to *inmemdb* *db*)
     (let ((hostname (car  *runremote*))
	   (port     (cadr *runremote*))
	   (pid      (if (null? params) #f (car params)))
	   (th1      (make-thread (lambda ()(thread-sleep! 3)(debug:print 0 "Server exiting!")(exit 0)) "Server exit thread")))

	      (let ((hideit (iup:button "HideTests" #:action (lambda (obj)
							       (set! *hide-not-hide* (not *hide-not-hide*))
							       (iup:attribute-set! obj "TITLE" (if *hide-not-hide* "HideTests" "NotHide"))
							       (mark-for-update)))))
		(set! *hide-not-hide-button* hideit)
		hideit))
	     (iup:hbox
	      (iup:button "Quit"      #:action (lambda (obj)(if *db* (db:close-all *db*))(exit)))
	      (iup:button "Refresh"   #:action (lambda (obj)
						 (mark-for-update)))
	      (iup:button "Collapse"  #:action (lambda (obj)
						 (let ((myname (iup:attribute obj "TITLE")))
						   (if (equal? myname "Collapse")
						       (begin
							 (for-each (lambda (tname)

(cond 
 ((args:get-arg "-run")
  (let ((runid (string->number (args:get-arg "-run"))))
    (if runid
	(begin
	  (lambda (x)
	    (on-exit (lambda ()
		       (if *db* (db:close-all *db*))))
	    (examine-run *db* runid)))
	(begin
	  (print "ERROR: runid is not a number " (args:get-arg "-run"))
	  (exit 1)))))
 ((args:get-arg "-test")
  (let ((testid (string->number (args:get-arg "-test"))))
    (if (and (number? testid)

			     (dashboard:run-update x)
			     (mutex-lock! *update-mutex*)
			     (set! *update-is-running* #f)
			     (mutex-unlock! *update-mutex*))))
		       1))))

(iup:main-loop)
(db:close-all *db*)

	       (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
	  (if write-access
	      (begin
		(sqlite3:set-busy-handler! db handler)
		(sqlite3:execute db "PRAGMA synchronous = 0;")))
	  (if (not dbexists)(db:initialize-run-id-db db))
	  (dbr:dbstruct-set-runvec! dbstruct run-id 'rundb db)
	  (dbr:dbstruct-set-runvec! dbstruct run-id 'inuse #t)
	  (if local
	      db
	      (begin
		(dbr:dbstruct-set-runvec! dbstruct run-id 'inmem inmem)
		(db:sync-tables db:sync-tests-only db inmem)

	   (sqlite3:finalize! rundb)
	   (debug:print 0 "WARNING: attempting to close databases but got " rundb " instead of a database"))))
   (hash-table-values (vector-ref dbstruct 1))))

(define (open-inmem-db)
  (let* ((db      (sqlite3:open-database ":memory:"))
	 (handler   (make-busy-timeout 3600)))
    (db:initialize-run-id-db db)
    (sqlite3:set-busy-handler! db handler)
    (set! sdb:qry (make-sdb:qry)) ;; we open the normalization helpers here
    (set! *fdb*   (filedb:open-db (conc *toppath* "/db/paths.db")))
    db))

;; just tests, test_steps and test_data tables
(define db:sync-tests-only

    (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" "MEGATEST_VERSION" megatest-version)
    (debug:print-info 11 "db:initialize END")))

;;======================================================================
;; R U N   S P E C I F I C   D B 
;;======================================================================

(define (db:initialize-run-id-db db)
  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS tests 
                    (id INTEGER PRIMARY KEY,
                     run_id       INTEGER   DEFAULT -1,
                     testname     TEXT      DEFAULT 'noname',
                     host         TEXT      DEFAULT 'n/a',
                     cpuload      REAL      DEFAULT -1,
                     diskfree     INTEGER   DEFAULT -1,

;; get a rundb vector
(define (dbr:dbstruct-get-rundb-rec vec run-id)
  (let* ((dbhash (vector-ref vec 1))
	 (runvec (hash-table-ref/default dbhash run-id #f)))
    (if runvec
	runvec
	(let ((nvec  (vector #f #f -1 -1 -1 #f)))
	  (hash-table-set! dbhash run-id nvec)
	  nvec))))

;;  [ rundb inmemdb last-mod last-read last-sync ]
(define-inline (dbr:dbstruct-field-name->num field-name)
  (case field-name
    ((rundb) 0) ;; the on-disk db
    ((inmem) 1) ;; the in-memory db
    ((mtime) 2) ;; last modification time
    ((rtime) 3) ;; last read time
    ((stime) 4) ;; last sync time
    ((inuse) 5) ;; is the db currently in use
    (else -1)))

;; get/set rundb fields
(define (dbr:dbstruct-get-runvec vec run-id field-name)
  (let ((runvec   (dbr:dbstruct-get-rundb-rec vec run-id))
	(fieldnum (dbr:dbstruct-field-name->num field-name)))
    ;; (vector-set! runvec (dbr:dbstruct-field-name->num 'inuse) #t)
    (vector-ref runvec fieldnum)))

(define (dbr:dbstruct-set-runvec! vec run-id field-name val)
  (let ((runvec (dbr:dbstruct-get-rundb-rec vec run-id)))

    (let loop ((count 0))
      ;; Use this opportunity to sync the inmemdb to db
      (let ((start-time (current-milliseconds))
	    (sync-time  #f)
	    (rem-time   #f))
	(if *inmemdb* (db:sync-touched *inmemdb*))
	(set! sync-time  (- (current-milliseconds) start-time))
	;; (debug:print 0 "SYNC: time= " sync-time)
	(set! rem-time (quotient (- 4000 sync-time) 1000))
	(if (and (< rem-time 4)
		 (> rem-time 0))
	    (thread-sleep! rem-time)))

      ;; (thread-sleep! 4) ;; no need to do this very often

(define (rmt:login)
  (rmt:send-receive 'login (list *toppath* megatest-version *my-client-signature*)))

(define (rmt:kill-server)
  (rmt:send-receive 'kill-server '()))

;; hand off a call to one of the db:queries statements
;; added run-id to make looking up the correct db possible 
;;
(define (rmt:general-call stmtname run-id . params)
  (rmt:send-receive 'general-call (append (list stmtname run-id) params)))

(define (rmt:sync-inmem->db)
  (rmt:send-receive 'sync-inmem->db '()))

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

;;======================================================================
;; S E R V E R
;;======================================================================

;; Run like this:
;;
;;  (cd ..;make && make install) && ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0)

(test #f #t                 (vector? (make-dbr:dbstruct "/tmp")))

(define dbstruct (make-dbr:dbstruct "/tmp"))

(test #f #t                 (begin (dbr:dbstruct-set-main! dbstruct "blah") #t))
(test #f "blah"             (dbr:dbstruct-get-main  dbstruct))
(test #f #t                 (vector? (dbr:dbstruct-get-rundb-rec dbstruct 1)))

(for-each
 (lambda (k)
   (test #f #t                 (begin (dbr:dbstruct-set-runvec! dbstruct 1 k (conc k)) #t))
   (test #f k                  (dbr:dbstruct-get-runvec dbstruct 1 k)))
 '(rundb inmem mtime rtime stime inuse))