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