Megatest

;; assemble into dbr:dbdat struct and return
;; 
(define (db:open-dbdat apath dbfile dbinit-proc)
  (let* (;; (dbfile   (db:run-id->path apath run-id))
	 (db       (db:open-run-db dbfile dbinit-proc))
	 (inmem    (db:open-inmem-db dbinit-proc))
	 (dbdat    (make-dbr:dbdat
		    db:     #f ;; db
		    inmem:  inmem
		    ;; run-id: run-id  ;; no can do, there are many run-id values that point to single db
		    fname:  dbfile)))
    ;; now sync the disk file data into the inmemory db
    (db:sync-tables (db:sync-all-tables-list) '("last_update" . 0) db inmem)
    (sqlite3:finalize! db) ;; open and close every sync
    dbdat))

;; open the disk database file
;; NOTE: May need to add locking to file create process here
;; returns an sqlite3 database handle
;;
(define (db:open-run-db dbfile dbinit-proc)

;; ;;     (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb)))

;; NOTE: touched logic is disabled/not done
;; sync run to disk if touched
;;
(define (db:sync-inmem->disk dbstruct apath dbfile #!key (force-sync #f))
  (let* ((dbdat       (db:get-dbdat dbstruct apath dbfile))
	 (dbfullname  (conc apath "/" dbfile))
	 (db          (db:open-run-db dbfullname db:initialize-db)) ;; (dbr:dbdat-db dbdat))
	 (inmem       (dbr:dbdat-inmem dbdat))
	 (start-t     (current-seconds))
	 (last-update (dbr:dbdat-last-write dbdat))
	 (last-sync   (dbr:dbdat-last-sync dbdat)))
    (debug:print-info 0 *default-log-port* "Syncing for dbfile: "dbfile", last-update: "last-update", last-sync: "last-sync)
    (mutex-lock! *db-multi-sync-mutex*)
    (let* ((update_info (cons "last_update" (if force-sync 0 last-update))) ;;  "last_update"))
    	   (need-sync   (or force-sync (>= last-update last-sync))))
      (if need-sync
	  (begin
	    (db:sync-tables (db:sync-all-tables-list) update_info inmem db)
	    (dbr:dbdat-last-sync-set! dbdat start-t))
	  (debug:print 0 *default-log-port* "Skipping sync as nothing touched.")))
    (sqlite3:finalize! db)
    (mutex-unlock! *db-multi-sync-mutex*)))

;; TODO: Add final sync to this
;;
#;(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 db #f))))
	      (if stmts (map sqlite3:finalize! (hash-table-values stmts)))
	      (sqlite3:finalize! db)
	      #t)
	    #f))))

;; close all opened run-id dbs
#;(define (db:close-all dbstruct)
  (assert (dbr:dbstruct? dbstruct) "FATAL: db:close-all called with dbstruct not set up.")
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "WARNING: Finalizing failed, "  ((condition-property-accessor 'exn 'message) exn) ", note - exn=" exn)
     (print-call-chain *default-log-port*))
   ;; (db:sync-touched dbstruct 0 force-sync: #t) ;; NO. Do not do this here. Instead we rely on a server to be started when there are writes, even if the server itself is not going to be used as a server.

	   (sqlite3:execute "DELETE FROM servers WHERE state LIKE 'defunct%';"))
	  (else
	   (sqlite3:execute db "vacuum;")))
	 
	 (sqlite3:finalize! db)
	 #t))))))

;; last-update is *always* a pair ( fieldname|#f . last-update-seconds|#f)
(define (db:sync-one-table fromdb todb tabledat last-update numrecs)
  (assert (pair? last-update) "FATAL: last-update must always be a pair.")
  (let* ((tablename        (car tabledat))
	 (fields           (cdr tabledat))
	 (has-last-update  (member "last_update" fields))
	 (last-update-field (or (car last-update)
				(if has-last-update














				    "last_update"



				    #f)))


	 (has-field         (member last-update-field fields))
	 (last-update-value (cdr last-update))

	 (use-last-update   (and has-field last-update-field last-update-value))




	 (num-fields (length fields))
	 (field->num (make-hash-table))
	 (num->field (apply vector (map car fields))) ;; BBHERE
	 (full-sel   (conc "SELECT " (string-intersperse (map car fields) ",") 
			   " FROM " tablename (if use-last-update ;; apply last-update criteria
						  (conc " WHERE " last-update-field " >= " last-update-value)
						  "")

;; db's are sqlite3 handles
;;
;; if last-update specified ("field-name" . time-in-seconds)
;;    then sync only records where field-name >= time-in-seconds
;;    IFF field-name exists
;;
(define (db:sync-tables tbls last-update fromdb todb)
  (assert (pair? last-update) "FATAL: last-update must always be a pair")
  ;; NOTE: I'm moving all the checking OUT of this routine. Check for read/write access, existance, etc
  ;;       BEFORE calling this sync
  
  (let ((stmts       (make-hash-table)) ;; table-field => stmt
	(all-stmts   '())              ;; ( ( stmt1 value1 ) ( stml2 value2 ))
	(numrecs     (make-hash-table))
	(start-time  (current-milliseconds))

			  (string->number res)
			  #f)))
          (if newres
              newres
              res))
        res)))

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

;; 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

    (debug:print 2 *default-log-port* "NOTE: using target " (string-intersperse (map cadr keyvals) "/") " for this run")
    (if (and runname (null? (filter (lambda (x)(not x)) keyvals))) ;; there must be a better way to "apply and"
	(db:with-db
	 dbstruct #f #f
	 (lambda (db)
	   (let ((res #f))
	     (apply sqlite3:execute db (conc "INSERT OR IGNORE INTO runs (runname,state,status,owner,event_time,contour" comma keystr ") VALUES (?,?,?,?,strftime('%s','now'),?" comma valslots ");")
		    allvals)
	     (apply sqlite3:for-each-row 
		    (lambda (id)
		      (set! res id))
		    db
		    (let ((qry (conc "SELECT id FROM runs WHERE (runname=? " andstr key=?str ");")))
		      qry)
		    qryvals)
	     (sqlite3:execute db "UPDATE runs SET state=?,status=?,event_time=strftime('%s','now') WHERE id=? AND state='deleted';" state status res)
	     res))) 
	(begin
	  (debug:print-error 0 *default-log-port* "Called without all necessary keys")
	  #f))))

;; register a test run with the db, this accesses the main.db and does NOT
;; use server api
;;
(define (db:insert-run dbstruct run-id keyvals runname state status user contour-in)
  (let* ((keys      (map car keyvals))
	 (keystr    (keys->keystr keys))
	 (contour   (or contour-in ""))  ;; empty string to force no hierarcy and be backwards compatible.
	 (comma     (if (> (length keys) 0) "," ""))
	 (andstr    (if (> (length keys) 0) " AND " ""))
	 (valslots  (keys->valslots keys)) ;; ?,?,? ...
	 (allvals   (append (list runname state status user contour) (map cadr keyvals)))
	 (qryvals   (append (list runname) (map cadr keyvals)))
	 (key=?str  (string-intersperse (map (lambda (k)(conc k "=?")) keys) " AND ")))
    (debug:print 3 *default-log-port* "keys: " keys " allvals: " allvals " keyvals: " keyvals " key=?str is " key=?str)
    (debug:print 2 *default-log-port* "NOTE: using target " (string-intersperse (map cadr keyvals) "/") " for this run")
    (if (and runname (null? (filter (lambda (x)(not x)) keyvals))) ;; there must be a better way to "apply and"
	(db:with-db
	 dbstruct #f #f
	 (lambda (db)
	   (let ((res #f))
	     (apply sqlite3:execute db (conc "INSERT OR IGNORE INTO runs (id,runname,state,status,owner,event_time,contour" comma keystr ") VALUES (?,?,?,?,?,strftime('%s','now'),?" comma valslots ");")
		    run-id
		    allvals)
	     (apply sqlite3:for-each-row 
		    (lambda (id)
		      (set! res id))
		    db
		    (let ((qry (conc "SELECT id FROM runs WHERE (runname=? " andstr key=?str ");")))
		      qry)