Overview
Comment: | re-refactor dbr:dbstruct |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | re-refactor-vec2defstruct |
Files: | files | file ages | folders |
SHA1: |
3becef064c40a91f655a5e7cd010f089 |
User & Date: | mrwellan on 2016-01-29 08:58:11 |
Other Links: | branch diff | manifest | tags |
Context
2016-01-29
| ||
12:39 | Added scripts used for refactor and refactored db:tests from db_records check-in: 3d5659bc1c user: mrwellan tags: re-refactor-vec2defstruct | |
08:58 | re-refactor dbr:dbstruct check-in: 3becef064c user: mrwellan tags: re-refactor-vec2defstruct | |
2016-01-13
| ||
16:23 | converted filedb:fdb from vec to defstruct Closed-Leaf check-in: fb18a8da9e user: bjbarcla tags: inline-vec-to-defstruct | |
Changes
Modified db.scm from [725b61e04a] to [146391768a].
︙ | ︙ | |||
85 86 87 88 89 90 91 | ;; '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) | | | | | 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-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 | (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*))) | | | | | 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-local dbstruct)) (rdb (if local (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 | (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 | | | | | | | | | | | | 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-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-localdb-set! dbstruct run-id db) ;; (dbr:dbstruct-inmem-set! dbstruct db) ;; direct access ... db) (begin (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-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-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-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 | (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)) | | | | | | | | | | | | | | | | | | | | 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-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-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-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-main dbstruct))) (if maindb (begin (sqlite3:finalize! (db:dbdat-get-db maindb)) (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-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-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-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-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 | (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) | | | 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-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)) |
︙ | ︙ |
Modified db_records.scm from [de0d03e562] to [72ec81ee08].
︙ | ︙ | |||
11 12 13 14 15 16 17 | ;; |-1.db ;; |-<N>.db ;; ;; ;; Accessors for a dbstruct ;; | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | ;; |-1.db ;; |-<N>.db ;; ;; ;; Accessors for a dbstruct ;; (define-inline (dbr:dbstruct-main vec) (vector-ref vec 0)) ;; ( db path ) (define-inline (dbr:dbstruct-strdb vec) (vector-ref vec 1)) ;; ( db path ) (define-inline (dbr:dbstruct-path vec) (vector-ref vec 2)) (define-inline (dbr:dbstruct-local vec) (vector-ref vec 3)) (define-inline (dbr:dbstruct-rundb vec) (vector-ref vec 4)) ;; ( db path ) (define-inline (dbr:dbstruct-inmem vec) (vector-ref vec 5)) ;; ( db #f ) (define-inline (dbr:dbstruct-mtime vec) (vector-ref vec 6)) (define-inline (dbr:dbstruct-rtime vec) (vector-ref vec 7)) (define-inline (dbr:dbstruct-stime vec) (vector-ref vec 8)) (define-inline (dbr:dbstruct-inuse vec) (vector-ref vec 9)) (define-inline (dbr:dbstruct-refdb vec) (vector-ref vec 10)) ;; ( db path ) (define-inline (dbr:dbstruct-locdbs vec) (vector-ref vec 11)) (define-inline (dbr:dbstruct-olddb vec) (vector-ref vec 12)) ;; ( db path ) ;; (define-inline (dbr:dbstruct-main-path vec) (vector-ref vec 13)) ;; (define-inline (dbr:dbstruct-rundb-path vec) (vector-ref vec 14)) ;; (define-inline (dbr:dbstruct-run-id vec) (vector-ref vec 13)) (define-inline (dbr:dbstruct-main-set! vec val)(vector-set! vec 0 val)) (define-inline (dbr:dbstruct-strdb-set! vec val)(vector-set! vec 1 val)) (define-inline (dbr:dbstruct-path-set! vec val)(vector-set! vec 2 val)) (define-inline (dbr:dbstruct-local-set! vec val)(vector-set! vec 3 val)) (define-inline (dbr:dbstruct-rundb-set! vec val)(vector-set! vec 4 val)) (define-inline (dbr:dbstruct-inmem-set! vec val)(vector-set! vec 5 val)) (define-inline (dbr:dbstruct-mtime-set! vec val)(vector-set! vec 6 val)) (define-inline (dbr:dbstruct-rtime-set! vec val)(vector-set! vec 7 val)) (define-inline (dbr:dbstruct-stime-set! vec val)(vector-set! vec 8 val)) (define-inline (dbr:dbstruct-inuse-set! vec val)(vector-set! vec 9 val)) (define-inline (dbr:dbstruct-refdb-set! vec val)(vector-set! vec 10 val)) (define-inline (dbr:dbstruct-locdbs-set! vec val)(vector-set! vec 11 val)) (define-inline (dbr:dbstruct-olddb-set! vec val)(vector-set! vec 12 val)) (define-inline (dbr:dbstruct-main-path-set! vec val)(vector-set! vec 13 val)) (define-inline (dbr:dbstruct-set-rupath-set! vec val)(vector-set! vec 14 val)) ; (define-inline (dbr:dbstruct-run-id-set! vec val)(vector-set! vec 13 val)) ;; constructor for dbstruct ;; (define (make-dbr:dbstruct #!key (path #f)(local #f)) (let ((v (make-vector 15 #f))) (dbr:dbstruct-path-set! v path) (dbr:dbstruct-local-set! v local) (dbr:dbstruct-locdbs-set! v (make-hash-table)) v)) (define (dbr:dbstruct-localdb v run-id) (hash-table-ref/default (dbr:dbstruct-locdbs v) run-id #f)) (define (dbr:dbstruct-localdb-set! v run-id db) (hash-table-set! (dbr:dbstruct-locdbs v) run-id db)) (define (make-db:test)(make-vector 20)) (define-inline (db:test-get-id vec) (vector-ref vec 0)) (define-inline (db:test-get-run_id vec) (vector-ref vec 1)) (define-inline (db:test-get-testname vec) (vector-ref vec 2)) (define-inline (db:test-get-state vec) (vector-ref vec 3)) |
︙ | ︙ |