Megatest

;;

;; Open the classic megatest.db file (defaults to open in toppath)
;;
;;   NOTE: returns a dbdat not a dbstruct!
;;
(define (dbfile:open-sqlite3-db dbpath init-proc)
  (let* ((dbexists     (file-exists? dbpath))
	 (db           ;; need locking here so multiple open
	  ;; do not collide
	  (begin
	    
	    (let* ((db (sqlite3:open-database dbpath)))
	      (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 10000))
	      (if (not dbexists)
		  (init-proc db))

	      db))
	  #;(dbfile:lock-create-open dbpath
	  (lambda (db)
	  (init-proc db))))
	 (write-access (file-write-access? dbpath)))
  (let* ((write-access (file-write-access? dbpath))
    #;(if (and dbexists (not write-access))
	(set! *db-write-access* #f))
    ;; (cons db dbpath)))
	 (db           (dbfile:cautious-open-database dbpath init-proc)))
    (make-dbr:dbdat dbfile: dbpath dbh: db read-only: (not write-access))))

(define (dbfile:print-and-exit . params)
  (with-output-to-port
      (current-error-port)
    (lambda ()
      (apply print params)))

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


(define (dbfile:cautious-open-database fname #!optional (tries-left 5))
(define (dbfile:cautious-open-database fname init-proc #!optional (tries-left 10))
  (let* ((retry (lambda ()
		  (thread-sleep! 0.5)
		  (if (> tries-left 0)
		      (dbfile:cautious-open-database fname (- tries-left 1))))))
		      (dbfile:cautious-open-database fname init-proc (- tries-left 1))))))
    (condition-case
	(let* ((db-exists (file-exists? fname))
	(sqlite3:open-database fname)
               (db        (sqlite3:open-database fname)))
	    (if (and init-proc (not db-exists))
	        (init-proc db))
            (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
		 db)
      (exn (io-error)
	   (dbfile:print-err exn "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again.")
	   (retry))
      (exn (corrupt)
	   (dbfile:print-err exn "ERROR: database " fname " is corrupt. Repair it to proceed.")
	   (retry))
      (exn (busy)

	   (retry)))))

(define (dbfile:open-no-sync-db dbpath)
  (if (not (file-exists? dbpath))
      (create-directory dbpath #t))
  (let* ((dbname    (conc dbpath "/no-sync.db"))
	 (db-exists (file-exists? dbname))
	 (db        (dbfile:cautious-open-database dbname))) ;; (sqlite3:open-database dbname)))
	 (db        (dbfile:cautious-open-database dbname)))
    (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
    (if (not db-exists)
	(begin
	  (sqlite3:execute db "PRAGMA synchronous = 0;")
	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS no_sync_metadat (var TEXT,val TEXT, CONSTRAINT no_sync_metadat_constraint UNIQUE (var));")
	  #;(sqlite3:execute db "PRAGMA journal_mode=WAL;")))
	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS no_sync_metadat (var TEXT,val TEXT, CONSTRAINT no_sync_metadat_constraint UNIQUE (var));")))
	  ;; (sqlite3:execute db "PRAGMA journal_mode=WAL;")))
    db))

(define (db:no-sync-set db var val)
  (sqlite3:execute db "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES (?,?);" var val))

(define (db:no-sync-del! db var)
  (sqlite3:execute db "DELETE FROM no_sync_metadat WHERE var=?;" var))