scripts: Give update-state! optional loop argument.
authorRicardo Wurmus <rekado@elephly.net>
Wed, 22 Apr 2020 08:34:32 +0000 (10:34 +0200)
committerRicardo Wurmus <rekado@elephly.net>
Wed, 22 Apr 2020 08:34:32 +0000 (10:34 +0200)
scripts/mumi.in

index 3a55ed9f7c23e7f568cb9202754267bcf0e115b3..45d034d9a594f34f30c9f258405e6c76296828a4 100644 (file)
           (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
          (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))))