Megatest

  (birth-sec   (current-seconds)))

;; used in simple-get-runs (thanks Brandon!)
(define-record simple-run target id runname state status owner event_time)
(define-record-printer (simple-run x out)
  (fprintf out "#,(simple-run ~S ~S ~S ~S)"
	   (simple-run-target x) (simple-run-id x) (simple-run-runname x) (time->string (seconds->local-time (simple-run-event_time x) ))))

;; args is hash table of string to value
;;
(define (get-purpose args)
  (let* ((get-arg    (lambda (key)
		       (hash-table-ref/default args key #f)))
	 (get-switch (lambda keys
		       (fold
			(lambda (key res)
			  (if (hash-table-ref/default args key #f)
			      (or key res)
			      res))
			#f
			keys)))
	 (action     (get-switch "-server" "-execute" "-run" "-rerun")))
    (cond
     (action
      (substring action 1 (string-length action)))
     (else
      "nopurpose"))))

;; megatest process tracking

(defstruct procinf
  (start      (current-seconds))
  (host       (get-host-name)) ;; why is this not being recognised?
  (pid        (current-process-id))
  (port       #f)
  (cwd        (current-directory))
  (load       #f)
  (purpose    #f) ;; get-purpose needed to be run in megatest.scm
  (dbname     #f)
  (mtbin      (car (argv)))
  (mtversion  #f)
  (status     "running")
  
  
  )

(define *procinf* (make-procinf))
(define *dbstruct-dbs* #f)
(define *db-open-mutex* (make-mutex))
(define *db-access-mutex* (make-mutex)) ;; used in common.scm
(define *no-sync-db*   #f)
(define *db-sync-in-progress* #f)
(define *db-with-db-mutex*    (make-mutex))
(define *max-api-process-requests* 0)

	  (sqlite3:execute db "PRAGMA synchronous = 0;")
	  (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))))
    db))

;; mtest processes registry calls

(define (dbfile:insert-or-update-process nsdb dat)
  (let* ((host      (procinf-host dat))
	 (pid       (procinf-pid  dat))
	 (curr-info (dbfile:get-process-info nsdb host pid)))
    (if curr-info ;; record exists, do update
	(match curr-info
	  ((host port pid starttime status purpose dbname mtversion)
	   (sqlite3:execute
	    nsdb
	    "UPDATE processes SET port=?,starttime=?,status=?,
                                  purpose=?,dbname=?,mtversion=?
              WHERE host=? AND pid=?;"
	    (or (procinf-port      dat) port)
	    (or (procinf-start     dat) starttime)
	    (or (procinf-status    dat) status)
	    (or (procinf-purpose   dat) purpose)
	    (or (procinf-dbname    dat) dbname)
	    (or (procinf-mtversion dat) mtversion)
	    host pid))
	  (else
	   #f ;; what to do?
	   ))
	(dbfile:register-process
	 nsdb
	 (procinf-host      dat)
	 (procinf-port      dat)
	 (procinf-pid       dat)
	 (procinf-start     dat)
	 (procinf-status    dat)
	 (procinf-purpose   dat)
	 (procinf-dbname    dat)
	 (procinf-mtversion dat)))))
	  

(define (dbfile:register-process nsdb host port pid starttime status purpose dbname mtversion)
  (sqlite3:execute nsdb "INSERT INTO processes (host,port,pid,starttime,status,purpose,dbname,mtversion) VALUES (?,?,?,?,?,?,?,?);"
		   host port pid starttime status purpose dbname mtversion))

(define (dbfile:set-process-status nsdb host pid newstatus)