Megatest

Check-in [f7059c9604]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:merged fork
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80
Files: files | file ages | folders
SHA1: f7059c96042b7c6356f7876b78b25999c0d1ac54
User & Date: mrwellan on 2023-03-27 15:51:37
Other Links: branch diff | manifest | tags
Context
2023-03-27
18:15
Lots of proper use of debugprint and mtargs plus some small cleanup. check-in: 7060a6d776 user: mrwellan tags: v1.80
15:51
merged fork check-in: f7059c9604 user: mrwellan tags: v1.80
15:49
Removed use of margs check-in: fba5bad548 user: mrwellan tags: v1.80
13:06
changed more cases of .megatest to .mtdb check-in: 85ebde8764 user: mmgraham tags: v1.80
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified common.scm from [292fdff8ab] to [7127d3c740].

︙
613
614
615
616
617
618
619
620

621
622
623
624
625
626
627

613
614
615
616
617
618
619

620
621
622
623
624
625
626
627








-
+








;; 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
︙
637
638
639
640
641
642
643
644

645
646
647

648
649
650
651
652
653
654

637
638
639
640
641
642
643

644
645
646

647
648
649
650
651
652
653
654








-
+


-
+








                 (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)))))))
︙
969
970
971
972
973
974
975
976
977


978
979
980
981


982
983
984
985
986
987
988

969
970
971
972
973
974
975


976
977
978
979


980
981
982
983
984
985
986
987
988








-
-
+
+


-
-
+
+








					  (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 [f5f3453a81] to [7b9e490b60].

︙
3910
3911
3912
3913
3914
3915
3916
3917

3918
3919
3920
3921
3922
3923
3924

3910
3911
3912
3913
3914
3915
3916

3917
3918
3919
3920
3921
3922
3923
3924








-
+









(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 [d7403f29d1] to [65ef661a4e].

︙
497
498
499
500
501
502
503
504

505
506
507
508
509
510
511
512
513

514
515
516
517
518
519
520

497
498
499
500
501
502
503

504
505
506
507
508
509
510
511
512

513
514
515
516
517
518
519
520








-
+








-
+








	 (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))
︙
599
600
601
602
603
604
605
606

607
608
609
610
611
612
613

599
600
601
602
603
604
605

606
607
608
609
610
611
612
613








-
+








	 (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))
︙
639
640
641
642
643
644
645
646

647
648
649
650
651
652
653

639
640
641
642
643
644
645

646
647
648
649
650
651
652
653








-
+








		 (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.14s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00