guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

01/19: database: 'with-database' can now initialize new databases.


From: Ludovic Courtès
Subject: 01/19: database: 'with-database' can now initialize new databases.
Date: Thu, 14 Jun 2018 05:17:07 -0400 (EDT)

civodul pushed a commit to branch master
in repository guix.

commit 3931c76154d4f418d5ea9acc5e47bf911d371c24
Author: Ludovic Courtès <address@hidden>
Date:   Mon Jun 4 15:40:09 2018 +0200

    database: 'with-database' can now initialize new databases.
    
    * nix/libstore/schema.sql: Rename to...
    * guix/store/schema.sql: ... this.
    * Makefile.am (nobase_dist_guilemodule_DATA): Add it.
    * nix/local.mk (%D%/libstore/schema.sql.hh): Adjust accordingly.
    * guix/store/database.scm (sql-schema): New variable.
    (sqlite-exec, initialize-database, call-with-database): New procedures.
    (with-database): Rewrite in terms of 'call-with-database'.
    * tests/store-database.scm ("new database"): New test.
    * guix/self.scm (compiled-guix)[*core-modules*]: Add 'schema.sql' to
     #:extra-files.
---
 Makefile.am                             |  1 +
 guix/self.scm                           |  4 ++-
 guix/store/database.scm                 | 50 +++++++++++++++++++++++++++++----
 {nix/libstore => guix/store}/schema.sql |  0
 nix/local.mk                            |  2 +-
 tests/store-database.scm                | 23 +++++++++++++++
 6 files changed, 73 insertions(+), 7 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index 7898a36..0267e8f 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -300,6 +300,7 @@ EXAMPLES =                                  \
 GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go $(dist_noinst_DATA:%.scm=%.go)
 
 nobase_dist_guilemodule_DATA =                                 \
+  guix/store/schema.sql                                                \
   $(MODULES) $(MODULES_NOT_COMPILED) $(AUX_FILES) $(EXAMPLES)  \
   $(MISC_DISTRO_FILES)
 nobase_nodist_guilemodule_DATA = guix/config.scm
diff --git a/guix/self.scm b/guix/self.scm
index e71e086..ed3f31c 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -482,7 +482,9 @@ the modules, and DEPENDENCIES, a list of packages depended 
on.  COMMAND is the
                  ;; but we don't need to compile it; not compiling it allows
                  ;; us to avoid an extra dependency on guile-gdbm-ffi.
                  #:extra-files
-                 `(("guix/man-db.scm" ,(local-file "../guix/man-db.scm")))
+                 `(("guix/man-db.scm" ,(local-file "../guix/man-db.scm"))
+                   ("guix/store/schema.sql"
+                    ,(local-file "../guix/store/schema.sql")))
 
                  #:guile-for-build guile-for-build))
 
diff --git a/guix/store/database.scm b/guix/store/database.scm
index 3623c0e..e81ab3d 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -24,25 +24,65 @@
   #:use-module (guix store deduplication)
   #:use-module (guix base16)
   #:use-module (guix build syscalls)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
+  #:use-module (rnrs io ports)
   #:use-module (ice-9 match)
-  #:export (sqlite-register
+  #:use-module (system foreign)
+  #:export (sql-schema
+            with-database
+            sqlite-register
             register-path
             reset-timestamps))
 
 ;;; Code for working with the store database directly.
 
+(define sql-schema
+  ;; Name of the file containing the SQL scheme or #f.
+  (make-parameter #f))
 
-(define-syntax-rule (with-database file db exp ...)
-  "Open DB from FILE and close it when the dynamic extent of EXP... is left."
-  (let ((db (sqlite-open file)))
+(define sqlite-exec
+  ;; XXX: This is was missing from guile-sqlite3 until
+  ;; 
<https://notabug.org/civodul/guile-sqlite3/commit/b87302f9bcd18a286fed57b2ea521845eb1131d7>.
+  (let ((exec (pointer->procedure
+               int
+               (dynamic-func "sqlite3_exec" (@@ (sqlite3) libsqlite3))
+               '(* * * * *))))
+    (lambda (db text)
+      (let ((ret (exec ((@@ (sqlite3) db-pointer) db)
+                       (string->pointer text)
+                       %null-pointer %null-pointer %null-pointer)))
+        (unless (zero? ret)
+          ((@@ (sqlite3) sqlite-error) db "sqlite-exec" ret))))))
+
+(define (initialize-database db)
+  "Initializing DB, an empty database, by creating all the tables and indexes
+as specified by SQL-SCHEMA."
+  (define schema
+    (or (sql-schema)
+        (search-path %load-path "guix/store/schema.sql")))
+
+  (sqlite-exec db (call-with-input-file schema get-string-all)))
+
+(define (call-with-database file proc)
+  "Pass PROC a database record corresponding to FILE.  If FILE doesn't exist,
+create it and initialize it as a new database."
+  (let ((new? (not (file-exists? file)))
+        (db   (sqlite-open file)))
     (dynamic-wind noop
                   (lambda ()
-                    exp ...)
+                    (when new?
+                      (initialize-database db))
+                    (proc db))
                   (lambda ()
                     (sqlite-close db)))))
 
+(define-syntax-rule (with-database file db exp ...)
+  "Open DB from FILE and close it when the dynamic extent of EXP... is left.
+If FILE doesn't exist, create it and initialize it as a new database."
+  (call-with-database file (lambda (db) exp ...)))
+
 (define (last-insert-row-id db)
   ;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'.
   ;; Work around that.
diff --git a/nix/libstore/schema.sql b/guix/store/schema.sql
similarity index 100%
rename from nix/libstore/schema.sql
rename to guix/store/schema.sql
diff --git a/nix/local.mk b/nix/local.mk
index 3971771..b4c6ba6 100644
--- a/nix/local.mk
+++ b/nix/local.mk
@@ -163,7 +163,7 @@ noinst_HEADERS =                                            
\
   $(libformat_headers) $(libutil_headers) $(libstore_headers)  \
   $(guix_daemon_headers)
 
-%D%/libstore/schema.sql.hh: %D%/libstore/schema.sql
+%D%/libstore/schema.sql.hh: guix/store/schema.sql
        $(AM_V_GEN)$(GUILE) --no-auto-compile -c                \
          "(use-modules (rnrs io ports))                        \
           (call-with-output-file \"address@hidden"                     \
diff --git a/tests/store-database.scm b/tests/store-database.scm
index 1348a75..7947368 100644
--- a/tests/store-database.scm
+++ b/tests/store-database.scm
@@ -20,6 +20,7 @@
   #:use-module (guix tests)
   #:use-module ((guix store) #:hide (register-path))
   #:use-module (guix store database)
+  #:use-module ((guix utils) #:select (call-with-temporary-output-file))
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64))
 
@@ -51,4 +52,26 @@
            (null? (valid-derivers %store file))
            (null? (referrers %store file))))))
 
+(test-equal "new database"
+  (list 1 2)
+  (call-with-temporary-output-file
+   (lambda (db-file port)
+     (delete-file db-file)
+     (sqlite-register #:db-file db-file
+                      #:path "/gnu/foo"
+                      #:references '()
+                      #:deriver "/gnu/foo.drv"
+                      #:hash (string-append "sha256:" (make-string 64 #\e))
+                      #:nar-size 1234)
+     (sqlite-register #:db-file db-file
+                      #:path "/gnu/bar"
+                      #:references '("/gnu/foo")
+                      #:deriver "/gnu/bar.drv"
+                      #:hash (string-append "sha256:" (make-string 64 #\a))
+                      #:nar-size 4321)
+     (let ((path-id (@@ (guix store database) path-id)))
+       (with-database db-file db
+         (list (path-id db "/gnu/foo")
+               (path-id db "/gnu/bar")))))))
+
 (test-end "store-database")



reply via email to

[Prev in Thread] Current Thread [Next in Thread]