[elpa] master 09936b3: Cache and reuse bug entries in debbugs

[Michael Albinus]

branch: master
commit 09936b35a29904362939ad734d97f49ffbd1d726
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Cache and reuse bug entries in debbugs
    
    * packages/debbugs/debbugs-gnu.el (debbugs-gnu-send-control-message):
    Remove cache entry.
    
    * packages/debbugs/debbugs.el (debbugs-cache-data): New defvar.
    (debbugs-cache-expiry): New defconst.
    (debbugs-get-status): Cache and reuse entries.
---
 packages/debbugs/debbugs-gnu.el |    1 +
 packages/debbugs/debbugs.el     |  173 +++++++++++++++++++++++---------------
 2 files changed, 106 insertions(+), 68 deletions(-)

diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el
index 78741a3..4920bb2 100644
--- a/packages/debbugs/debbugs-gnu.el
+++ b/packages/debbugs/debbugs-gnu.el
@@ -1319,6 +1319,7 @@ removed instead."
                        id (if reverse " -" "")
                        message))))
       (funcall send-mail-function)
+      (remhash id debbugs-cache-data)
       (message-goto-body)
       (message "Control message sent:\n%s"
               (buffer-substring-no-properties (point) (1- (point-max)))))))
diff --git a/packages/debbugs/debbugs.el b/packages/debbugs/debbugs.el
index aacd7a0..49960fe 100644
--- a/packages/debbugs/debbugs.el
+++ b/packages/debbugs/debbugs.el
@@ -106,6 +106,13 @@ This corresponds to the Debbugs server to be accessed, 
either
 (defconst debbugs-max-hits-per-request 500
   "The max number of bugs or results per soap invocation.")
 
+(defvar debbugs-cache-data
+  (make-hash-table :test 'equal :size debbugs-max-hits-per-request)
+  "Hash table of retrieved bugs.")
+
+(defconst debbugs-cache-expiry (* 60 60)
+  "How many seconds debbugs results are cached, or nil to disable expiring.")
+
 (defvar debbugs-soap-invoke-async-object nil
   "The object manipulated by `debbugs-soap-invoke-async'.")
 
@@ -330,74 +337,104 @@ Example:
        \(last_modified . 1271200046.0)
        \(pending . \"pending\")
        \(package \"emacs\")))"
-  (when bug-numbers
-    (if (<= (length bug-numbers) debbugs-max-hits-per-request)
-       ;; Do it directly.
-       (setq debbugs-soap-invoke-async-object
-             (car (soap-invoke
-                   debbugs-wsdl debbugs-port "get_status"
-                   (apply 'vector bug-numbers))))
-
-      ;; Retrieve bugs asynchronously.
-      (let ((bug-ids bug-numbers)
-           results)
-       (setq debbugs-soap-invoke-async-object nil)
-       (while bug-ids
-         (setq results
-               (append
-                results
-                (list
-                 (debbugs-soap-invoke-async
-                  "get_status"
-                  (apply
-                   'vector
-                   (butlast
-                    bug-ids (- (length bug-ids)
-                               debbugs-max-hits-per-request))))))
-
-               bug-ids
-               (last bug-ids (- (length bug-ids)
-                                debbugs-max-hits-per-request))))
-
-       (dolist (res results)
-         (if (bufferp res)
-             ;; This is soap-client 3.0.
-             (while (buffer-live-p res)
-               (accept-process-output (get-buffer-process res) 0.1))
-           ;; Fallback with async.
-           (dolist (status (async-get res))
-             (setq debbugs-soap-invoke-async-object
-                   (append debbugs-soap-invoke-async-object status)))))))
-
-    (mapcar
-     (lambda (x)
-       (let (y)
-        ;; "archived" is the number 1 or 0.
-        (setq y (assoc 'archived (cdr (assoc 'value x))))
-        (setcdr y (= (cdr y) 1))
-        ;; "found_versions" and "fixed_versions" are lists,
-        ;; containing strings or numbers.
-        (dolist (attribute '(found_versions fixed_versions))
-          (setq y (assoc attribute (cdr (assoc 'value x))))
-          (setcdr y (mapcar
-                     (lambda (z) (if (numberp z) (number-to-string z) z))
-                     (cdr y))))
-        ;; "mergedwith", "blocks" and "blockedby are strings,
-        ;; containing blank separated bug numbers.
-        (dolist (attribute '(mergedwith blocks blockedby))
-          (setq y (assoc attribute (cdr (assoc 'value x))))
-          (when (stringp (cdr y))
-            (setcdr y (mapcar
-                       'string-to-number (split-string (cdr y) " " t)))))
-        ;; "package" is a string, containing comma separated
-        ;; package names.  "keywords" and "tags" are strings,
-        ;; containing blank separated package names.
-        (dolist (attribute '(package keywords tags))
-          (setq y (assoc attribute (cdr (assoc 'value x))))
-          (when (stringp (cdr y))
-            (setcdr y (split-string (cdr y) ",\\| " t))))
-        (cdr (assoc 'value x))))
-     debbugs-soap-invoke-async-object)))
+  (let (cached-bugs)
+    ;; Check for cached bugs.
+    (setq bug-numbers
+         (delete
+          nil
+          (mapcar
+           (lambda (bug)
+             (let ((status (gethash bug debbugs-cache-data)))
+               (if (and
+                    status
+                    (or
+                     (null debbugs-cache-expiry)
+                     (> (cdr (assoc 'cache_time status))
+                        (- (float-time) debbugs-cache-expiry))))
+                   (progn
+                     (setq cached-bugs (append cached-bugs (list status)))
+                     nil)
+                 bug)))
+           bug-numbers)))
+
+    ;; Retrieve the data.
+    (setq debbugs-soap-invoke-async-object nil)
+    (when bug-numbers
+      (if (<= (length bug-numbers) debbugs-max-hits-per-request)
+         ;; Do it directly.
+         (setq debbugs-soap-invoke-async-object
+               (car (soap-invoke
+                     debbugs-wsdl debbugs-port "get_status"
+                     (apply 'vector bug-numbers))))
+
+       ;; Retrieve bugs asynchronously.
+       (let ((bug-ids bug-numbers)
+             results)
+         (setq debbugs-soap-invoke-async-object nil)
+         (while bug-ids
+           (setq results
+                 (append
+                  results
+                  (list
+                   (debbugs-soap-invoke-async
+                    "get_status"
+                    (apply
+                     'vector
+                     (butlast
+                      bug-ids (- (length bug-ids)
+                                 debbugs-max-hits-per-request))))))
+
+                 bug-ids
+                 (last bug-ids (- (length bug-ids)
+                                  debbugs-max-hits-per-request))))
+
+         (dolist (res results)
+           (if (bufferp res)
+               ;; This is soap-client 3.0.
+               (while (buffer-live-p res)
+                 (accept-process-output (get-buffer-process res) 0.1))
+             ;; Fallback with async.
+             (dolist (status (async-get res))
+               (setq debbugs-soap-invoke-async-object
+                     (append debbugs-soap-invoke-async-object status))))))))
+
+    (append
+     cached-bugs
+     ;; Massage results.
+     (mapcar
+      (lambda (x)
+       (let (y)
+         ;; "archived" is the number 1 or 0.
+         (setq y (assoc 'archived (cdr (assoc 'value x))))
+         (setcdr y (= (cdr y) 1))
+         ;; "found_versions" and "fixed_versions" are lists,
+         ;; containing strings or numbers.
+         (dolist (attribute '(found_versions fixed_versions))
+           (setq y (assoc attribute (cdr (assoc 'value x))))
+           (setcdr y (mapcar
+                      (lambda (z) (if (numberp z) (number-to-string z) z))
+                      (cdr y))))
+         ;; "mergedwith", "blocks" and "blockedby are strings,
+         ;; containing blank separated bug numbers.
+         (dolist (attribute '(mergedwith blocks blockedby))
+           (setq y (assoc attribute (cdr (assoc 'value x))))
+           (when (stringp (cdr y))
+             (setcdr y (mapcar
+                        'string-to-number (split-string (cdr y) " " t)))))
+         ;; "package" is a string, containing comma separated
+         ;; package names.  "keywords" and "tags" are strings,
+         ;; containing blank separated package names.
+         (dolist (attribute '(package keywords tags))
+           (setq y (assoc attribute (cdr (assoc 'value x))))
+           (when (stringp (cdr y))
+             (setcdr y (split-string (cdr y) ",\\| " t))))
+         ;; Cache the result, and return.
+         (puthash
+          (cdr (assoc 'key x))
+          ;; Put also a time stamp.
+          (cons (cons 'cache_time (float-time)) (cdr (assoc 'value x)))
+          debbugs-cache-data)))
+      debbugs-soap-invoke-async-object))))
 
 (defun debbugs-get-usertag (&rest query)
   "Return a list of bug numbers which match QUERY.