database: 'db-update-build-status!' takes a #:log-file parameter.
* src/cuirass/database.scm (sqlite-exec): Use (ice-9 format). (db-update-build-status!): Add #:log-file parameter and honor it. * tests/database.scm ("database")["db-update-build-status!"]: Test it.
This commit is contained in:
parent
1d7f4f07d9
commit
8675d6309b
|
@ -22,6 +22,7 @@
|
|||
#:use-module (cuirass config)
|
||||
#:use-module (cuirass utils)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 format)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-19)
|
||||
|
@ -54,9 +55,8 @@
|
|||
|
||||
(define (sqlite-exec db msg . args)
|
||||
"Wrap 'sqlite-prepare', 'sqlite-step', and 'sqlite-finalize'. Send message
|
||||
MSG to database DB. MSG can contain '~A' and '~S' escape characters which
|
||||
will be replaced by ARGS."
|
||||
(let* ((sql (apply simple-format #f msg args))
|
||||
MSG to database DB. MSG and ARGS are passed to 'format'."
|
||||
(let* ((sql (apply format #f msg args))
|
||||
(stmt (sqlite-prepare db sql))
|
||||
(res (let loop ((res '()))
|
||||
(let ((row (sqlite-step stmt)))
|
||||
|
@ -236,9 +236,10 @@ INSERT INTO Outputs (build, name, path) VALUES ('~A', '~A', '~A');"
|
|||
(assq-ref build #:outputs))
|
||||
build-id))
|
||||
|
||||
(define (db-update-build-status! db drv status)
|
||||
(define* (db-update-build-status! db drv status #:key log-file)
|
||||
"Update DB so that DRV's status is STATUS. This also updates the
|
||||
'starttime' or 'stoptime' fields."
|
||||
'starttime' or 'stoptime' fields. If LOG-FILE is true, record it as the build
|
||||
log file for DRV."
|
||||
(define now
|
||||
(time-second (current-time time-utc)))
|
||||
|
||||
|
@ -246,9 +247,9 @@ INSERT INTO Outputs (build, name, path) VALUES ('~A', '~A', '~A');"
|
|||
(sqlite-exec db "UPDATE Builds SET starttime='~A', status='~A' \
|
||||
WHERE derivation='~A';"
|
||||
now status drv)
|
||||
(sqlite-exec db "UPDATE Builds SET stoptime='~A', status='~A' \
|
||||
WHERE derivation='~A';"
|
||||
now status drv)))
|
||||
(sqlite-exec db "UPDATE Builds SET stoptime='~A', \
|
||||
status='~A'~@[, log='~A'~] WHERE derivation='~A';"
|
||||
now status log-file drv)))
|
||||
|
||||
(define (db-get-outputs db build-id)
|
||||
"Retrieve the OUTPUTS of the build identified by BUILD-ID in DB database."
|
||||
|
|
|
@ -146,7 +146,8 @@ INSERT INTO Evaluations (specification, revision) VALUES (3, 3);")
|
|||
(test-equal "db-update-build-status!"
|
||||
(list (build-status scheduled)
|
||||
(build-status started)
|
||||
(build-status succeeded))
|
||||
(build-status succeeded)
|
||||
"/foo.drv.log")
|
||||
(with-temporary-database db
|
||||
(let* ((id (db-add-build
|
||||
db
|
||||
|
@ -161,12 +162,14 @@ INSERT INTO Evaluations (specification, revision) VALUES (3, 3);")
|
|||
(let ((status0 (get-status)))
|
||||
(db-update-build-status! db "/foo.drv" (build-status started))
|
||||
(let ((status1 (get-status)))
|
||||
(db-update-build-status! db "/foo.drv" (build-status succeeded))
|
||||
(db-update-build-status! db "/foo.drv" (build-status succeeded)
|
||||
#:log-file "/foo.drv.log")
|
||||
(let ((status2 (get-status))
|
||||
(start (get-status #:starttime))
|
||||
(end (get-status #:stoptime)))
|
||||
(end (get-status #:stoptime))
|
||||
(log (get-status #:log)))
|
||||
(and (> start 0) (>= end start)
|
||||
(list status0 status1 status2))))))))
|
||||
(list status0 status1 status2 log))))))))
|
||||
|
||||
(test-assert "db-close"
|
||||
(db-close (%db)))
|
||||
|
|
Loading…
Reference in New Issue