Index: dbmod.scm ================================================================== --- dbmod.scm +++ dbmod.scm @@ -422,32 +422,22 @@ ;; create and fill the inmemory db ;; assemble into dbr:dbdat struct and return ;; (define (db:open-dbdat apath dbfile dbinit-proc) (let* ((db (db:open-run-db dbfile dbinit-proc)) - ;; (inmem (db:open-inmem-db dbinit-proc)) + (inmem (db:open-inmem-db dbinit-proc)) (dbdat (make-dbr:dbdat - db: #f ;; db - inmem: db ;; inmem + db: db + inmem: inmem ;; run-id: run-id ;; no can do, there are many run-id values that point to single db fname: dbfile))) + (assert (and (sqlite3:database? db)(sqlite3:database? inmem)) + "FATAL: should have both inmem and on-disk db at this time.") ;; now sync the disk file data into the inmemory db - ;; (db:sync-tables (db:sync-all-tables-list) '("last_update" . 0) db inmem) + (db:sync-tables (db:sync-all-tables-list) '("last_update" . 0) db inmem) ;; (sqlite3:finalize! db) ;; open and close every sync dbdat)) -;; (define (db:open-dbdat apath dbfile dbinit-proc) -;; (let* ((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 ;; @@ -501,11 +491,20 @@ (define (db:setup db-file) ;; run-id) (assert *toppath* "FATAL: db:setup called before toppath is available.") (let* ((dbstruct (or *dbstruct-db* (make-dbr:dbstruct)))) (db:get-dbdat dbstruct *toppath* db-file) (if (not *dbstruct-db*)(set! *dbstruct-db* dbstruct)) + (assert (db:check-setup dbstruct *toppath* db-file) "FATAL: db:setup did NOT complete properly") dbstruct)) + +(define (db:check-setup dbstruct apath dbfile) + (let* ((dbdat (db:get-dbdat dbstruct apath dbfile)) + (dbfullname (conc apath "/" dbfile)) + (db (dbr:dbdat-db dbdat)) ;; (db:open-run-db dbfullname db:initialize-db)) ;; + (inmem (dbr:dbdat-inmem dbdat))) + (and (sqlite3:database? db) + (sqlite3:database? inmem)))) ;;====================================================================== ;; setting/getting a lock on the db for only one server per db ;; ;; NOTE: @@ -693,35 +692,36 @@ ;; 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)) - (if #f - (debug:print-info 0 *default-log-port* "syncing "*toppath*" "dbfile" at "(current-seconds)) - #f)) ;; disabled -;; (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*))) - + (let* ((dbdat (db:get-dbdat dbstruct apath dbfile)) + (dbfullname (conc apath "/" dbfile)) + (db (dbr:dbdat-db dbdat)) ;; (db:open-run-db dbfullname db:initialize-db)) ;; + (inmem (dbr:dbdat-inmem dbdat)) + (start-t (current-seconds)) + (last-update (dbr:dbdat-last-write dbdat)) + (last-sync (dbr:dbdat-last-sync dbdat))) + (if (and (sqlite3:database? db) + (sqlite3:database? inmem)) + (begin + (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*)) + (debug:print-info 0 *default-log-port* "Skipping sync due to databases not being open.")))) + ;; TODO: Add final sync to this ;; -#;(define (db:safely-close-sqlite3-db db stmt-cache #!key (try-num 3)) +(define (db:safely-close-sqlite3-db db stmt-cache #!key (try-num 3)) (if (<= try-num 0) #f (handle-exceptions exn (begin @@ -735,11 +735,11 @@ (sqlite3:finalize! db) #t) #f)))) ;; close all opened run-id dbs -#;(define (db:close-all dbstruct) +(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) Index: tests/simplerun/debug.scm ================================================================== --- tests/simplerun/debug.scm +++ tests/simplerun/debug.scm @@ -32,17 +32,18 @@ (i 1) (s 0)) ;; sum (let ((start-time (current-milliseconds)) (run-id (+ r (make-run-id)))) (rmt:register-test run-id "test1" (conc "item_" i)) + (thread-sleep! 0.01) (let* ((qry-time (- (current-milliseconds) start-time)) (tot-query-time (+ qry-time s)) (avg-query-time (* 1.0 (/ tot-query-time i)))) (if (> qry-time 500) (print "WARNING: rmt:register-test took more than 500ms, "qry-time"ms, i="i", avg-query-time="avg-query-time)) (if (eq? (modulo i 100) 0) - (print "For run-id="run-id", "(rmt:get-keys-write)" num tests registered="i)) + (print "For run-id="run-id", "(rmt:get-keys-write)" num tests registered="i" avg-query-time="avg-query-time)) (if (< i 500) (loop r (+ i 1) tot-query-time) (if (< r 100) (let* ((start-time (current-milliseconds))) (print "rmt:get-keys "(rmt:get-keys)" in "(- (current-milliseconds) start-time))