| ︙ | | |
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
+
|
(import scheme
chicken
data-structures
extras
files
format
(prefix sqlite3 sqlite3:)
matchable
posix
typed-records
srfi-1
srfi-18
srfi-69
|
| ︙ | | |
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
-
-
-
+
+
+
-
-
+
+
|
;;======================================================================
;; The cachedb one-db file per server method goes in here
;;======================================================================
;; NOTE: the r/w is now w/r, #t=db modified by query, #f=db NOT modified by query
(define (dbmod:with-db dbstruct run-id w/r proc params)
(let* ((use-mutex (or (and w/r ;; use the mutex on queries that modify the db and for sync to disk
(> *api-process-request-count* 5)) ;; when writes are happening throttle more
(> *api-process-request-count* 50)))
(let* ((use-mutex w/r) ;; (or (and w/r ;; use the mutex on queries that modify the db and for sync to disk
;; (> *api-process-request-count* 5)) ;; when writes are happening throttle more
;; (> *api-process-request-count* 50)))
(dbdat (dbmod:open-db dbstruct run-id (dbfile:db-init-proc)))
(dbh (dbr:dbdat-dbh dbdat)) ;; this will be the cachedb handle
(dbfile (dbr:dbdat-dbfile dbdat)))
;; if nfs mode do a sync if delta > 2
(let* ((last-update (dbr:dbstruct-last-update dbstruct))
(sync-proc (dbr:dbstruct-sync-proc dbstruct))
#;(let* ((last-update (dbr:dbstruct-last-update dbstruct))
;; (sync-proc (dbr:dbstruct-sync-proc dbstruct))
(curr-secs (current-seconds)))
(if (> (- curr-secs last-update) 5)
(begin
(sync-proc last-update)
;; MOVE THIS CALL TO INSIDE THE sync-proc CALL
(dbr:dbstruct-last-update-set! dbstruct curr-secs)
|
| ︙ | | |
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
|
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
-
+
|
(tmpadj "") ;; add to tmp path
(syncdir 'todisk)) ;; todisk is used when caching in /tmp and writing data back to MTRAH
(let* ((dbstruct (or dbstruct-in (make-dbr:dbstruct areapath: areapath)))
(dbfname (or dbfname-in (dbmod:run-id->dbfname run-id)))
(dbpath (dbmod:get-dbdir dbstruct)) ;; directory where all the .db files are kept
(dbfullname (conc dbpath"/"dbfname)) ;; (dbmod:run-id->full-dbfname dbstruct run-id))
(dbexists (file-exists? dbfullname))
(tmpdir (dbfile:make-tmpdir-name areapath tmpadj))
(tmpdir (common:make-tmpdir-name areapath tmpadj))
(tmpdb (let* ((fname (conc tmpdir"/"dbfname)))
fname))
(cachedb (dbmod:open-cachedb-db init-proc
;; (if (eq? (dbfile:cache-method) 'cachedb)
;; #f
tmpdb
;; )
|
| ︙ | | |
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
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
|
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
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
+
+
-
-
-
-
|
(dbr:dbstruct-dbfile-set! dbstruct dbfullname)
(dbr:dbstruct-dbtmpname-set! dbstruct tmpdb)
(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")
(let* ((syncer-logfile (conc areapath"/logs/"dbfname"-syncer.log"))
(sync-cmd (if (eq? syncdir 'todisk)
(conc "(NBFAKE_LOG="syncer-logfile" nbfake megatest -db2db -from "tmpdb" -to "dbfullname" -period 5 -timeout 10 > /dev/null 2&>1)&")
(conc "(NBFAKE_LOG="syncer-logfile" nbfake megatest -db2db -from "dbfullname" -to "tmpdb" -period 5 -timeout 10 > /dev/null 2&>1)&")))
(synclock-file (conc dbfullname".lock"))
(syncer-running-file (conc dbfullname"-sync-running"))
(synclock-mod-time (if (file-exists? synclock-file)
(handle-exceptions
exn
#f
(file-modification-time synclock-file))
#f))
(thethread (lambda ()
(thread-start!
(make-thread
(lambda ()
(set! *sync-in-progress* #t)
(debug:print-info "Running "sync-cmd)
(if (file-exists? syncer-running-file)
(debug:print-info 0 *default-log-port* "Syncer still running, skipping syncer start.")
(system sync-cmd))
(set! *sync-in-progress* #f)))))))
(if ((if (eq? syncdir 'todisk) < >) ;; use less than for todisk, greater than for from disk
(file-modification-time tmpdb)
(file-modification-time dbfullname))
(debug:print 4 *default-log-port* "Skipping sync, "tmpdb" older than "dbfullname)
(if synclock-mod-time
(if (> (- (current-seconds) synclock-mod-time) 20) ;; something wrong with sync, remove file
(begin
(handle-exceptions
exn
#f
(begin
(debug:print 0 *default-log-port* "Sync lock file " synclock-file "is older than 20 seconds (" synclock-mod-time " seconds). Removing it")
(delete-file synclock-file)
)
)
(thethread))
(debug:print 0 *default-log-port* "Skipping sync, lockfile "synclock-file" found."))
(thethread)))))))
|
| ︙ | | |
854
855
856
857
858
859
860
861
|
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
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
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(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 'todisk keys)))
(sqlite3:finalize! sdb)
(sqlite3:finalize! ddb)
res)))
#f))
)
|