108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
-
-
-
+
+
+
+
+
+
|
;; (dbr:dbstruct-inuse-set! dbstruct #f)
;; (mutex-unlock! *rundb-mutex*))))
;; (db:with-db dbstruct run-id sqlite3:exec "select blah from blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
(let* ((dbdat ;; (if (dbr:dbstruct? dbstruct)
(db:get-db dbstruct run-id))
;; dbstruct)) ;; cheat, allow for passing in a dbdat
(let* ((dbdat (if (dbr:dbstruct? dbstruct)
(db:get-db dbstruct run-id)
(begin
(print-call-chain)
(print "db:with-db called with dbdat instead of dbstruct, FIXME!!")
dbstruct))) ;; cheat, allow for passing in a dbdat
(db (db:dbdat-get-db dbdat)))
(handle-exceptions
exn
(begin
(debug:print-error 0 *default-log-port* "sqlite3 issue in db:with-db, dbstruct=" dbstruct ", run-id=" run-id ", proc=" proc ", params=" params " error: " ((condition-property-accessor 'exn 'message) exn))
(print-call-chain (current-error-port)))
(let ((res (apply proc db params)))
|
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
|
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
|
-
+
|
(define (db:open-db dbstruct) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let ((tmpdb (dbr:dbstruct-tmpdb dbstruct))) ;; RA => Returns the first reference in dbstruct
(if tmpdb
tmpdb
;; (mutex-lock! *rundb-mutex*)
(let* ((dbpath (db:dbfile-path)) ;; 0))
(dbexists (file-exists? dbpath))
(tmpdb (db:open-megatest-db dbdir: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
(tmpdb (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
(mtdb (db:open-megatest-db))
(write-access (file-write-access? dbpath)))
(if (and dbexists (not write-access))
(set! *db-write-access* #f))
(dbr:dbstruct-mtdb-set! dbstruct mtdb)
(dbr:dbstruct-tmpdb-set! dbstruct tmpdb) ;; olddb is already a (cons db path)
;; (mutex-unlock! *rundb-mutex*)
|
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
|
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
|
-
+
|
dbstruct)))
;; Open the classic megatest.db file (defaults to open in toppath)
;;
;; NOTE: returns a dbdat not a dbstruct!
;;
(define (db:open-megatest-db #!key (path #f))
(let* ((dbpath (or path (conc *toppath* "/megatest.db")))
(let* ((dbpath (conc (or path *toppath*) "/megatest.db"))
(dbexists (file-exists? dbpath))
(db (db:lock-create-open dbpath
(lambda (db)
(db:initialize-main-db db)
(db:initialize-run-id-db db))))
(write-access (file-write-access? dbpath)))
(if (and dbexists (not write-access))
|
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
|
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
|
+
-
-
+
+
+
|
(define (db:get-access-mode)
(if (args:get-arg "-use-db-cache") 'cached 'rmt))
;; Add db direct
;;
(define (db:dispatch-query access-mode rmt-cmd db-cmd . params)
(if (eq? access-mode 'cached)
(print "not doing cached calls right now"))
(apply db:call-with-cached-db db-cmd params)
(apply rmt-cmd params)))
;; (apply db:call-with-cached-db db-cmd params)
(apply rmt-cmd params))
;;)
;; return the target db handle so it can be used
;;
(define (db:cache-for-read-only source target #!key (use-last-update #f))
(if (and (hash-table-ref/default *global-db-store* target #f)
(>= (file-modification-time target)(file-modification-time source)))
(hash-table-ref *global-db-store* target)
|