Overview
Comment: | refactor-dbr:dbstruct |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | refactor-dbr:dbstruct |
Files: | files | file ages | folders |
SHA1: |
8bd82d02ff6376f432bd674925f372c6 |
User & Date: | mrwellan on 2016-01-14 15:17:38 |
Other Links: | branch diff | manifest | tags |
Context
2016-01-25
| ||
18:50 | first pass converting db:test from vec to defstruct check-in: 76a0be2c09 user: bjbarcla tags: refactor-dbr:dbstruct | |
2016-01-14
| ||
15:17 | refactor-dbr:dbstruct check-in: 8bd82d02ff user: mrwellan tags: refactor-dbr:dbstruct | |
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 dashboard-tests.scm from [fe06b9cc98] to [c70ca54366].
︙ | ︙ | |||
407 408 409 410 411 412 413 | (cmtcmd comment) (iup:destroy! dlog)))))) (iup:button "Cancel" #:expand "HORIZONTAL" #:action (lambda (obj) (iup:destroy! dlog))))))) dlog)) | < | 407 408 409 410 411 412 413 414 415 416 417 418 419 420 | (cmtcmd comment) (iup:destroy! dlog)))))) (iup:button "Cancel" #:expand "HORIZONTAL" #:action (lambda (obj) (iup:destroy! dlog))))))) dlog)) ;;====================================================================== ;; ;;====================================================================== (define (examine-test run-id test-id) ;; run-id run-key origtest) (let* ((db-path (db:dbfile-path run-id)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/db/" run-id ".db")) (dbstruct (make-dbr:dbstruct path: (db:dbfile-path #f) ;; (configf:lookup *configdat* "setup" "linktree") |
︙ | ︙ |
Modified db.scm from [725b61e04a] to [cf4d2cae18].
︙ | ︙ | |||
10 11 12 13 14 15 16 | ;;====================================================================== ;;====================================================================== ;; Database access ;;====================================================================== (require-extension (srfi 18) extras tcp) | | > | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | ;;====================================================================== ;;====================================================================== ;; Database access ;;====================================================================== (require-extension (srfi 18) extras tcp) (use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64 format dot-locking z3 defstruct) (import (prefix sqlite3 sqlite3:)) (import (prefix base64 base64:)) (declare (unit db)) (declare (uses common)) (declare (uses keys)) (declare (uses ods)) |
︙ | ︙ | |||
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) | | | | | | 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | ;; '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 (dbr:dbstruct? 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) (handle-exceptions exn (begin |
︙ | ︙ | |||
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*))) | | | | | 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 | (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-set! dbstruct run-id) (dbr:dbstruct-inmem dbstruct)))) ;; (dbr:dbstruct-get-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 | | | | | | | | | | | 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 282 | (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-set-run-id! dbstruct run-id) (mutex-unlock! *rundb-mutex*) (if local (begin (dbr:dbstruct-localdb-set! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! 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)) | | | | | | | | | | | | | | | | 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 | (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-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) (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-get-local dbstruct)) ;; (rundb (db:dbdat-get-db (dbr:dbstruct-get-rundb dbstruct)))) |
︙ | ︙ |
Modified db_records.scm from [de0d03e562] to [7f72a33adc].
︙ | ︙ | |||
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 74 75 76 | ;; |-1.db ;; |-<N>.db ;; ;; ;; Accessors for a dbstruct ;; (use defstruct) (defstruct dbr:dbstruct main strdb path local rundb inmem mtime rtime stime inuse refdb locdbs olddb rundb-path) ;;; (define d1 (make-dbr:dbstruct)) ;;; (dbr:dbstruct-main d1) ==> retrive value ;;; (dbr:dbstruct-main-set! d1 'def) ==> set value ;; (define-inline (dbr:dbstruct-get-main vec) (vector-ref vec 0)) ;; ( db path ) ;; (define-inline (dbr:dbstruct-get-strdb vec) (vector-ref vec 1)) ;; ( db path ) ;; (define-inline (dbr:dbstruct-get-path vec) (vector-ref vec 2)) ;; (define-inline (dbr:dbstruct-get-local vec) (vector-ref vec 3)) ;; (define-inline (dbr:dbstruct-get-rundb vec) (vector-ref vec 4)) ;; ( db path ) ;; (define-inline (dbr:dbstruct-get-inmem vec) (vector-ref vec 5)) ;; ( db #f ) ;; (define-inline (dbr:dbstruct-get-mtime vec) (vector-ref vec 6)) ;; (define-inline (dbr:dbstruct-get-rtime vec) (vector-ref vec 7)) ;; (define-inline (dbr:dbstruct-get-stime vec) (vector-ref vec 8)) ;; (define-inline (dbr:dbstruct-get-inuse vec) (vector-ref vec 9)) ;; (define-inline (dbr:dbstruct-get-refdb vec) (vector-ref vec 10)) ;; ( db path ) ;; (define-inline (dbr:dbstruct-get-locdbs vec) (vector-ref vec 11)) ;; (define-inline (dbr:dbstruct-get-olddb vec) (vector-ref vec 12)) ;; ( db path ) ;; ;; (define-inline (dbr:dbstruct-get-main-path vec) (vector-ref vec 13)) ;; ;; (define-inline (dbr:dbstruct-get-rundb-path vec) (vector-ref vec 14)) ;; ;; (define-inline (dbr:dbstruct-get-run-id vec) (vector-ref vec 13)) ;; ;; (define-inline (dbr:dbstruct-set-main! vec val)(vector-set! vec 0 val)) ;; (define-inline (dbr:dbstruct-set-strdb! vec val)(vector-set! vec 1 val)) ;; (define-inline (dbr:dbstruct-set-path! vec val)(vector-set! vec 2 val)) ;; (define-inline (dbr:dbstruct-set-local! vec val)(vector-set! vec 3 val)) ;; (define-inline (dbr:dbstruct-set-rundb! vec val)(vector-set! vec 4 val)) ;; (define-inline (dbr:dbstruct-set-inmem! vec val)(vector-set! vec 5 val)) ;; (define-inline (dbr:dbstruct-set-mtime! vec val)(vector-set! vec 6 val)) ;; (define-inline (dbr:dbstruct-set-rtime! vec val)(vector-set! vec 7 val)) ;; (define-inline (dbr:dbstruct-set-stime! vec val)(vector-set! vec 8 val)) ;; (define-inline (dbr:dbstruct-set-inuse! vec val)(vector-set! vec 9 val)) ;; (define-inline (dbr:dbstruct-set-refdb! vec val)(vector-set! vec 10 val)) ;; (define-inline (dbr:dbstruct-set-locdbs! vec val)(vector-set! vec 11 val)) ;; (define-inline (dbr:dbstruct-set-olddb! vec val)(vector-set! vec 12 val)) ;; (define-inline (dbr:dbstruct-set-main-path! vec val)(vector-set! vec 13 val)) ;; (define-inline (dbr:dbstruct-set-rundb-path! vec val)(vector-set! vec 14 val)) ; (define-inline (dbr:dbstruct-set-run-id! vec val)(vector-set! vec 13 val)) ;; constructor for dbstruct ;; (define (actual-make-dbr:dbstruct #!key (path #f)(local #f)) (make-dbr:dbstruct path: path local: local locdbs: (make-hash-table))) (define (dbr:dbstruct-get-localdb v run-ids) (hash-table-ref/default (dbr:dbstruct-locdbs v) run-id #f)) (define (dbr:dbstruct-set-localdb! 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)) |
︙ | ︙ |
Modified runs.scm from [93791638c8] to [4f79eba8a1].
︙ | ︙ | |||
269 270 271 272 273 274 275 | (debug:print 0 "Done") (exit 4))))) (thread-start! th2) (thread-start! th1) (thread-join! th2))))) (set-signal-handler! signal/int sighand) (set-signal-handler! signal/term sighand) | | > | 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 | (debug:print 0 "Done") (exit 4))))) (thread-start! th2) (thread-start! th1) (thread-join! th2))))) (set-signal-handler! signal/int sighand) (set-signal-handler! signal/term sighand) ;; (set-signal-handler! signal/stop sighand) ;; should not be handling sigstop ) (runs:set-megatest-env-vars run-id inkeys: keys inrunname: runname) ;; these may be needed by the launching process (set! runconf (if (file-exists? runconfigf) (setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keyvals target) (begin (debug:print 0 "WARNING: You do not have a run config file: " runconfigf) #f))) |
︙ | ︙ |