summaryrefslogtreecommitdiff
path: root/scripts/mumi.in
diff options
context:
space:
mode:
authorRicardo Wurmus <rekado@elephly.net>2020-04-22 10:34:32 +0200
committerRicardo Wurmus <rekado@elephly.net>2020-04-22 10:34:32 +0200
commitf7f1cbd4aec0ab748c64e417c1dbd28e35556cb0 (patch)
tree3e159ca3925303feb207f00e53758315269c98eb /scripts/mumi.in
parent116c0067606484d70e7ad709e6d2b5c33b39985e (diff)
scripts: Give update-state! optional loop argument.
Diffstat (limited to 'scripts/mumi.in')
-rw-r--r--scripts/mumi.in49
1 files changed, 21 insertions, 28 deletions
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))))