Megatest

Check-in [6ddbf1276a]
Login
Overview
Comment:Fixed db:multi-db-sync when /tmp dbs do not exist
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.70
Files: files | file ages | folders
SHA1: 6ddbf1276ae00b2734ff4c76827758a0c5cbb61b
User & Date: mmgraham on 2022-06-10 10:49:45
Other Links: branch diff | manifest | tags
Context
2022-06-10
20:05
Added /utils/mt-new-to-old.sh and mt-old-to-new.sh for converting megatest.db to/from main.db, 1.db etc check-in: a0a226d3f4 user: mmgraham tags: v1.70
10:49
Fixed db:multi-db-sync when /tmp dbs do not exist check-in: 6ddbf1276a user: mmgraham tags: v1.70
2022-06-08
20:09
Turn off runremote reset of 180 sec check-in: 27718f7cf5 user: matt tags: v1.70, v1.7002
Changes

Modified db.scm from [999a675934] to [9efbc3dd89].

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