| ︙ | | |
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
|
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
|
-
+
|
(if (or rdb
do-not-open)
rdb
(let* ((dbpath (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
(dbexists (file-exists? dbpath))
(inmem (if local #f (db:open-inmem-db)))
(refdb (if local #f (db:open-inmem-db)))
(db (db:lock-create-open dbpath
(db (db:lock-create-open dbpath ;; this is the database physically on disk
(lambda (db)
(handle-exceptions
exn
(begin
(release-dot-lock dbpath)
(if (> attemptnum 2)
(debug:print 0 "ERROR: tried twice, cannot create/initialize db for run-id " run-id ", at path " dbpath)
|
| ︙ | | |
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
|
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
+
-
+
+
+
+
|
;; (dbr:dbstruct-set-run-id! dbstruct run-id)
(if local
(begin
(dbr:dbstruct-set-localdb! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! dbstruct db) ;; direct access ...
db)
(begin
(dbr:dbstruct-set-inmem! dbstruct inmem)
(sqlite3:execute db "DELETE FROM tests WHERE state='DELETED';") ;; they just slow us down in this context
(db:sync-tables db:sync-tests-only db inmem)
(db:delay-if-busy dbpath: (db:dbdat-get-path refdb))
(db:delay-if-busy refdb) ;; dbpath: (db:dbdat-get-path refdb))
(dbr:dbstruct-set-refdb! dbstruct refdb)
(db:sync-tables db:sync-tests-only db refdb)
;; sync once more to deal with delays
(db:sync-tables db:sync-tests-only db inmem)
(db:sync-tables db:sync-tests-only db refdb)
inmem))))))
;; This routine creates the db. It is only called if the db is not already ls opened
;;
(define (db:open-main dbstruct) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let ((mdb (dbr:dbstruct-get-main dbstruct)))
(if mdb
|
| ︙ | | |
290
291
292
293
294
295
296
297
298
299
300
301
302
303
|
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
|
+
|
(inmem (dbr:dbstruct-get-inmem dbstruct))
(maindb (dbr:dbstruct-get-main dbstruct))
(refdb (dbr:dbstruct-get-refdb dbstruct))
(olddb (dbr:dbstruct-get-olddb dbstruct))
;; (runid (dbr:dbstruct-get-run-id dbstruct))
)
(debug:print-info 4 "Syncing for run-id: " run-id)
(mutex-lock! *http-mutex*)
(if (eq? run-id 0)
;; runid equal to 0 is main.db
(if maindb
(if (or (not (number? mtime))
(not (number? stime))
(> mtime stime)
force-sync)
|
| ︙ | | |
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
|
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
|
+
+
+
-
+
|
(> mtime stime)
force-sync)
(begin
(db:delay-if-busy rundb)
(db:delay-if-busy olddb)
(let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb olddb)))
(dbr:dbstruct-set-stime! dbstruct (current-milliseconds))
(mutex-unlock! *http-mutex*)
num-synced)
(begin
(mutex-unlock! *http-mutex*)
0)))))
0))))))
(define (db:close-main dbstruct)
(let ((maindb (dbr:dbstruct-get-main dbstruct)))
(if maindb
(begin
(sqlite3:finalize! (db:dbdat-get-db maindb))
(dbr:dbstruct-set-main! dbstruct #f)))))
|
| ︙ | | |
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
|
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
|
-
+
-
+
|
(for-each
(lambda (run-id)
(db:delay-if-busy mtdb)
(let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id))
(dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t) #f)))
(debug:print 0 "INFO: Propagating " (length testrecs) " records for run-id=" run-id " to run specific db")
(db:replace-test-records dbstruct run-id testrecs)
(sqlite3:finalize! (dbr:dbstruct-get-rundb dbstruct))))
(sqlite3:finalize! (db:dbdat-get-db (dbr:dbstruct-get-rundb dbstruct)))))
run-ids)))
;; 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))
(cons 0 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)
(debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
|
| ︙ | | |
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
|
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
|
+
-
-
-
+
+
+
+
|
(define db:test-record-qry-selector (string-intersperse db:test-record-fields ","))
;; NOTE: Use db:test-get* to access records
;; NOTE: This needs rundir decoding? Decide, decode here or where used? For the moment decode where used.
(define (db:get-all-tests-info-by-run-id dbstruct run-id)
(let* ((dbdat (if (vector? dbstruct)
(let ((dbdat (db:get-db dbstruct run-id))
(db (db:dbdat-get-db dbdat))
(res '()))
|
| ︙ | | |