[PATCH v2 5/5] Download WSDL specification dynamically from selected server.

[Felix Lechner]

* debbugs.el: Download WSDL specification dynamically from selected
server.
---
 debbugs.el | 76 ++++++++++++++++++++++++++++++++++++++++++------------
 1 file changed, 59 insertions(+), 17 deletions(-)

diff --git a/debbugs.el b/debbugs.el
index 3f22ebc8f6..a3f848d0ad 100644
--- a/debbugs.el
+++ b/debbugs.el
@@ -89,16 +89,58 @@ 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
-  (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.")
+(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 60
+  "How many seconds to cache WSDL downloads.
+t or 0 disables caching, nil disables expiring."
+  :type '(choice (const :tag "Never" t)
+                (const :tag "Forever" nil)
+                (integer :tag "Seconds")))
+
+(defun debbugs-download-soap-wsdl ()
+  "Download the WSDL object describing the SOAP interface."
+  (let* ((selected-server (alist-get debbugs-port debbugs-servers nil nil 
#'equal))
+         (wsdl-url (plist-get selected-server :wsdl)))
+    (soap-load-wsdl wsdl-url)))
+
+(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)))))
+
+(defun debbugs-get-soap-wsdl ()
+  "Return the cached WSDL object describing the SOAP interface, or
+download a new one."
+  (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-download-soap-wsdl))))
+    (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 +169,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."
@@ -301,7 +343,7 @@ 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,7 +380,7 @@ patch:
            (cons 'newest_bug
                  (caar
                   (soap-invoke
-                   debbugs-wsdl debbugs-port "newest_bugs" amount)))))
+                   (debbugs-get-soap-wsdl) debbugs-port "newest_bugs" 
amount)))))
 
          ;; Cache it.
          (when (or (null debbugs-cache-expiry) (natnump debbugs-cache-expiry))
@@ -348,7 +390,7 @@ 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.
@@ -641,7 +683,7 @@ 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.
@@ -668,7 +710,7 @@ 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.
@@ -952,7 +994,7 @@ 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