From 33fddb763a71970961e87d26f222951ab7cd353c Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 4 Jun 2018 22:35:48 +0200
Subject: database: Provide a way to specify the schema location.

* guix/store/database.scm (sqlite-register): Add #:schema.  Parameterize
'sql-schema' based on this.
(register-path): Add #:schema and pass it to 'sqlite-register'.
---
 guix/store/database.scm | 30 +++++++++++++++++-------------
 1 file changed, 17 insertions(+), 13 deletions(-)

(limited to 'guix')

diff --git a/guix/store/database.scm b/guix/store/database.scm
index d5e34ef044..0f6d2e2c06 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -88,7 +88,7 @@ (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))
+                                 #:cache? #t))
          (result (sqlite-fold cons '() stmt)))
     (sqlite-finalize stmt)
     (match result
@@ -157,7 +157,8 @@ (define (add-references db referrer references)
 
 ;; XXX figure out caching of statement and database objects... later
 (define* (sqlite-register #:key db-file path (references '())
-                          deriver hash nar-size)
+                          deriver hash nar-size
+                          (schema (sql-schema)))
   "Registers this stuff in a database specified by DB-FILE. PATH is the string
 path of some store item, REFERENCES is a list of string paths which the store
 item PATH refers to (they need to be already registered!), DERIVER is a string
@@ -167,16 +168,17 @@ (define* (sqlite-register #:key db-file path (references '())
 bytes of the store item denoted by PATH after being converted to nar form.
 
 Every store item in REFERENCES must already be registered."
-  (with-database db-file db
-    (let ((id (update-or-insert db #:path path
-                                #:deriver deriver
-                                #:hash hash
-                                #:nar-size nar-size
-                                #:time (time-second (current-time time-utc)))))
-      ;; Call 'path-id' on each of REFERENCES.  This ensures we get a
-      ;; "non-NULL constraint" failure if one of REFERENCES is unregistered.
-      (add-references db id
-                      (map (cut path-id db <>) references)))))
+  (parameterize ((sql-schema schema))
+    (with-database db-file db
+      (let ((id (update-or-insert db #:path path
+                                  #:deriver deriver
+                                  #:hash hash
+                                  #:nar-size nar-size
+                                  #:time (time-second (current-time time-utc)))))
+        ;; Call 'path-id' on each of REFERENCES.  This ensures we get a
+        ;; "non-NULL constraint" failure if one of REFERENCES is unregistered.
+        (add-references db id
+                        (map (cut path-id db <>) references))))))
 
 
 ;;;
@@ -221,7 +223,8 @@ (define (reset-timestamps file)
 
 (define* (register-path path
                         #:key (references '()) deriver prefix
-                        state-directory (deduplicate? #t))
+                        state-directory (deduplicate? #t)
+                        (schema (sql-schema)))
   ;; Priority for options: first what is given, then environment variables,
   ;; then defaults. %state-directory, %store-directory, and
   ;; %store-database-directory already handle the "environment variables /
@@ -267,6 +270,7 @@ (define* (register-path path
       (reset-timestamps real-path)
       (sqlite-register
        #:db-file (string-append db-dir "/db.sqlite")
+       #:schema schema
        #:path to-register
        #:references references
        #:deriver deriver
-- 
cgit v1.2.3