Megatest

;;    inuse gets set automatically for rundb's
;;
(define (db:get-db dbstruct run-id)
  (if (sqlite3:database? dbstruct) ;; pass sqlite3 databases on through
      dbstruct
      (begin
	(mutex-lock! *rundb-mutex*)
	(let ((db (if (or (not run-id)
			  (eq? run-id 0))
		      (db:open-main dbstruct)
		      (db:open-rundb dbstruct run-id)
		      )))
	  ;; db prunning would go here
	  (mutex-unlock! *rundb-mutex*)
	  db))))

;; mod-read:
;;     'mod   modified data
;;     'read  read data

		       db
		       "INSERT OR IGNORE INTO tests (id,run_id,testname,event_time,item_path,state,status) VALUES (?,?,'bogustest',strftime('%s','now'),'nowherepath','DELETED','n/a');"
		       (* run-id 30000) ;; allow for up to 30k tests per run
		       run-id)
		      )) ;; add strings db to rundb, not in use yet
		(sqlite3:set-busy-handler! db handler)
		(sqlite3:execute db "PRAGMA synchronous = 1;"))) ;; was 0 but 0 is a gamble
	  (dbr:dbstruct-set-rundb!  dbstruct db)
	  (dbr:dbstruct-set-inuse!  dbstruct #t)
	  (dbr:dbstruct-set-olddb!  dbstruct olddb)
	  ;; (dbr:dbstruct-set-run-id! dbstruct run-id)
	  (if local
	      (begin
		(dbr:dbstruct-set-localdb! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! dbstruct db) ;; direct access ...
		db)
	      (begin
		(dbr:dbstruct-set-inmem!  dbstruct inmem)
		(db:sync-tables db:sync-tests-only db inmem)
		(dbr:dbstruct-set-refdb!  dbstruct refdb)
		(db:sync-tables db:sync-tests-only db refdb)
		inmem))))))

;; This routine creates the db. It is only called if the db is not already ls opened
;;
(define (db:open-main dbstruct) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let ((mdb (dbr:dbstruct-get-main dbstruct)))

	      (set! *db-write-access* #f))
	  (if write-access 
	      (begin
		(sqlite3:set-busy-handler! db handler)
		(sqlite3:execute db "PRAGMA synchronous = 0;")))
	  (if (not dbexists)
	      (db:initialize-main-db db))
	  ;; (dbr:dbstruct-set-run-id! dbstruct 0) ;; main.db is the zeroth "run"
	  (dbr:dbstruct-set-main!   dbstruct db)
	  (dbr:dbstruct-set-olddb!  dbstruct olddb)
	  db))))

;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
(define (db:setup run-id #!key (local #f))
  (let* ((dbdir    (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
	 (dbstruct (make-dbr:dbstruct path: dbdir local: local)))
    ;; (dbr:dbstruct-set-run-id! dbstruct run-id)
    ;; isn't this a hold-over from the multi-db in one process? Commenting it out for now ....
    ;; (db:get-db dbstruct #f) ;; force one call to main
    dbstruct))

;; Open the classic megatest.db file in toppath
;;
(define (db:open-megatest-db)

	(begin
	  (db:initialize-main-db db)
	  (db:initialize-run-id-db db)))
    db))

;; sync run to disk if touched
;;
(define (db:sync-touched dbstruct run-id #!key (force-sync #f))
  (let ((mtime  (dbr:dbstruct-get-mtime dbstruct))
	(stime  (dbr:dbstruct-get-stime dbstruct))
	(rundb  (dbr:dbstruct-get-rundb dbstruct))
	(inmem  (dbr:dbstruct-get-inmem dbstruct))
	(maindb (dbr:dbstruct-get-main  dbstruct))
	(refdb  (dbr:dbstruct-get-refdb dbstruct))
	(olddb  (dbr:dbstruct-get-olddb dbstruct))
	;; (runid  (dbr:dbstruct-get-run-id dbstruct))
	)
    (debug:print-info 0 "Syncing for run-id " run-id)
    (if (eq? run-id 0)
	;; runid equal to 0 is main.db
	(if maindb
	    (if (or (not (number? mtime))
		    (not (number? stime))
		    (> mtime stime)
		    force-sync)
		(let ((num-synced (db:sync-tables (db:sync-main-list maindb) maindb olddb)))
		  (dbr:dbstruct-set-stime! dbstruct (current-milliseconds))
		  num-synced)
		0)
	    (begin
	      (debug:print 0 "WARNING: call to sync main.db to megatest.db but main not initialized")
	      0))
	;; any other runid is a run
	(if (or (not (number? mtime))
		(not (number? stime))
		(> mtime stime)
		force-sync)
	    (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb olddb)))
	      (dbr:dbstruct-set-stime! dbstruct (current-milliseconds))
	      num-synced)
	    0))))

;; close all opened run-id dbs
(define (db:close-all dbstruct)
  ;; finalize main.db
  (db:sync-touched dbstruct force-sync: #t)
  (sqlite3:finalize! (db:get-db dbstruct #f))
  (let* ((local (dbr:dbstruct-get-local dbstruct))