| ︙ | | |
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
-
-
-
+
+
+
|
;; 'read read data
;;
(define (db:done-with dbstruct run-id mod-read)
(if (not (sqlite3:database? dbstruct))
(begin
(mutex-lock! *rundb-mutex*)
(if (eq? mod-read 'mod)
(dbr:dbstruct-set-mtime! dbstruct (current-milliseconds))
(dbr:dbstruct-set-rtime! dbstruct (current-milliseconds)))
(dbr:dbstruct-set-inuse! dbstruct #f)
(dbr:dbstruct-mtime-set! dbstruct (current-milliseconds))
(dbr:dbstruct-rtime-set! dbstruct (current-milliseconds)))
(dbr:dbstruct-inuse-set! 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)
|
| ︙ | | |
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
-
+
-
-
+
+
|
(begin
(debug:print 2 "WARNING: opening db in non-writable dir " fname)
(sqlite3:open-database fname))))) ;; )
;; This routine creates the db. It is only called if the db is not already opened
;;
(define (db:open-rundb dbstruct run-id #!key (attemptnum 0)(do-not-open #f)) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let* ((local (dbr:dbstruct-get-local dbstruct))
(let* ((local (dbr:dbstruct-local dbstruct))
(rdb (if local
(dbr:dbstruct-get-localdb dbstruct run-id)
(dbr:dbstruct-get-inmem dbstruct)))) ;; (dbr:dbstruct-get-runrec dbstruct run-id 'inmem)))
(dbr:dbstruct-localdb dbstruct run-id)
(dbr:dbstruct-inmem dbstruct)))) ;; (dbr:dbstruct-runrec dbstruct run-id 'inmem)))
(if (or rdb
do-not-open)
rdb
(begin
(mutex-lock! *rundb-mutex*)
(let* ((dbpath (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
(dbexists (file-exists? dbpath))
|
| ︙ | | |
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
|
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
|
-
-
-
-
+
+
+
+
-
+
-
+
-
+
-
+
-
-
+
+
|
(set! *megatest-db* db)
db)))
(write-access (file-write-access? dbpath))
;; (handler (make-busy-timeout 136000))
)
(if (and dbexists (not write-access))
(set! *db-write-access* #f)) ;; only unset so other db's also can use this control
(dbr:dbstruct-set-rundb! dbstruct (cons db dbpath))
(dbr:dbstruct-set-inuse! dbstruct #t)
(dbr:dbstruct-set-olddb! dbstruct olddb)
;; (dbr:dbstruct-set-run-id! dbstruct run-id)
(dbr:dbstruct-rundb-set! dbstruct (cons db dbpath))
(dbr:dbstruct-inuse-set! dbstruct #t)
(dbr:dbstruct-olddb-set! dbstruct olddb)
;; (dbr:dbstruct-run-id-set! dbstruct run-id)
(mutex-unlock! *rundb-mutex*)
(if local
(begin
(dbr:dbstruct-set-localdb! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! dbstruct db) ;; direct access ...
(dbr:dbstruct-localdb-set! dbstruct run-id db) ;; (dbr:dbstruct-inmem-set! dbstruct db) ;; direct access ...
db)
(begin
(dbr:dbstruct-set-inmem! dbstruct inmem)
(dbr:dbstruct-inmem-set! dbstruct inmem)
;; dec 14, 2014 - keep deleted records available. hunch is that they are needed for id placeholders
;; (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 refdb) ;; dbpath: (db:dbdat-get-path refdb)) ;; What does delaying here achieve?
(dbr:dbstruct-set-refdb! dbstruct refdb)
(dbr:dbstruct-refdb-set! dbstruct refdb)
(db:sync-tables db:sync-tests-only inmem refdb) ;; use inmem as the reference, don't read again from db
;; sync once more to deal with delays?
;; (db:sync-tables db:sync-tests-only db inmem)
;; (db:sync-tables db:sync-tests-only inmem 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)))
(let ((mdb (dbr:dbstruct-main dbstruct)))
(if mdb
mdb
(begin
(mutex-lock! *rundb-mutex*)
(let* ((dbpath (db:dbfile-path 0))
(dbexists (file-exists? dbpath))
(db (db:lock-create-open dbpath db:initialize-main-db))
(olddb (db:open-megatest-db))
(write-access (file-write-access? dbpath))
(dbdat (cons db dbpath)))
(if (and dbexists (not write-access))
(set! *db-write-access* #f))
(dbr:dbstruct-set-main! dbstruct dbdat)
(dbr:dbstruct-set-olddb! dbstruct olddb) ;; olddb is already a (cons db path)
(dbr:dbstruct-main-set! dbstruct dbdat)
(dbr:dbstruct-olddb-set! dbstruct olddb) ;; olddb is already a (cons db path)
(mutex-unlock! *rundb-mutex*)
(if (and (not dbexists)
*db-write-access*) ;; did not have a prior db and do have write access
(db:multi-db-sync #f 'old2new)) ;; migrate data from megatest.db automatically
dbdat)))))
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
|
| ︙ | | |
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
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
|
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
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
|
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
+
-
+
-
+
-
+
-
-
+
+
-
+
-
-
+
+
-
+
|
(if (and dbexists (not write-access))
(set! *db-write-access* #f))
(cons db dbpath)))
;; sync run to disk if touched
;;
(define (db:sync-touched dbstruct run-id #!key (force-sync #f))
(let ((mtime (dbr:dbstruct-get-mtime dbstruct))
(stime (dbr:dbstruct-get-stime dbstruct))
(rundb (dbr:dbstruct-get-rundb dbstruct))
(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))
(let ((mtime (dbr:dbstruct-mtime dbstruct))
(stime (dbr:dbstruct-stime dbstruct))
(rundb (dbr:dbstruct-rundb dbstruct))
(inmem (dbr:dbstruct-inmem dbstruct))
(maindb (dbr:dbstruct-main dbstruct))
(refdb (dbr:dbstruct-refdb dbstruct))
(olddb (dbr:dbstruct-olddb dbstruct))
;; (runid (dbr:dbstruct-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)
(begin
(db:delay-if-busy maindb)
(db:delay-if-busy olddb)
(let ((num-synced (db:sync-tables (db:sync-main-list maindb) maindb olddb)))
(dbr:dbstruct-set-stime! dbstruct (current-milliseconds))
(dbr:dbstruct-stime-set! dbstruct (current-milliseconds))
num-synced)
0))
(begin
;; this can occur when using local access (i.e. not in a server)
;; need a flag to turn it off.
;;
(debug:print 3 "WARNING: call to sync main.db to megatest.db but main not initialized")
0))
;; any other runid is a run
(if (or (not (number? mtime))
(not (number? stime))
(> mtime stime)
force-sync)
(begin
(db:delay-if-busy rundb)
(db:delay-if-busy olddb)
(dbr:dbstruct-set-stime! dbstruct (current-milliseconds))
(dbr:dbstruct-stime-set! dbstruct (current-milliseconds))
(let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb olddb)))
;; (mutex-unlock! *http-mutex*)
num-synced)
(begin
;; (mutex-unlock! *http-mutex*)
0))))))
(define (db:close-main dbstruct)
(let ((maindb (dbr:dbstruct-get-main dbstruct)))
(let ((maindb (dbr:dbstruct-main dbstruct)))
(if maindb
(begin
(sqlite3:finalize! (db:dbdat-get-db maindb))
(dbr:dbstruct-set-main! dbstruct #f)))))
(dbr:dbstruct-main-set! dbstruct #f)))))
(define (db:close-run-db dbstruct run-id)
(let ((rdb (db:open-rundb dbstruct run-id do-not-open: #t)))
(if (and rdb
(sqlite3:database? rdb))
(begin
(sqlite3:finalize! rdb)
(dbr:dbstruct-set-localdb! dbstruct run-id #f)
(dbr:dbstruct-set-inmem! dbstruct #f)))))
(dbr:dbstruct-localdb-set! dbstruct run-id #f)
(dbr:dbstruct-inmem-set! dbstruct #f)))))
;; close all opened run-id dbs
(define (db:close-all dbstruct)
;; finalize main.db
(db:sync-touched dbstruct 0 force-sync: #t)
;;(common:db-block-further-queries)
;; (mutex-lock! *db-sync-mutex*) ;; with this perhaps it isn't necessary to use the block-further-queries mechanism?
(db:close-main dbstruct)
(let ((locdbs (dbr:dbstruct-get-locdbs dbstruct)))
(let ((locdbs (dbr:dbstruct-locdbs dbstruct)))
(if (hash-table? locdbs)
(for-each (lambda (run-id)
(db:close-run-db dbstruct run-id))
(hash-table-keys locdbs))))
;; (let* ((local (dbr:dbstruct-get-local dbstruct))
;; (rundb (db:dbdat-get-db (dbr:dbstruct-get-rundb dbstruct))))
;; (let* ((local (dbr:dbstruct-local dbstruct))
;; (rundb (db:dbdat-get-db (dbr:dbstruct-rundb dbstruct))))
;; (if local
;; (for-each
;; (lambda (dbdat)
;; (let ((db (db:dbdat-get-db dbdat)))
;; (if (sqlite3:database? db)
;; (begin
;; (sqlite3:interrupt! db)
;; (sqlite3:finalize! db #t)))))
;; ;; TODO: Come back to this and rework to delete from hashtable when finalized
;; (hash-table-values (dbr:dbstruct-get-locdbs dbstruct))))
;; (hash-table-values (dbr:dbstruct-locdbs dbstruct))))
;; (thread-sleep! 3)
;; (if (and rundb
;; (sqlite3:database? rundb))
;; (handle-exceptions
;; exn
;; (begin
;; (debug:print 0 "WARNING: database files may not have been closed correctly. Consider running -cleanup-db")
|
| ︙ | | |
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
|
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
|
-
+
|
(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! (db:dbdat-get-db (dbr:dbstruct-get-rundb dbstruct)))))
(sqlite3:finalize! (db:dbdat-get-db (dbr:dbstruct-rundb dbstruct)))))
run-ids)))
;; now ensure all newdb data are synced to megatest.db
;; do not use the run-ids list passed in to the function
;;
(if (member 'new2old options)
(let* ((maindb (make-dbr:dbstruct path: toppath local: #t))
|
| ︙ | | |