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 @@ If FILE doesn't exist, create it and initialize it as a new database."
   ;; 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 @@ ids of items referred to."
 
 ;; 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 @@ base16-encoded sha256 hash of the store item denoted by PATH (prefixed with
 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 @@ it's a directory."
 
 (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 @@ be used internally by the daemon's build hook."
       (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