Megatest

Diff
Login

Differences From Artifact [999a675934]:

To Artifact [9efbc3dd89]:


39
40
41
42
43
44
45
46


47
48
49
50
51
52
53
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)
     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
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))
  (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        (glob (conc tmp-area"/.db/*.db")))
    (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 0 *default-log-port* "file: " 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)
			    (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)
		       (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