Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80-servload |
Files: | files | file ages | folders |
SHA1: |
411180a81e567f0798821e0ae1f5b0fd |
User & Date: | matt on 2023-05-05 06:46:05 |
Other Links: | branch diff | manifest | tags |
Context
2023-05-05
| ||
19:23 | Added serialize-env back in Makefile. Stabilize ids on init of keys and MEGATEST_VERSION on db creation Closed-Leaf check-in: ab0494b4b6 user: matt tags: v1.80-servload | |
06:46 | wip check-in: 411180a81e user: matt tags: v1.80-servload | |
2023-05-04
| ||
09:21 | Removed not-working-very-well threading stuff from dashboard and put sync in separate but joined process. check-in: 907e020fcf user: mrwellan tags: v1.80-servload | |
Changes
Modified dbmod.scm from [a008a03850] to [f508970062].
︙ | ︙ | |||
197 198 199 200 201 202 203 | (dbexists (file-exists? dbfullname)) (tmpdir (conc "/tmp/"(current-user-name))) (tmpdb (let* ((fname (conc tmpdir"/" (string-translate areapath "/" ".")"-"(current-process-id)"-"dbfname))) (if (not (file-exists? tmpdir))(create-directory tmpdir)) ;; check if tmpdb already exists, either delete it or ;; add something to the name fname)) | | < | | | > | | < < < | 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 | (dbexists (file-exists? dbfullname)) (tmpdir (conc "/tmp/"(current-user-name))) (tmpdb (let* ((fname (conc tmpdir"/" (string-translate areapath "/" ".")"-"(current-process-id)"-"dbfname))) (if (not (file-exists? tmpdir))(create-directory tmpdir)) ;; check if tmpdb already exists, either delete it or ;; add something to the name fname)) #;(inmem (dbmod:open-inmem-db init-proc (if (eq? (dbcache-mode) 'inmem) #f tmpdb) )) (write-access (file-write-access? dbpath)) (db (dbmod:safely-open-db dbfullname init-proc write-access)) (tables (db:sync-all-tables-list keys))) (if (not (sqlite3:database? db)) ;; db is our master database in the .mtdb dir (begin (debug:print 0 *default-log-port* "ERROR: Failed to properly open "dbfname-in", exiting immediately.") (exit))) ;; we sync to tmpdb here so that we use file-copy to get intial database (dbmod:db-to-db-sync dbfullname tmpdb 0 init-proc keys) (let* ((inmem (dbmod:open-inmem-db init-proc tmpdb))) (dbr:dbstruct-inmem-set! dbstruct inmem)) (dbr:dbstruct-ondiskdb-set! dbstruct db) (dbr:dbstruct-dbfile-set! dbstruct dbfullname) ; (dbr:dbstruct-dbfname-set! dbstruct dbfname) (dbr:dbstruct-sync-proc-set! dbstruct (lambda (last-update) (if *sync-in-progress* (debug:print 3 *default-log-port* "WARNING: overlapping calls to sync to disk") (thread-start! (make-thread (lambda () (mutex-lock! *db-with-db-mutex*) ;; this mutex is used when overloaded or during a query that modifies the db (set! *sync-in-progress* #t) #;(dbmod:sync-gasket tables last-update inmem db dbfullname syncdir) (system (conc "megatest -db2db -from "tmpdb" -to "dbfullname)) (mutex-unlock! *db-with-db-mutex*) (thread-sleep! 0.5) ;; ensure at least 1/2 second down time between sync calls (set! *sync-in-progress* #f))))))) (dbr:dbstruct-last-update-set! dbstruct (current-seconds)) ;; should this be offset back in time by one second? dbstruct)) ;; (if (eq? syncdir 'todisk) ;; sync to disk normally, sync from in dashboard ;; (dbmod:sync-tables tables last-update inmem db) ;; (dbmod:sync-tables tables last-update db inmem)))) |
︙ | ︙ | |||
387 388 389 390 391 392 393 | ");")) (proc (lambda () (apply sqlite3:execute db qry row)))) ;; (debug:print-info 0 *default-log-port* "qry="qry) (handle-exceptions ;; on exception do the cleanup qry then try one more time exn (begin | | | | | | 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 | ");")) (proc (lambda () (apply sqlite3:execute db qry row)))) ;; (debug:print-info 0 *default-log-port* "qry="qry) (handle-exceptions ;; on exception do the cleanup qry then try one more time exn (begin ;; (clean-up-qry id) (proc)) (proc))))) (num-inserts 0) (num-updates 0) ) ;; (debug:print-info 0 *default-log-port* "field-names: "field-names", fields-sans-lu: "fields-sans-lu) ;; (sqlite3:with-transaction ;; from-db ;; (lambda () (let* ((from-ids (get-ids from-db))) ;; (debug:print-info 0 *default-log-port* "Table "tablename", has "(length from-ids)" records.") (sqlite3:with-transaction to-db (lambda () (let* ((to-ids (get-ids to-db))) ;; (debug:print 0 *default-log-port* "to-ids="to-ids) |
︙ | ︙ | |||
425 426 427 428 429 430 431 | (if (not (equal? from-val dest-val)) (let* ((qry-proc (lambda () (sqlite3:execute to-db (conc "UPDATE "tablename" SET "fieldname"=? WHERE id=?;") from-val from-id)))) (handle-exceptions ;; try to remove the offending record and re-try once the update exn (begin | | | | 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 | (if (not (equal? from-val dest-val)) (let* ((qry-proc (lambda () (sqlite3:execute to-db (conc "UPDATE "tablename" SET "fieldname"=? WHERE id=?;") from-val from-id)))) (handle-exceptions ;; try to remove the offending record and re-try once the update exn (begin ;; (clean-up-qry from-id) (qry-proc)) (qry-proc)) (set! num-updates (+ num-updates 1)))))) fields-sans-lu) (let ((row (get-row from-db from-id))) ;; need to insert the row ;; (debug:print 0 *default-log-port* "row="row) (set! num-inserts (+ num-inserts 1)) (ins-row to-db from-id row)))) from-ids))))) (+ num-inserts num-updates))) ;; (for-each ;; table ;; (lambda (tabledat) ;; (let* ((tablename (car tabledat)) ;; (fields (cdr tabledat)) ;; (has-last-update (member "last_update" fields)) |
︙ | ︙ | |||
933 934 935 936 937 938 939 | (or newstatus currstate "UNKNOWN") run-id testname))))) ;;====================================================================== ;; db to db sync ;;====================================================================== (define (dbmod:db-to-db-sync src-db dest-db last-update init-proc keys) | | | > | | | < | | > > > > > > > > > > > > > | | | | > > > | < | 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 | (or newstatus currstate "UNKNOWN") run-id testname))))) ;;====================================================================== ;; db to db sync ;;====================================================================== (define (dbmod:db-to-db-sync src-db dest-db last-update init-proc keys) (if (and (file-exists? src-db) ;; can't proceed without a source (file-read-access? src-db)) (let* ((have-dest (file-exists? dest-db)) (dest-file-wr (and have-dest (file-write-access? dest-db))) ;; exists and writable (dest-dir (or (pathname-directory dest-db) ".")) (dest-dir-wr (and (file-exists? dest-dir) (file-write-access? dest-dir))) (d-wr (or (and have-dest dest-file-wr) dest-dir-wr)) (copied (if (and (not have-dest) dest-dir-wr) (begin (file-copy src-db dest-db) #t) #f))) (if copied (begin (debug:print-info 0 *default-log-port* "db-to-db-sync done with file-copy") #t) (let* ((tables (db:sync-all-tables-list keys)) (sdb (dbmod:safely-open-db src-db init-proc #t)) (ddb (dbmod:safely-open-db dest-db init-proc d-wr)) (res (dbmod:sync-gasket tables last-update sdb ddb dest-db 'todest keys))) (sqlite3:finalize! sdb) (sqlite3:finalize! ddb) res))) #f)) ) |
Modified megatest.scm from [a30f723389] to [5a6b09c0ae].
︙ | ︙ | |||
2577 2578 2579 2580 2581 2582 2583 | (lockfile (conc dest-db".lock")) (keys (db:get-keys #f)) ) (if (and src-db dest-db) (begin (debug:print-info 0 *default-log-port* "Attempting to sync data from "src-db" to "dest-db"...") | < < < < < < | 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 | (lockfile (conc dest-db".lock")) (keys (db:get-keys #f)) ) (if (and src-db dest-db) (begin (debug:print-info 0 *default-log-port* "Attempting to sync data from "src-db" to "dest-db"...") (let ((res (dbmod:db-to-db-sync src-db dest-db 0 (dbfile:db-init-proc) keys))) (if res (debug:print 0 *default-log-port* "Synced " res " records from "src-db" to "dest-db) (debug:print 0 *default-log-port* "No sync due to permissions or non-existant source db.")))) (debug:print 0 *default-log-port* "Skipping sync, there is a sync in progress.")) (set! *didsomething* #t)) (debug:print 0 *default-log-port* "Usage for -db2db; -to and -from must be specified")) |
︙ | ︙ |