Overview
| Comment: | Protect the transaction in sync-db with exception handler |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
d46174b7d1bb5ec62ac6d50bd298f4a9 |
| User & Date: | mrwellan on 2014-11-07 14:09:18 |
| Other Links: | branch diff | manifest | tags |
Context
|
2014-11-10
| ||
| 22:31 | Protected accesses to megatest.db and monitor.db with journal file busy control check-in: faeb319c76 user: matt tags: v1.60 | |
|
2014-11-07
| ||
| 14:09 | Protect the transaction in sync-db with exception handler check-in: d46174b7d1 user: mrwellan tags: v1.60 | |
|
2014-11-06
| ||
| 20:12 | Use run specific db access times to determine servers to start. check-in: 029c9c9936 user: matt tags: v1.60, v1.6005_ww45.2a | |
Changes
Modified db.scm from [97be499b49] to [6ed0b093c7].
| ︙ | ︙ | |||
392 393 394 395 396 397 398 399 400 401 402 403 404 405 |
'("avg_disk" #f)
'("tags" #f)
'("jobgroup" #f)))))
;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) )
(define (db:sync-tables tbls fromdb todb . slave-dbs)
(mutex-lock! *db-sync-mutex*)
(cond
((not fromdb) (debug:print 3 "WARNING: db:sync-tables called with fromdb missing") -1)
((not todb) (debug:print 3 "WARNING: db:sync-tables called with todb missing") -2)
((not (sqlite3:database? fromdb))
(debug:print 0 "ERROR: db:sync-tables called with fromdb not a database " fromdb) -3)
((not (sqlite3:database? todb))
(debug:print 0 "ERROR: db:sync-tables called with todb not a database " todb) -4)
| > > > > > > > > | 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 |
'("avg_disk" #f)
'("tags" #f)
'("jobgroup" #f)))))
;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) )
(define (db:sync-tables tbls fromdb todb . slave-dbs)
(mutex-lock! *db-sync-mutex*)
(handle-exceptions
exn
(begin
(debug:print 0 "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(print "exn=" (condition->list exn))
(debug:print 0 " status: " ((condition-property-accessor 'sqlite3 'status) exn))
(print-call-chain))
(cond
((not fromdb) (debug:print 3 "WARNING: db:sync-tables called with fromdb missing") -1)
((not todb) (debug:print 3 "WARNING: db:sync-tables called with todb missing") -2)
((not (sqlite3:database? fromdb))
(debug:print 0 "ERROR: db:sync-tables called with fromdb not a database " fromdb) -3)
((not (sqlite3:database? todb))
(debug:print 0 "ERROR: db:sync-tables called with todb not a database " todb) -4)
|
| ︙ | ︙ | |||
482 483 484 485 486 487 488 |
(let ((tblname (car dat))
(count (cdr dat)))
(set! tot-count (+ tot-count count))
(if (> count 0)
(if should-print (debug:print 0 (format #f " ~10a ~5a" tblname count))))))
(sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
tot-count)))
| | | 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 |
(let ((tblname (car dat))
(count (cdr dat)))
(set! tot-count (+ tot-count count))
(if (> count 0)
(if should-print (debug:print 0 (format #f " ~10a ~5a" tblname count))))))
(sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
tot-count)))
(mutex-unlock! *db-sync-mutex*)))
;; options:
;;
;; '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
|
| ︙ | ︙ |
Modified megatest.scm from [f4fb8b012f] to [4ce5effbaa].
| ︙ | ︙ | |||
296 297 298 299 300 301 302 | (mutex-lock! *db-multi-sync-mutex*) (for-each (lambda (run-id) (let ((last-write (hash-table-ref/default *db-local-sync* run-id 0))) (if ;; (and (> (- start-time last-write) 5) ;; every five seconds ;; (common:db-access-allowed?)) | | > | > > > | 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 |
(mutex-lock! *db-multi-sync-mutex*)
(for-each
(lambda (run-id)
(let ((last-write (hash-table-ref/default *db-local-sync* run-id 0)))
(if ;; (and
(> (- start-time last-write) 5) ;; every five seconds
;; (common:db-access-allowed?))
(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 (> sync-time 10) ;; took more than ten seconds, start a server for this run
(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-delete! *db-local-sync* run-id)))))
(hash-table-keys *db-local-sync*))
(mutex-unlock! *db-multi-sync-mutex*))
;; keep going unless time to exit
;;
(if (not *time-to-exit*)
|
| ︙ | ︙ | |||
809 810 811 812 813 814 815 | (tdb:step-get-stepname step) (tdb:step-get-state step) (tdb:step-get-status step) (tdb:step-get-event_time step))) steps))))) tests))))) runs) | | | 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 | (tdb:step-get-stepname step) (tdb:step-get-state step) (tdb:step-get-status step) (tdb:step-get-event_time step))) steps))))) tests))))) runs) ;; (db:close-all dbstruct) (set! *didsomething* #t)))) ;;====================================================================== ;; full run ;;====================================================================== ;; get lock in db for full run for this directory |
| ︙ | ︙ |