Index: dbmod.scm ================================================================== --- dbmod.scm +++ dbmod.scm @@ -199,29 +199,29 @@ (tmpdb (let* ((fname (conc tmpdir"/" (string-translate areapath "/" ".")"-"(current-process-id)"-"dbfname))) (if (not (file-exists? tmpdir))(create-directory tmpdir)) ;; check if tmpdb already exists, either delete it or ;; add something to the name fname)) - (inmem (dbmod:open-inmem-db init-proc + #;(inmem (dbmod:open-inmem-db init-proc (if (eq? (dbcache-mode) 'inmem) #f tmpdb) )) (write-access (file-write-access? dbpath)) (db (dbmod:safely-open-db dbfullname init-proc write-access)) (tables (db:sync-all-tables-list keys))) - (if (not (and (sqlite3:database? inmem) - (sqlite3:database? db))) + (if (not (sqlite3:database? db)) ;; db is our master database in the .mtdb dir (begin (debug:print 0 *default-log-port* "ERROR: Failed to properly open "dbfname-in", exiting immediately.") (exit))) - ;; (assert (sqlite3:database? inmem) "FATAL: open-dbmoddb: inmem is not a db") - ;; (assert (sqlite3:database? db) "FATAL: open-dbmoddb: db is not a db") - (dbr:dbstruct-inmem-set! dbstruct inmem) + ;; we sync to tmpdb here so that we use file-copy to get intial database + (dbmod:db-to-db-sync dbfullname tmpdb 0 init-proc keys) + (let* ((inmem (dbmod:open-inmem-db init-proc tmpdb))) + (dbr:dbstruct-inmem-set! dbstruct inmem)) (dbr:dbstruct-ondiskdb-set! dbstruct db) (dbr:dbstruct-dbfile-set! dbstruct dbfullname) - (dbr:dbstruct-dbfname-set! dbstruct dbfname) +; (dbr:dbstruct-dbfname-set! dbstruct dbfname) (dbr:dbstruct-sync-proc-set! dbstruct (lambda (last-update) (if *sync-in-progress* (debug:print 3 *default-log-port* "WARNING: overlapping calls to sync to disk") (thread-start! @@ -233,13 +233,10 @@ dbfullname syncdir) (system (conc "megatest -db2db -from "tmpdb" -to "dbfullname)) (mutex-unlock! *db-with-db-mutex*) (thread-sleep! 0.5) ;; ensure at least 1/2 second down time between sync calls (set! *sync-in-progress* #f))))))) - ;; (dbmod:sync-tables tables #f db inmem) - ;; (if db - (dbmod:sync-gasket tables #f inmem db dbfullname 'fromdest keys) ;; ) ;; load into inmem (dbr:dbstruct-last-update-set! dbstruct (current-seconds)) ;; should this be offset back in time by one second? dbstruct)) ;; (if (eq? syncdir 'todisk) ;; sync to disk normally, sync from in dashboard ;; (dbmod:sync-tables tables last-update inmem db) @@ -389,21 +386,21 @@ (apply sqlite3:execute db qry row)))) ;; (debug:print-info 0 *default-log-port* "qry="qry) (handle-exceptions ;; on exception do the cleanup qry then try one more time exn (begin - (clean-up-qry id) + ;; (clean-up-qry id) (proc)) (proc))))) (num-inserts 0) (num-updates 0) ) ;; (debug:print-info 0 *default-log-port* "field-names: "field-names", fields-sans-lu: "fields-sans-lu) - (sqlite3:with-transaction - from-db - (lambda () + ;; (sqlite3:with-transaction + ;; from-db + ;; (lambda () (let* ((from-ids (get-ids from-db))) ;; (debug:print-info 0 *default-log-port* "Table "tablename", has "(length from-ids)" records.") (sqlite3:with-transaction to-db (lambda () @@ -427,20 +424,20 @@ (sqlite3:execute to-db (conc "UPDATE "tablename" SET "fieldname"=? WHERE id=?;") from-val from-id)))) (handle-exceptions ;; try to remove the offending record and re-try once the update exn (begin - (clean-up-qry from-id) + ;; (clean-up-qry from-id) (qry-proc)) (qry-proc)) (set! num-updates (+ num-updates 1)))))) fields-sans-lu) (let ((row (get-row from-db from-id))) ;; need to insert the row ;; (debug:print 0 *default-log-port* "row="row) (set! num-inserts (+ num-inserts 1)) (ins-row to-db from-id row)))) - from-ids))))))) + from-ids))))) (+ num-inserts num-updates))) ;; (for-each ;; table ;; (lambda (tabledat) ;; (let* ((tablename (car tabledat)) @@ -935,22 +932,37 @@ ;;====================================================================== ;; db to db sync ;;====================================================================== (define (dbmod:db-to-db-sync src-db dest-db last-update init-proc keys) - (if (and (file-exists? src-db) + (if (and (file-exists? src-db) ;; can't proceed without a source (file-read-access? src-db)) - (let* ((d-wr (or (and (file-exists? dest-db) - (file-write-access? dest-db)) ;; exists and writable - (let* ((dirname (or (pathname-directory dest-db) - "."))) - (if dirname - (file-exists? dirname) - (file-write-access? dirname))))) - (tables (db:sync-all-tables-list keys)) - (sdb (dbmod:safely-open-db src-db init-proc #t)) - (ddb (dbmod:safely-open-db dest-db init-proc d-wr))) - (dbmod:sync-gasket tables last-update sdb ddb dest-db 'todest keys)) - #f - )) + (let* ((have-dest (file-exists? dest-db)) + (dest-file-wr (and have-dest + (file-write-access? dest-db))) ;; exists and writable + (dest-dir (or (pathname-directory dest-db) + ".")) + (dest-dir-wr (and (file-exists? dest-dir) + (file-write-access? dest-dir))) + (d-wr (or (and have-dest + dest-file-wr) + dest-dir-wr)) + (copied (if (and (not have-dest) + dest-dir-wr) + (begin + (file-copy src-db dest-db) + #t) + #f))) + (if copied + (begin + (debug:print-info 0 *default-log-port* "db-to-db-sync done with file-copy") + #t) + (let* ((tables (db:sync-all-tables-list keys)) + (sdb (dbmod:safely-open-db src-db init-proc #t)) + (ddb (dbmod:safely-open-db dest-db init-proc d-wr)) + (res (dbmod:sync-gasket tables last-update sdb ddb dest-db 'todest keys))) + (sqlite3:finalize! sdb) + (sqlite3:finalize! ddb) + res))) + #f)) ) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -2579,17 +2579,11 @@ ) (if (and src-db dest-db) (begin (debug:print-info 0 *default-log-port* "Attempting to sync data from "src-db" to "dest-db"...") - ;; (if (common:simple-file-lock lockfile) - ;; (begin - (if (and (file-exists? src-db) - (not (file-exists? dest-db))) ;; use copy to get going - (file-copy src-db dest-db)) (let ((res (dbmod:db-to-db-sync src-db dest-db 0 (dbfile:db-init-proc) keys))) - ;; (common:simple-file-release-lock lockfile) (if res (debug:print 0 *default-log-port* "Synced " res " records from "src-db" to "dest-db) (debug:print 0 *default-log-port* "No sync due to permissions or non-existant source db.")))) (debug:print 0 *default-log-port* "Skipping sync, there is a sync in progress.")) (set! *didsomething* #t))