suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

remove unused locking layer in the doc database manager

Browse Source
This commit is contained in:
Matthew Flatt 2012-11-24 05:37:52 -07:00
parent 124b5abb7d
commit c12a129b09
1 changed files with 50 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

136
collects/setup/doc-db.rkt
View File

@ -30,7 +30,6 @@
#:busy-retry-limit 0)) #:busy-retry-limit 0))
(unless exists? (unless exists?
(call-with-transaction/retry (call-with-transaction/retry
void
db db
#f #f
(lambda () (lambda ()
@ -47,7 +46,7 @@
(define select-other-path-vq (define select-other-path-vq
(virtual-statement "SELECT atmain, path FROM other.pathids WHERE pathid=$1")) (virtual-statement "SELECT atmain, path FROM other.pathids WHERE pathid=$1"))
(define (call-with-database lock db-file proc (define (call-with-database db-file proc
#:fail [fail #f] #:fail [fail #f]
#:setup [setup void] #:setup [setup void]
#:teardown [teardown void]) #:teardown [teardown void])
@ -60,7 +59,6 @@
(setup db) (setup db)
(begin0 (begin0
(call-with-transaction/retry (call-with-transaction/retry
lock
db db
(if (connection? db-file) (if (connection? db-file)
(lambda () (esc fail)) (lambda () (esc fail))
@ -80,7 +78,6 @@
#:fail [fail #f] #:fail [fail #f]
#:main-doc-relative-ok? [main-doc-relative-ok? #f]) #:main-doc-relative-ok? [main-doc-relative-ok? #f])
(call-with-database (call-with-database
void
db-file db-file
#:fail fail #:fail fail
(lambda (db) (lambda (db)
@ -92,9 +89,8 @@
(pathid->filename db pathid #f main-doc-relative-ok?))))) (pathid->filename db pathid #f main-doc-relative-ok?)))))
(define (add lock db-file elems filename callback) (define (add db-file elems filename callback)
(call-with-database (call-with-database
lock
db-file db-file
(lambda (db) (lambda (db)
(prepare-tables db) (prepare-tables db)
@ -103,9 +99,8 @@
(define stag (~s p)) (define stag (~s p))
(callback db stag pathid))))) (callback db stag pathid)))))
(define (clear lock db-file filename statement) (define (clear db-file filename statement)
(call-with-database (call-with-database
lock
db-file db-file
(lambda (db) (lambda (db)
(prepare-tables db) (prepare-tables db)
@ -113,38 +108,32 @@
(query-exec db statement (query-exec db statement
pathid)))) pathid))))
(define (doc-db-add-provides db-file provides filename (define (doc-db-add-provides db-file provides filename)
#:lock [lock void]) (add db-file provides filename
(add lock db-file provides filename
(lambda (db stag pathid) (lambda (db stag pathid)
(query-exec db "INSERT INTO documented VALUES ($1, $2)" (query-exec db "INSERT INTO documented VALUES ($1, $2)"
stag stag
pathid)))) pathid))))
(define (doc-db-clear-provides db-file filename (define (doc-db-clear-provides db-file filename)
#:lock [lock void]) (clear db-file filename
(clear lock db-file filename
"DELETE FROM documented WHERE pathid=$1")) "DELETE FROM documented WHERE pathid=$1"))
(define (doc-db-add-dependencies db-file depends filename (define (doc-db-add-dependencies db-file depends filename)
#:lock [lock void]) (add db-file depends filename
(add lock db-file depends filename
(lambda (db stag pathid) (lambda (db stag pathid)
(query-exec db "INSERT INTO dependencies VALUES ($1, $2)" (query-exec db "INSERT INTO dependencies VALUES ($1, $2)"
pathid pathid
stag)))) stag))))
(define (doc-db-clear-dependencies db-file filename (define (doc-db-clear-dependencies db-file filename)
#:lock [lock void]) (clear db-file filename
(clear lock db-file filename
"DELETE FROM dependencies WHERE pathid=$1")) "DELETE FROM dependencies WHERE pathid=$1"))
(define (doc-db-add-searches db-file searches filename (define (doc-db-add-searches db-file searches filename)
#:lock [lock void])
(call-with-database (call-with-database
lock
db-file db-file
(lambda (db) (lambda (db)
(prepare-tables db) (prepare-tables db)
@ -162,10 +151,8 @@
setid setid
stag)))))) stag))))))
(define (doc-db-clear-searches db-file filename (define (doc-db-clear-searches db-file filename)
#:lock [lock void])
(call-with-database (call-with-database
lock
db-file db-file
(lambda (db) (lambda (db)
(prepare-tables db) (prepare-tables db)
@ -188,7 +175,6 @@
#:attach [attach-db-path #f] #:attach [attach-db-path #f]
#:main-doc-relative-ok? [main-doc-relative-ok? #f]) #:main-doc-relative-ok? [main-doc-relative-ok? #f])
(call-with-database (call-with-database
void
db-file db-file
#:setup (maybe-attach attach-db-path) #:setup (maybe-attach attach-db-path)
#:teardown (maybe-detach attach-db-path) #:teardown (maybe-detach attach-db-path)
@ -231,7 +217,6 @@
(define (doc-db-check-unsatisfied filename db-file (define (doc-db-check-unsatisfied filename db-file
#:attach [attach-db-path #f]) #:attach [attach-db-path #f])
(call-with-database (call-with-database
void
db-file db-file
#:setup (maybe-attach attach-db-path) #:setup (maybe-attach attach-db-path)
#:teardown (maybe-detach attach-db-path) #:teardown (maybe-detach attach-db-path)
@ -294,7 +279,6 @@
#:attach [attach-db-path #f] #:attach [attach-db-path #f]
#:main-doc-relative-ok? [main-doc-relative-ok? #f]) #:main-doc-relative-ok? [main-doc-relative-ok? #f])
(call-with-database (call-with-database
void
db-file db-file
#:setup (maybe-attach attach-db-path) #:setup (maybe-attach attach-db-path)
#:teardown (maybe-detach attach-db-path) #:teardown (maybe-detach attach-db-path)
@ -321,10 +305,8 @@
pathid)) pathid))
null)))) null))))
(define (doc-db-clean-files db-file ok-files (define (doc-db-clean-files db-file ok-files)
#:lock [lock void])
(call-with-database (call-with-database
lock
db-file db-file
(lambda (db) (lambda (db)
(prepare-tables db) (prepare-tables db)
@ -440,62 +422,44 @@
(regexp-match #rx"the database file is locked$" (regexp-match #rx"the database file is locked$"
(exn-message v)))) (exn-message v))))
;; Call in a transation, and also with a lock if `lock' ;; Call in a transation and handle Sqlite-level lock failures. By
;; implements one. (Even though the database can ;; default, failure uses rollbacks, but `fast-abort' can be provided
;; handle locking, it deosn't handle contention all that ;; for a faster abort by dropping the connection. Don't try to use a
;; well, so we offer the option of manual locking.) ;; connection provided here in any other way on an abort.
;; If `lock' implements a lock, it should expect arguments: 'lock or (define (call-with-transaction/retry db fast-abort thunk)
;; 'unlock, and a boolean to indicate wheter breaks should be enabled
;; while waiting.
;;
;; Handle Sqlite-level lock failures, too. By default, failure
;; uses rollbacks, but `fast-abort' can be provided for a faster
;; abort by dropping the connection. Don't try to use a connection
;; provided here in any other way on an abort.
(define (call-with-transaction/retry lock db fast-abort thunk)
(let ([old-break-paramz (current-break-parameterization)] (let ([old-break-paramz (current-break-parameterization)]
[can-break? (break-enabled)]) [can-break? (break-enabled)])
(parameterize-break (let loop ([pause 0.01])
#f (define (call-with-lock-handler handler thunk)
(lock 'lock can-break?) (with-handlers* ([exn:fail:database-locked?
(dynamic-wind (lambda (exn)
void ;; Try again:
(lambda () (log-doc-db-info "database locked; now waiting ~a seconds" pause)
(call-with-break-parameterization (handler (min 10 (* pause 2))))])
old-break-paramz (thunk)))
(lambda () ((let/ec esc
(let loop ([pause 0.01]) (define success? #f)
(define (call-with-lock-handler handler thunk) (dynamic-wind
(with-handlers* ([exn:fail:database-locked? (lambda ()
(lambda (exn) (call-with-lock-handler
;; Try again: (lambda (pause) (esc (lambda ()
(log-doc-db-info "database locked; now waiting ~a seconds" pause) (sleep pause)
(handler (min 10 (* pause 2))))]) (loop pause))))
(thunk))) (lambda () (start-transaction db))))
((let/ec esc (lambda ()
(define success? #f) (call-with-lock-handler
(dynamic-wind (lambda (pause) (esc (lambda ()
(lambda () (rollback db fast-abort 1)
(call-with-lock-handler (sleep pause)
(lambda (pause) (esc (lambda () (loop pause))))
(sleep pause) (lambda ()
(loop pause)))) (define l (call-with-values thunk list))
(lambda () (start-transaction db)))) (commit-transaction db)
(lambda () (set! success? #t)
(call-with-lock-handler (lambda () (apply values l)))))
(lambda (pause) (esc (lambda () (lambda ()
(rollback db fast-abort 1) (unless success?
(sleep pause) (rollback db fast-abort 1)))))))))
(loop pause))))
(lambda ()
(define l (call-with-values thunk list))
(commit-transaction db)
(set! success? #t)
(lambda () (apply values l)))))
(lambda ()
(unless success?
(rollback db fast-abort 1))))))))))
(lambda () (lock 'unlock #f))))))
(define (rollback db fast-abort count) (define (rollback db fast-abort count)
(when (in-transaction? db) (when (in-transaction? db)