281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
|
(dbfexists (file-exists? (conc dbpath "/megatest.db")))
(tmpdb (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
(mtdb (db:open-megatest-db))
(mtdbpath (db:dbdat-get-path mtdb))
(mtdbexists (file-exists? mtdbpath))
(refndb (db:open-megatest-db path: dbpath name: "megatest_ref.db"))
(write-access (file-write-access? mtdbpath)))
(BB> "db:open-db>> mtdbpath="mtdbpath" mtdbexists="mtdbexists" and write-access="write-access)
(if (and dbexists (not write-access))
(begin (set! *db-write-access* #f)
(dbr:dbstruct-read-only-set! dbstruct #t)))
(dbr:dbstruct-mtdb-set! dbstruct mtdb)
(dbr:dbstruct-tmpdb-set! dbstruct tmpdb)
(dbr:dbstruct-dbstack-set! dbstruct (make-stack)) ;; BB: why a stack? Why would the number of db's be indeterminate? Is this a legacy of 1.db 2.db .. ?
(stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb) ;; olddb is already a (cons db path)
|
|
|
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
|
(dbfexists (file-exists? (conc dbpath "/megatest.db")))
(tmpdb (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
(mtdb (db:open-megatest-db))
(mtdbpath (db:dbdat-get-path mtdb))
(mtdbexists (file-exists? mtdbpath))
(refndb (db:open-megatest-db path: dbpath name: "megatest_ref.db"))
(write-access (file-write-access? mtdbpath)))
;;(BB> "db:open-db>> mtdbpath="mtdbpath" mtdbexists="mtdbexists" and write-access="write-access)
(if (and dbexists (not write-access))
(begin (set! *db-write-access* #f)
(dbr:dbstruct-read-only-set! dbstruct #t)))
(dbr:dbstruct-mtdb-set! dbstruct mtdb)
(dbr:dbstruct-tmpdb-set! dbstruct tmpdb)
(dbr:dbstruct-dbstack-set! dbstruct (make-stack)) ;; BB: why a stack? Why would the number of db's be indeterminate? Is this a legacy of 1.db 2.db .. ?
(stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb) ;; olddb is already a (cons db path)
|
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
|
(cond
(*dbstruct-db* *dbstruct-db*);; TODO: when multiple areas are supported, this optimization will be a hazard
(else ;;(common:on-homehost?)
(let* ((dbstruct (make-dbr:dbstruct)))
(when (not *toppath*) (launch:setup areapath: areapath))
(db:open-db dbstruct areapath: areapath)
(set! *dbstruct-db* dbstruct)
(BB> "new dbstruct = "(dbr:dbstruct->alist dbstruct))
dbstruct))))
;; (else
;; (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost))
;; (exit 1))))
;; Open the classic megatest.db file (defaults to open in toppath)
;;
|
|
|
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
|
(cond
(*dbstruct-db* *dbstruct-db*);; TODO: when multiple areas are supported, this optimization will be a hazard
(else ;;(common:on-homehost?)
(let* ((dbstruct (make-dbr:dbstruct)))
(when (not *toppath*) (launch:setup areapath: areapath))
(db:open-db dbstruct areapath: areapath)
(set! *dbstruct-db* dbstruct)
;;(BB> "new dbstruct = "(dbr:dbstruct->alist dbstruct))
dbstruct))))
;; (else
;; (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost))
;; (exit 1))))
;; Open the classic megatest.db file (defaults to open in toppath)
;;
|