Megatest

Check-in [c5e3d3ecf6]
Login
Overview
Comment:various
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.63
Files: files | file ages | folders
SHA1: c5e3d3ecf60bb218810f381ab702fc959e98127e
User & Date: bjbarcla on 2017-02-23 15:31:08
Other Links: branch diff | manifest | tags
Context
2017-02-23
16:41
bumped version check-in: 738c84b513 user: bjbarcla tags: v1.63, v1.6309
15:31
various check-in: c5e3d3ecf6 user: bjbarcla tags: v1.63
14:38
fixed read-only db init issue check-in: 9a5aabe821 user: bjbarcla tags: v1.63
Changes

Modified dashboard.scm from [15e4a69d2f] to [d0bd66aa0d].

114
115
116
117
118
119
120
121
122
123
124




125
126
127
128
129
130
131
114
115
116
117
118
119
120




121
122
123
124
125
126
127
128
129
130
131







-
-
-
-
+
+
+
+








;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
;;;(if (file-write-access? (conc *toppath* "/megatest.db"))
;;(debug:print-info 13 *default-log-port* "Before common:watchdog spawn")
(thread-start! (make-thread common:watchdog "Watchdog thread"))
;;(debug:print-info 13 *default-log-port* "After common:watchdog spawn")
(if (not (args:get-arg "-use-db-cache"))
    (begin
      (debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db")
      (hash-table-set! args:arg-hash "-use-db-cache" #t)));;;)
;; (if (not (args:get-arg "-use-db-cache"))
;;     (begin
;;       (debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db")
;;       (hash-table-set! args:arg-hash "-use-db-cache" #t)));;;)

;; data common to all tabs goes here
;;
(defstruct dboard:commondat
  ((curr-tab-num 0) : number)
  please-update  
  tabdats

Modified db.scm from [de4d95a6b2] to [08ea3af600].

302
303
304
305
306
307
308
309

310
311
312
313

314
315
316
317
318
319
320
302
303
304
305
306
307
308

309
310
311
312

313
314
315
316
317
318
319
320







-
+



-
+







          (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb) ;; olddb is already a (cons db path)
          (dbr:dbstruct-refndb-set! dbstruct refndb)
          ;;	    (mutex-unlock! *rundb-mutex*)
          (if (or (not dbfexists)
                  (and modtimedelta
                       (> modtimedelta 10))) ;; if db in tmp is over ten seconds older than the file in MTRA then do a sync back
	      (begin
		(debug:print 0 *default-log-port* "filling db " (db:dbdat-get-path tmpdb) " with data \n    from " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta)
		(debug:print 4 *default-log-port* "filling db " (db:dbdat-get-path tmpdb) " with data \n    from " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta)
		(db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb refndb tmpdb)
                (debug:print-info 13 *default-log-port* "db:sync-all-tables-list done.")
                )
	      (debug:print 0 *default-log-port* " db, " (db:dbdat-get-path tmpdb) " already exists or fresh enough, not propogating data from\n     " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta) )
	      (debug:print 4 *default-log-port* " db, " (db:dbdat-get-path tmpdb) " already exists or fresh enough, not propogating data from\n     " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta) )
	  ;; (db:multi-db-sync dbstruct 'old2new))  ;; migrate data from megatest.db automatically
          tmpdb))))

;; 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. 
;;

Modified megatest.scm from [c7c22f31b6] to [6e7b72b955].

900
901
902
903
904
905
906
907


908
909
910
911
912
913
914
900
901
902
903
904
905
906

907
908
909
910
911
912
913
914
915







-
+
+







       ((string=? (args:get-arg "-dumpmode") "json")
	(json-write data))
       ((string=? (args:get-arg "-dumpmode") "ini")
	(configf:config->ini data))
       (else
	(debug:print-error 0 *default-log-port* "-dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
      (set! *didsomething* #t)
      (pop-directory)))
      (pop-directory)
      (set! *time-to-exit* #t)))

(if (args:get-arg "-show-cmdinfo")
    (if (or (args:get-arg ":value")(getenv "MT_CMDINFO"))
	(let ((data (common:read-encoded-string (or (args:get-arg ":value")(getenv "MT_CMDINFO")))))
	  (if (equal? (args:get-arg "-dumpmode") "json")
	      (json-write data)
	      (pp data))