pkg/db: add support for grouping calls as a single transaction
Also avoids reundant table-preparation checks for calls that are grouped together.
This commit is contained in:
Matthew Flatt
parent
7596668762
commit
596a4f655c
|
|
@ -46,6 +46,16 @@ determined by @racket[(find-system-path 'addon-dir)] and within a
|
|||
subdirectory determined by @racket[get-installation-name].}
|
||||
|
||||
|
||||
@defproc[(call-with-pkgs-transaction [proc (-> any)]) any]{
|
||||
|
||||
Calls @racket[proc] so that multiple calls to other
|
||||
@racketmodname[pkg/db] functions are grouped as a database
|
||||
transaction, which avoids the overhead of making each individual call
|
||||
its own transaction.
|
||||
|
||||
@history[#:added "6.1.1.5"]}
|
||||
|
||||
|
||||
@deftogether[(
|
||||
@defproc[(get-catalogs) (listof string?)]
|
||||
@defproc[(set-catalogs! [catalogs (listof string?)]) void?]
|
||||
|
|
|
|||
|
|
@ -13,6 +13,8 @@
|
|||
(contract-out
|
||||
[current-pkg-catalog-file
|
||||
(parameter/c path-string?)]
|
||||
|
||||
[call-with-pkgs-transaction ((-> any) . -> . any)]
|
||||
|
||||
[get-catalogs (-> (listof string?))]
|
||||
[set-catalogs! ((listof string?) . -> . void?)]
|
||||
|
|
@ -125,21 +127,50 @@
|
|||
"pkgs"
|
||||
"catalog.sqlite")))
|
||||
|
||||
(define-struct catalog-db (connection in-transaction? ready-tables))
|
||||
(define current-catalog-db (make-parameter #f))
|
||||
|
||||
(define (call-with-pkgs-transaction proc)
|
||||
(call-with-catalog-db
|
||||
(lambda (db)
|
||||
(call-with-transaction
|
||||
(catalog-db-connection db)
|
||||
(lambda ()
|
||||
(parameterize ([current-catalog-db
|
||||
(make-catalog-db (catalog-db-connection db)
|
||||
#t
|
||||
(make-hash))])
|
||||
(proc)))))))
|
||||
|
||||
(define (call-with-catalog-db proc)
|
||||
(define file (current-pkg-catalog-file))
|
||||
(define dir (path-only file))
|
||||
(when dir
|
||||
(unless (directory-exists? dir)
|
||||
(make-directory* dir)))
|
||||
(define catalog-db (current-catalog-db))
|
||||
(define db #f)
|
||||
(dynamic-wind
|
||||
(lambda ()
|
||||
(define file (current-pkg-catalog-file))
|
||||
(define dir (path-only file))
|
||||
(when dir
|
||||
(unless (directory-exists? dir)
|
||||
(make-directory* dir)))
|
||||
(set! db (sqlite3-connect #:database file
|
||||
#:mode 'create
|
||||
#:busy-retry-limit +inf.0)))
|
||||
(lambda () (proc db))
|
||||
(set! db (if catalog-db
|
||||
(catalog-db-connection catalog-db)
|
||||
(sqlite3-connect #:database file
|
||||
#:mode 'create
|
||||
#:busy-retry-limit +inf.0))))
|
||||
(lambda () (proc (or catalog-db
|
||||
(make-catalog-db db #f (make-hash)))))
|
||||
(lambda ()
|
||||
(disconnect db))))
|
||||
(unless catalog-db
|
||||
(disconnect db)))))
|
||||
|
||||
(define (call-with-catalog-transaction db proc)
|
||||
(if (catalog-db-in-transaction? db)
|
||||
;; In one big transaction:
|
||||
(proc)
|
||||
;; Not already in one big transaction:
|
||||
(call-with-transaction
|
||||
(catalog-db-connection db)
|
||||
proc)))
|
||||
|
||||
(define (get-pkgs #:name [name #f]
|
||||
#:catalog [catalog #f])
|
||||
|
|
@ -150,7 +181,7 @@
|
|||
(for/list ([row (in-list
|
||||
(apply
|
||||
query-rows
|
||||
db
|
||||
(catalog-db-connection db)
|
||||
(~a "SELECT K.name, N.url, K.author, K.source, K.checksum, K.desc"
|
||||
" FROM pkg K, catalog N"
|
||||
" WHERE N.id = K.catalog"
|
||||
|
|
@ -184,11 +215,11 @@
|
|||
(prepare-pkg-table db)
|
||||
(prepare-modules-table db)
|
||||
(prepare-dependencies-table db)
|
||||
(call-with-transaction
|
||||
(call-with-catalog-transaction
|
||||
db
|
||||
(lambda ()
|
||||
(define catalog-id (url->catalog db catalog))
|
||||
(query db
|
||||
(query (catalog-db-connection db)
|
||||
(~a "UPDATE pkg"
|
||||
" SET author=$1, source=$2, checksum=$3, desc=$4"
|
||||
" WHERE name=$5"
|
||||
|
|
@ -196,13 +227,13 @@
|
|||
author source checksum desc
|
||||
name catalog-id)
|
||||
(when clear-other-checksums?
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
(~a "DELETE FROM modules"
|
||||
" WHERE catalog=$1 AND pkg=$2 AND checksum<>$3")
|
||||
catalog-id
|
||||
name
|
||||
checksum)
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
(~a "DELETE FROM dependencies"
|
||||
" WHERE catalog=$1 AND pkg=$2 AND checksum<>$3")
|
||||
catalog-id
|
||||
|
|
@ -217,7 +248,7 @@
|
|||
(prepare-pkg-table db)
|
||||
(prepare-tags-table db)
|
||||
(define catalog-id (url->catalog db catalog))
|
||||
(query-list db
|
||||
(query-list (catalog-db-connection db)
|
||||
(~a "SELECT tag FROM tags"
|
||||
" WHERE catalog=$1"
|
||||
" AND pkg=$2")
|
||||
|
|
@ -230,18 +261,18 @@
|
|||
(prepare-catalog-table db)
|
||||
(prepare-pkg-table db)
|
||||
(prepare-tags-table db)
|
||||
(call-with-transaction
|
||||
(call-with-catalog-transaction
|
||||
db
|
||||
(lambda ()
|
||||
(define catalog-id (url->catalog db catalog))
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
(~a "DELETE FROM tags"
|
||||
" WHERE catalog=$1"
|
||||
" AND pkg=$2")
|
||||
catalog-id
|
||||
name)
|
||||
(for ([tag (in-list tags)])
|
||||
(query db
|
||||
(query (catalog-db-connection db)
|
||||
(~a "INSERT INTO tags"
|
||||
" VALUES ($1, $2, $3)")
|
||||
name catalog-id tag)))))))
|
||||
|
|
@ -255,7 +286,7 @@
|
|||
(define catalog-id (url->catalog db catalog))
|
||||
(map
|
||||
string->mod
|
||||
(query-list db
|
||||
(query-list (catalog-db-connection db)
|
||||
(~a "SELECT name FROM modules"
|
||||
" WHERE catalog=$1"
|
||||
" AND pkg=$2"
|
||||
|
|
@ -270,11 +301,11 @@
|
|||
(prepare-catalog-table db)
|
||||
(prepare-pkg-table db)
|
||||
(prepare-modules-table db)
|
||||
(call-with-transaction
|
||||
(call-with-catalog-transaction
|
||||
db
|
||||
(lambda ()
|
||||
(define catalog-id (url->catalog db catalog))
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
(~a "DELETE FROM modules"
|
||||
" WHERE catalog=$1"
|
||||
" AND pkg=$2"
|
||||
|
|
@ -283,7 +314,7 @@
|
|||
name
|
||||
checksum)
|
||||
(for ([mod (in-list modules)])
|
||||
(query db
|
||||
(query (catalog-db-connection db)
|
||||
(~a "INSERT INTO modules"
|
||||
" VALUES ($1, $2, $3, $4)")
|
||||
(mod->string mod) name catalog-id checksum)))))))
|
||||
|
|
@ -294,7 +325,7 @@
|
|||
(prepare-catalog-table db)
|
||||
(prepare-modules-table db)
|
||||
(define rows
|
||||
(query-rows db
|
||||
(query-rows (catalog-db-connection db)
|
||||
(~a "SELECT M.pkg, P.url, M.checksum"
|
||||
" FROM modules M, catalog P"
|
||||
" WHERE M.name = $1"
|
||||
|
|
@ -320,7 +351,7 @@
|
|||
(define rows
|
||||
(apply
|
||||
query-rows
|
||||
db
|
||||
(catalog-db-connection db)
|
||||
(~a "SELECT K.name, N.url, K.checksum"
|
||||
" FROM pkg K, catalog N"
|
||||
" WHERE N.id = K.catalog"
|
||||
|
|
@ -353,7 +384,7 @@
|
|||
(prepare-dependencies-table db)
|
||||
(define catalog-id (url->catalog db catalog))
|
||||
(define rows
|
||||
(query-rows db
|
||||
(query-rows (catalog-db-connection db)
|
||||
(~a "SELECT onpkg, onversion, onplatform"
|
||||
" FROM dependencies"
|
||||
" WHERE catalog=$1"
|
||||
|
|
@ -384,11 +415,11 @@
|
|||
(prepare-catalog-table db)
|
||||
(prepare-pkg-table db)
|
||||
(prepare-dependencies-table db)
|
||||
(call-with-transaction
|
||||
(call-with-catalog-transaction
|
||||
db
|
||||
(lambda ()
|
||||
(define catalog-id (url->catalog db catalog))
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
(~a "DELETE FROM dependencies"
|
||||
" WHERE catalog=$1"
|
||||
" AND pkg=$2"
|
||||
|
|
@ -397,7 +428,7 @@
|
|||
name
|
||||
checksum)
|
||||
(for ([dep (in-list dependencies)])
|
||||
(query db
|
||||
(query (catalog-db-connection db)
|
||||
(~a "INSERT INTO dependencies"
|
||||
" VALUES ($1, $2, $3, $4, $5, $6)")
|
||||
(cond
|
||||
|
|
@ -422,8 +453,9 @@
|
|||
(call-with-catalog-db
|
||||
(lambda (db)
|
||||
(prepare-catalog-table db)
|
||||
(query-list db (~a "SELECT url FROM catalog"
|
||||
" ORDER BY pos")))))
|
||||
(query-list (catalog-db-connection db)
|
||||
(~a "SELECT url FROM catalog"
|
||||
" ORDER BY pos")))))
|
||||
|
||||
(define (set-catalogs! urls)
|
||||
(call-with-catalog-db
|
||||
|
|
@ -433,52 +465,54 @@
|
|||
(prepare-tags-table db)
|
||||
(prepare-modules-table db)
|
||||
(prepare-dependencies-table db)
|
||||
(call-with-transaction
|
||||
(call-with-catalog-transaction
|
||||
db
|
||||
(lambda ()
|
||||
(define current-url+ids
|
||||
(query-rows db "SELECT url, id FROM catalog"))
|
||||
(query-rows (catalog-db-connection db) "SELECT url, id FROM catalog"))
|
||||
(define old-urls (for/list ([old (in-list current-url+ids)])
|
||||
(vector-ref old 0)))
|
||||
(for ([old (in-list current-url+ids)])
|
||||
(define old-url (vector-ref old 0))
|
||||
(define old-id (vector-ref old 1))
|
||||
(unless (member old-url urls)
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
"DELETE FROM catalog WHERE id=$1"
|
||||
old-id)
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
"DELETE FROM pkg WHERE catalog=$1"
|
||||
old-id)
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
"DELETE FROM tags WHERE catalog=$1"
|
||||
old-id)
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
"DELETE FROM modules WHERE catalog=$1"
|
||||
old-id)
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
"DELETE FROM dependencies WHERE catalog=$1"
|
||||
old-id)))
|
||||
(for ([new-url (in-list urls)])
|
||||
(unless (member new-url old-urls)
|
||||
(let loop ([id 0])
|
||||
(if (query-maybe-row db
|
||||
(if (query-maybe-row (catalog-db-connection db)
|
||||
"SELECT url FROM catalog WHERE id=$1"
|
||||
id)
|
||||
(loop (add1 id))
|
||||
(query-exec db "INSERT INTO catalog VALUES ($1, $2, 0)"
|
||||
(query-exec (catalog-db-connection db)
|
||||
"INSERT INTO catalog VALUES ($1, $2, 0)"
|
||||
id
|
||||
new-url)))))
|
||||
(for ([new-url (in-list urls)]
|
||||
[pos (in-naturals)])
|
||||
(query-exec db (~a "UPDATE catalog"
|
||||
" SET pos = $1"
|
||||
" WHERE url = $2")
|
||||
(query-exec (catalog-db-connection db)
|
||||
(~a "UPDATE catalog"
|
||||
" SET pos = $1"
|
||||
" WHERE url = $2")
|
||||
pos
|
||||
new-url)))))))
|
||||
|
||||
(define (url->catalog db url)
|
||||
(query-value db
|
||||
(query-value (catalog-db-connection db)
|
||||
"SELECT id FROM catalog WHERE url=$1"
|
||||
url))
|
||||
|
||||
|
|
@ -490,7 +524,7 @@
|
|||
(prepare-pkg-table db)
|
||||
(prepare-modules-table db)
|
||||
(prepare-dependencies-table db)
|
||||
(call-with-transaction
|
||||
(call-with-catalog-transaction
|
||||
db
|
||||
(lambda ()
|
||||
(define catalog (url->catalog db url))
|
||||
|
|
@ -499,25 +533,26 @@
|
|||
(pkg-name p)
|
||||
p)))
|
||||
(define current-pkgs
|
||||
(query-list db "SELECT name FROM pkg WHERE catalog=$1"
|
||||
(query-list (catalog-db-connection db)
|
||||
"SELECT name FROM pkg WHERE catalog=$1"
|
||||
catalog))
|
||||
(define new-pkgs (list->set pkg-names))
|
||||
(define old-pkgs (list->set current-pkgs))
|
||||
(for ([old (in-list current-pkgs)])
|
||||
(unless (set-member? new-pkgs old)
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
"DELETE FROM pkg WHERE catalog=$1 AND name=$2"
|
||||
catalog
|
||||
old)
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
"DELETE FROM tags WHERE catalog=$1 AND pkg=$2"
|
||||
catalog
|
||||
old)
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
"DELETE FROM modules WHERE catalog=$1 AND pkg=$2"
|
||||
catalog
|
||||
old)
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
"DELETE FROM dependencies WHERE catalog=$1 AND pkg=$2"
|
||||
catalog
|
||||
old)))
|
||||
|
|
@ -527,13 +562,13 @@
|
|||
(pkg new0 "" "" "" "" "")))
|
||||
(when (and clear-other-checksums?
|
||||
(not (equal? "" (pkg-checksum new))))
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
(~a "DELETE FROM modules"
|
||||
" WHERE catalog=$1 AND pkg=$2 AND checksum<>$3")
|
||||
catalog
|
||||
(pkg-name new)
|
||||
(pkg-checksum new))
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
(~a "DELETE FROM dependencies"
|
||||
" WHERE catalog=$1 AND pkg=$2 AND checksum<>$3")
|
||||
catalog
|
||||
|
|
@ -542,7 +577,7 @@
|
|||
(unless (and (string? new0)
|
||||
(set-member? old-pkgs new0))
|
||||
(if (set-member? old-pkgs (pkg-name new))
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
(~a "UPDATE pkg"
|
||||
" SET author=$1, source=$2, checksum=$3, desc=$4"
|
||||
" WHERE name=$5"
|
||||
|
|
@ -553,7 +588,7 @@
|
|||
(pkg-desc new)
|
||||
(pkg-name new)
|
||||
catalog)
|
||||
(query-exec db
|
||||
(query-exec (catalog-db-connection db)
|
||||
"INSERT INTO pkg VALUES ($1, $2, $3, $4, $5, $6)"
|
||||
(pkg-name new)
|
||||
catalog
|
||||
|
|
@ -563,11 +598,17 @@
|
|||
(pkg-desc new))))))))))
|
||||
|
||||
(define (prepare-table db which desc [index #f])
|
||||
(when (null?
|
||||
(query-rows db (~a "SELECT name FROM sqlite_master"
|
||||
" WHERE type='table' AND name='" which "'")))
|
||||
(query-exec db (~a "CREATE TABLE " which " "
|
||||
desc))
|
||||
(when index
|
||||
(query-exec db (~a "CREATE INDEX " which "_index "
|
||||
"ON " which " " index)))))
|
||||
(define ready-tables (catalog-db-ready-tables db))
|
||||
(unless (hash-ref ready-tables which #f)
|
||||
(hash-set! ready-tables which #t)
|
||||
(when (null?
|
||||
(query-rows (catalog-db-connection db)
|
||||
(~a "SELECT name FROM sqlite_master"
|
||||
" WHERE type='table' AND name='" which "'")))
|
||||
(query-exec (catalog-db-connection db)
|
||||
(~a "CREATE TABLE " which " "
|
||||
desc))
|
||||
(when index
|
||||
(query-exec (catalog-db-connection db)
|
||||
(~a "CREATE INDEX " which "_index "
|
||||
"ON " which " " index))))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user