| ︙ | | | ︙ | |
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
(module dbmod
*
(import scheme
chicken
data-structures
extras
(prefix sqlite3 sqlite3:)
posix
typed-records
srfi-1
srfi-18
srfi-69
commonmod
|
>
>
|
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
(module dbmod
*
(import scheme
chicken
data-structures
extras
files
(prefix sqlite3 sqlite3:)
matchable
posix
typed-records
srfi-1
srfi-18
srfi-69
commonmod
|
| ︙ | | | ︙ | |
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
245
246
247
248
249
250
251
|
(lambda (last-update)
(if *sync-in-progress*
(debug:print 3 *default-log-port* "WARNING: overlapping calls to sync to disk")
(begin
(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)
(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)))))
;; (dbmod:sync-tables tables #f db inmem)
;; (if db
(dbmod:sync-gasket tables #f inmem db dbfullname 'fromdest) ;; ) ;; load into inmem
(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))))
;; direction: 'fromdest 'todest
;;
(define (dbmod:sync-gasket tables last-update inmem dbh dbfname direction)
(assert (sqlite3:database? inmem) "FATAL: sync-gasket: inmem is not a db")
(assert (sqlite3:database? inmem) "FATAL: sync-gasket: dbh is not a db")
(case (dbfile:sync-method)
((none) #f)
((attach)
(dbmod:attach-sync tables inmem dbfname direction))
((newsync)
(dbmod:new-sync tables inmem dbh dbfname direction))
(else
(case direction
((todisk)
(dbmod:sync-tables tables last-update inmem dbh)
)
(else
(dbmod:sync-tables tables last-update dbh inmem))))))
(define (dbmod:close-db dbstruct)
;; do final sync to disk file
;; (do-sync ...)
(sqlite3:finalize! (dbr:dbstruct-ondiskdb dbstruct)))
;;======================================================================
|
|
|
|
|
|
|
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
245
246
247
248
249
250
251
252
253
|
(lambda (last-update)
(if *sync-in-progress*
(debug:print 3 *default-log-port* "WARNING: overlapping calls to sync to disk")
(begin
(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 keys)
(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)))))
;; (dbmod:sync-tables tables #f db inmem)
;; (if db
(dbmod:sync-gasket tables #f inmem db dbfullname 'fromdest keys) ;; ) ;; load into inmem
(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))))
;; direction: 'fromdest 'todest
;;
(define (dbmod:sync-gasket tables last-update inmem dbh dbfname direction keys)
(assert (sqlite3:database? inmem) "FATAL: sync-gasket: inmem is not a db")
(assert (sqlite3:database? inmem) "FATAL: sync-gasket: dbh is not a db")
(case (dbfile:sync-method)
((none) #f)
((attach)
(dbmod:attach-sync tables inmem dbfname direction))
((newsync)
(dbmod:new-sync tables inmem dbh dbfname direction))
(else
(case direction
((todisk)
(dbmod:sync-tables tables last-update keys inmem dbh)
)
(else
(dbmod:sync-tables tables last-update keys dbh inmem))))))
(define (dbmod:close-db dbstruct)
;; do final sync to disk file
;; (do-sync ...)
(sqlite3:finalize! (dbr:dbstruct-ondiskdb dbstruct)))
;;======================================================================
|
| ︙ | | | ︙ | |
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
|
;;
;; if last-update specified ("field-name" . time-in-seconds)
;; then sync only records where field-name >= time-in-seconds
;; IFF field-name exists
;;
;; Use (db:sync-all-tables-list keys) to get the tbls input
;;
(define (dbmod:sync-tables tbls last-update fromdb todb)
(debug:print-info 0 *default-log-port* "dbmod:sync-tables called, from: "fromdb", to: "todb)
(assert (sqlite3:database? fromdb) "FATAL: dbmod:sync-tables called with fromdb not a database" fromdb)
(assert (sqlite3:database? todb) "FATAL: dbmod:sync-tables called with fromdb not a database" todb)
(let ((stmts (make-hash-table)) ;; table-field => stmt
(all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 ))
(numrecs (make-hash-table))
(start-time (current-milliseconds))
|
|
|
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
|
;;
;; if last-update specified ("field-name" . time-in-seconds)
;; then sync only records where field-name >= time-in-seconds
;; IFF field-name exists
;;
;; Use (db:sync-all-tables-list keys) to get the tbls input
;;
(define (dbmod:sync-tables tbls last-update keys fromdb todb)
(debug:print-info 0 *default-log-port* "dbmod:sync-tables called, from: "fromdb", to: "todb)
(assert (sqlite3:database? fromdb) "FATAL: dbmod:sync-tables called with fromdb not a database" fromdb)
(assert (sqlite3:database? todb) "FATAL: dbmod:sync-tables called with fromdb not a database" todb)
(let ((stmts (make-hash-table)) ;; table-field => stmt
(all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 ))
(numrecs (make-hash-table))
(start-time (current-milliseconds))
|
| ︙ | | | ︙ | |
750
751
752
753
754
755
756
757
|
(debug:print-info 0 *default-log-port* "Found old test in LAUNCHED state, test-id=" test-id
" 1 day since event_time marked")
(set! oldlaunched (cons (list test-id run-dir uname testname item-path run-id) oldlaunched)))))
stmth3
run-id))))
(list incompleted oldlaunched toplevels)))
)
|
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
|
(debug:print-info 0 *default-log-port* "Found old test in LAUNCHED state, test-id=" test-id
" 1 day since event_time marked")
(set! oldlaunched (cons (list test-id run-dir uname testname item-path run-id) oldlaunched)))))
stmth3
run-id))))
(list incompleted oldlaunched toplevels)))
;;======================================================================
;; 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))
)
|