aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMathieu Lirzin <mthl@gnu.org>2016-07-23 22:05:50 +0200
committerMathieu Lirzin <mthl@gnu.org>2016-07-25 02:37:00 +0200
commita063a2277e16765b986db6c974650fdd7614bf1d (patch)
treeefc7fecd0a87a3997446f747f3eeb18cca577379
parent5db6894ae24ef0925b19adcfcc15bc9f6e01143b (diff)
downloadcuirass-a063a2277e16765b986db6c974650fdd7614bf1d.tar
cuirass-a063a2277e16765b986db6c974650fdd7614bf1d.tar.gz
cuirass: Use database to store specifications.
-rw-r--r--bin/cuirass.in21
-rw-r--r--src/cuirass/database.scm32
-rw-r--r--tests/database.scm18
3 files changed, 61 insertions, 10 deletions
diff --git a/bin/cuirass.in b/bin/cuirass.in
index dad2239..fb4023c 100644
--- a/bin/cuirass.in
+++ b/bin/cuirass.in
@@ -118,10 +118,11 @@ if required."
(compile (string-append (%package-cachedir) "/"
(assq-ref spec #:name)))
(with-store store
- (let* ((id (db-add-specification db spec))
- (spec* (acons #:id id spec))
- (jobs (evaluate store db spec*)))
- (db-add-evaluation db jobs)
+ (let* ((jobs (evaluate store db spec)))
+ (for-each (λ (job)
+ (or (evaluation-exists? db job)
+ (db-add-evaluation db job)))
+ jobs)
(set-build-options store #:use-substitutes? #f)
(build-packages store db jobs))))
jobspecs))
@@ -158,8 +159,10 @@ if required."
(set-current-module (make-user-module))
(primitive-load (car specfile))))))
(with-database db
- (if one-shot?
- (process-specs db specs)
- (while #t
- (process-specs db specs)
- (sleep interval))))))))))
+ (for-each (λ (spec) (db-add-specification db spec)) specs)
+ (let ((specs* (db-get-specifications db)))
+ (if one-shot?
+ (process-specs db specs*)
+ (while #t
+ (process-specs db specs*)
+ (sleep interval)))))))))))
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 6c354bb..4405f6e 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -18,6 +18,8 @@
(define-module (cuirass database)
#:use-module (cuirass config)
+ #:use-module (cuirass utils)
+ #:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (sqlite3)
#:export (;; Procedures.
@@ -26,6 +28,8 @@
db-open
db-close
db-add-specification
+ db-get-specifications
+ evaluation-exists?
db-add-evaluation
db-get-evaluation
db-delete-evaluation
@@ -115,6 +119,32 @@ INSERT INTO Specifications\
(assq-refs spec '(#:branch #:tag #:commit) "NULL")))
(last-insert-rowid db))
+(define (db-get-specifications db)
+ (let loop ((rows (sqlite-exec db "SELECT * FROM Specifications;"))
+ (specs '()))
+ (match rows
+ (() specs)
+ ((#(id name url load-path file proc args branch tag rev) . rest)
+ (loop rest
+ (cons `((#:id . ,id)
+ (#:name . ,name)
+ (#:url . ,url)
+ (#:load-path . ,load-path)
+ (#:file . ,file)
+ (#:proc . ,(with-input-from-string proc read))
+ (#:arguments . ,(with-input-from-string args read))
+ (#:branch . ,branch)
+ (#:tag . ,(if (string=? tag "NULL") #f tag))
+ (#:commit . ,(if (string=? rev "NULL") #f rev)))
+ specs))))))
+
+(define (evaluation-exists? db job)
+ "Check if JOB is already added to DB."
+ (let ((primary-key (assq-ref job #:derivation)))
+ (not (null? (sqlite-exec db "\
+SELECT * FROM Evaluations WHERE derivation='~A';"
+ primary-key)))))
+
(define (db-add-evaluation db job)
"Store a derivation result in database DB and return its ID."
(sqlite-exec db "\
@@ -126,7 +156,7 @@ INSERT INTO Evaluations (derivation, job_name, specification)\
(define (db-get-evaluation db id)
"Retrieve a job in database DB which corresponds to ID."
- (car (sqlite-exec db "select * from Evaluations where derivation='~A';" id)))
+ (car (sqlite-exec db "SELECT * FROM Evaluations WHERE derivation='~A';" id)))
(define (db-delete-evaluation db id)
"Delete a job in database DB which corresponds to ID."
diff --git a/tests/database.scm b/tests/database.scm
index 964cd00..39f9fcc 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -20,6 +20,18 @@
(use-modules (cuirass database)
(srfi srfi-64))
+(define example-spec
+ '((#:id . 1)
+ (#:name . "guix")
+ (#:url . "git://git.savannah.gnu.org/guix.git")
+ (#:load-path . ".")
+ (#:file . "/tmp/gnu-system.scm")
+ (#:proc . hydra-jobs)
+ (#:arguments (subset . "hello"))
+ (#:branch . "master")
+ (#:tag . #f)
+ (#:commit . #f)))
+
(define* (make-dummy-job #:optional (name "foo"))
`((#:name . ,name)
(#:derivation . ,(string-append name ".drv"))
@@ -56,6 +68,12 @@ INSERT INTO Evaluations (derivation, job_name, specification)\
VALUES ('drv3', 'job3', 3);")
(sqlite-exec (%db) "SELECT * FROM Evaluations;")))
+ (test-equal "db-add-specification"
+ example-spec
+ (begin
+ (db-add-specification (%db) example-spec)
+ (car (db-get-specifications (%db)))))
+
(test-assert "db-add-evaluation"
(let* ((job (make-dummy-job))
(key (assq-ref job #:derivation)))