798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
|
798
799
800
801
802
803
804
805
806
807
808
809
810
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;"))
(define *global-db-store* (make-hash-table))
(define (db:get-access-mode)
(if (args:get-arg "-use-db-cache") 'cached 'rmt))
;; Add db direct
;;
(define (db:dispatch-query access-mode rmt-cmd db-cmd . params)
(if (eq? access-mode 'cached)
(apply db:call-with-cached-db db-cmd params)
(apply rmt-cmd params)))
;; return the target db handle so it can be used
;;
(define (db:cache-for-read-only source target #!key (use-last-update #f))
(common:sync-to-megatest.db #t) ;; BUG!! DON'T LEAVE THIS HERE!
(if (and (hash-table-ref/default *global-db-store* target #f)
(>= (file-modification-time target)(file-modification-time source)))
(hash-table-ref *global-db-store* target)
(let* ((toppath (launch:setup))
(targ-db-last-mod (if (file-exists? target)
(file-modification-time target)
0))
|
849
850
851
852
853
854
855
856
857
858
859
860
861
862
|
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
|
+
|
;;
;; 'killservers - kills all servers
;; 'dejunk - removes junk records
;; 'adj-testids - move test-ids into correct ranges
;; 'old2new - sync megatest.db records to .db/{main,1,2 ...}.db
;; 'new2old - sync .db/{main,1,2,3 ...}.db to megatest.db
;; 'closeall - close all opened dbs
;; 'schema - attempt to apply schema changes
;;
;; 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)))
|
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
|
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
|
+
-
-
-
-
+
+
+
+
|
(map
(lambda (run-id)
(thread-start!
(make-thread
(lambda ()
(let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
(frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
(if (member 'schema options)
(if (eq? run-id 0)
(let ((maindb (db:dbdat-get-db (db:get-db fromdb #f))))
(db:patch-schema-maindb run-id maindb))
(db:patch-schema-rundb run-id frundb)))
(if (eq? run-id 0)
(let ((maindb (db:dbdat-get-db (db:get-db fromdb #f))))
(db:patch-schema-maindb run-id maindb))
(db:patch-schema-rundb run-id frundb))))
(set! count (+ count 1))
(debug:print 0 *default-log-port* "Finished patching schema for " (if (eq? run-id 0) " main.db " (conc run-id ".db")) ", " count " of " total)))))
all-run-ids))
;; Then sync and fix db's
(set! count 0)
(process-fork
(lambda ()
|