Overview
| Comment: | Added back sync'ing to megatest.db but with simple file locking and much longer delay |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60-zero-local-access |
| Files: | files | file ages | folders |
| SHA1: |
29908b23edeb141d0d17f2dd77ab67ed |
| User & Date: | matt on 2015-11-11 22:28:56 |
| Other Links: | branch diff | manifest | tags |
Context
|
2015-11-11
| ||
| 22:58 | Added simple lock to on-exit call of sync to megatest.db. Set lots of vars when triggers are called. check-in: 2bae638e0f user: matt tags: v1.60-zero-local-access | |
| 22:28 | Added back sync'ing to megatest.db but with simple file locking and much longer delay check-in: 29908b23ed user: matt tags: v1.60-zero-local-access | |
| 20:50 | Merged in recent changes to v1.60 in prep for meld check-in: ab0d1e7633 user: matt tags: v1.60-zero-local-access | |
Changes
Modified common.scm from [2955bbfc6b] to [6b9cb42343].
| ︙ | ︙ | |||
266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 |
;;======================================================================
;; E X I T H A N D L I N G
;;======================================================================
(define (common:legacy-sync-recommended)
(or (args:get-arg "-runtests")
(args:get-arg "-server")
(args:get-arg "-set-run-status")
(args:get-arg "-remove-runs")
(args:get-arg "-get-run-status")
))
(define (common:legacy-sync-required)
(configf:lookup *configdat* "setup" "megatest-db"))
(define (std-exit-procedure)
| > > > > > > > > | | > | > > > > | 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 |
;;======================================================================
;; E X I T H A N D L I N G
;;======================================================================
(define (common:legacy-sync-recommended)
(or (args:get-arg "-runtests")
(args:get-arg "-run")
(args:get-arg "-server")
(args:get-arg "-set-run-status")
(args:get-arg "-remove-runs")
(args:get-arg "-get-run-status")
))
(define (common:legacy-sync-required)
(configf:lookup *configdat* "setup" "megatest-db"))
(define (std-exit-procedure)
;; (let ((dbpath (db:dbfile-path run-id))
;; (lockf (conc dbpath "/." run-id ".lck")))
;; (common:simple-file-lock lockf)
;; (db:multi-db-sync (list run-id) 'new2old)
;; (common:simple-file-release-lock lockf))
(let* ((dbpath (db:dbfile-path run-id))
(lockf (conc dbpath "/." run-id ".lck"))
(no-hurry (if *time-to-exit* ;; hurry up
#f
(begin
(set! *time-to-exit* #t)
#t))))
(debug:print-info 4 "starting exit process, finalizing databases.")
(if (and no-hurry (debug:debug-mode 18))
(rmt:print-db-stats))
(let ((th1 (make-thread (lambda () ;; thread for cleaning up, give it five seconds
(let ((run-ids (hash-table-keys *db-local-sync*)))
(if (and (not (null? run-ids))
(configf:lookup *configdat* "setup" "megatest-db"))
;; was if no-hurry but I always want it sync'd I think ...
;; (if no-hurry (db:multi-db-sync run-ids 'new2old))))
(begin
(common:simple-file-lock lockf)
(db:multi-db-sync run-ids 'new2old)
(common:simple-file-release-lock lockf))))
(if *dbstruct-db* (db:close-all *dbstruct-db*))
(if *inmemdb* (db:close-all *inmemdb*))
(if (and *megatest-db*
(sqlite3:database? *megatest-db*))
(begin
(sqlite3:interrupt! *megatest-db*)
(sqlite3:finalize! *megatest-db* #t)
|
| ︙ | ︙ |
Modified db.scm from [a67df6fe11] to [d10bf78e86].
| ︙ | ︙ | |||
136 137 138 139 140 141 142 | ;; (let ((fdb (db:get-filedb dbstruct))) ;; (filedb:get-path db id))) ;; NB// #f => return dbdir only ;; (was planned to be; zeroth db with name=main.db) ;; (define (db:dbfile-path run-id) | > | > | > > > > > | 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 |
;; (let ((fdb (db:get-filedb dbstruct)))
;; (filedb:get-path db id)))
;; NB// #f => return dbdir only
;; (was planned to be; zeroth db with name=main.db)
;;
(define (db:dbfile-path run-id)
(let* ((dbdirs (filter string?
(list (configf:lookup *configdat* "setup" "dbdir")
(conc *toppath* "/.db")
(conc (configf:lookup *configdat* "setup" "linktree") "/.db"))))
(existing-dirs (filter file-exists? dbdirs))
(dbdir (if (null? existing-dirs)
(or (configf:lookup *configdat* "setup" "dbdir")
(conc *toppath* "/.db"))
(car existing-dirs)))
(fname (if run-id
(if (eq? run-id 0) "main.db" (conc run-id ".db"))
#f)))
(handle-exceptions
exn
(begin
(debug:print 0 "ERROR: Couldn't create path to " dbdir)
|
| ︙ | ︙ |