From f7f1cbd4aec0ab748c64e417c1dbd28e35556cb0 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 22 Apr 2020 10:34:32 +0200 Subject: scripts: Give update-state! optional loop argument. --- scripts/mumi.in | 49 +++++++++++++++++++++---------------------------- 1 file changed, 21 insertions(+), 28 deletions(-) (limited to 'scripts') diff --git a/scripts/mumi.in b/scripts/mumi.in index 3a55ed9..45d034d 100644 --- a/scripts/mumi.in +++ b/scripts/mumi.in @@ -55,24 +55,25 @@ (format (current-error-port) "Failed to index `~a'~%" (%config 'mail-dir))))))) -(define update-state! - (lambda _ - (catch #t - (lambda () - (let ((nums (sort (append-map (lambda (package) - (soap-invoke* (%config 'debbugs) - get-bugs - `((package . ,package)))) - (%config 'packages)) >))) - (update-bug-database! nums)) - (format (current-error-port) - "Sleeping for ~a seconds." %update-interval) - (sleep %update-interval) - (update-state!)) - (lambda args - (format (current-error-port) "worker error: ~a~%" args) - (sleep %update-interval) - (update-state!))))) +(define* (update-state! #:key loop?) + (catch #t + (lambda () + (let ((nums (sort (append-map (lambda (package) + (soap-invoke* (%config 'debbugs) + get-bugs + `((package . ,package)))) + (%config 'packages)) >))) + (update-bug-database! nums)) + (and loop? + (begin + (format (current-error-port) + "Sleeping for ~a seconds." %update-interval) + (sleep %update-interval) + (update-state!)))) + (lambda args + (format (current-error-port) "worker error: ~a~%" args) + (sleep %update-interval) + (update-state!)))) (define %options ;; Specifications of the command-line options @@ -137,17 +138,9 @@ (worker-loop opts) (error "Both sender and smtp options must be provided!")))) (("fetch") - (let ((nums (sort - (append-map (lambda (package) - (soap-invoke* - (%config 'debbugs) - get-bugs - `((package . ,package) - (archive . both)))) - (%config 'packages)) >))) - (update-bug-database! nums))) + (update-state! #:loop? #f)) (("worker") - (update-state!)) + (update-state! #:loop? #t)) (("web" . rest) (let ((opts (parse-options rest))) (parameterize ((mailer-enabled? (not (assoc-ref opts 'disable-mailer)))) -- cgit v1.2.3