Megatest

Diff
Login

Differences From Artifact [f56a3b83fd]:

To Artifact [14f049015a]:


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))