Megatest

Check-in [85ebde8764]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:changed more cases of .megatest to .mtdb
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80
Files: files | file ages | folders
SHA1: 85ebde8764f6782997e1254b33a72cc39efeac59
User & Date: mmgraham on 2023-03-27 13:06:13
Other Links: branch diff | manifest | tags
Context
2023-03-27
15:51
merged fork check-in: f7059c9604 user: mrwellan tags: v1.80
13:06
changed more cases of .megatest to .mtdb check-in: 85ebde8764 user: mmgraham tags: v1.80
2023-03-22
19:40
Changed .megatest to .mtdb in several places check-in: 332dd9df31 user: mmgraham tags: v1.80
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified common.scm from [2e8089abf6] to [79dbcf6321].

︙
610
611
612
613
614
615
616
617

618
619
620
621
622
623
624

610
611
612
613
614
615
616

617
618
619
620
621
622
623
624








-
+








;; Do NOT check if not on homehost!
;;
(define (common:exit-on-version-changed)
  (if (and *toppath*              ;; do nothing if *toppath* not yet provided
	   (common:on-homehost?))
      (if (common:api-changed?)
	  (let* ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config"))
                 (dbfile  (conc (get-environment-variable "MT_RUN_AREA_HOME") ".megatest/main.db"))
                 (dbfile  (conc (get-environment-variable "MT_RUN_AREA_HOME") ".mtdb/main.db"))
                 (read-only (not (file-write-access? dbfile)))
                 (dbstruct (db:setup #t))) ;; (db:setup-db *dbstruct-dbs* *toppath* #f))) ;;  #t)))
	    (debug:print 0 *default-log-port*
			 "WARNING: Version mismatch!\n"
			 "   expected: " (common:version-signature) "\n"
			 "   got:      " (common:get-last-run-version))
            (cond
︙
634
635
636
637
638
639
640
641

642
643
644

645
646
647
648
649
650
651

634
635
636
637
638
639
640

641
642
643

644
645
646
647
648
649
650
651








-
+


-
+








                 (print-call-chain (current-error-port))
                 (exit 1))
               (common:cleanup-db dbstruct)))
             ((not (common:file-exists? mtconf))
              (debug:print 0 *default-log-port* "   megatest.config does not exist in this area.  Cannot proceed with megatest version migration.")
              (exit 1))
             ((not (common:file-exists? dbfile))
              (debug:print 0 *default-log-port* "   .megatest/main.db does not exist in this area.  Cannot proceed with megatest version migration.")
              (debug:print 0 *default-log-port* "   .mtdb/main.db does not exist in this area.  Cannot proceed with megatest version migration.")
              (exit 1))
             ((not (eq? (current-user-id)(file-owner mtconf)))
              (debug:print 0 *default-log-port* "   You do not own .megatest/main.db in this area.  Cannot proceed with megatest version migration.")
              (debug:print 0 *default-log-port* "   You do not own .mtdb/main.db in this area.  Cannot proceed with megatest version migration.")
              (exit 1))
             (read-only
              (debug:print 0 *default-log-port* "   You have read-only access to this area.  Cannot proceed with megatest version migration.")
              (exit 1))
             (else
              (debug:print 0 *default-log-port* " to switch versions you can run: \"megatest -cleanup-db\"")
              (exit 1)))))))
︙
966
967
968
969
970
971
972
973
974


975
976
977
978


979
980
981
982
983
984
985

966
967
968
969
970
971
972


973
974
975
976


977
978
979
980
981
982
983
984
985








-
-
+
+


-
-
+
+








					  (string-translate toppath "/" "."))
				    (conc "/tmp/" (current-process-id) ;; just in case we have an issue with the dir by own user name
					  "/megatest_localdb/"
					  tsname
					  (string-translate toppath "/" "."))
				    ))))
		(set! *db-cache-path* dbpath)
		;; ensure megatest area has .megatest
		(let ((dbarea (conc *toppath* "/.megatest")))
		;; ensure megatest area has .mtdb
		(let ((dbarea (conc *toppath* "/.mtdb")))
		  (if (not (file-exists? dbarea))
		      (create-directory dbarea)))
		;; ensure tmp area has .megatest
		(let ((dbarea (conc dbpath "/.megatest")))
		;; ensure tmp area has .mtdb
		(let ((dbarea (conc dbpath "/.mtdb")))
		  (if (not (file-exists? dbarea))
		      (create-directory dbarea)))
		dbpath))
	  #f)))

(define (common:get-area-path-signature)
  (message-digest-string (md5-primitive) *toppath*))
︙

Modified dashboard.scm from [7b2a364846] to [6f0f8b33f8].

︙
3908
3909
3910
3911
3912
3913
3914
3915

3916
3917
3918
3919
3920
3921
3922

3908
3909
3910
3911
3912
3913
3914

3915
3916
3917
3918
3919
3920
3921
3922








-
+









(define last-copy-time 0)


;; Sync to tmp only if in read-only mode.

(define (sync-db-to-tmp tabdat)
  (let* ((db-file "./.megatest/main.db"))
  (let* ((db-file "./.mtdb/main.db"))
    (if (and (not (file-write-access? db-file)) ( > (current-seconds) (+ last-copy-time 5)))
      (begin
        (db:multi-db-sync (db:setup #f) 'old2new)
        (set! last-copy-time (current-seconds))
      )
    )
  )
︙

Modified db.scm from [7db3e81d62] to [e59fcb4590].

︙
495
496
497
498
499
500
501
502

503
504
505
506
507
508
509
510
511

512
513
514
515
516
517
518

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")))
;;     (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*"/.megatest/"fname)) ;; fulln is nfs db name
;; 	      (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

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"))
	(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

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
			;; 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))
︙

This page was generated in about 0.115s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00