53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
(define (dbmod:run-id->full-dbfname dbstruct run-id)
(conc (dbmod:get-dbdir dbstruct run-id)"/"(dbmod:run-id->dbfname run-id)))
;;======================================================================
;; The inmem one-db file per server method goes in here
;;======================================================================
(define (dbmod:open-inmem-db initproc)
(let* ((db (sqlite3:open-database ":memory:"))
(handler (sqlite3:make-busy-timeout 3600)))
(sqlite3:set-busy-handler! db handler)
(initproc db)
db))
(define (dbmod:open-db dbstruct run-id dbinit)
(or (dbr:dbstruct-dbdat dbstruct)
(let* ((dbdat (make-dbr:dbdat
dbfile: (dbr:dbstruct-dbfile dbstruct)
dbh: (dbr:dbstruct-inmen dbstruct)
)))
(dbr:dbstruct-dbdat-set! dbstruct dbdat)
dbdat)))
;; Open the inmem db and the on-disk db
;; populate the inmem db with data
;;
;; Updates fields in dbstruct
;; Returns dbstruct
;;
;; * This routine creates the db if not found
;; * Probably can get rid of the dbstruct-in
;;
(define (db:open-dbmoddb areapath run-id init-proc #!key (dbstruct-in #f)) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let* ((dbstruct (or dbstruct-in (make-dbr:dbstruct areapath: areapath)))
(dbfname (dbmod:run-id->dbfname run-id))
(dbpath (dbmod:get-dbdir dbstruct run-id)) ;; directory where all the .db files are kept
(dbfullname (dbmod:run-id->full-dbfname dbstruct run-id))
(dbexists (file-exists? dbfullname))
(inmem (dbmod:open-inmem-db init-proc))
(write-access (file-write-access? dbpath))
|
>
>
>
>
>
>
|
|
|
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
(define (dbmod:run-id->full-dbfname dbstruct run-id)
(conc (dbmod:get-dbdir dbstruct run-id)"/"(dbmod:run-id->dbfname run-id)))
;;======================================================================
;; The inmem one-db file per server method goes in here
;;======================================================================
(define (dbmod:with-db dbstruct run-id r/w proc params)
(let* ((dbdat (dbmod:open-db dbstruct run-id (dbfile:db-init-proc)))
(dbh (dbr:dbdat-dbh dbdat))
(dbfile (dbr:dbdat-dbfile dbdat)))
(apply proc dbdat dbh params)))
(define (dbmod:open-inmem-db initproc)
(let* ((db (sqlite3:open-database ":memory:"))
(handler (sqlite3:make-busy-timeout 3600)))
(sqlite3:set-busy-handler! db handler)
(initproc db)
db))
(define (dbmod:open-db dbstruct run-id dbinit)
(or (dbr:dbstruct-dbdat dbstruct)
(let* ((dbdat (make-dbr:dbdat
dbfile: (dbr:dbstruct-dbfile dbstruct)
dbh: (dbr:dbstruct-inmem dbstruct)
)))
(dbr:dbstruct-dbdat-set! dbstruct dbdat)
dbdat)))
;; Open the inmem db and the on-disk db
;; populate the inmem db with data
;;
;; Updates fields in dbstruct
;; Returns dbstruct
;;
;; * This routine creates the db if not found
;; * Probably can get rid of the dbstruct-in
;;
(define (dbmod:open-dbmoddb areapath run-id init-proc #!key (dbstruct-in #f)) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let* ((dbstruct (or dbstruct-in (make-dbr:dbstruct areapath: areapath)))
(dbfname (dbmod:run-id->dbfname run-id))
(dbpath (dbmod:get-dbdir dbstruct run-id)) ;; directory where all the .db files are kept
(dbfullname (dbmod:run-id->full-dbfname dbstruct run-id))
(dbexists (file-exists? dbfullname))
(inmem (dbmod:open-inmem-db init-proc))
(write-access (file-write-access? dbpath))
|
105
106
107
108
109
110
111
112
113
|
(dbr:dbstruct-dbfile-set! dbstruct dbfullname)
dbstruct))
(define (dbmod:close-db dbstruct)
;; do final sync to disk file
;; (do-sync ...)
(sqlite3:finalize! (dbr:dbstruct-ondiskdb dbstruct)))
)
|
>
>
>
|
>
>
|
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
(dbr:dbstruct-dbfile-set! dbstruct dbfullname)
dbstruct))
(define (dbmod:close-db dbstruct)
;; do final sync to disk file
;; (do-sync ...)
(sqlite3:finalize! (dbr:dbstruct-ondiskdb dbstruct)))
;;======================================================================
;; Moved from dbfile
;;======================================================================
)
|