Overview
Comment: | merged fork |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80 |
Files: | files | file ages | folders |
SHA1: |
f7059c96042b7c6356f7876b78b25999 |
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
Modified common.scm from [292fdff8ab] to [7127d3c740].
︙ | ︙ | |||
613 614 615 616 617 618 619 | ;; 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")) | | | 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") ".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 | (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)) | | | | 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* " .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 .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 | (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) | | | | | | 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 .mtdb (let ((dbarea (conc *toppath* "/.mtdb"))) (if (not (file-exists? dbarea)) (create-directory dbarea))) ;; 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 | (define last-copy-time 0) ;; Sync to tmp only if in read-only mode. (define (sync-db-to-tmp tabdat) | | | 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 "./.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 | (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)) | | | | 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"/.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*"/,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 | (keys (db:get-keys dbstruct)) (sync-durations (make-hash-table))) ;; kill servers (if killservers (db:kill-servers)) (if (not dbfiles) | | | 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* "/.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 | (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)) ;; | | | 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 .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)) |
︙ | ︙ |