Package: guix-patches;
Reported by: Clément Lassieur <clement <at> lassieur.org>
Date: Tue, 10 Jul 2018 22:59:02 UTC
Severity: normal
Done: Clément Lassieur <clement <at> lassieur.org>
Bug is archived. No further changes may be made.
Message #14 received at 32121 <at> debbugs.gnu.org (full text, mbox):
From: Clément Lassieur <clement <at> lassieur.org> To: 32121 <at> debbugs.gnu.org Subject: [PATCH 3/5] database: Add support for database upgrades. Date: Wed, 11 Jul 2018 01:02:45 +0200
* Makefile.am: Copy SQL files into their data directory.
* doc/cuirass.texi (Database schema): Document the change.
* src/cuirass/database.scm (%package-sql-dir): New parameter.
(db-load, db-get-version, db-set-version, get-target-version,
get-upgrade-file, db-upgrade): New procedures.
(db-init): Set version corresponding to the existing upgrade-n.sql files.
(db-open): If database exists, upgrade it.
* src/schema.sql: New file.
* src/sql/upgrade-1.sql: New file.
---
Makefile.am | 3 +++
doc/cuirass.texi | 16 ++++++++++---
src/cuirass/database.scm | 50 +++++++++++++++++++++++++++++++++++++---
src/schema.sql | 5 ++++
src/sql/upgrade-1.sql | 7 ++++++
5 files changed, 75 insertions(+), 6 deletions(-)
create mode 100644 src/sql/upgrade-1.sql
diff --git a/Makefile.am b/Makefile.am
index d372b9e..00954b8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -3,6 +3,7 @@
# Copyright © 1995-2016 Free Software Foundation, Inc.
# Copyright © 2016, 2017 Mathieu Lirzin <mthl <at> gnu.org>
# Copyright © 2018 Ludovic Courtès <ludo <at> gnu.org>
+# Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
#
# This file is part of Cuirass.
#
@@ -32,6 +33,7 @@ pkgmoduledir = $(guilesitedir)/$(PACKAGE)
pkgobjectdir = $(guileobjectdir)/$(PACKAGE)
webmoduledir = $(guilesitedir)/web/server
webobjectdir = $(guileobjectdir)/web/server
+sqldir = $(pkgdatadir)/sql
dist_pkgmodule_DATA = \
src/cuirass/base.scm \
@@ -55,6 +57,7 @@ nodist_webobject_DATA = \
$(dist_webmodule_DATA:.scm=.go)
dist_pkgdata_DATA = src/schema.sql
+dist_sql_DATA = src/sql/upgrade-*.sql
TEST_EXTENSIONS = .scm .sh
AM_TESTS_ENVIRONMENT = \
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index b5b27e8..38eb0b0 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -12,7 +12,8 @@ server.
Copyright @copyright{} 2016, 2017 Mathieu Lirzin@*
Copyright @copyright{} 2017 Mathieu Othacehe@*
-Copyright @copyright{} 2018 Ludovic Courtès
+Copyright @copyright{} 2018 Ludovic Courtès@*
+Copyright @copyright{} 2018 Clément Lassieur
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -228,8 +229,8 @@ Cuirass uses a SQLite database to store information about jobs and past
build results, but also to coordinate the execution of jobs.
The database contains the following tables: @code{Specifications},
-@code{Stamps}, @code{Evaluations}, @code{Derivations}, and
-@code{Builds}. The purpose of each of these tables is explained below.
+@code{Stamps}, @code{Evaluations}, @code{Derivations}, @code{Builds} and
+@code{SchemaVersion}. The purpose of each of these tables is explained below.
@section Specifications
@cindex specifications, database
@@ -412,6 +413,15 @@ This text field holds the path of the output.
@end table
+@section SchemaVersion
+@cindex version, database
+
+This table keeps track of the schema version. During the initialization, the
+version @code{v} is compared to the highest @code{n} of the
+@code{sql/upgrade-n.sql} files, so that if that @code{n} is higher than the
+schema version, files @code{sql/upgrade-(v+1).sql} to @code{sql/upgrade-n.sql}
+are loaded and the version is updated.
+
@c *********************************************************************
@node Web API
@chapter Web API
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index a1398bc..188b9a8 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl <at> gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;; Copyright © 2018 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -23,10 +24,13 @@
#:use-module (cuirass utils)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
+ #:use-module (ice-9 ftw)
#:use-module (ice-9 rdelim)
+ #:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-42)
#:use-module (sqlite3)
#:export (;; Procedures.
db-init
@@ -126,6 +130,12 @@ question marks matches the number of arguments to bind."
(string-append %datadir "/" %package))
"/schema.sql")))
+(define %package-sql-dir
+ ;; Define to the directory containing the SQL files.
+ (make-parameter (string-append (or (getenv "CUIRASS_DATADIR")
+ (string-append %datadir "/" %package))
+ "/sql")))
+
(define (read-sql-file file-name)
"Return a list of string containing SQL instructions from FILE-NAME."
(call-with-input-file file-name
@@ -153,6 +163,30 @@ question marks matches the number of arguments to bind."
db)
+(define (db-load db schema)
+ (for-each (cut sqlite-exec db <>)
+ (read-sql-file schema)))
+
+(define (db-get-version db)
+ (if (pair? (sqlite-exec db "SELECT name FROM sqlite_master WHERE \
+type='table' AND name='SchemaVersion';"))
+ (vector-ref
+ (car (sqlite-exec db "SELECT MAX(version) FROM SchemaVersion;")) 0)
+ 0))
+
+(define (db-set-version db version)
+ (sqlite-exec db "INSERT INTO SchemaVersion (version) VALUES (" version
+ ");"))
+
+(define (get-target-version)
+ (apply max
+ (map string->number
+ (map (cut match:substring <> 1)
+ (filter regexp-match?
+ (map (cut string-match
+ "^upgrade-([0-9]+)\\.sql$" <>)
+ (scandir (%package-sql-dir))))))))
+
(define* (db-init #:optional (db-name (%package-database))
#:key (schema (%package-schema-file)))
"Open the database to store and read jobs and builds informations. Return a
@@ -162,10 +196,20 @@ database object."
(delete-file db-name))
(let ((db (sqlite-open db-name (logior SQLITE_OPEN_CREATE
SQLITE_OPEN_READWRITE))))
- (for-each (lambda (sql) (sqlite-exec db sql))
- (read-sql-file schema))
+ (db-load db schema)
+ (db-set-version db (get-target-version))
db))
+(define (get-upgrade-file version)
+ (in-vicinity (%package-sql-dir) (format #f "upgrade-~a.sql" version)))
+
+(define (db-upgrade db)
+ (do-ec (:range version (db-get-version db) (get-target-version))
+ (let ((intermediate-version (1+ version)))
+ (db-load db (get-upgrade-file intermediate-version))
+ (db-set-version db intermediate-version)))
+ db)
+
(define* (db-open #:optional (db (%package-database)))
"Open database to store or read jobs and builds informations. Return a
database object."
@@ -173,7 +217,7 @@ database object."
;; avoid SQLITE_LOCKED errors when we have several readers:
;; <https://www.sqlite.org/wal.html>.
(set-db-options (if (file-exists? db)
- (sqlite-open db SQLITE_OPEN_READWRITE)
+ (db-upgrade (sqlite-open db SQLITE_OPEN_READWRITE))
(db-init db))))
(define (db-close db)
diff --git a/src/schema.sql b/src/schema.sql
index 65aebbd..a3f14eb 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -1,5 +1,10 @@
BEGIN TRANSACTION;
+-- Singleton table to keep track of the schema version.
+CREATE TABLE SchemaVersion (
+ version integer not null
+);
+
CREATE TABLE Specifications (
repo_name TEXT NOT NULL PRIMARY KEY,
url TEXT NOT NULL,
diff --git a/src/sql/upgrade-1.sql b/src/sql/upgrade-1.sql
new file mode 100644
index 0000000..8f561da
--- /dev/null
+++ b/src/sql/upgrade-1.sql
@@ -0,0 +1,7 @@
+BEGIN TRANSACTION;
+
+CREATE TABLE SchemaVersion (
+ version integer not null
+);
+
+COMMIT;
--
2.18.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.