;;; debbugs.el --- SOAP library to access debbugs servers
-;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, hypermedia
;; Package: debbugs
-;; Version: 0.7
+;; Version: 0.8
+;; Package-Requires: ((async "1.6"))
;; This file is not part of GNU Emacs.
(require 'soap-client)
(eval-when-compile (require 'cl))
+(declare-function soap-invoke-async "soap-client")
+(declare-function async-start "async")
+(declare-function async-get "async")
+
(defgroup debbugs nil
"Debbugs library"
:group 'hypermedia)
default-directory)))
"The WSDL object to be used describing the SOAP interface.")
+;; Please do not increase this value, otherwise we would run into
+;; performance problems on the server. Maybe we need to change this a
+;; server specific value.
+(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'.")
+
+(defun debbugs-soap-invoke-async (operation-name &rest parameters)
+ "Invoke the SOAP connection asynchronously.
+If possible, it uses `soap-invoke-async' from soapclient 3.0.
+Otherwise, `async-start' from the async package is used."
+ (if (fboundp 'soap-invoke-async)
+ ;; This is soap-client 3.0.
+ (apply
+ 'soap-invoke-async
+ (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)
+ ;; Fallback with async.
+ (async-start
+ `(lambda ()
+ (load ,(locate-library "soap-client"))
+ (apply
+ 'soap-invoke
+ (soap-load-wsdl
+ ,(expand-file-name
+ "Debbugs.wsdl"
+ (file-name-directory (locate-library "debbugs"))))
+ ,debbugs-port ,operation-name ',parameters)))))
+
(defun debbugs-get-bugs (&rest query)
"Return a list of bug numbers which match QUERY.
`package': A list of package names the bug belongs to.
`severity': The severity of the bug report. This can be
- \"important\", \"grave\", \"normal\", \"minor\" or \"wishlist\".
+ \"critical\", \"grave\", \"serious\", \"important\",
+ \"normal\", \"minor\" or \"wishlist\".
`tags': The status of the bug report, a list of strings. This
can be \"fixed\", \"notabug\", \"wontfix\", \"unreproducible\",
\(last_modified . 1271200046.0)
\(pending . \"pending\")
\(package \"emacs\")))"
- (when bug-numbers
- (let ((object
- (car
- (soap-invoke
- debbugs-wsdl debbugs-port "get_status"
- (apply 'vector bug-numbers)))))
- (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))))
- 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.