From 738336fb9a1fb836a5436b5f417727845906870d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 17 Jan 2016 15:03:31 +0100 Subject: [PATCH] Further improvements to debbugs * packages/debbugs/debbugs-gnu.el (debbugs-gnu-get-bugs): Do not specify :max. (debbugs-gnu-rescan): Handle `current-prefix-arg'. (debbugs-gnu-display-status): Insert comments in output. * packages/debbugs/debbugs-ug.texi (Tabulated Lists): Mention the prefix argument of debbugs-gnu-rescan. * packages/debbugs/debbugs.el (debbugs-cache-expiry): Make it a defcustom. (debbugs-get-status): Delete dups before sending the soap request. `debbugs-cache-expiry' could also be `t'. (debbugs-get-status): Remove double code. Add bug to cache only if `debbugs-cache-expiry' indicates this. (debbugs-search-est): Retrieve all hits when there is no :skip or :max. * packages/debbugs/debbugs.texi (Configuration): Describe debbugs-cache-expiry. --- packages/debbugs/debbugs-gnu.el | 13 +- packages/debbugs/debbugs-ug.info | 30 +-- packages/debbugs/debbugs-ug.texi | 4 +- packages/debbugs/debbugs.el | 378 +++++++++++++++++-------------- packages/debbugs/debbugs.info | 16 +- packages/debbugs/debbugs.texi | 9 + 6 files changed, 251 insertions(+), 199 deletions(-) diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el index 4920bb2a0..294dda66f 100644 --- a/packages/debbugs/debbugs-gnu.el +++ b/packages/debbugs/debbugs-gnu.el @@ -354,7 +354,7 @@ marked as \"client-side filter\"." (if (zerop (length phrase)) (setq phrase nil) (add-to-list 'debbugs-gnu-current-query (cons 'phrase phrase))) - ;; We suppress the bugs if there is no phrase. + ;; We suppress closed bugs if there is no phrase. (setq debbugs-gnu-current-suppress (null phrase)) ;; The other queries. @@ -550,7 +550,7 @@ marked as \"client-side filter\"." (if phrase (cond ((eq (car elt) 'phrase) - (list (list :phrase (cdr elt) :max 500))) + (list (list :phrase (cdr elt)))) ((eq (car elt) 'date) (list (list :date (cddr elt) (cadr elt) :operator "NUMBT"))) @@ -854,7 +854,8 @@ Used instead of `tabulated-list-print-entry'." (let ((id (debbugs-gnu-current-id)) (debbugs-gnu-current-query debbugs-gnu-local-query) (debbugs-gnu-current-filter debbugs-gnu-local-filter) - (debbugs-gnu-current-suppress debbugs-gnu-local-suppress)) + (debbugs-gnu-current-suppress debbugs-gnu-local-suppress) + (debbugs-cache-expiry (if current-prefix-arg t debbugs-cache-expiry))) (debbugs-gnu-show-reports) (when id (debbugs-gnu-goto id)))) @@ -1100,12 +1101,16 @@ interest to you." (let ((inhibit-read-only t)) (erase-buffer) (when query + (insert ";; Query\n") (pp query (current-buffer)) (insert "\n")) (when filter + (insert ";; Filter\n") (pp filter (current-buffer)) (insert "\n")) - (when status (pp status (current-buffer))) + (when status + (insert ";; Status\n") + (pp status (current-buffer))) (goto-char (point-min))) (set-buffer-modified-p nil) (special-mode)) diff --git a/packages/debbugs/debbugs-ug.info b/packages/debbugs/debbugs-ug.info index b3bbaa0d4..413792aa1 100644 --- a/packages/debbugs/debbugs-ug.info +++ b/packages/debbugs/debbugs-ug.info @@ -322,7 +322,9 @@ This enables the following key strokes: Restore the full list again after narrowing. 'g' 'debbugs-gnu-rescan' - Reload all bugs from the GNU Debbugs server. + Reload all bugs. With a prefix argument 'C-u', the + bug status cache is disabled, and all bug reports are + retrieved from the GNU Debbugs server. 'B' 'debbugs-gnu-show-blocking-reports' 'b' 'debbugs-gnu-show-blocked-by-reports' @@ -537,7 +539,7 @@ Variable Index * debbugs-gnu-default-packages: Retrieving Bugs. (line 63) * debbugs-gnu-default-severities: Retrieving Bugs. (line 63) * debbugs-gnu-default-suppress-bugs: Retrieving Bugs. (line 44) -* debbugs-gnu-mail-backend: Tabulated Lists. (line 69) +* debbugs-gnu-mail-backend: Tabulated Lists. (line 71)  File: debbugs-ug.info, Node: Key Index, Prev: Variable Index, Up: Top @@ -549,9 +551,9 @@ Key Index * Menu: * '/': Tabulated Lists. (line 36) -* 'B': Tabulated Lists. (line 50) -* 'b': Tabulated Lists. (line 51) -* 'C': Tabulated Lists. (line 64) +* 'B': Tabulated Lists. (line 52) +* 'b': Tabulated Lists. (line 53) +* 'C': Tabulated Lists. (line 66) * 'C-c # C': TODO Items. (line 25) * 'C-c # d': TODO Items. (line 19) * 'C-c # t': TODO Items. (line 22) @@ -561,11 +563,11 @@ Key Index * '': Tabulated Lists. (line 31) * 'R': Tabulated Lists. (line 40) * '': Tabulated Lists. (line 29) -* 's': Tabulated Lists. (line 55) -* 't': Tabulated Lists. (line 58) +* 's': Tabulated Lists. (line 57) +* 't': Tabulated Lists. (line 60) * '': TODO Items. (line 16) * 'w': Tabulated Lists. (line 44) -* 'x': Tabulated Lists. (line 61) +* 'x': Tabulated Lists. (line 63)  @@ -577,11 +579,11 @@ Ref: Searching Bugs-Footnote-19980 Ref: Searching Bugs-Footnote-210068 Node: Layout10159 Node: Tabulated Lists10634 -Node: TODO Items13751 -Node: Control Messages14798 -Node: Minor Mode17109 -Node: Command Index18048 -Node: Variable Index18695 -Node: Key Index19343 +Node: TODO Items13881 +Node: Control Messages14928 +Node: Minor Mode17239 +Node: Command Index18178 +Node: Variable Index18825 +Node: Key Index19473  End Tag Table diff --git a/packages/debbugs/debbugs-ug.texi b/packages/debbugs/debbugs-ug.texi index f38bccf74..b32006163 100644 --- a/packages/debbugs/debbugs-ug.texi +++ b/packages/debbugs/debbugs-ug.texi @@ -352,7 +352,9 @@ Restore the full list again after narrowing. @kindex @kbd{g} @kbd{g} @tab @code{debbugs-gnu-rescan} @* -Reload all bugs from the GNU Debbugs server. +Reload all bugs. With a prefix argument @kbd{C-u}, the bug status +cache is disabled, and all bug reports are retrieved from the GNU +Debbugs server. @item @kindex @kbd{B} diff --git a/packages/debbugs/debbugs.el b/packages/debbugs/debbugs.el index 49960fe14..2c41fcb0a 100644 --- a/packages/debbugs/debbugs.el +++ b/packages/debbugs/debbugs.el @@ -110,8 +110,13 @@ This corresponds to the Debbugs server to be accessed, either (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.") +(defcustom debbugs-cache-expiry (* 60 60) + "How many seconds debbugs query results are cached. +`t' or 0 disables caching, `nil' disables expiring." + :group 'debbugs + :type '(choice (const :tag "Always" t) + (const :tag "Never" nil) + (integer :tag "Seconds"))) (defvar debbugs-soap-invoke-async-object nil "The object manipulated by `debbugs-soap-invoke-async'.") @@ -339,7 +344,8 @@ Example: \(package \"emacs\")))" (let (cached-bugs) ;; Check for cached bugs. - (setq bug-numbers + (setq bug-numbers (delete-dups bug-numbers) + bug-numbers (delete nil (mapcar @@ -349,8 +355,10 @@ Example: status (or (null debbugs-cache-expiry) - (> (cdr (assoc 'cache_time status)) - (- (float-time) debbugs-cache-expiry)))) + (and + (natnump debbugs-cache-expiry) + (> (cdr (assoc 'cache_time status)) + (- (float-time)) debbugs-cache-expiry)))) (progn (setq cached-bugs (append cached-bugs (list status))) nil) @@ -360,43 +368,35 @@ Example: ;; 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)))))))) + ;; Retrieve bugs asynchronously. + (let ((bug-ids bug-numbers) + results) + (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 @@ -429,11 +429,15 @@ Example: (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))) + (if (and debbugs-cache-expiry (natnump debbugs-cache-expiry)) + (puthash + (cdr (assoc 'key x)) + ;; Put also a time stamp. + (cons (cons 'cache_time (floor (float-time))) + (cdr (assoc 'value x))) + debbugs-cache-data) + ;; Don't cache. + (cdr (assoc 'value x))))) debbugs-soap-invoke-async-object)))) (defun debbugs-get-usertag (&rest query) @@ -551,7 +555,8 @@ The following conditions are possible: :skip and :max are optional. They specify, how many hits are skipped, and how many maximal hits are returned. This can be - used for paged results. Per default, :skip is 0 and :max is 10. + used for paged results. Per default, :skip is 0 and all + possible hits are returned. There must be exactly one such condition. @@ -653,134 +658,155 @@ Examples: ,\(floor \(float-time \(encode-time 0 0 0 31 8 2011))) :operator \"NUMBT\"))" - (let (args result) - ;; Compile search arguments. - (dolist (elt query) - (let (vec kw key val - phrase-cond attr-cond) - - ;; Phrase is mandatory, even if empty. - (when (and (or (member :skip elt) (member :max elt)) - (not (member :phrase elt))) - (setq vec (vector "phrase" ""))) - - ;; Parse condition. - (while (consp elt) - (setq kw (pop elt)) - (unless (keywordp kw) - (error "Wrong keyword: %s" kw)) - (setq key (substring (symbol-name kw) 1)) - (cl-case kw - ;; Phrase condition. - (:phrase - ;; It shouldn't happen in an attribute condition. - (if attr-cond - (error "Wrong keyword: %s" kw)) - (setq phrase-cond t val (pop elt)) - ;; Value is a string. - (if (stringp val) - (setq vec (vconcat vec (list key val))) - (error "Wrong %s: %s" key val))) - - ((:skip :max) - ;; It shouldn't happen in an attribute condition. - (if attr-cond - (error "Wrong keyword: %s" kw)) - (setq phrase-cond t val (pop elt)) - ;; Value is a number. - (if (numberp val) - (setq vec (vconcat vec (list key (number-to-string val)))) - (error "Wrong %s: %s" key val))) - - ;; Attribute condition. - ((:submitter :@author) - ;; It shouldn't happen in a phrase condition. - (if phrase-cond - (error "Wrong keyword: %s" kw)) - (if (not (stringp (car elt))) - (setq vec (vconcat vec (list key ""))) - ;; Value is an email address. - (while (and (stringp (car elt)) - (string-match "\\`\\S-+\\'" (car elt))) - (when (string-equal "me" (car elt)) - (setcar elt user-mail-address)) - (when (string-match "<\\(.+\\)>" (car elt)) - (setcar elt (match-string 1 (car elt)))) - (let ((x (pop elt))) - (unless (member x val) - (setq val (append val (list x)))))) - (setq vec - (vconcat vec (list key (mapconcat 'identity val " ")))))) - - (:status - ;; It shouldn't happen in a phrase condition. - (if phrase-cond - (error "Wrong keyword: %s" kw)) - (setq attr-cond t) - (if (not (stringp (car elt))) - (setq vec (vconcat vec (list key ""))) - ;; Possible values: "done", "forwarded" and "open" - (while (and (stringp (car elt)) - (string-match - "\\`\\(done\\|forwarded\\|open\\)\\'" (car elt))) - (let ((x (pop elt))) - (unless (member x val) - (setq val (append val (list x)))))) - (setq vec - (vconcat vec (list key (mapconcat 'identity val " ")))))) - - ((:subject :package :tags :severity :@title) - ;; It shouldn't happen in a phrase condition. - (if phrase-cond - (error "Wrong keyword: %s" kw)) - (setq attr-cond t) - (if (not (stringp (car elt))) - (setq vec (vconcat vec (list key ""))) - ;; Just a string. - (while (stringp (car elt)) - (let ((x (pop elt))) - (unless (member x val) - (setq val (append val (list x)))))) - (setq vec - (vconcat vec (list key (mapconcat 'identity val " ")))))) - - ((:date :@cdate) - ;; It shouldn't happen in a phrase condition. - (if phrase-cond - (error "Wrong keyword: %s" kw)) - (setq attr-cond t) - (if (not (numberp (car elt))) - (setq vec (vconcat vec (list key ""))) - ;; Just a number. - (while (numberp (car elt)) - (let ((x (pop elt))) - (unless (member x val) - (setq val (append val (list x)))))) - (setq vec - (vconcat - vec (list key (mapconcat 'number-to-string val " ")))))) - - ((:operator :order) - ;; It shouldn't happen in a phrase condition. - (if phrase-cond - (error "Wrong keyword: %s" kw)) - (setq attr-cond t val (pop elt)) - ;; Value is a number. - (if (stringp val) - (setq vec (vconcat vec (list key val))) - (error "Wrong %s: %s" key val))) - - (t (error "Unknown key: %s" kw)))) - - (setq args (vconcat args (list vec))))) - - (setq result - (car (soap-invoke debbugs-wsdl debbugs-port "search_est" args))) - ;; The result contains lists (key value). We transform it into - ;; cons cells (key . value). - (dolist (elt1 result result) - (dolist (elt2 elt1) - (setcdr elt2 (cadr elt2)))))) + (let ((phrase (assoc :phrase query)) + args result) + (if (and phrase (not (member :skip phrase)) (not (member :skip phrase))) + ;; We loop, until we have all results. + (let ((skip 0) + (query (delete phrase query)) + result1) + (while skip + (setq result1 + (apply + 'debbugs-search-est + (append + (list + (append + phrase `(:skip ,skip) + `(:max ,debbugs-max-hits-per-request))) + query)) + skip (and (= (length result1) debbugs-max-hits-per-request) + (+ skip debbugs-max-hits-per-request)) + result (append result result1))) + result) + + ;; Compile search arguments. + (dolist (elt query) + (let (vec kw key val + phrase-cond attr-cond) + + ;; Phrase is mandatory, even if empty. + (when (and (or (member :skip elt) (member :max elt)) + (not (member :phrase elt))) + (setq vec (vector "phrase" ""))) + + ;; Parse condition. + (while (consp elt) + (setq kw (pop elt)) + (unless (keywordp kw) + (error "Wrong keyword: %s" kw)) + (setq key (substring (symbol-name kw) 1)) + (cl-case kw + ;; Phrase condition. + (:phrase + ;; It shouldn't happen in an attribute condition. + (if attr-cond + (error "Wrong keyword: %s" kw)) + (setq phrase-cond t val (pop elt)) + ;; Value is a string. + (if (stringp val) + (setq vec (vconcat vec (list key val))) + (error "Wrong %s: %s" key val))) + + ((:skip :max) + ;; It shouldn't happen in an attribute condition. + (if attr-cond + (error "Wrong keyword: %s" kw)) + (setq phrase-cond t val (pop elt)) + ;; Value is a number. + (if (numberp val) + (setq vec (vconcat vec (list key (number-to-string val)))) + (error "Wrong %s: %s" key val))) + + ;; Attribute condition. + ((:submitter :@author) + ;; It shouldn't happen in a phrase condition. + (if phrase-cond + (error "Wrong keyword: %s" kw)) + (if (not (stringp (car elt))) + (setq vec (vconcat vec (list key ""))) + ;; Value is an email address. + (while (and (stringp (car elt)) + (string-match "\\`\\S-+\\'" (car elt))) + (when (string-equal "me" (car elt)) + (setcar elt user-mail-address)) + (when (string-match "<\\(.+\\)>" (car elt)) + (setcar elt (match-string 1 (car elt)))) + (let ((x (pop elt))) + (unless (member x val) + (setq val (append val (list x)))))) + (setq vec + (vconcat vec (list key (mapconcat 'identity val " ")))))) + + (:status + ;; It shouldn't happen in a phrase condition. + (if phrase-cond + (error "Wrong keyword: %s" kw)) + (setq attr-cond t) + (if (not (stringp (car elt))) + (setq vec (vconcat vec (list key ""))) + ;; Possible values: "done", "forwarded" and "open" + (while (and (stringp (car elt)) + (string-match + "\\`\\(done\\|forwarded\\|open\\)\\'" (car elt))) + (let ((x (pop elt))) + (unless (member x val) + (setq val (append val (list x)))))) + (setq vec + (vconcat vec (list key (mapconcat 'identity val " ")))))) + + ((:subject :package :tags :severity :@title) + ;; It shouldn't happen in a phrase condition. + (if phrase-cond + (error "Wrong keyword: %s" kw)) + (setq attr-cond t) + (if (not (stringp (car elt))) + (setq vec (vconcat vec (list key ""))) + ;; Just a string. + (while (stringp (car elt)) + (let ((x (pop elt))) + (unless (member x val) + (setq val (append val (list x)))))) + (setq vec + (vconcat vec (list key (mapconcat 'identity val " ")))))) + + ((:date :@cdate) + ;; It shouldn't happen in a phrase condition. + (if phrase-cond + (error "Wrong keyword: %s" kw)) + (setq attr-cond t) + (if (not (numberp (car elt))) + (setq vec (vconcat vec (list key ""))) + ;; Just a number. + (while (numberp (car elt)) + (let ((x (pop elt))) + (unless (member x val) + (setq val (append val (list x)))))) + (setq vec + (vconcat + vec (list key (mapconcat 'number-to-string val " ")))))) + + ((:operator :order) + ;; It shouldn't happen in a phrase condition. + (if phrase-cond + (error "Wrong keyword: %s" kw)) + (setq attr-cond t val (pop elt)) + ;; Value is a number. + (if (stringp val) + (setq vec (vconcat vec (list key val))) + (error "Wrong %s: %s" key val))) + + (t (error "Unknown key: %s" kw)))) + + (setq args (vconcat args (list vec))))) + + (setq result + (car (soap-invoke debbugs-wsdl debbugs-port "search_est" args))) + ;; The result contains lists (key value). We transform it into + ;; cons cells (key . value). + (dolist (elt1 result result) + (dolist (elt2 elt1) + (setcdr elt2 (cadr elt2))))))) (defun debbugs-get-attribute (bug-or-message attribute) "Return the value of key ATTRIBUTE. diff --git a/packages/debbugs/debbugs.info b/packages/debbugs/debbugs.info index f29d07e7a..b05bf77d1 100644 --- a/packages/debbugs/debbugs.info +++ b/packages/debbugs/debbugs.info @@ -150,6 +150,14 @@ selected by the 'debbugs-port' variable. accessed, either '"gnu.org"' or '"debian.org"', or a user defined port name. + -- Variable: debbugs-cache-expiry + The function 'debbugs-get-status' (*note Requesting bugs + statuses::) caches retrieved status entries in order to improve + the performance. This variable determines the number of seconds + an entry is cached, before it is retrieved again. A value of + 'nil' disables cache expiration, and a value of 't' disables + caching. Both values are not recommended for a usual workflow. +  File: debbugs.info, Node: Requesting bug numbers, Next: Requesting bugs statuses, Prev: Configuration, Up: Top @@ -541,9 +549,9 @@ Tag Table: Node: Top1094 Node: Installation3179 Node: Configuration4278 -Node: Requesting bug numbers6190 -Node: Requesting bugs statuses11444 -Node: Requesting messages15495 -Node: Requesting user tags18510 +Node: Requesting bug numbers6629 +Node: Requesting bugs statuses11883 +Node: Requesting messages15934 +Node: Requesting user tags18949  End Tag Table diff --git a/packages/debbugs/debbugs.texi b/packages/debbugs/debbugs.texi index 705e15329..0a627d6b9 100644 --- a/packages/debbugs/debbugs.texi +++ b/packages/debbugs/debbugs.texi @@ -160,6 +160,15 @@ the variable corresponds to the Debbugs server to be accessed, either @code{"gnu.org"} or @code{"debian.org"}, or a user defined port name. @end defvar +@defvar debbugs-cache-expiry +The function @code{debbugs-get-status} (@pxref{Requesting bugs +statuses}) caches retrieved status entries in order to improve the +performance. This variable determines the number of seconds an entry +is cached, before it is retrieved again. A value of @code{nil} +disables cache expiration, and a value of @code{t} disables caching. +Both values are not recommended for a usual workflow. +@end defvar + @node Requesting bug numbers @chapter Requesting bug numbers -- 2.39.2