From 596a4f655c653c833e25e0bd3f23f6693445f722 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 26 Nov 2014 06:45:37 -0700 Subject: [PATCH] pkg/db: add support for grouping calls as a single transaction Also avoids reundant table-preparation checks for calls that are grouped together. --- .../racket-doc/pkg/scribblings/db.scrbl | 10 ++ racket/collects/pkg/db.rkt | 165 +++++++++++------- 2 files changed, 113 insertions(+), 62 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/db.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/db.scrbl index d379170e30..4d793f9951 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/db.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/db.scrbl @@ -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?] diff --git a/racket/collects/pkg/db.rkt b/racket/collects/pkg/db.rkt index 375a35f3b2..5a14948651 100644 --- a/racket/collects/pkg/db.rkt +++ b/racket/collects/pkg/db.rkt @@ -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))))))