Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -243,11 +243,19 @@ (if (dboard:common-get-tabdat commondat tab-num: tab-num) ;; only update if there is a tabdat (let* ((tnum (or tab-num (dboard:commondat-curr-tab-num commondat))) (updaters (hash-table-ref/default (dboard:commondat-updaters commondat) tnum '()))) - (if *updaters-running* + (debug:print 4 *default-log-port* "Found these updaters: " updaters " for tab-num: " tnum) + (for-each ;; perform the function calls for the complete updaters list + (lambda (updater) + ;; (debug:print 3 *default-log-port* "Running " updater) + (updater)) + updaters)))) + + + #;(if *updaters-running* (debug:print 0 *default-log-port* "updaters still running.") (let* ((th1 (make-thread (lambda () (debug:print 4 *default-log-port* "Found these updaters: " updaters " for tab-num: " tnum) (for-each ;; perform the function calls for the complete updaters list (lambda (updater) @@ -283,11 +291,12 @@ (set! *updaters-running* #t) (thread-start! th1) (thread-sleep! 0.1) (thread-start! th2) (thread-join! th1) - (set! *updaters-running* #f)))))) +(set! *updaters-running* #f))) + ;; if tab-num passed in then use it, otherwise look in commondat at curr-tab-num ;; adds the updater passed in the updaters list at that hashkey ;; (define (dboard:commondat-add-updater commondat updater #!key (tab-num #f)) Index: dbmod.scm ================================================================== --- dbmod.scm +++ dbmod.scm @@ -222,19 +222,21 @@ (dbr:dbstruct-dbfname-set! dbstruct dbfname) (dbr:dbstruct-sync-proc-set! dbstruct (lambda (last-update) (if *sync-in-progress* (debug:print 3 *default-log-port* "WARNING: overlapping calls to sync to disk") - (begin - (mutex-lock! *db-with-db-mutex*) ;; this mutex is used when overloaded or during a query that modifies the db - (set! *sync-in-progress* #t) - #;(dbmod:sync-gasket tables last-update inmem db - dbfullname syncdir) - (system (conc "megatest -db2db -from "tmpdb" -to "dbfullname"&")) - (mutex-unlock! *db-with-db-mutex*) - (thread-sleep! 0.5) ;; ensure at least 1/2 second down time between sync calls - (set! *sync-in-progress* #f))))) + (thread-start! + (make-thread + (lambda () + (mutex-lock! *db-with-db-mutex*) ;; this mutex is used when overloaded or during a query that modifies the db + (set! *sync-in-progress* #t) + #;(dbmod:sync-gasket tables last-update inmem db + dbfullname syncdir) + (system (conc "megatest -db2db -from "tmpdb" -to "dbfullname)) + (mutex-unlock! *db-with-db-mutex*) + (thread-sleep! 0.5) ;; ensure at least 1/2 second down time between sync calls + (set! *sync-in-progress* #f))))))) ;; (dbmod:sync-tables tables #f db inmem) ;; (if db (dbmod:sync-gasket tables #f inmem db dbfullname 'fromdest keys) ;; ) ;; load into inmem (dbr:dbstruct-last-update-set! dbstruct (current-seconds)) ;; should this be offset back in time by one second? dbstruct)) @@ -945,8 +947,10 @@ (file-exists? dirname) (file-write-access? dirname))))) (tables (db:sync-all-tables-list keys)) (sdb (dbmod:safely-open-db src-db init-proc #t)) (ddb (dbmod:safely-open-db dest-db init-proc d-wr))) - (dbmod:sync-gasket tables last-update sdb ddb dest-db 'todest keys)))) + (dbmod:sync-gasket tables last-update sdb ddb dest-db 'todest keys)) + #f + )) ) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -284,11 +284,11 @@ -list-test-time : list time requered to complete each test in a run. It following following arguments -runname -target -dumpmode -syscheck : do some very basic checks; write access and space in tmp, home, runs, links and is $DISPLAY valid -list-waivers : dump waivers for specified target, runname, testpatt to stdout - -db2db : sync db to db, use -from and -to to specify the databases + -db2db : sync db to db, use -from, -to for dbs, -period and -timeout for continuous sync Diff report -diff-rep : generate diff report (must include -src-target, -src-runname, -target, -runname and either -diff-email or -diff-html) -src-target @@ -334,11 +334,11 @@ ":status" "-status" "-list-runs" "-testdata-csv" "-testpatt" - "--modepatt" + ;; "--modepatt" "-modepatt" "-tagexpr" "-itempatt" "-setlog" "-set-toplog" @@ -380,10 +380,12 @@ "-envcap" "-envdelta" "-setvars" "-set-state-status" "-import-sexpr" + "-period" ;; sync period in seconds + "-timeout" ;; exit sync if timeout in seconds exceeded since last change ;; move runs stuff here "-remove-keep" "-set-run-status" "-age" @@ -2579,15 +2581,18 @@ (if (and src-db dest-db) (begin (debug:print-info 0 *default-log-port* "Attempting to sync data from "src-db" to "dest-db"...") ;; (if (common:simple-file-lock lockfile) ;; (begin - (if (not (file-exists? dest-db)) ;; use copy to get going + (if (and (file-exists? src-db) + (not (file-exists? dest-db))) ;; use copy to get going (file-copy src-db dest-db)) (let ((res (dbmod:db-to-db-sync src-db dest-db 0 (dbfile:db-init-proc) keys))) ;; (common:simple-file-release-lock lockfile) - (debug:print 0 *default-log-port* "Synced " res " records from "src-db" to "dest-db))) + (if res + (debug:print 0 *default-log-port* "Synced " res " records from "src-db" to "dest-db) + (debug:print 0 *default-log-port* "No sync due to permissions or non-existant source db.")))) (debug:print 0 *default-log-port* "Skipping sync, there is a sync in progress.")) (set! *didsomething* #t)) (debug:print 0 *default-log-port* "Usage for -db2db; -to and -from must be specified")) (if (args:get-arg "-list-test-time")