cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make deleting the existing log parts optional

Browse source
This commit is contained in:
Christopher Baines 2020-02-15 13:42:52 +00:00
parent 46c8ce5b82
commit 40f6de27f6
1 changed files with 11 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

19
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -65,7 +65,7 @@
enqueue-load-new-guix-revision-job enqueue-load-new-guix-revision-job
most-recent-n-load-new-guix-revision-jobs)) most-recent-n-load-new-guix-revision-jobs))
(define (log-port job-id conn) (define* (log-port job-id conn #:key delete-existing-log-parts?)
(define output-port (define output-port
(current-output-port)) (current-output-port))
@ -89,12 +89,13 @@
(display output output-port)) (display output output-port))
(set! buffer (string-append buffer s)))) (set! buffer (string-append buffer s))))
;; TODO, this is useful when re-running jobs, but I'm not sure that should (when delete-existing-log-parts?
;; be a thing, jobs should probably be only attempted once. ;; TODO, this is useful when re-running jobs, but I'm not sure that should
(exec-query ;; be a thing, jobs should probably be only attempted once.
conn (exec-query
"DELETE FROM load_new_guix_revision_job_log_parts WHERE job_id = $1" conn
(list job-id)) "DELETE FROM load_new_guix_revision_job_log_parts WHERE job_id = $1"
(list job-id)))
(let ((port (let ((port
(make-soft-port (make-soft-port
@ -1545,7 +1546,9 @@ SKIP LOCKED")
(simple-format #f "load-new-guix-revision ~A logging" id) (simple-format #f "load-new-guix-revision ~A logging" id)
(lambda (logging-conn) (lambda (logging-conn)
(insert-empty-log-entry logging-conn id) (insert-empty-log-entry logging-conn id)
(let ((logging-port (log-port id logging-conn))) (let ((logging-port
(log-port id logging-conn
#:delete-existing-log-parts? #t)))
(set-current-output-port logging-port) (set-current-output-port logging-port)
(set-current-error-port logging-port) (set-current-error-port logging-port)
(let ((result (let ((result