[PATCH v3 6/8] Offer cache facility for WSDL specification; default to no expiry.

[Felix Lechner]

---
 debbugs.el | 84 +++++++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 71 insertions(+), 13 deletions(-)

diff --git a/debbugs.el b/debbugs.el
index df80107627..b8acfea3da 100644
--- a/debbugs.el
+++ b/debbugs.el
@@ -89,16 +89,67 @@ This corresponds to the Debbugs server to be accessed, 
either
   :type '(choice :tag "Debbugs server" (const "gnu.org") (const "debian.org")
                 (string :tag "user defined port name")))
 
-;; It would be nice if we could retrieve it from the debbugs server.
-;; Not supported yet.
-(defconst debbugs-wsdl
+(defun debbugs-read-soap-wsdl-file ()
+  "Return the WSDL object from the local file describing the SOAP interface."
   (soap-load-wsdl
    (expand-file-name
     "Debbugs.wsdl"
     (if load-in-progress
        (file-name-directory load-file-name)
-      default-directory)))
-  "The WSDL object to be used describing the SOAP interface.")
+      default-directory))))
+
+(defvar debbugs-wsdl-cache-alist nil
+  "Cache of WSDL objects for SOAP access.")
+
+(defvar debbugs-wsdl-cache-last-update-alist nil
+  "Lisp timestamps per server for the most recent updates of the
+WSDL cache used in SOAP access.")
+
+(defcustom debbugs-wsdl-cache-expiry nil
+  "How many seconds to cache the WSDL specification.
+t or 0 disables caching, nil disables expiring."
+  :type '(choice (const :tag "Never" t)
+                (const :tag "Forever" nil)
+                (integer :tag "Seconds")))
+
+(defun debbugs-wsdl-cache-valid ()
+  "True if the WSDL cache is valid timewise, nil otherwise."
+  (let ((last-update (alist-get debbugs-port
+                                debbugs-wsdl-cache-last-update-alist
+                                nil nil 'equal)))
+    (and (natnump debbugs-wsdl-cache-expiry)
+         (not (null last-update))
+         (let ((age (time-convert
+                     (time-subtract (current-time) last-update)
+                     'integer)))
+           (< age debbugs-wsdl-cache-expiry)))))
+
+;; It would be nice if we could retrieve it from the debbugs server.
+;; Not supported yet.
+(defun debbugs-get-soap-wsdl ()
+  "Return the cached WSDL object describing the SOAP interface, or
+reload it if the cache expired."
+  (let* ((cache-hit
+          (if (or (not debbugs-wsdl-cache-expiry)
+                  (debbugs-wsdl-cache-valid))
+              (alist-get debbugs-port debbugs-wsdl-cache-alist
+                         nil nil 'equal)
+            nil))
+         (wsdl-object (or cache-hit
+                          (debbugs-read-soap-wsdl-file))))
+    (if (or (eq debbugs-wsdl-cache-expiry t)
+            (eq debbugs-wsdl-cache-expiry 0))
+        (progn
+          (setq debbugs-wsdl-cache-alist nil)
+          (setq debbugs-wsdl-cache-last-update-alist nil))
+      (progn
+        (setf (alist-get debbugs-port debbugs-wsdl-cache-alist
+                         nil nil 'equal)
+              wsdl-object)
+        (setf (alist-get debbugs-port debbugs-wsdl-cache-last-update-alist
+                         nil nil 'equal)
+              (current-time))))
+    wsdl-object))
 
 ;; Please do not increase this value, otherwise we would run into
 ;; performance problems on the server.  Maybe we need to change this a
@@ -127,7 +178,7 @@ t or 0 disables caching, nil disables expiring."
    (lambda (response &rest _args)
      (setq debbugs-soap-invoke-async-object
           (append debbugs-soap-invoke-async-object (car response))))
-   nil debbugs-wsdl debbugs-port operation-name parameters))
+   nil (debbugs-get-soap-wsdl) debbugs-port operation-name parameters))
 
 (defcustom debbugs-show-progress t
   "Whether progress report is shown."
@@ -302,7 +353,9 @@ patch:
     (unless (null query)
       (error "Unknown key: %s" (car query)))
     (prog1
-       (sort (car (soap-invoke debbugs-wsdl debbugs-port "get_bugs" vec)) #'<)
+       (sort (car (soap-invoke (debbugs-get-soap-wsdl) debbugs-port
+                                "get_bugs" vec))
+              #'<)
       (when debbugs-show-progress
        (remove-function
         (symbol-function debbugs-url-display-message-or-percentage-function)
@@ -338,8 +391,8 @@ patch:
            (cons 'cache_time (float-time))
            (cons 'newest_bug
                  (caar
-                  (soap-invoke
-                   debbugs-wsdl debbugs-port "newest_bugs" amount)))))
+                  (soap-invoke (debbugs-get-soap-wsdl) debbugs-port
+                                "newest_bugs" amount)))))
 
          ;; Cache it.
          (when (or (null debbugs-cache-expiry) (natnump debbugs-cache-expiry))
@@ -349,7 +402,9 @@ patch:
        (list (alist-get 'newest_bug status)))
 
     (sort
-     (car (soap-invoke debbugs-wsdl debbugs-port "newest_bugs" amount)) #'<)))
+     (car (soap-invoke (debbugs-get-soap-wsdl) debbugs-port
+                       "newest_bugs" amount))
+     #'<)))
 
 (defun debbugs-convert-soap-value-to-string (string-value)
   "If STRING-VALUE is unibyte, decode its contents as a UTF-8 string.
@@ -643,7 +698,8 @@ Example:
 
     (setq
      object
-     (car (soap-invoke debbugs-wsdl debbugs-port "get_usertag" (car user))))
+     (car (soap-invoke (debbugs-get-soap-wsdl) debbugs-port
+                       "get_usertag" (car user))))
 
     (if (null tags)
        ;; Return the list of existing tags.
@@ -670,7 +726,8 @@ Every message is an association list with the following 
attributes:
 
   `attachments' A list of possible attachments, or nil.  Not
   implemented yet server side."
-  (car (soap-invoke debbugs-wsdl debbugs-port "get_bug_log" bug-number)))
+  (car (soap-invoke (debbugs-get-soap-wsdl) debbugs-port
+                    "get_bug_log" bug-number)))
 
 (defun debbugs-search-est (&rest query)
   "Return the result of a full text search according to QUERY.
@@ -955,7 +1012,8 @@ Examples:
          (setq args (vconcat args (list vec)))))
 
       (setq result
-           (car (soap-invoke debbugs-wsdl debbugs-port "search_est" args)))
+           (car (soap-invoke (debbugs-get-soap-wsdl) debbugs-port
+                              "search_est" args)))
       ;; The result contains lists (key value).  We transform it into
       ;; cons cells (key . value).
       (dolist (elt1 result)
-- 
2.41.0