39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
md5
message-digest
(prefix base64 base64:)
format
dot-locking
z3
typed-records
matchable)
(declare (unit db))
(declare (uses common))
(declare (uses dbmod))
;; (declare (uses debugprint))
(declare (uses dbfile))
(declare (uses keys))
|
|
>
|
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
md5
message-digest
(prefix base64 base64:)
format
dot-locking
z3
typed-records
matchable
files)
(declare (unit db))
(declare (uses common))
(declare (uses dbmod))
;; (declare (uses debugprint))
(declare (uses dbfile))
(declare (uses keys))
|
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
|
;; 'old2new - sync megatest.db to /tmp/.../megatest.db and /tmp/.../megatest_ref.db
;; 'new2old - sync /tmp/.../megatest.db to megatest.db and /tmp/.../megatest_ref.db (and update data_synced)
;; 'closeall - close all opened dbs
;; 'schema - attempt to apply schema changes
;; run-ids: '(1 2 3 ...) or #f (for all)
;;
(define (db:multi-db-sync dbstruct . options)
(let* ((dbdat (db:open-db dbstruct #f))
(data-synced 0) ;; count of changed records
(tmp-area (common:get-db-tmp-area))
(old2new (member 'old2new options))
(src-area (if old2new *toppath* tmp-area))
(dest-area (if old2new tmp-area *toppath*))
(dbfiles (glob (conc tmp-area"/.db/*.db")))
(keys (db:get-keys dbstruct))
(sync-durations (make-hash-table)))
(for-each
(lambda (srcfile)
(debug:print-info 0 *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 "/.db/" fname))
(time1 (file-modification-time srcfile))
(time2 (if (file-exists? destfile)
(file-modification-time destfile)
(begin
(debug:print-info 0 *default-log-port* "Sync - I do not see file " destfile)
0)))
(changed (> time1 time2))
(do-cp (cond
((not (file-exists? destfile)) ;; shouldn't happen, but this might recover
(debug:print-info 0 *default-log-port* "File " destfile " not found! Copying "srcfile" to "destfile)
#t)
(changed ;; (and changed
;; (> (- (current-seconds) time1) 3)) ;; if file is changed and three seconds have passed.
#t)
((and changed *time-to-exit*) ;; last sync
#t)
(else
|
|
|
|
>
>
>
>
|
>
|
>
>
|
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
|
;; 'old2new - sync megatest.db to /tmp/.../megatest.db and /tmp/.../megatest_ref.db
;; 'new2old - sync /tmp/.../megatest.db to megatest.db and /tmp/.../megatest_ref.db (and update data_synced)
;; 'closeall - close all opened dbs
;; 'schema - attempt to apply schema changes
;; run-ids: '(1 2 3 ...) or #f (for all)
;;
(define (db:multi-db-sync dbstruct . options)
(let* (;; (dbdat (db:open-db dbstruct #f dbfile:db-init-proc))
(data-synced 0) ;; count of changed records
(tmp-area (common:get-db-tmp-area))
(old2new (member 'old2new options))
(src-area (if old2new *toppath* tmp-area))
(dest-area (if old2new tmp-area *toppath*))
(dbfiles (if old2new (glob (conc *toppath* "/.db/*.db")) (glob (conc tmp-area "/.db/*.db"))))
(keys (db:get-keys dbstruct))
(sync-durations (make-hash-table)))
(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 "/.db/" fname))
(dest-directory (conc dest-area "/.db/"))
(dummy (debug:print-info 0 *default-log-port* "destfile = " destfile))
(time1 (file-modification-time srcfile))
(time2 (if (file-exists? destfile)
(begin
(debug:print-info 0 *default-log-port* "destfile " destfile " exists")
(file-modification-time destfile)
)
(begin
(debug:print-info 0 *default-log-port* "Sync - I do not see file " destfile)
0)))
(changed (> time1 time2))
(do-cp (cond
((not (file-exists? destfile)) ;; shouldn't happen, but this might recover
(debug:print-info 0 *default-log-port* "File " destfile " not found. Copying "srcfile" to "destfile)
(system (conc "/bin/mkdir -p " dest-directory))
(system (conc "/bin/cp " srcfile " " destfile))
#t)
(changed ;; (and changed
;; (> (- (current-seconds) time1) 3)) ;; if file is changed and three seconds have passed.
#t)
((and changed *time-to-exit*) ;; last sync
#t)
(else
|