Megatest

    
    ((delete-test-records)             (apply db:delete-test-records dbstruct params))
    ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
    ((test-set-state-status)           (apply db:test-set-state-status dbstruct params))
    ((test-set-top-process-pid)        (apply db:test-set-top-process-pid dbstruct params))
    ((set-state-status-and-roll-up-items) (apply db:set-state-status-and-roll-up-items dbstruct params))
    ((set-state-status-and-roll-up-run) (apply db:set-state-status-and-roll-up-run dbstruct params)) 
    ((top-test-set-per-pf-counts)       (apply db:top-test-set-per-pf-counts dbstruct params))
    ((test-set-archive-block-id)        (apply db:test-set-archive-block-id dbstruct params))

    ((insert-test)                      (db:insert-test dbstruct run-id params))

    ;; RUNS
    ((register-run)                 (apply db:register-run dbstruct params))
    ((set-tests-state-status)       (apply db:set-tests-state-status dbstruct params))
    ((delete-run)                   (apply db:delete-run dbstruct params))
    ((lock/unlock-run)              (apply db:lock/unlock-run dbstruct params))
    ((update-run-event_time)        (apply db:update-run-event_time dbstruct params))
    ((update-run-stats)             (apply db:update-run-stats dbstruct params))
    ((set-var)                      (apply db:set-var dbstruct params))
    ((inc-var)                      (apply db:inc-var dbstruct params))
    ((dec-var)                      (apply db:dec-var dbstruct params))
    ((del-var)                      (apply db:del-var dbstruct params))
    ((add-var)                      (apply db:add-var dbstruct params))

    ((insert-run)                   (apply db:insert-run dbstruct params))

    ;; STEPS
    ((teststep-set-status!)         (apply db:teststep-set-status! dbstruct params))
    ((delete-steps-for-test!)       (apply db:delete-steps-for-test! dbstruct params))
    
    ;; TEST DATA
    ((test-data-rollup)             (apply db:test-data-rollup dbstruct params))

(define (db:get-run-id dbstruct runname target)
  (let ((runs (db:simple-get-runs dbstruct runname #f #f target #f))) ;; runpatt count offset target last-update
    (if (null? runs)
	#f
	(simple-run-id (car runs)))))

;; called with run-id=#f so will operate on main.db
;;
(define (db:insert-run dbstruct target runname run-meta)
  (let* ((keys (db:get-keys dbstruct))
     	 (runs (db:simple-get-runs dbstruct runname #f #f target #f))) ;; runpatt count offset target last-update
    ;; need to insert run based on target and runname
    (let* ((targvals (string-split target "/"))
	   (keystr   (string-intersperse keys ","))
	   (key?str  (string-intersperse (make-list (length targvals) "?") ","))
	   (qrystr   (conc "INSERT INTO runs (runname,"keystr") VALUES (?,"key?str")"))
	   (get-var  (lambda (db qrystr)
		       (let* ((res #f))
			 (sqlite3:for-each-row
			  (lambda row
			    (set res (car row)))
			  db qrystr runname)
			 res))))
      (if (null? runs)
	  (db:create-initial-run-record dbstruct runname target))
      (let* ((run-id (db:get-run-id dbstruct runname target)))
	(db:with-db
	 dbstruct
	 #f #f
	 (lambda (dbdat db)
	   (for-each
	    (lambda (keyval)
	      (let* ((fieldname (car keyval))
		     (getqry    (conc "SELECT "fieldname" FROM runs WHERE id=?;"))
		     (setqry    (conc "UPDATE runs SET "fieldname"=? WHERE id=?;"))
		     (val       (cdr keyval))
		     (valnum    (if (number? val)
				    val
				    (if (string? val)
					(string->number val)
					#f))))
		(if (not (member fieldname (cons "runname" keys))) ;; don't attempt to tweak these
		    (let* ((curr-val (get-var db getqry))
			   (have-it  (or (equal? curr-val val)
					 (equal? curr-val valnum))))
		      (if (not have-it)
			  (sqlite3:execute db setqry (or valnum val) run-id))))))
	    run-meta)))
	run-id))))
  
(define (db:create-initial-run-record dbstruct runname target)	  
  (let* ((keys     (db:get-keys dbstruct))
     	 (targvals (string-split target "/"))
	 (keystr   (string-intersperse keys ","))
	 (key?str  (string-intersperse (make-list (length targvals) "?") ","))
	 (qrystr   (conc "INSERT INTO runs (runname,"keystr") VALUES (?,"key?str")")))
    (db:with-db
     dbstruct #f #f
     (lambda (dbdat db)
       (apply sqlite3:execute db qrystr runname targvals)))))

(define (db:insert-test dbstruct run-id test-rec)
  (let* ((testname  (alist-ref "testname" test-rec equal?))
	 (item-path (alist-ref "item_path" test-rec equal?))
	 (id        (db:get-test-id dbstruct run-id testname item-path))
	 (fieldvals (filter (lambda (x)(not (member (car x) '("id" "last_update")))) test-rec))
	 (setqry    (conc "UPDATE tests SET "(string-intersperse
					      (map (lambda (dat)
						     (conc (car dat)"=?"))
						   fieldvals)
					      ",")" WHERE id=?;"))
	 (insqry   (conc "INSERT INTO tests ("(string-intersperse (map (lambda (x) (car x)) fieldvals) ",")
			 ") VALUES ("(string-intersperse (make-list (length fieldvals) "?") ",")");")))
    (debug:print 0 *default-log-port* "id: "id"\nset: "setqry"\ninsqry: "insqry)
    (db:with-db
     dbstruct
     run-id #f
     (lambda (dbdat db)
       (if id
	   (apply sqlite3:execute db setqry (append (map cdr fieldvals) (list id)))
	   (apply sqlite3:execute db insqry (map cdr fieldvals)))))))

;; replace header and keystr with a call to runs:get-std-run-fields
;;
;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
;; runpatts: patt1,patt2 ...
;;
(define (db:get-runs dbstruct runpatt count offset keypatts)
  (let* ((res       '())

(declare (uses db))
(declare (uses dbfile))
(declare (uses dbfile.import))
(declare (uses dbmod))
(declare (uses dbmod.import))
(declare (uses tcp-transportmod))
(declare (uses tcp-transportmod.import))
(declare (uses rmtmod))
(declare (uses rmtmod.import))

;; (declare (uses debugprint))
;; (declare (uses debugprint.import))

;; (declare (uses ftail))
;; (import ftail)

(import mtargs
        debugprint
	dbmod
	commonmod
	dbfile
	tcp-transportmod
	rmtmod
        )

(define *db* #f) ;; this is only for the repl, do not use in general!!!!

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")

;; set some parameters here - these need to be put in something that can be loaded from other
;; executables such as dashboard and mtutil
;;
(include "transport-mode.scm")
(dbfile:db-init-proc db:initialize-main-db)
(debug:enable-timestamp #t) 


(set! rmtmod:send-receive rmt:send-receive)
 ;;(lambda params (apply rmt:send-receive params))) ;; make send-receive available to rmtmod via parameter


;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;;
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
  (if (common:file-exists? debugcontrolf)
      (load debugcontrolf)))

  -load file.scm          : load and run file.scm
  -mark-incompletes       : find and mark incomplete tests
  -ping run-id|host:port  : ping server, exit with 0 if found
  -debug N|N,M,O...       : enable debug 0-N or N and M and O ...
  -debug-noprop N|M,M,O...: enable debug but do not propagate to subprocesses via MT_DEBUG
  -config fname           : override the megatest.config file with fname
  -append-config fname    : append fname to the megatest.config file
  -import-sexpr fname     : import a sexpr file (use -list-runs % -dumpmode sexpr to create)

Utilities
  -env2file fname         : write the environment to fname.csh and fname.sh
  -envcap a               : save current variables labeled as context 'a' in file envdat.db
  -envdelta a-b           : output enviroment delta from context a to context b to -o fname
                            set the output mode with -dumpmode csh, bash or ini
                            note: ini format will use calls to use curr and minimize path

			"-extract-ods"
			"-pathmod"
			"-env2file"
			"-envcap"
			"-envdelta"
			"-setvars"
			"-set-state-status"
			"-import-sexpr"

                        ;; move runs stuff here
                        "-remove-keep"           
			"-set-run-status"
			"-age"

			;; archive 

       (db:setup #f)
       'killservers
       'dejunk
       'adj-testids
       'old2new
       )
      (set! *didsomething* #t)))

(if (args:get-arg "-import-sexpr")
    (begin
      (launch:setup)
      (rmt:import-sexpr (args:get-arg "-import-sexpr"))
      (set! *didsomething* #t)))

(when (args:get-arg "-sync-brute-force")
  (launch:setup)
  ((server:get-bruteforce-syncer (db:setup #t) persist-until-sync: #t))
  (set! *didsomething* #t))

(if (args:get-arg "-sync-to-megatest.db")

    (case (rmt:transport-mode)
      ((http)(http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode))
      ((tcp) (tcp-transport-handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode testsuite mtexe))
      ((nfs) (nfs-transport-handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode testsuite mtexe))
      )))



(define (nfs-transport-handler  runremote cmd run-id params attemptnum area-dat areapath readonly-mode testsuite mtexe)
  (let* ((keys     (common:get-fields *configdat*))
	 (dbstruct (dbmod:nfs-get-dbstruct run-id keys (dbfile:db-init-proc) areapath)))
    (api:dispatch-request dbstruct cmd run-id params)))
	 
(define (tcp-transport-handler runremote cmd run-id params attemptnum area-dat areapath readonly-mode testsuite mtexe)
  (if (not runremote)

;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit rmtmod))
(declare (uses commonmod))
(declare (uses dbfile))    ;; needed for records
(declare (uses debugprint))

;; (declare (uses apimod))
;; (declare (uses apimod.import))
;; (declare (uses ulex))

;; (include "ulex/ulex.scm")

(module rmtmod
	*
	
(import scheme chicken data-structures extras matchable)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
(import commonmod dbfile debugprint) ;; (prefix commonmod cmod:))
;; (import apimod)
;; (import (prefix ulex ulex:))

(defstruct alldat
  (areapath #f)
  (ulexdat  #f)
  )

;; hold the send-receive proc in this parameter
(define rmtmod:send-receive #f) ;; (make-parameter #f))

;;======================================================================
;; import an sexpr file into the db
;;======================================================================

(define (rmt:import-sexpr sexpr-file)
  (if (file-exists? sexpr-file)
      (let* ((data (with-input-from-file sexpr-file read)))
	(for-each
	 (lambda (targ-dat)
	   (rmt:import-target targ-dat)) ;; ("target" ("run1" ("data" (1 ("field" . "value") ...
	 data))
      (let* ((msg (conc "ERROR: file "sexpr-file" not found")))
	(debug:print 0 *default-log-port* msg)
	(cons #f msg))))

(define (rmt:import-target targ-dat)
  (let* ((target (car targ-dat))
	 (data   (cdr targ-dat)))
    (for-each
     (lambda (run-dat)
       (rmt:import-run target run-dat)) ;; ("runname" ("data" ("testid" ("field" . "value") ...

	      (test-rec (cdr test-dat)))
	 (rmt:insert-test run-id test-rec)))
     tests-data)))

;; insert run if not there, return id either way
(define (rmt:insert-run target runname run-meta)
  ;; look for id, return if found
  (debug:print 0 *default-log-port* "Insert run: "target"/"runname)
  (let* ((runs (rmtmod:send-receive 'simple-get-runs #f
				    ;;    runpatt count offset target last-update)
				    (list runname #f    #f     target #f))))
    (if (null? runs)
	(rmtmod:send-receive 'insert-run #f (list target runname run-meta))
	(simple-run-id (car runs)))))


(define (rmt:insert-test run-id test-rec)
  (let* ((testname  (alist-ref "testname" test-rec equal?))
	 (item-path (alist-ref "item_path" test-rec equal?)))
    (debug:print 0 *default-log-port* "   Insert test: "testname"/"item-path)
    (rmtmod:send-receive 'insert-test run-id test-rec)))

;;======================================================================
;; return the handle struct for sending queries to a specific database
;;  - initializes the connection object if this is the first access
;;    - finds the "captain" and asks who to talk to for the given dbfname
;;    - establishes the connection to the current dbowner
;;