︙ | | |
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
|
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
|
-
-
-
+
+
+
|
;; (db:sync-tables db:sync-tests-only db inmem)
;; (db:sync-tables db:sync-tests-only inmem refdb)
inmem)))))))
;; This routine creates the db. It is only called if the db is not already ls opened
;;
(define (db:open-main dbstruct) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let ((mdb (dbr:dbstruct-get-main dbstruct)))
(if mdb
mdb
(let ((megatest-db (dbr:dbstruct-get-main dbstruct)))
(if megatest-db
megatest-db
(begin
(mutex-lock! *rundb-mutex*)
(let* ((dbpath (db:dbfile-path 0))
(dbexists (file-exists? dbpath))
(db (db:lock-create-open dbpath db:initialize-main-db))
(olddb (db:open-megatest-db))
(write-access (file-write-access? dbpath))
|
︙ | | |
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
|
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
|
-
-
-
+
+
+
-
+
|
(let ((maindb (dbr:dbstruct-get-main dbstruct)))
(if maindb
(begin
(sqlite3:finalize! (db:dbdat-get-db maindb))
(dbr:dbstruct-set-main! dbstruct #f)))))
(define (db:close-run-db dbstruct run-id)
(let ((rdb (db:open-rundb dbstruct run-id do-not-open: #t)))
(if (and rdb
(sqlite3:database? rdb))
(let ((run-db (db:open-rundb dbstruct run-id do-not-open: #t)))
(if (and run-db
(sqlite3:database? run-db))
(begin
(sqlite3:finalize! rdb)
(sqlite3:finalize! run-db)
(dbr:dbstruct-set-localdb! dbstruct run-id #f)
(dbr:dbstruct-set-inmem! dbstruct #f)))))
;; close all opened run-id dbs
(define (db:close-all dbstruct)
;; finalize main.db
(db:sync-touched dbstruct 0 force-sync: #t)
|
︙ | | |
703
704
705
706
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
750
751
752
753
754
755
756
757
|
703
704
705
706
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
750
751
752
753
754
755
756
757
|
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
|
;; 'closeall - close all opened dbs
;;
;; run-ids: '(1 2 3 ...) or #f (for all)
;;
(define (db:multi-db-sync run-ids . options)
(let* ((toppath (launch:setup))
(dbstruct (if toppath (make-dbr:dbstruct path: toppath) #f))
(mtdb (if toppath (db:open-megatest-db)))
(megatest-db (if toppath (db:open-megatest-db)))
(allow-cleanup (if run-ids #f #t))
(run-ids (if run-ids
run-ids
(if toppath (begin
(db:delay-if-busy mtdb)
(db:get-all-run-ids mtdb)))))
(db:delay-if-busy megatest-db)
(db:get-all-run-ids megatest-db)))))
(tdbdat (tasks:open-db))
(servers (tasks:get-all-servers (db:delay-if-busy tdbdat))))
;; kill servers
(if (member 'killservers options)
(for-each
(lambda (server)
(tasks:server-delete-record (db:delay-if-busy tdbdat) (vector-ref server 0) "dbmigration")
(tasks:kill-server (vector-ref server 2)(vector-ref server 1)))
servers))
;; clear out junk records
;;
(if (member 'dejunk options)
(begin
(db:delay-if-busy mtdb)
(db:clean-up mtdb)))
(db:delay-if-busy megatest-db)
(db:clean-up megatest-db)))
;; adjust test-ids to fit into proper range
;;
(if (member 'adj-testids options)
(begin
(db:delay-if-busy mtdb)
(db:prep-megatest.db-for-migration mtdb)))
(db:delay-if-busy megatest-db)
(db:prep-megatest.db-for-migration megatest-db)))
;; sync runs, test_meta etc.
;;
(if (member 'old2new options)
(begin
(db:sync-tables (db:sync-main-list mtdb) mtdb (db:get-db dbstruct #f))
(db:sync-tables (db:sync-main-list megatest-db) megatest-db (db:get-db dbstruct #f))
(for-each
(lambda (run-id)
(db:delay-if-busy mtdb)
(let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id))
(db:delay-if-busy megatest-db)
(let ((testrecs (db:get-all-tests-info-by-run-id megatest-db run-id))
(dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t) #f)))
(debug:print 0 *default-log-port* "INFO: Propagating " (length testrecs) " records for run-id=" run-id " to run specific db")
(db:replace-test-records dbstruct run-id testrecs)
(sqlite3:finalize! (db:dbdat-get-db (dbr:dbstruct-get-rundb dbstruct)))))
run-ids)))
;; now ensure all newdb data are synced to megatest.db
|
︙ | | |
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
|
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
|
-
+
|
(let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
(frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
;; (db:delay-if-busy frundb)
;; (db:delay-if-busy mtdb)
;; (db:clean-up frundb)
(if (eq? run-id 0)
(let ((maindb (db:dbdat-get-db (db:get-db fromdb #f))))
(db:sync-tables (db:sync-main-list dbstruct) (db:get-db fromdb #f) mtdb)
(db:sync-tables (db:sync-main-list dbstruct) (db:get-db fromdb #f) megatest-db)
(set! dead-runs (db:clean-up-maindb (db:get-db fromdb #f)))
;;
;; Feb 18, 2016: add field last_update to runs table
;;
;; remove all these some time after september 2016 (added in v1.6031
;;
(handle-exceptions
|
︙ | | |
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
|
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
|
-
+
|
BEGIN
UPDATE run_stats SET last_update=(strftime('%s','now'))
WHERE id=old.id;
END;")
)
(begin
;; NB// must sync first to ensure deleted tests get marked as such in megatest.db
(db:sync-tables db:sync-tests-only (db:get-db fromdb run-id) mtdb)
(db:sync-tables db:sync-tests-only (db:get-db fromdb run-id) megatest-db)
(db:clean-up-rundb (db:get-db fromdb run-id))
;;
;; Feb 18, 2016: add field last_update to tests, test_steps and test_data
;;
;; remove this some time after September 2016 (added in version v1.6031
;;
(for-each
|
︙ | | |
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
|
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
|
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
-
+
+
|
;; (debug:print 0 *default-log-port* "INFO: Inserting values: " (string-intersperse (map conc (vector->list rec)) ",") "\n")
(apply sqlite3:execute qry (vector->list rec)))
testrecs)))
(sqlite3:finalize! qry)))))
;; map a test-id into the proper range
;;
(define (db:adj-test-id mtdb min-test-id test-id)
(define (db:adj-test-id megatest-db min-test-id test-id)
(if (>= test-id min-test-id)
test-id
(let loop ((new-id min-test-id))
(let ((test-id-found #f))
(sqlite3:for-each-row
(lambda (id)
(set! test-id-found id))
(db:dbdat-get-db mtdb)
(db:dbdat-get-db megatest-db)
"SELECT id FROM tests WHERE id=?;"
new-id)
;; if test-id-found then need to try again
(if test-id-found
(loop (+ new-id 1))
(begin
(debug:print-info 0 *default-log-port* "New test id " new-id " selected for test with id " test-id)
(sqlite3:execute mtdb "UPDATE tests SET id=? WHERE id=?;" new-id test-id)))))))
(sqlite3:execute megatest-db "UPDATE tests SET id=? WHERE id=?;" new-id test-id)))))))
;; move test ids into the 30k * run_id range
;;
(define (db:prep-megatest.db-adj-test-ids mtdb run-id testrecs)
(define (db:prep-megatest.db-adj-test-ids megatest-db run-id testrecs)
(debug:print-info 0 *default-log-port* "Adjusting test ids in megatest.db for run " run-id)
(let ((min-test-id (* run-id 30000)))
(for-each
(lambda (testrec)
(let* ((test-id (vector-ref testrec (db:field->number "id" db:test-record-fields))))
(db:adj-test-id (db:dbdat-get-db mtdb) min-test-id test-id)))
(db:adj-test-id (db:dbdat-get-db megatest-db) min-test-id test-id)))
testrecs)))
;; 1. move test ids into the 30k * run_id range
;; 2. move step ids into the 30k * run_id range
;;
(define (db:prep-megatest.db-for-migration mtdb)
(let* ((run-ids (db:get-all-run-ids mtdb)))
(define (db:prep-megatest.db-for-migration megatest-db)
(let* ((run-ids (db:get-all-run-ids megatest-db)))
(for-each
(lambda (run-id)
(let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)))
(db:prep-megatest.db-adj-test-ids (db:dbdat-get-db mtdb) run-id testrecs)))
(let ((testrecs (db:get-all-tests-info-by-run-id megatest-db run-id)))
(db:prep-megatest.db-adj-test-ids (db:dbdat-get-db megatest-db) run-id testrecs)))
run-ids)))
;; Get test data using test_id
(define (db:get-test-info-by-id dbstruct run-id test-id)
(db:with-db
dbstruct
run-id
|
︙ | | |