495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
|
(get-mtime wal-file)
(get-mtime shm-file))))
;; (define (db:all-db-sync dbstruct)
;; (let* ((dbdat (db:open-db dbstruct #f db:initialize-main-db))
;; (data-synced 0) ;; count of changed records
;; (tmp-area (common:get-db-tmp-area))
;; (dbfiles (glob (conc tmp-area"/.megatest/*.db")))
;; (sync-durations (make-hash-table))
;; (no-sync-db (db:open-no-sync-db)))
;; (for-each
;; (lambda (file) ;; tmp db file
;; (debug:print-info 3 *default-log-port* "file: " file)
;; (let* ((fname (conc (pathname-file file) ".db")) ;; fname is tmp db file
;; (wal-file (conc fname "-wal"))
;; (shm-file (conc fname "-shm"))
;; (fulln (conc *toppath*"/.megatest/"fname)) ;; fulln is nfs db name
;; (wal-time (if (file-exists? wal-file)
;; (file-modification-time wal-file)
;; 0))
;; (shm-time (if (file-exists? shm-file)
;; (file-modification-time shm-file)
;; 0))
;; (time1 (db:get-sqlite3-mod-time file))
|
|
|
|
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
|
(get-mtime wal-file)
(get-mtime shm-file))))
;; (define (db:all-db-sync dbstruct)
;; (let* ((dbdat (db:open-db dbstruct #f db:initialize-main-db))
;; (data-synced 0) ;; count of changed records
;; (tmp-area (common:get-db-tmp-area))
;; (dbfiles (glob (conc tmp-area"/.mtdb/*.db")))
;; (sync-durations (make-hash-table))
;; (no-sync-db (db:open-no-sync-db)))
;; (for-each
;; (lambda (file) ;; tmp db file
;; (debug:print-info 3 *default-log-port* "file: " file)
;; (let* ((fname (conc (pathname-file file) ".db")) ;; fname is tmp db file
;; (wal-file (conc fname "-wal"))
;; (shm-file (conc fname "-shm"))
;; (fulln (conc *toppath*"/,mtdb/"fname)) ;; fulln is nfs db name
;; (wal-time (if (file-exists? wal-file)
;; (file-modification-time wal-file)
;; 0))
;; (shm-time (if (file-exists? shm-file)
;; (file-modification-time shm-file)
;; 0))
;; (time1 (db:get-sqlite3-mod-time file))
|
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
|
(keys (db:get-keys dbstruct))
(sync-durations (make-hash-table)))
;; kill servers
(if killservers (db:kill-servers))
(if (not dbfiles)
(debug:print-error 0 *default-log-port* "no dbfiles found in " (conc *toppath* "/.megatest"))
(for-each
(lambda (srcfile)
(debug:print-info 3 *default-log-port* "file: " srcfile)
(let* ((fname (conc (pathname-file srcfile) ".db"))
(basename (pathname-file srcfile))
(run-id (if (string= basename "main") #f (string->number basename)))
(destfile (conc dest-area "/.mtdb/" fname))
|
|
|
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
|
(keys (db:get-keys dbstruct))
(sync-durations (make-hash-table)))
;; kill servers
(if killservers (db:kill-servers))
(if (not dbfiles)
(debug:print-error 0 *default-log-port* "no dbfiles found in " (conc *toppath* "/.mtdb"))
(for-each
(lambda (srcfile)
(debug:print-info 3 *default-log-port* "file: " srcfile)
(let* ((fname (conc (pathname-file srcfile) ".db"))
(basename (pathname-file srcfile))
(run-id (if (string= basename "main") #f (string->number basename)))
(destfile (conc dest-area "/.mtdb/" fname))
|
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
|
(let* ((start-time (current-milliseconds))
;; subdb is misnamed - should be dbdat (I think...)
(subdb (dbfile:open-db dbstruct run-id dbfile:db-init-proc))
;; (or (dbfile:get-subdb dbstruct run-id)
;; (dbfile:init-subdb dbstruct run-id dbfile:db-init-proc)))
(mtdb (dbr:subdb-mtdbdat subdb))
;;
;; BUG: -mrw- I think this next line is wrong. run-id should be the path to .megatest/<runid>.db
;;
(tmpdb (dbfile:open-db dbstruct run-id dbfile:db-init-proc)))
(debug:print-info 2 *default-log-port* "delta syncing file: " srcfile ", time diff: " (- time1 time2) " seconds")
(if old2new
(begin
(if dejunk (db:clean-up run-id mtdb))
|
|
|
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
|
(let* ((start-time (current-milliseconds))
;; subdb is misnamed - should be dbdat (I think...)
(subdb (dbfile:open-db dbstruct run-id dbfile:db-init-proc))
;; (or (dbfile:get-subdb dbstruct run-id)
;; (dbfile:init-subdb dbstruct run-id dbfile:db-init-proc)))
(mtdb (dbr:subdb-mtdbdat subdb))
;;
;; BUG: -mrw- I think this next line is wrong. run-id should be the path to .mtdb/<runid>.db
;;
(tmpdb (dbfile:open-db dbstruct run-id dbfile:db-init-proc)))
(debug:print-info 2 *default-log-port* "delta syncing file: " srcfile ", time diff: " (- time1 time2) " seconds")
(if old2new
(begin
(if dejunk (db:clean-up run-id mtdb))
|