]> git.elephly.net Git - software/mumi.git/commitdiff
scripts: Add support for "--fetch" option.
authorRicardo Wurmus <rekado@elephly.net>
Sun, 21 Jul 2019 10:14:00 +0000 (12:14 +0200)
committerRicardo Wurmus <rekado@elephly.net>
Sun, 21 Jul 2019 11:11:39 +0000 (13:11 +0200)
* scripts/mumi.in (%options): Recognize "fetch" option.
(%default-options): Set default for "fetch".
* mumi/config.scm.in (%config): Remove extraneous quotes from "lists"
and "packages".

mumi/config.scm.in
scripts/mumi.in

index 4a0b69dc0c48a8ea919e4fb725b0a72889fc0a88..098e2e8e2df5732c1eb9a6c6ade7d9461a3f4fb9 100644 (file)
@@ -44,8 +44,8 @@
            (port        . 1234)
            (submission-email-address . "guix-patches@gnu.org")
            (submission-bug-email-address . "bug-guix@gnu.org")
-           (lists       . '("guix-patches@gnu.org" "bug-guix@gnu.org"))
-           (packages    . '("guix-patches" "guix"))
+           (lists       . ("guix-patches@gnu.org" "bug-guix@gnu.org"))
+           (packages    . ("guix-patches" "guix"))
            (debbugs     . ,%gnu)
            (debbugs-domain . "debbugs.gnu.org"))))
     (lambda (key)
index 1b1c5e50abf4301a8ad47ae5d699e22aaac8104b..2abfd513fb175244a58bd1696edb675dd6460dba 100644 (file)
@@ -3,7 +3,7 @@
 -*- geiser-scheme-implementation: guile -*-
 !#
 ;;; mumi -- Mediocre, uh, mail interface
-;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2016, 2017, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of mumi.
 ;;; along with mumi.  If not, see <http://www.gnu.org/licenses/>.
 
 (use-modules (srfi srfi-1)
+             (srfi srfi-26)
              (srfi srfi-37)
              (system repl server)
-             (mumi web server))
+             (ice-9 match)
+             (ice-9 threads)
+             (mumi config)
+             (mumi messages)
+             (mumi web server)
+             (debbugs))
 
 (define %default-repl-server-port
   ;; Default port to run REPL server on, if --listen-repl is provided
                     (if port
                         (alist-cons 'listen-repl port
                                     (alist-delete 'listen-repl result))
-                        (error "invalid REPL server port" arg)))))))
+                        (error "invalid REPL server port" arg)))))
+        (option '("fetch") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'fetch #t result)))))
 
 (define %default-options
   ;; Alist of default option values
-  `((listen-repl . #f)))
+  `((listen-repl . #f)
+    (fetch . #f)))
 
 (define (parse-options args)
   (args-fold
    %default-options))
 
 (let ((opts (parse-options (cdr (program-arguments)))))
-  (let ((repl-port (assoc-ref opts 'listen-repl)))
-    (when repl-port
-      (spawn-server (make-tcp-server-socket #:port repl-port)))))
+  (cond
+   ((assoc-ref opts 'fetch)
+    (let ((bug-nums
+           (sort (append-map (lambda (package)
+                               (soap-invoke (%config 'debbugs)
+                                            get-bugs
+                                            `((package . ,package))))
+                             (%config 'packages)) <)))
+      (for-each (lambda (bug-num i)
+                  (let ((msg-nums
+                         (match (soap-invoke (%config 'debbugs)
+                                             get-bug-message-numbers
+                                             bug-num)
+                           ((nums . ids) nums))))
+                    (format (current-error-port)
+                            "[~a/~a] Downloading ~a messages of bug ~a...~%"
+                            i (length bug-nums)
+                            (length msg-nums) bug-num)
+                    (parameterize ((current-error-port (%make-void-port OPEN_WRITE)))
+                      (par-for-each (cut download-message bug-num <>)
+                                    msg-nums))))
+                bug-nums
+                (iota (length bug-nums) 1))))
+   (else
+    (let ((repl-port (assoc-ref opts 'listen-repl)))
+      (when repl-port
+        (spawn-server (make-tcp-server-socket #:port repl-port)))))))
 
 (start-mumi-web-server 1234)