Overview
| Comment: | WIP Fixed delta syncing with locking |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.7001-multi-db-rb01 |
| Files: | files | file ages | folders |
| SHA1: |
7011056de432990a3287554525a3330c |
| User & Date: | mmgraham on 2022-05-04 18:54:06 |
| Other Links: | branch diff | manifest | tags |
Context
|
2022-05-09
| ||
| 07:30 | merged fork check-in: 782400400d user: matt tags: v1.7001-multi-db-rb01 | |
|
2022-05-04
| ||
| 18:54 | WIP Fixed delta syncing with locking check-in: 7011056de4 user: mmgraham tags: v1.7001-multi-db-rb01 | |
|
2022-05-02
| ||
| 11:29 | WIP Fixed db:sync-touched and db:sync-tables. Disabled watchdog threads. Will use only keep-running thread. check-in: c597d4e8cf user: mmgraham tags: v1.7001-multi-db-rb01 | |
Changes
Modified db.scm from [3fa116b68d] to [767b31815a].
| ︙ | ︙ | |||
427 428 429 430 431 432 433 |
(write-access (file-write-access? dbpath)))
(debug:print-info 13 *default-log-port* "db:open-megatest-db "dbpath)
(if (and dbexists (not write-access))
(set! *db-write-access* #f))
;; (cons db dbpath)))
(make-dbr:dbdat dbfile: dbpath dbh: db read-only: (not write-access))))
| | > > | | | < < < | 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 |
(write-access (file-write-access? dbpath)))
(debug:print-info 13 *default-log-port* "db:open-megatest-db "dbpath)
(if (and dbexists (not write-access))
(set! *db-write-access* #f))
;; (cons db dbpath)))
(make-dbr:dbdat dbfile: dbpath dbh: db read-only: (not write-access))))
;; sync run from tmp disk to nfs disk if touched
;;
(define (db:sync-touched dbstruct run-id #!key (force-sync #f))
(debug:print-info 0 *default-log-port* "db:sync-touched Syncing: " (conc (if run-id run-id "main") ".db"))
(let* (
(subdb (or (dbfile:get-subdb dbstruct run-id) (dbfile:init-subdb dbstruct run-id db:initialize-main-db)))
(tmpdbfile (dbr:subdb-tmpdbfile subdb))
(mtdb (dbr:subdb-mtdbdat subdb))
(tmpdb (dbfile:open-sqlite3-db tmpdbfile #f))
(start-t (current-seconds)))
(mutex-lock! *db-multi-sync-mutex*)
(let ((update_info (cons "last_update" (if force-sync 0 *db-last-sync*) )))
(mutex-unlock! *db-multi-sync-mutex*)
(db:sync-tables (db:sync-all-tables-list dbstruct) update_info tmpdb mtdb))
(mutex-lock! *db-multi-sync-mutex*)
(set! *db-last-sync* start-t)
(set! *db-last-access* start-t)
|
| ︙ | ︙ | |||
658 659 660 661 662 663 664 |
(define (db:sync-tables tbls last-update fromdb todb . slave-dbs)
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.")
(print-call-chain (current-error-port))
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
| | | | | 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 |
(define (db:sync-tables tbls last-update fromdb todb . slave-dbs)
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.")
(print-call-chain (current-error-port))
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 *default-log-port* "exn=" (condition->list exn))
(debug:print 0 *default-log-port* " status: " ((condition-property-accessor 'sqlite3 'status) exn))
(debug:print 0 *default-log-port* " src db: " (dbr:dbdat-dbfile fromdb))
(for-each (lambda (dbdat)
(let ((dbpath (dbr:dbdat-dbfile dbdat)))
(debug:print 0 *default-log-port* " dbpath: " dbpath)
(if (not (db:repair-db dbdat))
(begin
(debug:print-error 0 *default-log-port* "Failed to rebuild " dbpath ", exiting now.")
(exit)))))
(cons todb slave-dbs))
0)
;; this is the work to be done")
(cond
((not fromdb) (debug:print 0 *default-log-port* "WARNING: db:sync-tables called with fromdb missing")
-1)
((not todb) (debug:print 0 *default-log-port* "WARNING: db:sync-tables called with todb missing")
-2)
((not (sqlite3:database? (dbr:dbdat-dbh fromdb)))
(debug:print-error 0 *default-log-port* "db:sync-tables called with fromdb not a database " fromdb)
-3)
((not (sqlite3:database? (dbr:dbdat-dbh todb)))
(debug:print-error 0 *default-log-port* "db:sync-tables called with todb not a database " todb)
-4)
|
| ︙ | ︙ | |||
763 764 765 766 767 768 769 | ;; set up the field->num table (for-each (lambda (field) (hash-table-set! field->num field count) (set! count (+ count 1))) fields) | < < | 762 763 764 765 766 767 768 769 770 771 772 773 774 775 |
;; set up the field->num table
(for-each
(lambda (field)
(hash-table-set! field->num field count)
(set! count (+ count 1)))
fields)
;; read the source table
;; store a list of all rows in the table in fromdat, up to batch-len.
;; Then add fromdat to the fromdats list, clear fromdat and repeat.
(sqlite3:for-each-row
(lambda (a . b)
(set! fromdat (cons (apply vector a b) fromdat))
(if (> (length fromdat) batch-len)
|
| ︙ | ︙ | |||
790 791 792 793 794 795 796 |
(set! totrecords (+ totrecords 1)))
;; tack on remaining records in fromdat
(if (not (null? fromdat))
(set! fromdats (cons fromdat fromdats)))
(if (common:low-noise-print 120 "sync-records")
| | | 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 |
(set! totrecords (+ totrecords 1)))
;; tack on remaining records in fromdat
(if (not (null? fromdat))
(set! fromdats (cons fromdat fromdats)))
(if (common:low-noise-print 120 "sync-records")
(debug:print 0 *default-log-port* "found " totrecords " records to sync"))
(sqlite3:for-each-row
(lambda (a . b)
(hash-table-set! todat a (apply vector a b)))
(dbr:dbdat-dbh todb)
full-sel)
|
| ︙ | ︙ | |||
850 851 852 853 854 855 856 |
)
)
))
fromdat-lst))))
fromdats)
| > | > | | 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 |
)
)
))
fromdat-lst))))
fromdats)
(if (> changed-rows 0)
(debug:print 0 *default-log-port* "table " tablename " changed rows: " changed-rows)
)
(sqlite3:finalize! stmth)
(if (member "last_update" field-names)
(db:create-trigger db tablename))))
(append (list todb) slave-dbs)
)
)
)
tbls)
(let* ((runtime (- (current-milliseconds) start-time))
(should-print (or (debug:debug-mode 12)
(common:low-noise-print 120 "db sync" (> runtime 500))))) ;; low and high sync times treated as separate.
(if should-print (debug:print 0 *default-log-port* "INFO: db sync, total run time " runtime " ms"))
(for-each
(lambda (dat)
(let ((tblname (car dat))
(count (cdr dat)))
(set! tot-count (+ tot-count count))
(if (> count 0)
(if should-print (debug:print 0 *default-log-port* (format #f " ~10a ~5a" tblname count))))))
|
| ︙ | ︙ | |||
1053 1054 1055 1056 1057 1058 1059 | ;; )))) ;; Get a lock from the no-sync-db for the from-db, then delta sync the from-db to the to-db, otherwise return #f | | > | > > | < > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 |
;; ))))
;; Get a lock from the no-sync-db for the from-db, then delta sync the from-db to the to-db, otherwise return #f
(define (db:lock-and-delta-sync no-sync-db dbstruct from-db-file runid)
(assert (not *db-sync-in-progress*) "FATAL: db:lock-and-sync called while a sync is in progress.")
(debug:print-info 3 *default-log-port* "db:lock-and-delta-sync")
(let* ((lockdat (db:no-sync-get-lock no-sync-db from-db-file))
(gotlock (car lockdat))
(locktime (cdr lockdat)))
(debug:print-info 3 *default-log-port* "db:lock-and-delta-sync: go lock?")
(if gotlock
(begin
(debug:print 0 *default-log-port* "db:lock-and-delta-sync copying db")
(db:sync-touched dbstruct runid)
(db:no-sync-del! no-sync-db from-db-file)
#t)
(begin
(debug:print 0 *default-log-port* "could not get lock for " from-db-file " from no-sync-db")
#f
))))
(define (db:all-db-sync dbstruct)
(db:open-db dbstruct #f)
(let* ((data-synced 0) ;; count of changed records
(tmp-area (common:get-db-tmp-area))
(dbfiles (glob (conc tmp-area"/.db/*.db")))
(sync-durations (make-hash-table))
(no-sync-db (db:open-no-sync-db))
)
(for-each
(lambda (file)
(debug:print-info 3 *default-log-port* "file: " file)
(let* ((fname (conc (pathname-file file) ".db"))
(fulln (conc *toppath*"/.db/"fname))
(time1 (if (file-exists? file)
(file-modification-time file)
(begin
(debug:print-info 0 *default-log-port* "Sync - I do not see file "file)
1)))
(time2 (if (file-exists? fulln)
(file-modification-time fulln)
(begin
(debug:print-info 0 *default-log-port* "Sync - I do not see file "fulln)
0)))
(changed (> time1 time2))
(do-cp (cond
((not (file-exists? fulln)) ;; shouldn't happen, but this might recover
(debug:print-info 0 *default-log-port* "File "fulln" not found! Copying "fname" to "fulln)
#t)
(changed ;; (and changed
;; (> (- (current-seconds) time1) 3)) ;; if file is changed and three seconds have passed.
#t)
((and changed *time-to-exit*) ;; last sync
#t)
(else
#f))))
(if do-cp
(let* ((start-time (current-milliseconds))
(fname (pathname-file file))
(runid (if (string= fname "main") #f (string->number fname)))
)
(debug:print-info 3 *default-log-port* "db:all-db-sync: fname: " fname", delta: " (- time1 time2) " seconds")
(db:lock-and-delta-sync no-sync-db dbstruct fname runid)
(hash-table-set! sync-durations (conc fname".db") (- (current-milliseconds) start-time)))
(debug:print-info 3 *default-log-port* "skipping sync. " file " is up to date")
)
)
)
dbfiles
)
)
#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)
(db:open-db dbstruct #f)
(let* ((data-synced 0) ;; count of changed records
(tmp-area (common:get-db-tmp-area))
(dbfiles (glob (conc tmp-area"/.db/*.db")))
(sync-durations (make-hash-table))
)
|
| ︙ | ︙ | |||
5102 5103 5104 5105 5106 5107 5108 |
(exit 1)))
;;(debug:print 1 *default-log-port* "INFO: ["(common:human-time)"] Syncer started (method="syncer")")
)))
(debug:print-info 13 *default-log-port* "watchdog done."))
(debug:print-info 13 *default-log-port* "no need for watchdog on non-homehost"))))
| | | > | | | > > | > > > | 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 |
(exit 1)))
;;(debug:print 1 *default-log-port* "INFO: ["(common:human-time)"] Syncer started (method="syncer")")
)))
(debug:print-info 13 *default-log-port* "watchdog done."))
(debug:print-info 13 *default-log-port* "no need for watchdog on non-homehost"))))
(define (db:do-sync no-sync-db)
(let* ((syncer (or (configf:lookup *configdat* "server" "sync-method") "delta-sync"))
(dbstruct (db:setup #t)))
(debug:print 0 *default-log-port* "db:do-sync: sync-method: " syncer)
(cond
((equal? syncer "brute-force-sync")
(db:run-lock-and-sync no-sync-db))
((equal? syncer "delta-sync")
(debug:print 0 *default-log-port* "db:do-sync: db:multi-db-sync" )
(let* (
(tmpdbpth (dbr:dbstruct-tmppath dbstruct))
(lockfile (conc tmpdbpth ".lock"))
(locked (common:simple-file-lock lockfile))
(res (if locked
;; sync all dbs for this area
(db:all-db-sync dbstruct)
#f
)
)
)
(if res
(begin
(common:simple-file-release-lock lockfile)
(print "db:do-sync: Synced " res " records to megatest.db")
)
(print "db:do-sync: Skipping sync, there is a sync in progress.")
)
|
| ︙ | ︙ |
Modified dbfile.scm from [d652e662dd] to [b44432f57b].
| ︙ | ︙ | |||
447 448 449 450 451 452 453 |
(retry (lambda ()
(thread-sleep! 1.1)
(if (> tries-left 0)
(dbfile:cautious-open-database fname init-proc (- tries-left 1))))))
(assert (>= tries-left 0) (conc "FATAL: Five attempts in dbfile:cautious-open-database of "fname", giving up."))
(if (and (file-write-access? fname) (not (dbfile:simple-file-lock lock-file)))
(begin
| | | 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 |
(retry (lambda ()
(thread-sleep! 1.1)
(if (> tries-left 0)
(dbfile:cautious-open-database fname init-proc (- tries-left 1))))))
(assert (>= tries-left 0) (conc "FATAL: Five attempts in dbfile:cautious-open-database of "fname", giving up."))
(if (and (file-write-access? fname) (not (dbfile:simple-file-lock lock-file)))
(begin
(dbfile:print-err "INFO: dbfile:cautious-open-database: lock file " lock-file " exists, trying again in 1 second.")
(thread-sleep! 1)
(dbfile:cautious-open-database fname init-proc (- tries-left 1)))
(let* ((db-exists (file-exists? fname))
(result (condition-case
(let* ((db (sqlite3:open-database fname)))
(if (and init-proc (not db-exists))
(init-proc db))
|
| ︙ | ︙ |
Modified http-transport.scm from [5185faa44b] to [c12a4eb4f0].
| ︙ | ︙ | |||
391 392 393 394 395 396 397 398 399 400 401 402 403 404 |
;;
(define (http-transport:client-connect iface port server-id)
(let* ((api-url (conc "http://" iface ":" port "/api"))
(api-uri (uri-reference (conc "http://" iface ":" port "/api")))
(api-req (make-request method: 'POST uri: api-uri))
(server-dat (vector iface port api-uri api-url api-req (current-seconds) server-id)))
server-dat))
;; run http-transport:keep-running in a parallel thread to monitor that the db is being
;; used and to shutdown after sometime if it is not.
;;
(define (http-transport:keep-running)
;; if none running or if > 20 seconds since
;; server last used then start shutdown
| > > > | 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 |
;;
(define (http-transport:client-connect iface port server-id)
(let* ((api-url (conc "http://" iface ":" port "/api"))
(api-uri (uri-reference (conc "http://" iface ":" port "/api")))
(api-req (make-request method: 'POST uri: api-uri))
(server-dat (vector iface port api-uri api-url api-req (current-seconds) server-id)))
server-dat))
;; run http-transport:keep-running in a parallel thread to monitor that the db is being
;; used and to shutdown after sometime if it is not.
;;
(define (http-transport:keep-running)
;; if none running or if > 20 seconds since
;; server last used then start shutdown
|
| ︙ | ︙ | |||
470 471 472 473 474 475 476 |
(debug:print 0 *default-log-port* "SERVER: dbprep")
(set! *dbstruct-dbs* (db:setup #t)) ;; run-id)) FIXME!!!
(set! server-going #t)
(debug:print 0 *default-log-port* "SERVER: running, megatest version: " (common:get-full-version)) ;; NOTE: the server is NOT yet marked as running in the log. We do that in the keep-running routine.
;; (thread-start! *watchdog*)
)
| | | > | | 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 |
(debug:print 0 *default-log-port* "SERVER: dbprep")
(set! *dbstruct-dbs* (db:setup #t)) ;; run-id)) FIXME!!!
(set! server-going #t)
(debug:print 0 *default-log-port* "SERVER: running, megatest version: " (common:get-full-version)) ;; NOTE: the server is NOT yet marked as running in the log. We do that in the keep-running routine.
;; (thread-start! *watchdog*)
)
(if no-sync-db
(begin
(debug:print 0 *default-log-port* "keep-running calling db:all-db-sync at " (time->string (seconds->local-time) "%H:%M:%S"))
(db:all-db-sync *dbstruct-dbs*)
;; (db:do-sync no-sync-db)
;; (db:run-lock-and-sync *no-sync-db*)
)
)
)
;; when things go wrong we don't want to be doing the various queries too often
;; so we strive to run this stuff only every four seconds or so.
|
| ︙ | ︙ |
Modified tests/simplerun/thebeginning.scm from [4f9085105b] to [43c4eb8711].
| ︙ | ︙ | |||
9 10 11 12 13 14 15 16 17 18 | ;; dbfile:add-dbdat ;; db:initialize-main-db ;; dbfile:set-subdb ;; db:with-db ;; dbfile:get-subdb ) ;; *************** dbfile.scm tests **************** | > > | | | | | | > | | > < | 9 10 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 |
;; dbfile:add-dbdat
;; db:initialize-main-db
;; dbfile:set-subdb
;; db:with-db
;; dbfile:get-subdb
)
(system "touch /tmp/mmgraham/megatest_localdb/simplerun/.nfs.pdx.disks.icf_gwa_001.mmgraham.fossil.megatest1.7.mod.tests.simplerun/.db/10.db")
;; *************** dbfile.scm tests ****************
;; (debug:print 0 *default-log-port* " tmp area: " (common:get-db-tmp-area))
(define tmpdir (common:get-db-tmp-area))
(test #f #t (dbr:dbstruct? (dbfile:setup #t *toppath* tmpdir)))
(test #f #t (dbr:dbstruct? (db:setup #t)))
(define dbstruct *dbstruct-dbs*)
;; (test #f #t (dbr:subdb? (dbfile:init-subdb dbstruct #f db:initialize-main-db))) ;; this opens the nfs main db
;; (test #f #t (dbr:dbdat? (dbfile:open-db *dbstruct-dbs* #f db:initialize-main-db))) ;; this opens the tmp db.
;; (define maindbdat (dbfile:open-db *dbstruct-dbs* #f db:initialize-main-db)) ;; this opens the tmp db.
;; (dbfile:add-dbdat dbstruct #f maindbdat)
;;(test #f #t (dbr:subdb? (dbfile:get-subdb dbstruct #f)))
;; (test #f #t (dbr:dbdat? (dbfile:get-dbdat dbstruct #f)))
;; (test #f #f (dbr:dbdat? (dbfile:get-dbdat dbstruct #f))) ;; stack empty so should fail.
;; (test #f #t (hash-table? (dbr:dbstruct-subdbs dbstruct)))
;; (test #f #t (stack? (dbr:subdb-dbstack (dbfile:get-subdb dbstruct #f))))
;; (test #f '("SYSTEM" "RELEASE") (db:get-keys *dbstruct-dbs*))
;; (test #f #t (dbr:dbdat? (dbfile:open-db dbstruct 1 db:initialize-main-db)))
;; (test #f #t (dbr:dbdat? (dbfile:open-db dbstruct 2 db:initialize-main-db)))
;; (define rundbdat (dbfile:open-db dbstruct 1 db:initialize-main-db))
;; (define rundbdat2 (dbfile:open-db dbstruct 2 db:initialize-main-db))
;; (define rundbdat3 (dbfile:open-db dbstruct 3 db:initialize-main-db))
;; (dbfile:add-dbdat dbstruct 1 rundbdat)
;; (dbfile:add-dbdat dbstruct 2 rundbdat2)
;; (dbfile:add-dbdat dbstruct 3 rundbdat3)
;; (test #f #t (dbr:subdb? (dbfile:get-subdb dbstruct 1)))
;; (test #f #t (dbr:dbdat? (dbfile:get-dbdat dbstruct 1)))
;; (test #f #t (dbr:subdb? (dbfile:get-subdb dbstruct 2)))
;; (test #f #t (dbr:dbdat? (dbfile:get-dbdat dbstruct 2)))
;; (test #f #t (> (dbfile:lazy-sqlite-db-modification-time ".db/main.db") 0))
;; (test #f #t (> (dbfile:lazy-sqlite-db-modification-time ".db/1.db") 0))
;; (test #f #t (> (dbfile:lazy-sqlite-db-modification-time ".db/2.db") 0))
;; (test #f #t (common:simple-file-lock "./db.lock"))
|
| ︙ | ︙ | |||
70 71 72 73 74 75 76 | ;; (test #f #t (dbr:dbdat? (db:get-db dbstruct 1))) ;; (test #f #t (dbr:dbdat? (db:get-db dbstruct 2))) ;; (dbfile:add-dbdat dbstruct #f maindbdat) ;; (define maindbdat (dbfile:get-dbdat dbstruct #f)) ;; (dbfile:add-dbdat dbstruct #f maindbdat) | | | | | | | | < < | | | | | | < > | | | | | > > > > > > > > > > > > > > > > | 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | ;; (test #f #t (dbr:dbdat? (db:get-db dbstruct 1))) ;; (test #f #t (dbr:dbdat? (db:get-db dbstruct 2))) ;; (dbfile:add-dbdat dbstruct #f maindbdat) ;; (define maindbdat (dbfile:get-dbdat dbstruct #f)) ;; (dbfile:add-dbdat dbstruct #f maindbdat) ;; (define mtdbdat2 (dbr:subdb-mtdbdat (dbfile:get-subdb dbstruct #f))) ;; (define areapath (dbr:dbstruct-areapath dbstruct)) ;; (define mtdbpath (dbfile:run-id->path areapath #f)) ;; (define init-proc db:initialize-main-db) ;; (define mtdbdat (dbfile:open-sqlite3-db mtdbpath init-proc)) ;; (define maindb-handle (dbr:dbdat-dbh mtdbdat)) ;; (define maindb-handle2 (dbr:dbdat-dbh mtdbdat2)) ;; (sqlite3:execute maindb-handle "vacuum") ;; (sqlite3:execute maindb-handle2 "vacuum") ;; (define full-sel (conc "SELECT * from runs")) ;; (sqlite3:for-each-row ;; (lambda (a . b) ;; (debug:print 0 *default-log-port* "a: " a " b: " b) ;; ) ;; maindb-handle ;; full-sel) ;; (test #f #t (db:sync-touched dbstruct #f)) ;; (test #f #t (db:sync-touched dbstruct 1)) ;; (test #f #t (db:sync-touched dbstruct 2)) ;; (test #f #t (dbr:subdb? (dbfile:get-subdb dbstruct #f))) ;; (test #f #t (dbr:subdb? (dbfile:get-subdb dbstruct (string->number "1")))) ;; (test #f #t (dbr:subdb? (dbfile:get-subdb dbstruct 2))) ;; (test #f #t (db:sync-touched dbstruct #f)) ;; (test #f #t (db:sync-touched dbstruct 1)) ;; (test #f #t (db:sync-touched dbstruct 2)) (test #f #t (db:all-db-sync dbstruct)) (exit) ;; (test #f #t (db:close-all dbstruct)) (test #f #t (db:safely-close-sqlite3-db (dbr:dbdat-dbh rundbdat) (dbr:dbdat-stmt-cache rundbdat))) (test #f #t (db:safely-close-sqlite3-db (dbr:dbdat-dbh rundbdat2) (dbr:dbdat-stmt-cache rundbdat2))) (test #f #t (db:safely-close-sqlite3-db (dbr:dbdat-dbh mtdbdat) (dbr:dbdat-stmt-cache mtdbdat))) |