Megatest

;;    if run-id is a string treat it as a filename
;;    if db already open - return inmem
;;    if db not open, open inmem, rundb and sync then return inmem
;;    inuse gets set automatically for rundb's
;;
;; (define db:get-db db:get-subdb)

(define (db:get-db dbstruct run-id) 
   (let* ((subdb (dbfile:get-subdb dbstruct run-id))


        (dbdat (dbfile:get-dbdat dbstruct run-id)))



        (if (dbr:dbdat? dbdat)
          dbdat

          (dbfile:open-db *dbstruct-dbs* #f db:initialize-main-db)
        )
   )
)

(define-inline (db:generic-error-printout exn . message)
  (print-call-chain (current-error-port))
  (apply debug:print-error 0 *default-log-port* message)
  (debug:print-error 0 *default-log-port* "   params: " params
		     ", error: "     ((condition-property-accessor 'exn 'message)   exn)
		     ", arguments: " ((condition-property-accessor 'exn 'arguments) exn)

	 (use-mutex (> *api-process-request-count* 25))) ;; was 25
    (if (and use-mutex
	     (common:low-noise-print 120 "over-50-parallel-api-requests"))
	(debug:print-info 0 *default-log-port* *api-process-request-count* " parallel api requests being processed in process " (current-process-id) ", throttling access"))
    (if (common:low-noise-print 600 (conc "parallel-api-requests" *max-api-process-requests*))
	(debug:print-info 2 *default-log-port* "Parallel api request count: " *api-process-request-count* " max parallel requests: " *max-api-process-requests*))
    (condition-case
	(begin
	  (if use-mutex (mutex-lock! *db-with-db-mutex*))
	  (let ((res (apply proc dbdat db params)))
	    (if use-mutex (mutex-unlock! *db-with-db-mutex*))
	    ;; (if (vector? dbstruct)(db:done-with dbstruct run-id r/w))
	    (if dbdat (stack-push! (dbr:subdb-dbstack subdb) dbdat))
	    res))
      (exn (io-error)
	   (db:generic-error-printout exn "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again."))
      (exn (corrupt)
	   (db:generic-error-printout exn "ERROR: database " fname " is corrupt. Repair it to proceed."))
      (exn (busy)
	   (db:generic-error-printout exn "ERROR: database " fname
				      " is locked. Try copying to another location, remove original and copy back."))
      (exn (permission)(db:generic-error-printout exn "ERROR: database " fname " has some permissions problem."))
      (exn ()
	   (db:generic-error-printout exn "ERROR: Unknown error with database " fname " message: "
				      ((condition-property-accessor 'exn 'message) exn))))))
      

;; NB// #f => return dbdir only
;;      (was planned to be;  zeroth db with name=main.db)
;; 
;; If run-id is #f return to create and retrieve the path where the db will live.
;;

  (db:with-db dbstruct #f #t 
	      (lambda (dbdat db)
		(sqlite3:execute db "DELETE FROM metadat WHERE var=?;" var))))

;;======================================================================
;; no-sync.db - small bits of data to be shared between servers
;;======================================================================

(define (db:no-sync-db db-in)
  (if db-in
      db-in
      (if *no-sync-db*
	  *no-sync-db*
	  (begin
	    (mutex-lock! *db-access-mutex*)
	    (let ((dbpath (common:get-db-tmp-area))
		  (db     (dbfile:open-no-sync-db dbpath)))
	      (set! *no-sync-db* db)
	      (mutex-unlock! *db-access-mutex*)
	      db)))))

(define (with-no-sync-db proc)
  (let* ((db  (db:no-sync-db *no-sync-db*)))
    (proc db)))

(define (db:open-no-sync-db)
  (dbfile:open-no-sync-db (db:dbfile-path)))

(define (db:no-sync-close-db db stmt-cache)
  (db:safely-close-sqlite3-db db stmt-cache))

	 (dbfiles        (glob (conc tmp-area"/.db/*.db")))
	 (sync-durations (make-hash-table)))
    ;; (debug:print-info 0 *default-log-port* "lock-and-sync, dbfiles: "dbfiles)
    (for-each
     (lambda (file)
       (let* ((fname (conc (pathname-file file) ".db"))
	      (fulln (conc *toppath*"/.db/"fname))
	      (time1 (if (file-exists? file)
			 (file-modification-time file)
			 (begin
			   (debug:print-info 0 *default-log-port* "Sync - I do not see file "file)
			   1)))
	      (time2 (if (file-exists? fulln)
			 (file-modification-time fulln)
			 (begin
			   (debug:print-info 0 *default-log-port* "Sync - I do not see file "fulln)
			   0)))
	      (changed (> time1 time2))
	      (do-cp (cond
		      ((not (file-exists? fulln)) ;; shouldn't happen, but this might recover
		       (debug:print-info 0 *default-log-port* "File "fulln" not found! Copying "fname" to "fulln)
		       #t)
		      (changed ;; (and changed
		       ;; (> (- (current-seconds) time1) 3)) ;; if file is changed and three seconds have passed.

    
    (if (and legacy-sync (not *time-to-exit*))
 	(begin
 	  (debug:print-info 0 *default-log-port* "Server running, periodic copy-based sync started.")
	  (let loop ()

	    ;; run the sync and print out durations
	    (let* ((changed (db:run-lock-and-sync no-sync-db)))
	      (if (not (null? changed))
		  (debug:print-info 0 *default-log-port* "Sync durations: "changed)))
	    ;; keep going unless time to exit
	    ;;
	    (if (not *time-to-exit*)
		(let delay-loop ((count 0))
		  ;;(debug:print-info 13 *default-log-port* "delay-loop top; count="count" pid="(current-process-id)" this-wd-num="this-wd-num" *time-to-exit*="*time-to-exit*)
		  
		  (if (and (not *time-to-exit*)