Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -135,10 +135,11 @@ (let* ((dbpath (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db")) (dbexists (file-exists? dbpath)) (inmem (if local #f (db:open-inmem-db))) (refdb (if local #f (db:open-inmem-db))) (db (sqlite3:open-database dbpath)) + (olddb (db:open-megatest-db)) (write-access (file-write-access? dbpath)) (handler (make-busy-timeout 136000))) (if (and dbexists (not write-access)) (set! *db-write-access* #f)) ;; only unset so other db's also can use this control (if write-access @@ -154,10 +155,11 @@ )) ;; add strings db to rundb, not in use yet (sqlite3:set-busy-handler! db handler) (sqlite3:execute db "PRAGMA synchronous = 1;"))) ;; was 0 but 0 is a gamble (dbr:dbstruct-set-rundb! dbstruct db) (dbr:dbstruct-set-inuse! dbstruct #t) + (dbr:dbstruct-set-olddb! dbstruct olddb) (if local (begin (dbr:dbstruct-set-localdb! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! dbstruct db) ;; direct access ... db) (begin @@ -179,10 +181,11 @@ ;; (if (not (directory-exists? dbdir)) ;; (create-direcory dbdir)) ;; (conc *toppath* "/db/main.db"))) (dbexists (file-exists? dbpath)) (db (sqlite3:open-database dbpath)) + (olddb (db:open-megatest-db)) (write-access (file-write-access? dbpath)) (handler (make-busy-timeout 136000))) (if (and dbexists (not write-access)) (set! *db-write-access* #f)) (if write-access @@ -190,10 +193,11 @@ (sqlite3:set-busy-handler! db handler) (sqlite3:execute db "PRAGMA synchronous = 0;"))) (if (not dbexists) (db:initialize-main-db db)) (dbr:dbstruct-set-main! dbstruct db) + (dbr:dbstruct-set-olddb! dbstruct olddb) db)))) ;; Make the dbstruct, setup up auxillary db's and call for main db at least once ;; (define (db:setup run-id #!key (local #f)) @@ -220,41 +224,43 @@ (begin (db:initialize-main-db db) (db:initialize-run-id-db db))) db)) -;; sync all touched runs to disk -;; -(define (db:sync-touched dbstruct #!key (force-sync #f)) - (let ((tot-synced 0)) - (for-each - (lambda (runvec) - (let ((mtime (vector-ref runvec (dbr:dbstruct-field-name->num 'mtime))) - (stime (vector-ref runvec (dbr:dbstruct-field-name->num 'stime))) - (rundb (vector-ref runvec (dbr:dbstruct-field-name->num 'rundb))) - (inmem (vector-ref runvec (dbr:dbstruct-field-name->num 'inmem))) - (refdb (vector-ref runvec (dbr:dbstruct-field-name->num 'refdb)))) - (if (or (> mtime stime) force-sync) - (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb))) - (set! tot-synced (+ tot-synced num-synced)) - (vector-set! runvec (dbr:dbstruct-field-name->num 'stime) (current-milliseconds)))))) - (hash-table-values (vector-ref dbstruct 1))) - tot-synced)) +;; ;; sync all touched runs to disk +;; ;; +;; (define (db:sync-touched dbstruct #!key (force-sync #f)) +;; (let ((tot-synced 0)) +;; (for-each +;; (lambda (runvec) +;; (let ((mtime (vector-ref runvec (dbr:dbstruct-field-name->num 'mtime))) +;; (stime (vector-ref runvec (dbr:dbstruct-field-name->num 'stime))) +;; (rundb (vector-ref runvec (dbr:dbstruct-field-name->num 'rundb))) +;; (inmem (vector-ref runvec (dbr:dbstruct-field-name->num 'inmem))) +;; (refdb (vector-ref runvec (dbr:dbstruct-field-name->num 'refdb))) +;; (slave (vector-ref runvec (dbr:dbstruct-field-name->num 'slavedb)))) +;; (if (or (> mtime stime) force-sync) +;; (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb))) +;; (set! tot-synced (+ tot-synced num-synced)) +;; (vector-set! runvec (dbr:dbstruct-field-name->num 'stime) (current-milliseconds)))))) +;; (hash-table-values (vector-ref dbstruct 1))) +;; tot-synced)) ;; sync run to disk if touched ;; (define (db:sync-touched dbstruct #!key (force-sync #f)) (let ((mtime (dbr:dbstruct-get-mtime dbstruct)) (stime (dbr:dbstruct-get-stime dbstruct)) (rundb (dbr:dbstruct-get-rundb dbstruct)) (inmem (dbr:dbstruct-get-inmem dbstruct)) - (refdb (dbr:dbstruct-get-refdb dbstruct))) + (refdb (dbr:dbstruct-get-refdb dbstruct)) + (olddb (dbr:dbstruct-get-olddb dbstruct))) (if (or (not (number? mtime)) (not (number? stime)) (> mtime stime) force-sync) - (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb))) + (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb slavedb olddb))) (dbr:dbstruct-set-stime! dbstruct (current-milliseconds)) num-synced) 0))) ;; close all opened run-id dbs Index: db_records.scm ================================================================== --- db_records.scm +++ db_records.scm @@ -25,10 +25,11 @@ (define-inline (dbr:dbstruct-get-rtime vec) (vector-ref vec 7)) (define-inline (dbr:dbstruct-get-stime vec) (vector-ref vec 8)) (define-inline (dbr:dbstruct-get-inuse vec) (vector-ref vec 9)) (define-inline (dbr:dbstruct-get-refdb vec) (vector-ref vec 10)) (define-inline (dbr:dbstruct-get-locdbs vec) (vector-ref vec 11)) +(define-inline (dbr:dbstruct-get-olddb vec) (vector-ref vec 12)) (define-inline (dbr:dbstruct-set-main! vec val)(vector-set! vec 0 val)) (define-inline (dbr:dbstruct-set-strdb! vec val)(vector-set! vec 1 val)) (define-inline (dbr:dbstruct-set-path! vec val)(vector-set! vec 2 val)) (define-inline (dbr:dbstruct-set-local! vec val)(vector-set! vec 3 val)) @@ -38,15 +39,16 @@ (define-inline (dbr:dbstruct-set-rtime! vec val)(vector-set! vec 7 val)) (define-inline (dbr:dbstruct-set-stime! vec val)(vector-set! vec 8 val)) (define-inline (dbr:dbstruct-set-inuse! vec val)(vector-set! vec 9 val)) (define-inline (dbr:dbstruct-set-refdb! vec val)(vector-set! vec 10 val)) (define-inline (dbr:dbstruct-set-locdbs! vec val)(vector-set! vec 11 val)) +(define-inline (dbr:dbstruct-set-olddb! vec val)(vector-set! vec 12 val)) ;; constructor for dbstruct ;; (define (make-dbr:dbstruct #!key (path #f)(local #f)) - (let ((v (make-vector 12 #f))) + (let ((v (make-vector 13 #f))) (dbr:dbstruct-set-path! v path) (dbr:dbstruct-set-local! v local) (dbr:dbstruct-set-locdbs! v (make-hash-table)) v))