Megatest

Check-in [be8e6a1b38]
Login
Overview
Comment:Changed .db directories to .megatest
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.70 | v1.7003
Files: files | file ages | folders
SHA1: be8e6a1b381dc6ec12732ed3eb96ac864a6ed2aa
User & Date: mmgraham on 2022-06-10 23:36:27
Other Links: branch diff | manifest | tags
Context
2022-06-13
17:44
Got pgdb sync working by querying for test related data in the correct dbs, passing the test ids, test_step ids and test_data ids as pairs with the run-id, and adding run-id to a few test data query functions. check-in: 6fb02466de user: mmgraham tags: v1.70
2022-06-10
23:36
Changed .db directories to .megatest check-in: be8e6a1b38 user: mmgraham tags: v1.70, v1.7003
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
Changes

Modified common.scm from [fda00ca967] to [a70e001edf].

935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
					  (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 .db
		(let ((dbarea (conc *toppath* "/.db")))
		  (if (not (file-exists? dbarea))
		      (create-directory dbarea)))
		;; ensure tmp area has .db
		(let ((dbarea (conc dbpath "/.db")))
		  (if (not (file-exists? dbarea))
		      (create-directory dbarea)))
		dbpath))
	  #f)))

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







|
|


|
|







935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
					  (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")))
		  (if (not (file-exists? dbarea))
		      (create-directory dbarea)))
		;; ensure tmp area has .megatest
		(let ((dbarea (conc dbpath "/.megatest")))
		  (if (not (file-exists? dbarea))
		      (create-directory dbarea)))
		dbpath))
	  #f)))

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

Modified db.scm from [9efbc3dd89] to [624e4507df].

649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670



(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"/.db/*.db")))
    (sync-durations (make-hash-table))
    (no-sync-db        (db:open-no-sync-db)))
    (for-each
     (lambda (file)
       (debug:print-info 3 *default-log-port* "file: " file)
       (let* ((fname (conc (pathname-file file) ".db"))
	      (fulln (conc *toppath*"/.db/"fname))
	      (time1 (if (file-exists? file)
			 (file-modification-time file)
			 (begin
			   (debug:print-info 0 *default-log-port* "Sync - I do not see file "file)
			   1)))
	      (time2 (if (file-exists? fulln)
			 (file-modification-time fulln)







|






|







649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670



(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")))
    (sync-durations (make-hash-table))
    (no-sync-db        (db:open-no-sync-db)))
    (for-each
     (lambda (file)
       (debug:print-info 3 *default-log-port* "file: " file)
       (let* ((fname (conc (pathname-file file) ".db"))
	      (fulln (conc *toppath*"/.megatest/"fname))
	      (time1 (if (file-exists? file)
			 (file-modification-time file)
			 (begin
			   (debug:print-info 0 *default-log-port* "Sync - I do not see file "file)
			   1)))
	      (time2 (if (file-exists? fulln)
			 (file-modification-time fulln)
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
(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)







|









|
|







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
(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* "/.megatest/*.db")) (glob (conc tmp-area "/.megatest/*.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 "/.megatest/" fname))
              (dest-directory  (conc dest-area "/.megatest/"))
              (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)
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
	  #f
        ))))

;; sync for filesystem local db writes
;;
(define (db:run-lock-and-sync no-sync-db)
  (let* ((tmp-area       (common:get-db-tmp-area))
	 (dbfiles        (glob (conc tmp-area"/.db/*.db")))
	 (sync-durations (make-hash-table)))
    ;; (debug:print-info 0 *default-log-port* "lock-and-sync, dbfiles: "dbfiles)
    (for-each
     (lambda (file)
       (let* ((fname (conc (pathname-file file) ".db"))
	      (fulln (conc *toppath*"/.db/"fname))
	      (time1 (if (file-exists? file)
			 (file-modification-time file)
			 (begin
			   (debug:print-info 0 *default-log-port* "Sync - I do not see file "file)
			   1)))
	      (time2 (if (file-exists? fulln)
			 (file-modification-time fulln)







|





|







4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
	  #f
        ))))

;; sync for filesystem local db writes
;;
(define (db:run-lock-and-sync no-sync-db)
  (let* ((tmp-area       (common:get-db-tmp-area))
	 (dbfiles        (glob (conc tmp-area"/.megatest/*.db")))
	 (sync-durations (make-hash-table)))
    ;; (debug:print-info 0 *default-log-port* "lock-and-sync, dbfiles: "dbfiles)
    (for-each
     (lambda (file)
       (let* ((fname (conc (pathname-file file) ".db"))
	      (fulln (conc *toppath*"/.megatest/"fname))
	      (time1 (if (file-exists? file)
			 (file-modification-time file)
			 (begin
			   (debug:print-info 0 *default-log-port* "Sync - I do not see file "file)
			   1)))
	      (time2 (if (file-exists? fulln)
			 (file-modification-time fulln)

Modified dbfile.scm from [476e5e812e] to [2cf29f02a0].

57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
  (read-only #f)
  (subdbs (make-hash-table))
  )

;; NOTE: Need one dbr:subdb per main.db, 1.db ...
;;
(defstruct dbr:subdb
  (dbname      #f) ;; .db/1.db
  (mtdbfile    #f) ;; mtrah/.db/1.db
  (mtdbdat     #f) ;; only need one of these for syncing
  ;; (dbdats      (make-hash-table))  ;; id => dbdat 
  (tmpdbfile   #f) ;; /tmp/.../.db/1.db
  ;; (refndbfile  #f) ;; /tmp/.../.db/1.db_ref
  (dbstack     (make-stack)) ;; stack for tmp dbr:dbdat,
  (homehost    #f) ;; not used yet
  (on-homehost #f) ;; not used yet
  (read-only   #f)
  (last-sync   0)
  (last-write  (current-seconds))
  )                ;; goal is to converge on one struct for an area but for now it is too confusing







|
|


|
|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
  (read-only #f)
  (subdbs (make-hash-table))
  )

;; NOTE: Need one dbr:subdb per main.db, 1.db ...
;;
(defstruct dbr:subdb
  (dbname      #f) ;; .megatest/1.db
  (mtdbfile    #f) ;; mtrah/.megatest/1.db
  (mtdbdat     #f) ;; only need one of these for syncing
  ;; (dbdats      (make-hash-table))  ;; id => dbdat 
  (tmpdbfile   #f) ;; /tmp/.../.megatest/1.db
  ;; (refndbfile  #f) ;; /tmp/.../.megatest/1.db_ref
  (dbstack     (make-stack)) ;; stack for tmp dbr:dbdat,
  (homehost    #f) ;; not used yet
  (on-homehost #f) ;; not used yet
  (read-only   #f)
  (last-sync   0)
  (last-write  (current-seconds))
  )                ;; goal is to converge on one struct for an area but for now it is too confusing
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
  (conc apath"/"(dbfile:run-id->dbname run-id)))

(define (db:dbname->path apath dbname)
  (conc apath"/"dbname))

(define (dbfile:run-id->dbname run-id)
  (cond
   ((number? run-id) (conc ".db/" (modulo run-id 100) ".db"))
   ((not run-id)     (conc ".db/main.db"))
   (else             run-id)))

;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
;; called in http-transport and replicated in rmt.scm for *local* access. 
;;
(define (dbfile:setup do-sync areapath tmppath)







|
|







191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
  (conc apath"/"(dbfile:run-id->dbname run-id)))

(define (db:dbname->path apath dbname)
  (conc apath"/"dbname))

(define (dbfile:run-id->dbname run-id)
  (cond
   ((number? run-id) (conc ".megatest/" (modulo run-id 100) ".db"))
   ((not run-id)     (conc ".megatest/main.db"))
   (else             run-id)))

;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
;; called in http-transport and replicated in rmt.scm for *local* access. 
;;
(define (dbfile:setup do-sync areapath tmppath)
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
	   (mtdbmodtime  (if mtdbexists (dbfile:lazy-sqlite-db-modification-time mtdbfname)  #f))
	   (mtdb         (db:open-sqlite-db mtdbfname init-proc))
	   ;; the reference db for syncing
	   (refdbfname   (conc dbpath "/"dbname"_ref"))
	   (refndb       (db:open-megatest-db refdbfname))
	   ;; (mtdbpath     (dbr:dbdat-dbfile mtdb))
	   ;; the tmpdb
	   (tmpdbfname   (conc dbpath"/"dbname)) ;; /tmp/<stuff>/.db/[main|1,2...].db 
	   (tmpdb        (db:open-megatest-db tmpdbfname)) ;; lock-create-open dbpath db:initialize-main-db))
	   (dbfexists    (common:file-exists? tmpdbfname))  ;; (conc dbpath "/megatest.db")))
	   (tmpdbmodtime (if dbfexists  (common:lazy-sqlite-db-modification-time tmpdbfname) #f))
	   
	   (write-access (file-write-access? mtdbfname))
	   
	   ;; (mtdbmodtime (if mtdbexists







|







419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
	   (mtdbmodtime  (if mtdbexists (dbfile:lazy-sqlite-db-modification-time mtdbfname)  #f))
	   (mtdb         (db:open-sqlite-db mtdbfname init-proc))
	   ;; the reference db for syncing
	   (refdbfname   (conc dbpath "/"dbname"_ref"))
	   (refndb       (db:open-megatest-db refdbfname))
	   ;; (mtdbpath     (dbr:dbdat-dbfile mtdb))
	   ;; the tmpdb
	   (tmpdbfname   (conc dbpath"/"dbname)) ;; /tmp/<stuff>/.megatest/[main|1,2...].db 
	   (tmpdb        (db:open-megatest-db tmpdbfname)) ;; lock-create-open dbpath db:initialize-main-db))
	   (dbfexists    (common:file-exists? tmpdbfname))  ;; (conc dbpath "/megatest.db")))
	   (tmpdbmodtime (if dbfexists  (common:lazy-sqlite-db-modification-time tmpdbfname) #f))
	   
	   (write-access (file-write-access? mtdbfname))
	   
	   ;; (mtdbmodtime (if mtdbexists

Modified runs.scm from [32a6ef2bce] to [2838f87e3f].

2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
	 (state-status (if (string? new-state-status) (string-split new-state-status ",") '(#f #f)))
	 (rp-mutex     (make-mutex))
	 (bup-mutex    (make-mutex))
         (keep-records (args:get-arg "-keep-records")) ;; used in conjunction with -remove-runs to keep the records, TODO: consolidate this with "mode".
	 (test-records '())) ;; for tasks that we wish to operate on all tests in one fell swoop

    (let* ((write-access-actions '(remove-runs set-state-status archive run-wait kill-runs))
           (dbfile             (conc  *toppath* "/.db/main.db"))
           (readonly-mode      (not (file-write-access? dbfile))))
      (when (and readonly-mode
                 (member action write-access-actions))
        (debug:print-error 0 *default-log-port* dbfile " is readonly.  Cannot proceed with action ["action"] in which write-access isrequired .")
        (exit 1)))
    
    (debug:print-info 4 *default-log-port* "runs:operate-on => Header: " header " action: " action " new-state-status: " new-state-status)







|







2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
	 (state-status (if (string? new-state-status) (string-split new-state-status ",") '(#f #f)))
	 (rp-mutex     (make-mutex))
	 (bup-mutex    (make-mutex))
         (keep-records (args:get-arg "-keep-records")) ;; used in conjunction with -remove-runs to keep the records, TODO: consolidate this with "mode".
	 (test-records '())) ;; for tasks that we wish to operate on all tests in one fell swoop

    (let* ((write-access-actions '(remove-runs set-state-status archive run-wait kill-runs))
           (dbfile             (conc  *toppath* "/.megatest/main.db"))
           (readonly-mode      (not (file-write-access? dbfile))))
      (when (and readonly-mode
                 (member action write-access-actions))
        (debug:print-error 0 *default-log-port* dbfile " is readonly.  Cannot proceed with action ["action"] in which write-access isrequired .")
        (exit 1)))
    
    (debug:print-info 4 *default-log-port* "runs:operate-on => Header: " header " action: " action " new-state-status: " new-state-status)

Modified utils/mt-new-to-old.sh from [ae5555fb0a] to [09b9e5e09c].

1
2
3
4
5
6
7
8
#!/bin/bash 

cp .db/main.db megatest.db

for db in $(ls .db/?.db); do
  echo $db
  sqlite3 $db "SELECT * FROM tests" | sqlite3 megatest.db ".import /dev/stdin tests"
done


|

|



1
2
3
4
5
6
7
8
#!/bin/bash 

cp .megatest/main.db megatest.db

for db in $(ls .megatest/?.db); do
  echo $db
  sqlite3 $db "SELECT * FROM tests" | sqlite3 megatest.db ".import /dev/stdin tests"
done

Modified utils/mt-old-to-new.sh from [891011889e] to [0e59c08737].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
#!/bin/bash 

mkdir -p .db
cp megatest.db .db/main.db
sqlite3 .db/main.db << END_SQL
delete from tests; 
delete from test_steps;
END_SQL
version_id=$(sqlite3 .db/main.db "select id from metadat where var = 'MEGATEST_VERSION'")
current_version=$(megatest -version)
sqlite3 .db/main.db "replace into metadat (id,var,val) values($version_id,'MEGATEST_VERSION','$current_version')"


sqlite3 megatest.db 'select id from runs' > runs.txt
for run in $(cat runs.txt)
do
   dbnum=$(($run%100))
   cp megatest.db .db/$dbnum.db
   sqlite3 .db/$dbnum.db  << END_SQL
   delete from tests where run_id != $run; 
   delete from test_data; 
   delete from test_meta; 
   delete from test_rundat;
   delete from test_steps where not exists ( select id from tests where tests.id = test_steps.test_id);
   replace into metadat (id,var,val) values($version_id,'MEGATEST_VERSION','$current_version');
END_SQL


|
|
|



|

|






|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
#!/bin/bash 

mkdir -p .megatest
cp megatest.db .megatest/main.db
sqlite3 .megatest/main.db << END_SQL
delete from tests; 
delete from test_steps;
END_SQL
version_id=$(sqlite3 .megatest/main.db "select id from metadat where var = 'MEGATEST_VERSION'")
current_version=$(megatest -version)
sqlite3 .megatest/main.db "replace into metadat (id,var,val) values($version_id,'MEGATEST_VERSION','$current_version')"


sqlite3 megatest.db 'select id from runs' > runs.txt
for run in $(cat runs.txt)
do
   dbnum=$(($run%100))
   cp megatest.db .megatest/$dbnum.db
   sqlite3 .megatest/$dbnum.db  << END_SQL
   delete from tests where run_id != $run; 
   delete from test_data; 
   delete from test_meta; 
   delete from test_rundat;
   delete from test_steps where not exists ( select id from tests where tests.id = test_steps.test_id);
   replace into metadat (id,var,val) values($version_id,'MEGATEST_VERSION','$current_version');
END_SQL