Megatest

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

;; if we are not a server create a db handle. this is not finalized
;; so watch for problems. I'm still not clear if it is needed to manually
;; finalize sqlite3 dbs with the sqlite3 egg.
;;
(define (db:no-sync-db db-in)
  (if db-in
      db-in
      (if *no-sync-db*
	  *no-sync-db*
	  (begin

(define (dbfile:cautious-open-database fname #!optional (tries-left 5))
  (let* ((retry (lambda ()
		  (thread-sleep! 0.5)
		  (if (> tries-left 0)
		      (dbfile:cautious-open-database fname (- tries-left 1))))))
    (condition-case
	(sqlite3:open-database fname)
      (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)
	    (mutex-lock! *db-access-mutex*)
	    (let ((db (dbfile:open-no-sync-db)))
	      (set! *no-sync-db* db)
	      (mutex-unlock! *db-access-mutex*)
	      db)))))
	   (dbfile:print-err exn "ERROR: database " fname
			     " is locked. Try copying to another location, remove original and copy back.")
	   (retry))
      (exn (permission)(dbfile:print-err exn "ERROR: database " fname " has some permissions problem.")
	   (retry))
      (exn ()
	   (dbfile:print-err exn "ERROR: Unknown error with database " fname " message: "
			     ((condition-property-accessor 'exn 'message) exn))
	   (retry)))))


(define (dbfile:open-no-sync-db dbpath)
  (if (not (file-exists? dbpath))
  (let* (;; (dbpath (db:dbfile-path))
	 (dbname (conc dbpath "/no-sync.db"))
      (create-directory dbpath #t))
  (let* ((dbname    (conc dbpath "/no-sync.db"))
	 (db-exists (file-exists? dbname))
	 (db     (sqlite3:open-database dbname)))
	 (db        (dbfile:cautious-open-database dbname))) ;; (sqlite3: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 "PRAGMA journal_mode=WAL;")))
    db))

(define (db:no-sync-set db var val)
  (sqlite3:execute (db:no-sync-db db) "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES (?,?);" 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:no-sync-db db) "DELETE FROM no_sync_metadat WHERE var=?;" var))
  (sqlite3:execute db "DELETE FROM no_sync_metadat WHERE var=?;" var))

(define (db:no-sync-get/default db var default)
  (let ((res default))
    (sqlite3:for-each-row
     (lambda (val)
       (set! res val))
     (db:no-sync-db db)
     db
     "SELECT val FROM no_sync_metadat WHERE var=?;"
     var)
    (if res
        (let ((newres (if (string? res)
			  (string->number res)
			  #f)))
          (if newres
              newres
              res))
        res)))

;; transaction protected lock aquisition
;; either:
;;    fails    returns  (#f . lock-creation-time)
;;    succeeds (returns (#t . lock-creation-time)
;; use (db:no-sync-del! db keyname) to release the lock
;;
(define (db:no-sync-get-lock db-in keyname)
(define (db:no-sync-get-lock db keyname)
  (let ((db (db:no-sync-db db-in)))
    (sqlite3:with-transaction
     db
     (lambda ()
       (handle-exceptions
	   exn
  (sqlite3:with-transaction
   db
   (lambda ()
     (handle-exceptions
	 exn
	 (let ((lock-time (current-seconds)))
	   ;; (debug:print-info 2 *default-log-port* "db:no-sync-get-lock keyname=" keyname ", lock-time=" lock-time ", exn=" exn)
	   (sqlite3:execute db "INSERT INTO no_sync_metadat (var,val) VALUES(?,?);" keyname lock-time)
	   `(#t . ,lock-time))
	 `(#f . ,(sqlite3:first-result db "SELECT val FROM no_sync_metadat WHERE var=?;" keyname)))))))
       `(#f . ,(sqlite3:first-result db "SELECT val FROM no_sync_metadat WHERE var=?;" keyname))))))


;;======================================================================
;; file utils
;;======================================================================

;;======================================================================