Megatest

							      ((h) 3600)
							      ((d) 86400)
							      ((w) 604800)
							      ((M) 2628000) ;; aproximately one month
							      ((y) 31536000)
							      (else
							       0)))))))
		      ;; (print "ERROR: can't parse timestring "tstr", component "part)
		      ;; can't (yet) use debugprint. rely on -show-config for user to find errors
		      )))
	      parts)
    time-secs))
		       
(define (seconds->hr-min-sec secs)
  (let* ((hrs (quotient secs 3600))
	 (min (quotient (- secs (* hrs 3600)) 60))

		    qryvals)
	     (sqlite3:execute db "UPDATE runs SET state=?,status=?,event_time=strftime('%s','now') WHERE id=? AND state='deleted';" state status res)
	     res))) 
	(begin
	  (debug:print-error 0 *default-log-port* "Called without all necessary keys")
	  #f))))

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

(define (db:insert-run dbstruct target runname run-meta)
  (let* ((keys    (db:get-keys dbstruct)))
    (if (null? runs)
	;; 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)
			     res))))
	  (db:create-initial-run-record dbstruct runname target)
    	  (let* ((run-id (db:get-run-id dbstruct runname target)))
	    (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))))))
  
(define (db:create-initial-run-record dbstruct runname target)	  
  (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")")))
    (db:with-db
     dbstruct #f #f
     (lambda (dbdat db)
       (apply sqlite3:execute db qrystr runname targvals)))))

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

		     (set! res (cons (apply vector a x) res)))
		   db
		   qrystr
		   )))
    (debug:print-info 11 *default-log-port* "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count)
    (vector header res)))







;; simple get-runs
;;
;;  records used defined in dbfile
;;
(define (db:simple-get-runs dbstruct runpatt count offset target last-update)
    (let* ((res       '())
	   (keys       (db:get-keys dbstruct))
	   (runpattstr (db:patt->like "runname" runpatt))
	   (remfields  (list "id" "runname" "state" "status" "owner" "event_time"))
	   (targstr    (string-intersperse keys "||'/'||"))

(defstruct dbr:dbdat
  (dbfile      #f)
  (dbh         #f)    
  (stmt-cache  (make-hash-table))
  (read-only   #f)
  (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) ))))

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

;;     You should have received a copy of the GNU General Public License
;;     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 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) ;; (prefix commonmod cmod:))
;; (import apimod)
;; (import (prefix ulex ulex:))

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

	 (run-id     (rmt:insert-run target runname run-meta)))
    (for-each
     (lambda (test-dat)
       (let* ((test-id  (car test-dat))
	      (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
  (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)))

    ))

(define (rmt:insert-test run-id test-rec)
  (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