Overview
| Comment: | Refactored db opening, removed some old cruft |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
c95e61dd03589a4bc815e5d889a2ada8 |
| User & Date: | matt on 2014-08-28 22:08:30 |
| Other Links: | branch diff | manifest | tags |
Context
|
2014-08-30
| ||
| 02:00 | Paths in configs must not be built using PWD check-in: 9944381f09 user: matt tags: v1.60 | |
|
2014-08-28
| ||
| 22:08 | Refactored db opening, removed some old cruft check-in: c95e61dd03 user: matt tags: v1.60 | |
| 20:29 | Partial implimentation of dot locking on run-id db creation. check-in: c64332761d user: mrwellan tags: v1.60 | |
Changes
Modified db.scm from [7570a5a330] to [38cafde93b].
| ︙ | ︙ | |||
127 128 129 130 131 132 133 | ;; open an sql database inside a file lock ;; ;; returns: db existed-prior-to-opening ;; (define (db:lock-create-open fname initproc) (if (file-exists? fname) | < | > > > < | > | > > | | | < < | > > | 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 |
;; open an sql database inside a file lock
;;
;; returns: db existed-prior-to-opening
;;
(define (db:lock-create-open fname initproc)
(if (file-exists? fname)
(let ((db (sqlite3:open-database fname)))
(sqlite3:set-busy-handler! db (make-busy-timeout 136000))
(sqlite3:execute db "PRAGMA synchronous = 0;")
db)
(let* ((parent-dir (pathname-directory fname))
(dir-writable (file-write-access? parent-dir)))
(if dir-writable
(let ((lock (obtain-dot-lock fname 1 5 10))
(exists (file-exists? fname))
(db (sqlite3:open-database fname)))
(sqlite3:set-busy-handler! db (make-busy-timeout 136000))
(sqlite3:execute db "PRAGMA synchronous = 0;")
(if (not exists)(initproc db))
(release-dot-lock fname)
db)
(begin
(debug:print 0 "ERROR: no such db in non-writable dir " fname)
(sqlite3:open-database fname))))))
;; This routine creates the db. It is only called if the db is not already opened
;;
(define (db:open-rundb dbstruct run-id) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let* ((local (dbr:dbstruct-get-local dbstruct))
(rdb (if local
(dbr:dbstruct-get-localdb dbstruct run-id)
|
| ︙ | ︙ | |||
167 168 169 170 171 172 173 |
"INSERT OR IGNORE INTO tests (id,run_id,testname,event_time,item_path,state,status) VALUES (?,?,'bogustest',strftime('%s','now'),'nowherepath','DELETED','n/a');"
(* run-id 30000) ;; allow for up to 30k tests per run
run-id)
))) ;; add strings db to rundb, not in use yet
;; )) ;; (sqlite3:open-database dbpath))
(olddb (db:open-megatest-db))
(write-access (file-write-access? dbpath))
| | > < < < < < < < < < < < < < | 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 |
"INSERT OR IGNORE INTO tests (id,run_id,testname,event_time,item_path,state,status) VALUES (?,?,'bogustest',strftime('%s','now'),'nowherepath','DELETED','n/a');"
(* run-id 30000) ;; allow for up to 30k tests per run
run-id)
))) ;; add strings db to rundb, not in use yet
;; )) ;; (sqlite3:open-database dbpath))
(olddb (db:open-megatest-db))
(write-access (file-write-access? dbpath))
;; (handler (make-busy-timeout 136000))
)
(if (and dbexists (not write-access))
(set! *db-write-access* #f)) ;; only unset so other db's also can use this control
(dbr:dbstruct-set-rundb! dbstruct db)
(dbr:dbstruct-set-inuse! dbstruct #t)
(dbr:dbstruct-set-olddb! dbstruct olddb)
;; (dbr:dbstruct-set-run-id! dbstruct run-id)
(if local
(begin
(dbr:dbstruct-set-localdb! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! dbstruct db) ;; direct access ...
|
| ︙ | ︙ | |||
204 205 206 207 208 209 210 |
;; This routine creates the db. It is only called if the db is not already ls opened
;;
(define (db:open-main dbstruct) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let ((mdb (dbr:dbstruct-get-main dbstruct)))
(if mdb
mdb
| < < | < < < | | < < < < < < < < < < < | > > > | < < < < < < < < < | 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 231 232 233 234 235 236 237 238 239 |
;; This routine creates the db. It is only called if the db is not already ls opened
;;
(define (db:open-main dbstruct) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let ((mdb (dbr:dbstruct-get-main dbstruct)))
(if mdb
mdb
(let* ((dbpath (db:dbfile-path 0))
(dbexists (file-exists? dbpath))
(db (db:lock-create-open dbpath db:initialize-main-db))
(olddb (db:open-megatest-db))
(write-access (file-write-access? dbpath)))
(if (and dbexists (not write-access))
(set! *db-write-access* #f))
(dbr:dbstruct-set-main! dbstruct db)
(dbr:dbstruct-set-olddb! dbstruct olddb)
db))))
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
(define (db:setup run-id #!key (local #f))
(let* ((dbdir (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(dbstruct (make-dbr:dbstruct path: dbdir local: local)))
dbstruct))
;; Open the classic megatest.db file in toppath
;;
(define (db:open-megatest-db)
(let* ((dbpath (conc *toppath* "/megatest.db"))
(dbexists (file-exists? dbpath))
(db (db:lock-create-open dbpath
(lambda (db)
(db:initialize-main-db db)
(db:initialize-run-id-db db))))
(write-access (file-write-access? dbpath)))
(if (and dbexists (not write-access))
(set! *db-write-access* #f))
db))
;; sync run to disk if touched
;;
(define (db:sync-touched dbstruct run-id #!key (force-sync #f))
(let ((mtime (dbr:dbstruct-get-mtime dbstruct))
(stime (dbr:dbstruct-get-stime dbstruct))
|
| ︙ | ︙ |