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

1 files changed, 12 insertions, 8 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)