aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.dir-locals.el1
-rw-r--r--guix/store/database.scm53
2 files changed, 30 insertions, 24 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index dc8bc0e437..77c12f9411 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -89,6 +89,7 @@
(eval . (put 'with-database 'scheme-indent-function 2))
(eval . (put 'call-with-transaction 'scheme-indent-function 2))
+ (eval . (put 'with-statement 'scheme-indent-function 3))
(eval . (put 'call-with-container 'scheme-indent-function 1))
(eval . (put 'container-excursion 'scheme-indent-function 1))
diff --git a/guix/store/database.scm b/guix/store/database.scm
index ae7e96df2f..e74c4ba991 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -141,14 +141,26 @@ If FILE doesn't exist, create it and initialize it as a new database."
(sqlite-reset stmt)
((@ (sqlite3) sqlite-finalize) stmt))
+(define (call-with-statement db sql proc)
+ (let ((stmt (sqlite-prepare db sql #:cache? #t)))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (proc stmt))
+ (lambda ()
+ (sqlite-finalize stmt)))))
+
+(define-syntax-rule (with-statement db sql stmt exp ...)
+ "Run EXP... with STMT bound to a prepared statement corresponding to the sql
+string SQL for DB."
+ (call-with-statement db sql
+ (lambda (stmt) exp ...)))
+
(define (last-insert-row-id db)
;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'.
;; Work around that.
- (let* ((stmt (sqlite-prepare db "SELECT last_insert_rowid();"
- #:cache? #t))
- (result (sqlite-fold cons '() stmt)))
- (sqlite-finalize stmt)
- (match result
+ (with-statement db "SELECT last_insert_rowid();" stmt
+ (match (sqlite-fold cons '() stmt)
((#(id)) id)
(_ #f))))
@@ -158,13 +170,11 @@ If FILE doesn't exist, create it and initialize it as a new database."
(define* (path-id db path)
"If PATH exists in the 'ValidPaths' table, return its numerical
identifier. Otherwise, return #f."
- (let ((stmt (sqlite-prepare db path-id-sql #:cache? #t)))
+ (with-statement db path-id-sql stmt
(sqlite-bind-arguments stmt #:path path)
- (let ((result (sqlite-fold cons '() stmt)))
- (sqlite-finalize stmt)
- (match result
- ((#(id) . _) id)
- (_ #f)))))
+ (match (sqlite-fold cons '() stmt)
+ ((#(id) . _) id)
+ (_ #f))))
(define update-sql
"UPDATE ValidPaths SET hash = :hash, registrationTime = :time, deriver =
@@ -181,20 +191,17 @@ and re-inserting instead of updating, which causes problems with foreign keys,
of course. Returns the row id of the row that was modified or inserted."
(let ((id (path-id db path)))
(if id
- (let ((stmt (sqlite-prepare db update-sql #:cache? #t)))
+ (with-statement db update-sql stmt
(sqlite-bind-arguments stmt #:id id
#:deriver deriver
#:hash hash #:size nar-size #:time time)
- (sqlite-fold cons '() stmt)
- (sqlite-finalize stmt)
- (last-insert-row-id db))
- (let ((stmt (sqlite-prepare db insert-sql #:cache? #t)))
+ (sqlite-fold cons '() stmt))
+ (with-statement db insert-sql stmt
(sqlite-bind-arguments stmt
#:path path #:deriver deriver
#:hash hash #:size nar-size #:time time)
- (sqlite-fold cons '() stmt) ;execute it
- (sqlite-finalize stmt)
- (last-insert-row-id db)))))
+ (sqlite-fold cons '() stmt)))
+ (last-insert-row-id db)))
(define add-reference-sql
"INSERT OR REPLACE INTO Refs (referrer, reference) VALUES (:referrer, :reference);")
@@ -202,15 +209,13 @@ of course. Returns the row id of the row that was modified or inserted."
(define (add-references db referrer references)
"REFERRER is the id of the referring store item, REFERENCES is a list
ids of items referred to."
- (let ((stmt (sqlite-prepare db add-reference-sql #:cache? #t)))
+ (with-statement db add-reference-sql stmt
(for-each (lambda (reference)
(sqlite-reset stmt)
(sqlite-bind-arguments stmt #:referrer referrer
#:reference reference)
- (sqlite-fold cons '() stmt) ;execute it
- (last-insert-row-id db))
- references)
- (sqlite-finalize stmt)))
+ (sqlite-fold cons '() stmt))
+ references)))
(define* (sqlite-register db #:key path (references '())
deriver hash nar-size time)