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

This commit is contained in:
Mathieu Lirzin 2016-07-25 20:31:06 +02:00
parent 7292bd5019
commit e51a755f10
No known key found for this signature in database
GPG Key ID: 0ADEE10094604D37
2 changed files with 21 additions and 18 deletions

View File

@ -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)

View File

@ -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))