79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
(dbr:dbstruct-set-inuse! dbstruct #f)
(mutex-unlock! *rundb-mutex*))))
;; (db:with-db dbstruct run-id sqlite3:exec "select blah from blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
(let* ((dbdat (db:get-db dbstruct run-id))
(db:done-with dbstruct run-id r/w)
res)))
;;======================================================================
;; K E E P F I L E D B I N dbstruct
;;======================================================================
;; (define (db:get-filedb dbstruct run-id)
|
>
|
>
|
|
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
(dbr:dbstruct-set-inuse! dbstruct #f)
(mutex-unlock! *rundb-mutex*))))
;; (db:with-db dbstruct run-id sqlite3:exec "select blah from blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
(let* ((dbdat (if (vector? dbstruct)
(db:get-db dbstruct run-id)
dbstruct)) ;; cheat, allow for passing in a dbdat
(db (db:dbdat-get-db dbdat)))
(db:delay-if-busy dbdat)
(let ((res (apply proc db params)))
(if (vector? dbstruct)(db:done-with dbstruct run-id r/w))
res)))
;;======================================================================
;; K E E P F I L E D B I N dbstruct
;;======================================================================
;; (define (db:get-filedb dbstruct run-id)
|
413
414
415
416
417
418
419
420
421
422
423
424
425
426
|
'("iterated" #f)
'("avg_runtime" #f)
'("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))
|
>
>
|
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
|
'("iterated" #f)
'("avg_runtime" #f)
'("avg_disk" #f)
'("tags" #f)
'("jobgroup" #f)))))
;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) )
;; db's are dbdat's
;;
(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))
|
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
|
;; now ensure all newdb data are synced to megatest.db
(if (member 'new2old options)
(for-each
(lambda (run-id)
(let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
(frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
(db:delay-if-busy frundb)
(db:delay-if-busy mtdb)
(if (eq? run-id 0)
(db:sync-tables (db:sync-main-list dbstruct) fromdb mtdb)
(db:sync-tables db:sync-tests-only fromdb mtdb))))
run-ids))
;; (db:close-all dbstruct)
;; (sqlite3:finalize! mdb)
))
;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling proc idb . params)
|
|
|
|
|
|
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
|
;; now ensure all newdb data are synced to megatest.db
(if (member 'new2old options)
(for-each
(lambda (run-id)
(let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
(frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
;; (db:delay-if-busy frundb)
;; (db:delay-if-busy mtdb)
(if (eq? run-id 0)
(db:sync-tables (db:sync-main-list dbstruct) (db:get-db fromdb #f) mtdb)
(db:sync-tables db:sync-tests-only (db:get-db fromdb run-id) mtdb))))
run-ids))
;; (db:close-all dbstruct)
;; (sqlite3:finalize! mdb)
))
;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling proc idb . params)
|