Overview
Comment: | Simplified triggering of sync |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 |
Files: | files | file ages | folders |
SHA1: |
a1b0d55f2385efd02952f6c5953a1a0f |
User & Date: | mrwellan on 2014-11-14 14:04:17 |
Other Links: | branch diff | manifest | tags |
Context
2014-11-14
| ||
20:54 | streamline sync more check-in: 854b6c8345 user: matt tags: v1.60 | |
14:04 | Simplified triggering of sync check-in: a1b0d55f23 user: mrwellan tags: v1.60 | |
07:50 | Added removal of old tasks entries check-in: 9bebf08382 user: mrwellan tags: v1.60 | |
Changes
Modified megatest.scm from [027a7b81ad] to [1795fd261c].
︙ | ︙ | |||
284 285 286 287 288 289 290 | 0)) ;; The watchdog is to keep an eye on things like db sync etc. ;; (define *watchdog* (make-thread (lambda () | | < > | | | | | | | | | | | | | | < | > | | | 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 | 0)) ;; The watchdog is to keep an eye on things like db sync etc. ;; (define *watchdog* (make-thread (lambda () (thread-sleep! 0.05) ;; delay for startup (let loop () ;; sync for filesystem local db writes ;; (let ((start-time (current-seconds)) (servers-started (make-hash-table))) (for-each (lambda (run-id) (mutex-lock! *db-multi-sync-mutex*) (if (hash-table-ref/default *db-local-sync* run-id 0) ;; (if (> (- start-time last-write) 5) ;; every five seconds (let ((sync-time (- (current-seconds) start-time))) (db:multi-db-sync (list run-id) 'new2old) (if (common:low-noise-print 30 "sync new to old") (begin (debug:print-info 0 "Sync of newdb to olddb for run-id " run-id " completed in " sync-time " seconds") (if (and (> sync-time 10) ;; took more than ten seconds, start a server for this run (hash-table-ref/default servers-started run-id #f)) (begin (debug:print-info 0 "Sync is taking a long time, start up a server to assist for run " run-id) (server:kind-run run-id) (hash-table-set! servers-started run-id #t))))) (hash-table-delete! *db-local-sync* run-id))) (mutex-unlock! *db-multi-sync-mutex*)) (hash-table-keys *db-local-sync*))) ;; keep going unless time to exit ;; (if (not *time-to-exit*) (begin (thread-sleep! 1) ;; wait one second before syncing again (loop))))) "Watchdog thread")) (thread-start! *watchdog*) (define (std-exit-procedure) (rmt:print-db-stats) |
︙ | ︙ | |||
1374 1375 1376 1377 1378 1379 1380 | (begin (db:multi-db-sync #f ;; do all run-ids 'killservers 'dejunk 'adj-testids 'old2new | | | 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 | (begin (db:multi-db-sync #f ;; do all run-ids 'killservers 'dejunk 'adj-testids 'old2new ;; 'new2old ) (set! *didsomething* #t))) (if (args:get-arg "-sync-to-megatest.db") (begin (db:multi-db-sync #f ;; do all run-ids |
︙ | ︙ |
Modified rmt.scm from [79ec3bfb22] to [6409627d1a].
︙ | ︙ | |||
184 185 186 187 188 189 190 | (res (api:execute-requests dbstruct-local (symbol->string cmd) params)) (duration (- (current-milliseconds) start))) (rmt:update-db-stats run-id cmd params duration) ;; mark this run as dirty if this was a write (if (not (member cmd api:read-only-queries)) (let ((start-time (current-seconds))) (mutex-lock! *db-multi-sync-mutex*) | | > | | 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 | (res (api:execute-requests dbstruct-local (symbol->string cmd) params)) (duration (- (current-milliseconds) start))) (rmt:update-db-stats run-id cmd params duration) ;; mark this run as dirty if this was a write (if (not (member cmd api:read-only-queries)) (let ((start-time (current-seconds))) (mutex-lock! *db-multi-sync-mutex*) ;; (if (not (hash-table-ref/default *db-local-sync* run-id #f)) ;; just set it every time. Is a write more expensive than a read and does it matter? (hash-table-set! *db-local-sync* run-id start-time) ;; the oldest "write" (mutex-unlock! *db-multi-sync-mutex*))) res))) (define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params) (let* ((run-id (if run-id run-id 0)) (jparams (db:obj->string params)) ;; (rmt:dat->json-str params)) (res (http-transport:client-api-send-receive run-id connection-info cmd jparams))) |
︙ | ︙ |