database: Add 'db-add-build' procedure.

2 files changed, 21 insertions, 18 deletions

diff --git a/bin/cuirass.in b/bin/cuirass.in
index 5f89379..43f4661 100644
--- a/bin/cuirass.in
+++ b/bin/cuirass.in
@@ -94,19 +94,23 @@ if required."
     jobs))
 
 (define (build-packages store db jobs)
-  "Build JOBS which is a list of <job> objects."
+  "Build JOBS and return a list of Build results."
   (map (λ (job)
-         (let ((log-port (tmpfile))
+         (let ((log-port (%make-void-port "w0"))
                (name     (assq-ref job #:job-name))
                (drv      (assq-ref job #:derivation)))
-           (setvbuf log-port _IOLBF)
-           (format #t "building ~A...~%" drv)
+           (simple-format #t "building ~A...\n" drv)
            (parameterize ((current-build-output-port log-port))
              (build-derivations store (list drv))
-             ;; XXX: 'Builds' database table is not implemented yet.
-             ;; (db-add-build-log db job log-port)
-             (close-port log-port))
-           (format #t "~A~%" (derivation-path->output-path drv))))
+             (let* ((output (derivation-path->output-path drv))
+                    (log    (log-file store output))
+                    (build  `((#:derivation . ,drv)
+                              (#:log . ,log)
+                              (#:output . ,output)))
+                    (id     (db-add-build db build)))
+               (close-port log-port)
+               (simple-format #t "~A\n" output)
+               (acons #:id id build)))))
        jobs))
 
 (define (process-specs db jobspecs)
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index f746289..3b8ffb9 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -33,7 +33,7 @@
             db-add-evaluation
             db-get-evaluation
             db-delete-evaluation
-            db-add-build-log
+            db-add-build
             read-sql-file
             read-quoted-string
             sqlite-exec
@@ -180,12 +180,11 @@ string."
             ((char=? char #\')  (loop (cons* char char chars)))
             (else (loop (cons char chars)))))))
 
-(define (db-add-build-log db job log)
-  "Store a build LOG corresponding to JOB in database DB."
-  (let ((id   (assq-ref job #:id))
-        (log* (cond ((string? log) log)
-                    ((port? log)
-                     (seek log 0 SEEK_SET)
-                     (read-quoted-string log))
-                    (else #f))))
-    (sqlite-exec db "update build set log='~A' where id=~A;" log* id)))
+(define (db-add-build db build)
+  "Store BUILD in database DB."
+  (sqlite-exec db "\
+INSERT INTO Builds (derivation, log, output) VALUES ('~A', '~A', '~A');"
+               (assq-ref build #:derivation)
+               (assq-ref build #:log)
+               (assq-ref build #:output))
+  (last-insert-rowid db))