From caa127d37e9e682a461b0d628b58eb80e074c792 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Sun, 21 Jul 2019 12:14:00 +0200 Subject: scripts: Add support for "--fetch" option. * 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". --- scripts/mumi.in | 48 +++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 41 insertions(+), 7 deletions(-) (limited to 'scripts') diff --git a/scripts/mumi.in b/scripts/mumi.in index 1b1c5e5..2abfd51 100644 --- a/scripts/mumi.in +++ b/scripts/mumi.in @@ -3,7 +3,7 @@ -*- geiser-scheme-implementation: guile -*- !# ;;; mumi -- Mediocre, uh, mail interface -;;; Copyright © 2016, 2017 Ricardo Wurmus +;;; Copyright © 2016, 2017, 2019 Ricardo Wurmus ;;; Copyright © 2018 Arun Isaac ;;; ;;; This file is part of mumi. @@ -22,9 +22,15 @@ ;;; along with mumi. If not, see . (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 @@ -40,11 +46,15 @@ (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 @@ -56,8 +66,32 @@ %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) -- cgit v1.2.3