143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
+
-
+
-
|
;; and then return it.
;;
(define (db:get-subdb dbstruct run-id)
(let* ((res (dbfile:get-subdb dbstruct run-id)))
(if res
res
(let* ((newsubdb (make-dbr:subdb)))
(dbfile:set-subdb dbstruct run-id newsubdb)
(db:open-db newsubdb run-id areapath: (dbr:dbstruct-areapath dbstruct) do-sync: #t)
(db:open-db dbstruct run-id areapath: (dbr:dbstruct-areapath dbstruct) do-sync: #t)
(hash-table-set! (dbr:dbstruct-subdbs dbstruct) (dbfile:run-id->key run-id) newsubdb)
newsubdb))))
;; Get/open a database
;; if run-id => get run specific db
;; if #f => get main db
;; if run-id is a string treat it as a filename
;; if db already open - return inmem
|
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
|
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
|
-
-
+
+
+
|
(exn (busy) (debug:print 0 *default-log-port* "ERROR: database " fname " is locked. Try copying to another location, remove original and copy back."))
(exn (permission)(debug:print 0 *default-log-port* "ERROR: database " fname " has some permissions problem."))
(exn () (debug:print 0 *default-log-port* "ERROR: Unknown error with database " fname " message: " ((condition-property-accessor 'exn 'message) exn))))
)))
;; This routine creates the db if not already present. It is only called if the db is not already opened
;;
(define (db:open-db subdb run-id #!key (areapath #f)(do-sync #t)) ;; TODO: actually use areapath
(let* ((tmpdb-stack (dbr:subdb-dbstack subdb))) ;; RA => Returns the first reference in dbstruct
(define (db:open-db dbstruct run-id #!key (areapath #f)(do-sync #t))
(let* ((subdb (dbfile:get-subdb dbstruct run-id))
(tmpdb-stack (dbr:subdb-dbstack subdb)))
(if (stack? tmpdb-stack)
(db:get-db tmpdb-stack run-id) ;; get previously opened db (will create new db handle if all in the stack are already used
(let* ((max-stale-tmp (configf:lookup-number *configdat* "server" "filling-db-max-stale-seconds" default: 10))
(dbpath (db:dbfile-path)) ;; path to tmp db area
(dbname (db:run-id->dbname run-id))
(dbexists (common:file-exists? dbpath))
(mtdbfname (conc *toppath* "/"dbname))
|