302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
|
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
|
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
tmpdb))))
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
;; called in http-transport and replicated in rmt.scm for *local* access.
;;
(define (db:setup #!key (areapath #f))
(cond
(or *dbstruct-db* ;; TODO: when multiple areas are supported, this optimization will be a hazard
(if (common:on-homehost?)
(let* ((dbstruct (make-dbr:dbstruct)))
(db:open-db dbstruct areapath: areapath)
(set! *dbstruct-db* dbstruct)
dbstruct)
(begin
(debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost))
(exit 1)))))
(*dbstruct-db* *dbstruct-db*);; TODO: when multiple areas are supported, this optimization will be a hazard
((not (file-write-access? (or areapath *toppath*)))
(let* ((dbstruct (make-dbr:dbstruct)))
(db:open-db dbstruct areapath: areapath)
(set! *dbstruct-db* dbstruct)
dbstruct))
((common:on-homehost?)
(let* ((dbstruct (make-dbr:dbstruct)))
(db:open-db dbstruct areapath: areapath)
(set! *dbstruct-db* 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)
;;
;; NOTE: returns a dbdat not a dbstruct!
;;
(define (db:open-megatest-db #!key (path #f)(name #f))
(let* ((dbpath (conc (or path *toppath*) "/" (or name "megatest.db")))
|