Megatest

           #t
          )
          #f
  )
)

(define (dbfile:make-tmpdir-name areapath tmpadj)
  (let* ((area (pathname-file areapath))
         (dname (conc "/tmp/"(current-user-name)"/megatest_localdb/" area "/" (string-translate areapath "/" ".") tmpadj "/.mtdb")))
    (unless (directory-exists? dname)
      (create-directory dname #t))
    dname))

(define (dbfile:run-id->path apath run-id)
  (conc apath"/"(dbfile:run-id->dbname run-id)))

;; opens and returns handle and nothing else
;;
;; NOTE: this is already protected by mutex *no-sync-db-mutex*
;;
(define (dbfile:raw-open-no-sync-db dbpath)
  (if (not (file-exists? dbpath))
      (create-directory dbpath #t))
  (debug:print-info 2 *default-log-port* "(dbfile:raw-open-no-sync-db: Opening "dbpath"/no-sync.db")
  (let* ((dbname    (conc dbpath "/no-sync.db"))
	 (db-exists (file-exists? dbname))
	 (init-proc (lambda (db)
		      (sqlite3:with-transaction
		       db
		       (lambda ()
			 ;; I have been having trouble with init of no-sync.db so

                                 dbname TEXT,
                                 mtversion TEXT,
                                 reason TEXT DEFAULT 'none',
                                   CONSTRAINT no_sync_processes UNIQUE (host,pid));"
			    ))))))
	 (on-tmp      (equal? (car (string-split dbpath "/")) "tmp"))
	 (db        (if on-tmp
			(dbfile:cautious-open-database dbname init-proc 1 "WAL" force-init: #t) ;; WAL MODE should use syncronous=1
			;; (dbfile:cautious-open-database dbname init-proc 0 #f    force-init: #t)
			(dbfile:cautious-open-database dbname init-proc 0 "MEMORY" force-init: #t) ;; Journal mode = memory is fastest?
			;; (sqlite3:open-database dbname)
			)))
    ;; (if on-tmp	      ;; done in cautious-open-database
    ;;    (begin
    ;; (sqlite3:execute db "PRAGMA synchronous = 0;") ;; why was this here when is is handled by cautious-open-database?
    (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))

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

(define (dbfile:set-process-status nsdb host pid newstatus)
  (sqlite3:execute nsdb "UPDATE processes SET status=? WHERE host=? AND pid=?;" newstatus host pid))

;; as sorted should be stable. can use to choose "winner"
;;
(define (dbfile:get-process-options nsdb purpose dbname)
  (sqlite3:fold-row
   ;; host port pid starttime status mtversion
   (lambda (res . row)
     (cons row res))
   '()
   nsdb
   "SELECT host,port,pid,starttime,endtime,status,mtversion FROM processes WHERE purpose=? AND dbname LIKE ? AND status IN ('running','alive') ORDER BY starttime ASC,host,port;"
   purpose dbname))

(define (dbfile:get-process-info nsdb host pid)
  (let ((res (sqlite3:fold-row
	      ;; host port pid starttime status mtversion
	      (lambda (res . row)
		(cons row res))
	      '()
	      nsdb
	      "SELECT host,port,pid,starttime,endtime,status,purpose,dbname,mtversion FROM processes WHERE host=? AND pid=?;"
	      host pid)))
    (if (null? res)
	#f
	(car res))))

(define (dbfile:row->procinf row)
  (match row
   ((host port pid starttime endtime status mtversion)
    (make-procinf host: host port: port pid: pid starttime: starttime endtime: endtime status: status mtversion: mtversion))
   (else
    (debug:print 0 *default-log-port* "ERROR: row "row" did not match host,port,pid,starttime,endtime,status,mtversion")
    #f)))

(define (dbfile:set-process-done nsdb host pid reason)
  (sqlite3:execute nsdb "UPDATE processes SET status='done',endtime=?,reason=? WHERE host=? AND pid=?;" (current-seconds) reason host pid)
  (dbfile:cleanup-old-entries nsdb))

(define (dbfile:cleanup-old-entries nsdb)
  (sqlite3:execute nsdb "DELETE FROM process WHERE status='done' AND endtime<?;" (- (current-seconds) (* 3600 48))))

;; other no-sync functions

(define (dbfile:with-no-sync-db dbpath proc)
  (mutex-lock! *no-sync-db-mutex*)
  (let* ((already-open *no-sync-db*)
	 (db  (or already-open (dbfile:raw-open-no-sync-db dbpath)))

;; transaction protected lock aquisition
;; either:
;;    fails    returns  (#f lock-creation-time identifier)
;;    succeeds (returns (#t lock-creation-time identifier)
;; use (db:no-sync-del! db keyname) to release the lock
;;
(define (db:no-sync-get-lock-with-id db keyname identifier)
  (debug:print 2 *default-log-port* "db:no-sync-get-lock-with-id: db: " db " keyname: " keyname " identifier: " identifier)
  (sqlite3:with-transaction
   db
   (lambda ()
     (condition-case
      (let* ((curr-val (db:no-sync-get/default db keyname #f)))
        (debug:print 2 *default-log-port* "db:no-sync-get-lock-with-id: curr-val: " curr-val)
	(if curr-val
	    (match (db:extract-time-identifier curr-val) ;; result->timestamp, identifier
	       ((timestamp . ident)
		(cons (equal? ident identifier) timestamp))
	       (else 
                (debug:print 2 *default-log-port* "db:no-sync-get-lock-with-id: malformed lock")
                (cons #f 'malformed-lock)
                )
            )  ;; lock malformed
	    (let ((curr-sec (current-seconds))
		  (lock-value (if identifier
				  (conc (current-seconds)"+"identifier)
				  (current-seconds))))
	      (sqlite3:execute db "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES(?,?);" keyname lock-value)
	      (cons #t curr-sec))))
      (exn (io-error)  (dbfile:print-err "ERROR: i/o error with no-sync db. Check permissions, disk space etc. and try again."))

	 (result      (or stmth
			  (let* ((newstmth (sqlite3:prepare db stmt)))
			    ;; (db:hoh-set! stmt-cache db stmt newstmth)
			    (hash-table-set! stmt-cache stmt newstmth)
			    newstmth))))
    (mutex-unlock! *get-cache-stmth-mutex*)
    result))

;; (define *mutex-stmth-call* (make-mutex))
;; 
;; (define (db:with-mutex-for-stmth proc)
;;   (mutex-lock! *mutex-stmth-call*)
;;   (let* ((res (proc)))
;;     (mutex-unlock! *mutex-stmth-call*)
;;     res))

)