Changes In Branch v1.80-cleanup Excluding Merge-Ins
This is equivalent to a diff from 19861e6399 to e973b1fb77
2023-02-10
| ||
21:16 | Merge v1.80-cleanup as it passed QA check-in: 34c5263e66 user: matt tags: v1.80 | |
21:06 | Merging pretty good branch v1.80-dbperf to v1.80 check-in: 7170e5f43b user: matt tags: v1.80 | |
20:19 | Use debugprint module in dbfile module as stepping stone to replacing old debug:print calls with new. Closed-Leaf check-in: 0e8fa15f1d user: matt tags: v1.80-debugprint | |
2023-02-06
| ||
19:35 | Squashed v1.80-dbperformance into one commit check-in: 6c7b8be468 user: matt tags: v1.80-dbperf | |
2023-02-05
| ||
11:47 | Minor clean up. There were a couple communication errors in sixtyfivek but they looked likely to be host related. Closed-Leaf check-in: e973b1fb77 user: matt tags: v1.80-cleanup | |
08:36 | wip, close idle db connections check-in: 97a3c4ad11 user: matt tags: v1.80-close-idle-connections | |
2023-02-03
| ||
02:16 | Reduce load from get-state-status-and-roll-up-run. check-in: 4e634eb46a user: matt tags: v1.80-dbperformance | |
2023-02-02
| ||
12:54 | Use an actual droop check-in: 19861e6399 user: matt tags: v1.80 | |
09:27 | Change couple queries to use prepared statements check-in: a2e41e0613 user: matt tags: v1.80 | |
Modified db.scm from [66cca5d3c4] to [b67cfa89a8].
︙ | ︙ | |||
469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 | (- (current-milliseconds) start-time))) (debug:print-info 3 *default-log-port* "skipping sync. " file " is up to date") ))) dbfiles) (if dbdat (dbfile:add-dbdat dbstruct #f dbdat))) #t) ;; options: ;; ;; 'killservers - kills all servers ;; 'dejunk - removes junk records ;; 'adj-testids - move test-ids into correct ranges ;; 'old2new - sync megatest.db to /tmp/.../megatest.db and /tmp/.../megatest_ref.db ;; 'new2old - sync /tmp/.../megatest.db to megatest.db and /tmp/.../megatest_ref.db (and update data_synced) ;; 'closeall - close all opened dbs ;; 'schema - attempt to apply schema changes ;; run-ids: '(1 2 3 ...) or #f (for all) ;; (define (db:multi-db-sync dbstruct . options) (let* (;; (dbdat (db:open-db dbstruct #f dbfile:db-init-proc)) (data-synced 0) ;; count of changed records | > > > > > > > > > > > > > > > | | | | < | | | | | > | < < < < < < < < < < < < < | < < | | | | | | | | | < < | | | | | < | | | | | | | | | | | | < | | | | | | < | | > > | | > > > | | < | < | | | | > > | | | | < < | | < < < | < < | < < < < | 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 | (- (current-milliseconds) start-time))) (debug:print-info 3 *default-log-port* "skipping sync. " file " is up to date") ))) dbfiles) (if dbdat (dbfile:add-dbdat dbstruct #f dbdat))) #t) (define (db:kill-servers) (let* ((servers (server:choose-server *toppath* 'all-valid))) ;; (server:get-list *toppath*)) (for-each (lambda (server) (handle-exceptions exn (begin (debug:print-info 0 *default-log-port* "Unable to get host and/or port from " server ", exn=" exn) #f) (match-let (((mod-time host port start-time server-id pid) server)) (if (and host pid) (tasks:kill-server host pid))))) servers) (delete-file* (common:get-sync-lock-filepath)))) ;; options: ;; ;; 'killservers - kills all servers ;; 'dejunk - removes junk records ;; 'adj-testids - move test-ids into correct ranges ;; 'old2new - sync megatest.db to /tmp/.../megatest.db and /tmp/.../megatest_ref.db ;; 'new2old - sync /tmp/.../megatest.db to megatest.db and /tmp/.../megatest_ref.db (and update data_synced) ;; 'closeall - close all opened dbs ;; 'schema - attempt to apply schema changes ;; run-ids: '(1 2 3 ...) or #f (for all) ;; (define (db:multi-db-sync dbstruct . options) (let* (;; (dbdat (db:open-db dbstruct #f dbfile:db-init-proc)) (data-synced 0) ;; count of changed records (tmp-area (common:get-db-tmp-area)) (old2new (member 'old2new options)) (dejunk (member 'dejunk options)) (killservers (member 'killservers options)) (src-area (if old2new *toppath* tmp-area)) (dest-area (if old2new tmp-area *toppath*)) (dbfiles (if old2new (glob (conc *toppath* "/.megatest/*.db")) (glob (conc tmp-area "/.megatest/*.db")))) (keys (db:get-keys dbstruct)) (sync-durations (make-hash-table))) ;; kill servers (if (and killservers servers)(db:kill-servers)) (if (not dbfiles) (debug:print-error 0 *default-log-port* "no dbfiles found in " (conc *toppath* "/.megatest")) (for-each (lambda (srcfile) (debug:print-info 3 *default-log-port* "file: " srcfile) (let* ((fname (conc (pathname-file srcfile) ".db")) (basename (pathname-file srcfile)) (run-id (if (string= basename "main") #f (string->number basename))) (destfile (conc dest-area "/.megatest/" fname)) (dest-directory (conc dest-area "/.megatest/")) (time1 (file-modification-time srcfile)) (time2 (if (file-exists? destfile) (begin (debug:print-info 2 *default-log-port* "destfile " destfile " exists") (file-modification-time destfile)) (begin (debug:print-info 0 *default-log-port* "Sync - I do not see file " destfile) 0))) (changed ( < (- time2 time1) 6.0)) ;; dest db not updated within last 6 seconds (do-cp (cond ((not (file-exists? destfile)) ;; shouldn't happen, but this might recover (debug:print-info 2 *default-log-port* "File " destfile " not found. Copying "srcfile" to "destfile) ;; TODO: Need to fix this for WAL mod. Can't just copy. (system (conc "/bin/mkdir -p " dest-directory)) (system (conc "/bin/cp " srcfile " " destfile)) #t) (changed ;; (and changed #t) ((and changed *time-to-exit*) ;; last sync #t) (else #f)))) (if (or dejunk do-cp) (let* ((start-time (current-milliseconds)) ;; subdb is misnamed - should be dbdat (I think...) (subdb (dbfile:open-db dbstruct run-id dbfile:db-init-proc)) ;; (or (dbfile:get-subdb dbstruct run-id) ;; (dbfile:init-subdb dbstruct run-id dbfile:db-init-proc))) (mtdb (dbr:subdb-mtdbdat subdb)) ;; ;; BUG: -mrw- I think this next line is wrong. run-id should be the path to .megatest/<runid>.db ;; (tmpdb (dbfile:open-db dbstruct run-id dbfile:db-init-proc))) (debug:print-info 2 *default-log-port* "delta syncing file: " srcfile ", time diff: " (- time1 time2) " seconds") (if old2new (begin (if dejunk (db:clean-up run-id mtdb)) (db:sync-tables (db:sync-all-tables-list dbstruct (db:get-keys dbstruct)) #f mtdb tmpdb)) (begin (if dejunk (db:clean-up run-id tmpdb)) (db:sync-tables (db:sync-all-tables-list dbstruct (db:get-keys dbstruct)) #f tmpdb mtdb))) (hash-table-set! sync-durations (conc srcfile ".db") (- (current-milliseconds) start-time))) (debug:print-info 2 *default-log-port* "skipping delta sync. " srcfile " is up to date")))) dbfiles)) data-synced)) ;; Sync all changed db's ;; (define (db:tmp->megatest.db-sync dbstruct run-id last-update) (let* ((subdbs (hash-table-values (dbr:dbstruct-subdbs dbstruct))) (res '())) (for-each |
︙ | ︙ |
Modified dbfile.scm from [25f8271ef2] to [ace9ea7280].
︙ | ︙ | |||
222 223 224 225 226 227 228 | (hash-table-ref/default (dbr:dbstruct-subdbs dbstruct) dbfname #f))) (define (dbfile:set-subdb dbstruct run-id subdb) (hash-table-set! (dbr:dbstruct-subdbs dbstruct) (dbfile:run-id->dbname run-id) subdb)) ;; (define *dbfile:num-handles-in-use* 0) | | > > > | | 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 | (hash-table-ref/default (dbr:dbstruct-subdbs dbstruct) dbfname #f))) (define (dbfile:set-subdb dbstruct run-id subdb) (hash-table-set! (dbr:dbstruct-subdbs dbstruct) (dbfile:run-id->dbname run-id) subdb)) ;; (define *dbfile:num-handles-in-use* 0) ;; Get/open a database. ;; ;; NOTE: most usage should call dbfile:open-db to get a dbdat ;; ;; if run-id => get run specific db ;; if #f => get main db ;; if run-id is a string treat it as a filename - DON'T use this - we'll get rid of it. ;; if db already open - return inmem ;; if db not open, open inmem, rundb and sync then return inmem ;; inuse gets set automatically for rundb's ;; (define (dbfile:get-dbdat dbstruct run-id) (let* ((subdb (dbfile:get-subdb dbstruct run-id))) (if (stack-empty? (dbr:subdb-dbstack subdb)) |
︙ | ︙ |