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

setup/doc-db: propagate read-only flag for database connection

Browse Source 
Fixes a problem installation Planet packages under Windows,
for example, where attempting to open a read-only file in
write mode triggers an extremely slow result.

Merge bug fix to v6.0 (pending review)
This commit is contained in:
Matthew Flatt 2013-12-16 12:44:12 -07:00
parent ec5157d78f
commit 0f80c71fab
1 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
racket/collects/setup/doc-db.rkt
View File

@ -29,10 +29,10 @@
(define (doc-db-available?) (define (doc-db-available?)
(sqlite3-available?)) (sqlite3-available?))
(define (doc-db-file->connection db-file) (define (doc-db-file->connection db-file [write? #f])
(define exists? (file-exists? db-file)) (define exists? (file-exists? db-file))
(define db (sqlite3-connect #:database db-file (define db (sqlite3-connect #:database db-file
#:mode 'create #:mode (if write? 'create 'read-only)
#:busy-retry-limit 0)) #:busy-retry-limit 0))
(unless exists? (unless exists?
(call-with-retry/transaction (call-with-retry/transaction
@ -74,7 +74,7 @@
#:teardown [teardown void]) #:teardown [teardown void])
(define db (if (connection? db-file) (define db (if (connection? db-file)
db-file db-file
(doc-db-file->connection db-file))) (doc-db-file->connection db-file write?)))
(setup db) (setup db)
(begin0 (begin0
(call-with-retry/transaction (call-with-retry/transaction
@ -155,8 +155,7 @@
'doc-db-get-provides-timestamp 'doc-db-get-provides-timestamp
db-file db-file
(lambda (db) (lambda (db)
(prepare-tables db) (define pathid (filename->pathid db filename #f))
(define pathid (filename->pathid db filename))
(define row (define row
(query-maybe-row db (~a "SELECT seconds FROM timestamps" (query-maybe-row db (~a "SELECT seconds FROM timestamps"
" WHERE pathid=$1") " WHERE pathid=$1")
@ -272,7 +271,7 @@
#:setup (maybe-attach attach-db-path) #:setup (maybe-attach attach-db-path)
#:teardown (maybe-detach attach-db-path) #:teardown (maybe-detach attach-db-path)
(lambda (db) (lambda (db)
(define pathid (filename->pathid db filename)) (define pathid (filename->pathid db filename #f))
;; Items with no `searches' entries: ;; Items with no `searches' entries:
(define rows (define rows
(query-rows db (~a "SELECT P.stag " (query-rows db (~a "SELECT P.stag "
@ -335,7 +334,7 @@
#:setup (maybe-attach attach-db-path) #:setup (maybe-attach attach-db-path)
#:teardown (maybe-detach attach-db-path) #:teardown (maybe-detach attach-db-path)
(lambda (db) (lambda (db)
(define pathid (filename->pathid db filename)) (define pathid (filename->pathid db filename #f))
(define ((rows->paths in-other?) rows) (define ((rows->paths in-other?) rows)
(for/list ([row (in-list rows)]) (for/list ([row (in-list rows)])
(pathid->filename db (vector-ref row 0) in-other? main-doc-relative-ok?))) (pathid->filename db (vector-ref row 0) in-other? main-doc-relative-ok?)))
@ -397,7 +396,7 @@
pathid)))))) pathid))))))
(define (filename->pathid db filename) (define (filename->pathid db filename [write? #t])
(define filename* (path->main-doc-relative filename)) (define filename* (path->main-doc-relative filename))
(define filename-bytes (cond (define filename-bytes (cond
[(pair? filename*) [(pair? filename*)
@ -412,10 +411,13 @@
(cond (cond
[(not id) [(not id)
(define num (vector-ref (query-row db "SELECT COUNT(pathid) FROM pathids") 0)) (define num (vector-ref (query-row db "SELECT COUNT(pathid) FROM pathids") 0))
(query-exec db "INSERT INTO pathids VALUES ($1, $2, $3)" (when write?
(add1 num) (query-exec db "INSERT INTO pathids VALUES ($1, $2, $3)"
(if (pair? filename*) "y" "n") (add1 num)
filename-bytes) (if (pair? filename*) "y" "n")
filename-bytes))
;; If we can't write, then this result is bogus, but it should lead
;; to empty query results in a transaction:
(add1 num)] (add1 num)]
[else (vector-ref id 0)])) [else (vector-ref id 0)]))