195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
;; megatest area database access functions
;;
(defstruct mtdb
name
db
path)
;; dbname is main.db, 1.db ...
(define (megatest-open-db area-name dbname)
(let* ((mtdbh (area-get-dbh area-name dbname)))
(if mtdbh
mtdbh
(let* ((ainfo (get-area-info area-name))
(path (area-path ainfo))
(dbpath (conc path"/.megatest/"dbname))
(dbexists (and (file-exists? dbpath)
(file-read-access? dbpath))))
(if dbexists
(let* ((db (open-database dbpath)))
(set-busy-handler! db (make-busy-timeout 136000))
(execute db "PRAGMA synchronous = 0;")
(let* ((mtdbh (make-mtdb db: db path: dbpath)))
(area-save-dbh area-name dbname mtdbh)
|
>
>
>
>
>
>
>
>
>
>
>
|
|
>
|
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
|
;; megatest area database access functions
;;
(defstruct mtdb
name
db
path)
;; fall back to old megatest db if .megatest/dbname not found
;;
(define (megatest-find-db path dbname)
(let ((newpath (conc path"/.megatest/"dbname))
(oldpath (conc path"/megatest.db")))
(if (file-exists? newpath)
newpath
(if (file-exists? oldpath)
oldpath
#f))))
;; dbname is main.db, 1.db ...
(define (megatest-open-db area-name dbname)
(let* ((mtdbh (area-get-dbh area-name dbname)))
(if mtdbh
mtdbh
(let* ((ainfo (get-area-info area-name))
(path (area-path ainfo))
(dbpath (megatest-find-db path dbname))
(dbexists (and dbpath
(file-exists? dbpath)
(file-read-access? dbpath))))
(if dbexists
(let* ((db (open-database dbpath)))
(set-busy-handler! db (make-busy-timeout 136000))
(execute db "PRAGMA synchronous = 0;")
(let* ((mtdbh (make-mtdb db: db path: dbpath)))
(area-save-dbh area-name dbname mtdbh)
|