Overview
| Comment: | If .megatest does not exist but megatest.db does, try using it. NOTE: can't work with current calls creating .megatest area. Abandon this but keep the code for now. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.70-ndboard |
| Files: | files | file ages | folders |
| SHA1: |
533667efdefe8d11907888deb415919b |
| User & Date: | matt on 2022-10-31 09:47:31 |
| Other Links: | branch diff | manifest | tags |
Context
|
2022-11-18
| ||
| 12:53 | rebased newdashboard branch forward on v1.70 check-in: 5820f690ed user: mrwellan tags: v1.70-ndboard | |
|
2022-10-31
| ||
| 09:47 | If .megatest does not exist but megatest.db does, try using it. NOTE: can't work with current calls creating .megatest area. Abandon this but keep the code for now. check-in: 533667efde user: matt tags: v1.70-ndboard | |
|
2022-10-30
| ||
| 22:59 | info from -show commands should go to stdout. Misc progress on newdashboard check-in: e4d1922be4 user: matt tags: v1.70-ndboard | |
Changes
Modified newdashboard.scm from [67df0a6428] to [5eb08b6cf2].
| ︙ | ︙ | |||
195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 |
;; 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))
| > > > > > > > > > > > | | > | 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)
|
| ︙ | ︙ |