Megatest

;; NOTE: Need one dbr:subdb per main.db, 1.db ...
;;
(defstruct dbr:subdb
  (dbname      #f) ;; .megatest/1.db
  (mtdbfile    #f) ;; mtrah/.megatest/1.db
  (mtdbdat     #f) ;; only need one of these for syncing

  (tmpdbfile   #f) ;; /tmp/.../.megatest/1.db

  (dbstack     (make-stack)) ;; stack for tmp dbr:dbdat, ie. dbdats
  (homehost    #f) ;; not used yet
  (on-homehost #f) ;; not used yet
  (read-only   #f)
  (last-sync   0)
  (last-write  (current-seconds))
  )                ;; goal is to converge on one struct for an area but for now it is too confusing

;; need to keep dbhandles and cached statements together
;; This is the handle and associated file for a single db
;;
(defstruct dbr:dbdat
  (dbfile      #f)
  (dbh         #f)    
  (stmt-cache  (make-hash-table))
  (read-only   #f)
  (birth-sec   (current-seconds)))

  (print-call-chain (current-error-port))
  (apply dbfile:print-err message)
  (dbfile:print-err
    ", error: "     ((condition-property-accessor 'exn 'message)   exn)
    ", arguments: " ((condition-property-accessor 'exn 'arguments) exn)
    ", location: "  ((condition-property-accessor 'exn 'location)  exn)
    ))

;; the stmt-cache is associated with a single db handle
;; so there is no need for the hoh stuff. 
(define (db:get-cache-stmth dbdat db stmt)
  (let* ((stmt-cache  (dbr:dbdat-stmt-cache dbdat))
	 ;; (stmth       (db:hoh-get stmt-cache db stmt))
	 (stmth       (hash-table-ref/default stmt-cache stmt #f))
	 )
    (or stmth
	(let* ((newstmth (sqlite3:prepare db stmt)))
	  ;; (db:hoh-set! stmt-cache db stmt newstmth)
	  (hash-table-set! stmt-cache stmt newstmth)
	  newstmth))))

(define (dbfile:run-id->key run-id)
  (or run-id 'main))

(define (db:safely-close-sqlite3-db db stmt-cache #!key (try-num 3))
  (if (<= try-num 0)
      #f
      (handle-exceptions
	  exn
	(begin
	  (print "Attempt to safely close sqlite3 db failed. Trying again. exn=" exn)
	  (thread-sleep! 3)
	  (sqlite3:interrupt! db)
	  (db:safely-close-sqlite3-db db stmt-cache try-num: (- try-num 1)))
	(if (sqlite3:database? db)
	    ;; (let* ((stmts (and stmt-cache (hash-table-ref/default stmt-cache #f))))
	    (begin
	      (if stmt-cache
		  (map sqlite3:finalize! (hash-table-values stmt-cache)))
	      (sqlite3:finalize! db)
	      #t)
            (begin
             (dbfile:print-err "db:safely-close-sqlite3-db: " db " is not an sqlite3 db")


	     #f)))))

;; close all opened run-id dbs
(define (db:close-all dbstruct)
  (if (dbr:dbstruct? dbstruct)






      (let* ((subdbs     (hash-table-values (dbr:dbstruct-subdbs dbstruct))))
	(for-each
	 (lambda (subdb)
	   (let* ((tdbs       (stack->list (dbr:subdb-dbstack subdb)))
		  (mtdbdat    (dbr:dbdat-dbh (dbr:subdb-mtdbdat subdb))))


	     (map (lambda (dbdat)
		    (let* ((stmt-cache (dbr:dbdat-stmt-cache dbdat))
			   (dbh        (dbr:dbdat-dbh        dbdat)))
		      (db:safely-close-sqlite3-db dbh stmt-cache)))
		  tdbs)
	     (db:safely-close-sqlite3-db mtdbdat (dbr:dbdat-stmt-cache  (dbr:subdb-mtdbdat subdb)))))


	 subdbs)
        #t)

      #f))



;; ;; set up a single db (e.g. main.db, 1.db ... etc.)
;; ;;
;; (define (db:setup-db dbstruct areapath run-id)
;;   (let* ((dbname   (db:run-id->dbname run-id))
;; 	 (dbstruct (hash-table-ref/default dbstructs dbname #f)))
;;     (if dbstruct

  (let* ((backupfname (conc fname"-"(current-process-id)".bak"))
	 (cmd (conc "cp "fname" "backupfname";mv "fname" "(conc fname ".delme;")
		    "cp "backupfname" "fname)))
    (dbfile:print-err "WARNING: attempting recovery of file "fname" by running commands:\n"
		      "  "cmd)
    (system cmd)))


(define (dbfile:open-no-sync-db dbpath)
  (if *no-sync-db*
      *no-sync-db*
      (begin
	(if (not (file-exists? dbpath))
	    (create-directory dbpath #t))
	(let* ((dbname    (conc dbpath "/no-sync.db"))
	       (db-exists (file-exists? dbname))
	       (init-proc (lambda (db)
			    (if (not db-exists)
				(begin
				  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS no_sync_metadat (var TEXT,val TEXT, CONSTRAINT no_sync_metadat_constraint UNIQUE (var));"))
				)))
	       (db        (dbfile:cautious-open-database dbname init-proc 0 "WAL"))) ;; (sqlite3:open-database dbname)))
	  ;; (sqlite3:execute db "PRAGMA synchronous = 0;")
	  ;; (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000)) ;; done in cautious-open-database
	  (set! *no-sync-set-prep* (sqlite3:prepare db "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES (?,?);"))
	  (set! *no-sync-del-prep* (sqlite3:prepare db "DELETE FROM no_sync_metadat WHERE var=?;"))
	  (set! *no-sync-get-prep* (sqlite3:prepare db "SELECT val FROM no_sync_metadat WHERE var=?;"))
	  (set! *no-sync-db* db)
	  db))))

(define *no-sync-set-prep* #f)
(define *no-sync-del-prep* #f)
(define *no-sync-get-prep* #f)

(define (db:no-sync-set db var val)
  (sqlite3:execute *no-sync-set-prep* var val))

(define (db:no-sync-del! db var)
  (sqlite3:execute  *no-sync-del-prep* var))

(define (db:no-sync-get/default db var default)
  (let ((res default))
    (sqlite3:for-each-row
     (lambda (val)
       (set! res val))


     *no-sync-get-prep* var)
    (if res
        (let ((newres (if (string? res)
			  (string->number res)
			  #f)))
          (if newres
              newres
              res))

;; (db:with-db dbstruct run-id sqlite3:exec "select blah fgrom blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
  (assert dbstruct "FATAL: db:with-db called with dbstruct "#f)
  (assert (dbr:dbstruct? dbstruct) "FATAL: dbstruct is "dbstruct)
  (let* ((use-mutex (> *api-process-request-count* 25)) ;; risk of db corruption
	 (load-delay  (/ *api-process-request-count* 25))
	 (have-struct (dbr:dbstruct? dbstruct))
         (dbdat     (if have-struct                ;; this stuff just allows us to call with a db handle directly
			(db:open-db dbstruct run-id (dbfile:db-init-proc)) ;; (dbfile:get-subdb dbstruct run-id)
			#f))
	 (db        (if have-struct                ;; this stuff just allows us to call with a db handle directly
			(dbr:dbdat-dbh dbdat)
			dbstruct))

	 ) ;; was 25
    (assert (sqlite3:database? db) "FATAL: db:with-db, db is not a database, db="db", fname="fname)
    (if (file-exists? jfile)
	(begin
	  (dbfile:print-err "INFO: "jfile" exists, delaying to reduce database load")
	  (thread-sleep! 0.2)))
    (if (and use-mutex
	     (common:low-noise-print 120 "over-25-parallel-api-requests"))
	(dbfile:print-err *api-process-request-count* " parallel api requests being processed in process "
			  (current-process-id)
			  ", throttling access for "load-delay" seconds."))
    (condition-case
	(begin
	  (if use-mutex
	      (begin
		(thread-sleep! load-delay) ;; time to slow everything down
		(mutex-lock! *db-with-db-mutex*)))
	  (let ((res (apply proc dbdat db params))) ;; the actual call is here.
	    (if use-mutex (mutex-unlock! *db-with-db-mutex*))
	    ;; (if (vector? dbstruct)(db:done-with dbstruct run-id r/w))
	    (if dbdat
		(dbfile:add-dbdat dbstruct run-id dbdat))
	    res))
      (exn (io-error)