1 ;;; debbugs.el --- SOAP library to access debbugs servers
3 ;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
6 ;; Keywords: comm, hypermedia
9 ;; Package-Requires: ((async "1.6"))
11 ;; This file is not part of GNU Emacs.
13 ;; This program is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; This program is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 ;; This package provides basic functions to access a Debbugs SOAP
29 ;; server (see <http://wiki.debian.org/DebbugsSoapInterface>).
31 ;; The function "get_versions" is not implemented (yet). "search_est"
32 ;; is an extension on <http://debbugs.gnu.org>.
36 ;(setq soap-debug t message-log-max t)
37 (require 'soap-client)
38 (eval-when-compile (require 'cl))
40 (declare-function soap-invoke-async "soap-client")
41 (declare-function async-start "async")
42 (declare-function async-get "async")
48 (defcustom debbugs-servers
50 :wsdl "http://debbugs.gnu.org/cgi/soap.cgi?WSDL"
51 :bugreport-url "http://debbugs.gnu.org/cgi/bugreport.cgi")
53 :wsdl "http://bugs.debian.org/cgi-bin/soap.cgi?WSDL"
54 :bugreport-url "http://bugs.debian.org/cgi-bin/bugreport.cgi"))
55 "*List of Debbugs server specifiers.
56 Each entry is a list that contains a string identifying the port
57 name and the server parameters in keyword-value form. Allowed
60 `:wsdl' -- Location of WSDL. The value is a string with URL that
61 should return the WSDL specification of Debbugs/SOAP service.
63 `:bugreport-url' -- URL of the server script that returns mboxes
66 The list initially contains two predefined and configured Debbugs
67 servers: \"gnu.org\" and \"debian.org\"."
69 :link '(custom-manual "(debbugs)Debbugs server specifiers")
74 (string :tag "Port name")
75 (checklist :tag "Options" :greedy t
77 (const :format "" :value :wsdl)
80 (const :format "" :value :bugreport-url)
81 (string :tag "Bugreport URL")))))))
83 (defcustom debbugs-port "gnu.org"
84 "The port instance to be applied from `debbugs-wsdl'.
85 This corresponds to the Debbugs server to be accessed, either
86 \"gnu.org\", or \"debian.org\", or user defined port name."
87 ;; Maybe we should create an own group?
89 :type '(choice :tag "Debbugs server" (const "gnu.org") (const "debian.org")
90 (string :tag "user defined port name")))
92 ;; It would be nice if we could retrieve it from the debbugs server.
94 (defconst debbugs-wsdl
99 (file-name-directory load-file-name)
101 "The WSDL object to be used describing the SOAP interface.")
103 ;; Please do not increase this value, otherwise we would run into
104 ;; performance problems on the server. Maybe we need to change this a
105 ;; server specific value.
106 (defconst debbugs-max-hits-per-request 500
107 "The max number of bugs or results per soap invocation.")
109 (defvar debbugs-cache-data
110 (make-hash-table :test 'equal :size debbugs-max-hits-per-request)
111 "Hash table of retrieved bugs.")
113 (defconst debbugs-cache-expiry (* 60 60)
114 "How many seconds debbugs results are cached, or nil to disable expiring.")
116 (defvar debbugs-soap-invoke-async-object nil
117 "The object manipulated by `debbugs-soap-invoke-async'.")
119 (defun debbugs-soap-invoke-async (operation-name &rest parameters)
120 "Invoke the SOAP connection asynchronously.
121 If possible, it uses `soap-invoke-async' from soapclient 3.0.
122 Otherwise, `async-start' from the async package is used."
123 (if (fboundp 'soap-invoke-async)
124 ;; This is soap-client 3.0.
127 (lambda (response &rest args)
128 (setq debbugs-soap-invoke-async-object
129 (append debbugs-soap-invoke-async-object (car response))))
131 debbugs-wsdl debbugs-port operation-name parameters)
132 ;; Fallback with async.
135 (load ,(locate-library "soap-client"))
141 (file-name-directory (locate-library "debbugs"))))
142 ,debbugs-port ,operation-name ',parameters)))))
144 (defun debbugs-get-bugs (&rest query)
145 "Return a list of bug numbers which match QUERY.
147 QUERY is a sequence of keyword-value pairs where the values are
148 strings, i.e. :KEYWORD \"VALUE\" [:KEYWORD \"VALUE\"]*
150 The keyword-value pair is a subquery. The keywords are allowed to
151 have multiple occurrence within the query at any place. The
152 subqueries with the same keyword form the logical subquery, which
153 returns the union of bugs of every subquery it contains.
155 The result of the QUERY is an intersection of results of all
160 :package -- The value is the name of the package a bug belongs
161 to, like \"emacs\", \"coreutils\", \"gnus\", or \"tramp\".
163 :src -- This is used to retrieve bugs that belong to source
166 :severity -- This is the severity of the bug. The exact set of
167 allowed values depends on the Debbugs port. Examples are
168 \"normal\", \"minor\", \"wishlist\" etc.
170 :tag -- An arbitrary string the bug is annotated with.
171 Usually, this is used to mark the status of the bug, like
172 \"fixed\", \"moreinfo\", \"notabug\", \"patch\",
173 \"unreproducible\" or \"wontfix\". The exact set of tags
174 depends on the Debbugs port.
176 :owner -- This is used to identify bugs by the owner's email
177 address. The special email address \"me\" is used as pattern,
178 replaced with `user-mail-address'.
180 :submitter -- With this keyword it is possible to filter bugs
181 by the submitter's email address. The special email address
182 \"me\" is used as pattern, replaced with `user-mail-address'.
184 :maint -- This is used to find bugs of the packages which are
185 maintained by the person with the given email address. The
186 special email address \"me\" is used as pattern, replaced with
189 :correspondent -- This allows to find bug reports where the
190 person with the given email address has participated. The
191 special email address \"me\" is used as pattern, replaced with
194 :affects -- With this keyword it is possible to find bugs which
195 affect the package with the given name. The bugs are chosen by
196 the value of field `affects' in bug's status. The returned bugs
197 do not necessary belong to this package.
199 :status -- Status of bug. Valid values are \"done\",
200 \"forwarded\" and \"open\".
202 :archive -- A keyword to filter for bugs which are already
203 archived, or not. Valid values are \"0\" (not archived),
204 \"1\" (archived) or \"both\". If this keyword is not given in
205 the query, `:archive \"0\"' is assumed by default.
207 Example. Get all opened and forwarded release critical bugs for
208 the packages which are maintained by \"me\" and which have a
211 \(debbugs-get-bugs :maint \"me\" :tag \"patch\"
212 :severity \"critical\"
215 :status \"forwarded\"
216 :severity \"serious\")"
218 (let (vec kw key val)
220 (while (and (consp query) (<= 2 (length query)))
223 (unless (and (keywordp kw) (stringp val))
224 (error "Wrong query: %s %s" kw val))
225 (setq key (substring (symbol-name kw) 1))
227 ((:package :severity :tag :src :affects)
228 ;; Value shall be one word.
229 (if (string-match "\\`\\S-+\\'" val)
230 (setq vec (vconcat vec (list key val)))
231 (error "Wrong %s: %s" key val)))
232 ((:owner :submitter :maint :correspondent)
233 ;; Value is an email address.
234 (if (string-match "\\`\\S-+\\'" val)
236 (when (string-equal "me" val)
237 (setq val user-mail-address))
238 (when (string-match "<\\(.+\\)>" val)
239 (setq val (match-string 1 val)))
240 (setq vec (vconcat vec (list key val))))
241 (error "Wrong %s: %s" key val)))
243 ;; Possible values: "done", "forwarded" and "open"
244 (if (string-match "\\`\\(done\\|forwarded\\|open\\)\\'" val)
245 (setq vec (vconcat vec (list key val)))
246 (error "Wrong %s: %s" key val)))
248 ;; Value is `0' or `1' or `both'.
249 (if (string-match "\\`\\(0\\|1\\|both\\)\\'" val)
250 (setq vec (vconcat vec (list key val)))
251 (error "Wrong %s: %s" key val)))
252 (t (error "Unknown key: %s" kw))))
255 (error "Unknown key: %s" (car query)))
256 (sort (car (soap-invoke debbugs-wsdl debbugs-port "get_bugs" vec)) '<)))
258 (defun debbugs-newest-bugs (amount)
259 "Return the list of bug numbers, according to AMOUNT (a number) latest bugs."
260 (sort (car (soap-invoke debbugs-wsdl debbugs-port "newest_bugs" amount)) '<))
262 (defun debbugs-get-status (&rest bug-numbers)
263 "Return a list of status entries for the bugs identified by BUG-NUMBERS.
265 Every returned entry is an association list with the following attributes:
267 `bug_num': The bug number.
269 `package': A list of package names the bug belongs to.
271 `severity': The severity of the bug report. This can be
272 \"critical\", \"grave\", \"serious\", \"important\",
273 \"normal\", \"minor\" or \"wishlist\".
275 `tags': The status of the bug report, a list of strings. This
276 can be \"fixed\", \"notabug\", \"wontfix\", \"unreproducible\",
277 \"moreinfo\" or \"patch\".
279 `pending': The string \"pending\", \"forwarded\" or \"done\".
281 `subject': Subject/Title of the bugreport.
283 `originator': Submitter of the bugreport.
285 `mergedwith': A list of bug numbers this bug was merged with.
286 If it is a single bug, then this attribute contains just a
289 `source': Source package name of the bug report.
291 `date': Date of bug creation.
293 `log_modified', `last_modified': Date of last update.
295 `found_date', `fixed_date': Date of bug report / bug fix
298 `done': The email address of the worker who has closed the bug (if done).
300 `archived': `t' if the bug is archived, `nil' otherwise.
302 `unarchived': The date the bug has been unarchived, if ever.
304 `found_versions', `fixed_versions': List of version strings.
306 `forwarded': A URL or an email address.
308 `blocks': A list of bug numbers this bug blocks.
310 `blockedby': A list of bug numbers this bug is blocked by.
312 `msgid': The message id of the initial bug report.
314 `owner': Who is responsible for fixing.
316 `location': Always the string \"db-h\" or \"archive\".
318 `affects': A list of package names.
320 `summary': Arbitrary text.
324 \(debbugs-get-status 10)
326 => ;; Attributes with empty values are not shown
328 \(source . \"unknown\")
329 \(date . 1203606305.0)
330 \(msgid . \"<87zltuz7eh.fsf@freemail.hu>\")
331 \(severity . \"wishlist\")
332 \(owner . \"Magnus Henoch <mange@freemail.hu>\")
333 \(log_modified . 1261079402.0)
334 \(location . \"db-h\")
335 \(subject . \"url-gw should support HTTP CONNECT proxies\")
336 \(originator . \"Magnus Henoch <mange@freemail.hu>\")
337 \(last_modified . 1271200046.0)
338 \(pending . \"pending\")
339 \(package \"emacs\")))"
341 ;; Check for cached bugs.
347 (let ((status (gethash bug debbugs-cache-data)))
351 (null debbugs-cache-expiry)
352 (> (cdr (assoc 'cache_time status))
353 (- (float-time) debbugs-cache-expiry))))
355 (setq cached-bugs (append cached-bugs (list status)))
360 ;; Retrieve the data.
361 (setq debbugs-soap-invoke-async-object nil)
363 (if (<= (length bug-numbers) debbugs-max-hits-per-request)
365 (setq debbugs-soap-invoke-async-object
367 debbugs-wsdl debbugs-port "get_status"
368 (apply 'vector bug-numbers))))
370 ;; Retrieve bugs asynchronously.
371 (let ((bug-ids bug-numbers)
373 (setq debbugs-soap-invoke-async-object nil)
379 (debbugs-soap-invoke-async
384 bug-ids (- (length bug-ids)
385 debbugs-max-hits-per-request))))))
388 (last bug-ids (- (length bug-ids)
389 debbugs-max-hits-per-request))))
391 (dolist (res results)
393 ;; This is soap-client 3.0.
394 (while (buffer-live-p res)
395 (accept-process-output (get-buffer-process res) 0.1))
396 ;; Fallback with async.
397 (dolist (status (async-get res))
398 (setq debbugs-soap-invoke-async-object
399 (append debbugs-soap-invoke-async-object status))))))))
407 ;; "archived" is the number 1 or 0.
408 (setq y (assoc 'archived (cdr (assoc 'value x))))
409 (setcdr y (= (cdr y) 1))
410 ;; "found_versions" and "fixed_versions" are lists,
411 ;; containing strings or numbers.
412 (dolist (attribute '(found_versions fixed_versions))
413 (setq y (assoc attribute (cdr (assoc 'value x))))
415 (lambda (z) (if (numberp z) (number-to-string z) z))
417 ;; "mergedwith", "blocks" and "blockedby are strings,
418 ;; containing blank separated bug numbers.
419 (dolist (attribute '(mergedwith blocks blockedby))
420 (setq y (assoc attribute (cdr (assoc 'value x))))
421 (when (stringp (cdr y))
423 'string-to-number (split-string (cdr y) " " t)))))
424 ;; "package" is a string, containing comma separated
425 ;; package names. "keywords" and "tags" are strings,
426 ;; containing blank separated package names.
427 (dolist (attribute '(package keywords tags))
428 (setq y (assoc attribute (cdr (assoc 'value x))))
429 (when (stringp (cdr y))
430 (setcdr y (split-string (cdr y) ",\\| " t))))
431 ;; Cache the result, and return.
434 ;; Put also a time stamp.
435 (cons (cons 'cache_time (float-time)) (cdr (assoc 'value x)))
436 debbugs-cache-data)))
437 debbugs-soap-invoke-async-object))))
439 (defun debbugs-get-usertag (&rest query)
440 "Return a list of bug numbers which match QUERY.
442 QUERY is a sequence of keyword-value pairs where the values are
443 strings, i.e. :KEYWORD \"VALUE\" [:KEYWORD \"VALUE\"]*
447 :user -- The value is the name of the package a bug belongs to,
448 like \"emacs\", \"coreutils\", \"gnus\", or \"tramp\". It can
449 also be an email address of a user who has applied a user tag.
450 The special email address \"me\" is used as pattern, replaced
451 with `user-mail-address'. There must be at least one such
452 entry; it is recommended to have exactly one.
454 :tag -- A string applied as user tag. Often, it is a
455 subproduct identification, like \"cedet\" or \"tramp\" for the
458 If there is no :tag entry, no bug numbers will be returned but a list of
459 existing user tags for :user.
463 \(debbugs-get-usertag :user \"emacs\")
465 => (\"www\" \"solaris\" \"ls-lisp\" \"cygwin\")
467 \(debbugs-get-usertag :user \"emacs\" :tag \"www\" :tag \"cygwin\")
471 (let (user tags kw key val object result)
473 (while (and (consp query) (<= 2 (length query)))
476 (unless (and (keywordp kw) (stringp val))
477 (error "Wrong query: %s %s" kw val))
478 (setq key (substring (symbol-name kw) 1))
481 ;; Value shall be one word. Extract email address, if existing.
482 (if (string-match "\\`\\S-+\\'" val)
484 (when (string-equal "me" val)
485 (setq val user-mail-address))
486 (when (string-match "<\\(.+\\)>" val)
487 (setq val (match-string 1 val)))
488 (pushnew val user :test #'equal))
489 (error "Wrong %s: %s" key val)))
491 ;; Value shall be one word.
492 (if (string-match "\\`\\S-+\\'" val)
493 (pushnew val tags :test #'equal)
494 (error "Wrong %s: %s" key val)))
495 (t (error "Unknown key: %s" kw))))
498 (error "Unknown key: %s" (car query)))
499 (unless (= (length user) 1)
500 (error "There must be exactly one :user entry"))
504 (car (soap-invoke debbugs-wsdl debbugs-port "get_usertag" (car user))))
507 ;; Return the list of existing tags.
508 (mapcar (lambda (x) (symbol-name (car x))) object)
510 ;; Return bug numbers.
511 (dolist (elt object result)
512 (when (member (symbol-name (car elt)) tags)
513 (setq result (append (cdr elt) result)))))))
515 (defun debbugs-get-bug-log (bug-number)
516 "Return a list of messages related to BUG-NUMBER.
518 Every message is an association list with the following attributes:
520 `msg_num': The number of the message inside the bug log. The
521 numbers are ascending, newer messages have a higher number.
523 `header': The message header lines, as arrived at the bug tracker.
525 `body': The message body.
527 `attachments' A list of possible attachments, or `nil'. Not
528 implemented yet server side."
529 (car (soap-invoke debbugs-wsdl debbugs-port "get_bug_log" bug-number)))
531 (defun debbugs-search-est (&rest query)
532 "Return the result of a full text search according to QUERY.
534 QUERY is a sequence of lists of keyword-value pairs where the
535 values are strings or numbers, i.e. :KEYWORD \"VALUE\" [:KEYWORD
538 Every sublist of the QUERY forms a hyperestraier condition. A
539 detailed description of hyperestraier conditions can be found at
540 URL `http://fallabs.com/hyperestraier/uguide-en.html#searchcond'.
542 The following conditions are possible:
544 \[:phrase SEARCH-PHRASE :skip NUMBER :max NUMBER\]
546 The string SEARCH-PHRASE forms the search on the database. It
547 contains words to be searched for, combined by operators like
548 AND, ANDNOT and OR. If there is no operator between the words,
549 AND is used by default. The phrase keyword and value can also
550 be omitted, this is useful in combination with other conditions.
552 :skip and :max are optional. They specify, how many hits are
553 skipped, and how many maximal hits are returned. This can be
554 used for paged results. Per default, :skip is 0 and :max is 10.
556 There must be exactly one such condition.
558 \[ATTRIBUTE VALUE+ :operation OPERATION :order ORDER\]
560 ATTRIBUTE is one of the following keywords:
562 :status -- Status of bug. Valid values are \"done\",
563 \"forwarded\" and \"open\".
565 :subject, :@title -- The subject of a message or the title of
568 :date, :@cdate -- The submission or modification dates of a
571 :submitter, :@author -- The email address of the submitter of a
572 bug or the author of a message belonging to this bug, a string.
573 The special email address \"me\" is used as pattern, replaced
574 with `user-mail-address'.
576 :package -- The value is the name of the package a bug belongs
577 to, like \"emacs\", \"coreutils\", \"gnus\", or \"tramp\".
579 :tags -- An arbitrary string the bug is annotated with.
581 :severity -- This is the severity of the bug. The exact set of
582 allowed values depends on the Debbugs port. Examples are
583 \"normal\", \"minor\", \"wishlist\" etc.
585 :operator defines the comparison operator to be applied to
586 ATTRIBUTE. For string attributes this could be \"STREQ\" \(is
587 equal to the string), \"STRNE\" \(is not equal to the string),
588 \"STRINC\" \(includes the string), \"STRBW\" \(begins with the
589 string), \"STREW\" \(ends with the string), \"STRAND\"
590 \(includes all tokens in the string), \"STROR\" \(includes at
591 least one token in the string), \"STROREQ\" \(is equal to at
592 least one token in the string) or \"STRRX\" \(matches regular
593 expressions of the string). For operators with tokens, several
594 values for ATTRIBUTE shall be used.
596 Numbers can be compared by the operators \"NUMEQ\" \(is equal
597 to the number), \"NUMNE\" \(is not equal to the number),
598 \"NUMGT\" \(is greater than the number), \"NUMGE\" \(is greater
599 than or equal to the number), \"NUMLT\" \(is less than the
600 number), \"NUMLE\" \(is less than or equal to the number) or
601 \"NUMBT\" \(is between the two numbers). In the last case,
602 there must be two values for ATTRIBUTE.
604 If an operator is leaded by \"!\", the meaning is inverted. If
605 a string operator is leaded by \"I\", the case of the value is
608 The optional :order can be specified only in one condition. It
609 means, that ATTRIBUTE is used for sorting the results. The
610 following order operators exist: \"STRA\" \(ascending by
611 string), \"STRD\" \(descending by string), \"NUMA\" \(ascending
612 by number) or \"NUMD\" \(descending by number).
614 A special case is an :order, where there is no corresponding
615 attribute value and no operator. In this case, ATTRIBUTE is
616 not used for the search.
618 The result of the QUERY is a list of association lists with the
619 same attributes as in the conditions. Additional attributes are
621 `id': The bug number.
623 `msg_num': The number of the message inside the bug log.
625 `snippet': The surrounding text found by the search. For the
626 syntax of the snippet, consult the hyperestraier user guide.
631 '\(:phrase \"armstrong AND debbugs\" :skip 10 :max 2)
632 '\(:severity \"normal\" :operator \"STRINC\")
633 '\(:date :order \"NUMA\"))
635 => \(\(\(msg_num . 21)
637 \(@author . \"Glenn Morris <rgm@gnu.org>\")
638 \(@title . \"Re: bug#1567: Mailing an archived bug\")
640 \(severity . \"normal\")
641 \(@cdate . \"Wed, 17 Dec 2008 14:34:50 -0500\")
643 \(subject . \"Mailing an archived bug\")
644 \(package . \"debbugs.gnu.org\"))
647 ;; Show all messages from me between 2011-08-01 and 2011-08-31.
650 '\(:@author \"me\" :operator \"ISTRINC\")
652 ,\(floor \(float-time \(encode-time 0 0 0 1 8 2011)))
653 ,\(floor \(float-time \(encode-time 0 0 0 31 8 2011)))
654 :operator \"NUMBT\"))"
657 ;; Compile search arguments.
660 phrase-cond attr-cond)
662 ;; Phrase is mandatory, even if empty.
663 (when (and (or (member :skip elt) (member :max elt))
664 (not (member :phrase elt)))
665 (setq vec (vector "phrase" "")))
670 (unless (keywordp kw)
671 (error "Wrong keyword: %s" kw))
672 (setq key (substring (symbol-name kw) 1))
676 ;; It shouldn't happen in an attribute condition.
678 (error "Wrong keyword: %s" kw))
679 (setq phrase-cond t val (pop elt))
680 ;; Value is a string.
682 (setq vec (vconcat vec (list key val)))
683 (error "Wrong %s: %s" key val)))
686 ;; It shouldn't happen in an attribute condition.
688 (error "Wrong keyword: %s" kw))
689 (setq phrase-cond t val (pop elt))
690 ;; Value is a number.
692 (setq vec (vconcat vec (list key (number-to-string val))))
693 (error "Wrong %s: %s" key val)))
695 ;; Attribute condition.
696 ((:submitter :@author)
697 ;; It shouldn't happen in a phrase condition.
699 (error "Wrong keyword: %s" kw))
700 (if (not (stringp (car elt)))
701 (setq vec (vconcat vec (list key "")))
702 ;; Value is an email address.
703 (while (and (stringp (car elt))
704 (string-match "\\`\\S-+\\'" (car elt)))
705 (when (string-equal "me" (car elt))
706 (setcar elt user-mail-address))
707 (when (string-match "<\\(.+\\)>" (car elt))
708 (setcar elt (match-string 1 (car elt))))
710 (unless (member x val)
711 (setq val (append val (list x))))))
713 (vconcat vec (list key (mapconcat 'identity val " "))))))
716 ;; It shouldn't happen in a phrase condition.
718 (error "Wrong keyword: %s" kw))
720 (if (not (stringp (car elt)))
721 (setq vec (vconcat vec (list key "")))
722 ;; Possible values: "done", "forwarded" and "open"
723 (while (and (stringp (car elt))
725 "\\`\\(done\\|forwarded\\|open\\)\\'" (car elt)))
727 (unless (member x val)
728 (setq val (append val (list x))))))
730 (vconcat vec (list key (mapconcat 'identity val " "))))))
732 ((:subject :package :tags :severity :@title)
733 ;; It shouldn't happen in a phrase condition.
735 (error "Wrong keyword: %s" kw))
737 (if (not (stringp (car elt)))
738 (setq vec (vconcat vec (list key "")))
740 (while (stringp (car elt))
742 (unless (member x val)
743 (setq val (append val (list x))))))
745 (vconcat vec (list key (mapconcat 'identity val " "))))))
748 ;; It shouldn't happen in a phrase condition.
750 (error "Wrong keyword: %s" kw))
752 (if (not (numberp (car elt)))
753 (setq vec (vconcat vec (list key "")))
755 (while (numberp (car elt))
757 (unless (member x val)
758 (setq val (append val (list x))))))
761 vec (list key (mapconcat 'number-to-string val " "))))))
764 ;; It shouldn't happen in a phrase condition.
766 (error "Wrong keyword: %s" kw))
767 (setq attr-cond t val (pop elt))
768 ;; Value is a number.
770 (setq vec (vconcat vec (list key val)))
771 (error "Wrong %s: %s" key val)))
773 (t (error "Unknown key: %s" kw))))
775 (setq args (vconcat args (list vec)))))
778 (car (soap-invoke debbugs-wsdl debbugs-port "search_est" args)))
779 ;; The result contains lists (key value). We transform it into
780 ;; cons cells (key . value).
781 (dolist (elt1 result result)
783 (setcdr elt2 (cadr elt2))))))
785 (defun debbugs-get-attribute (bug-or-message attribute)
786 "Return the value of key ATTRIBUTE.
788 BUG-OR-MESSAGE must be list element returned by either
789 `debbugs-get-status' or `debbugs-get-bug-log'.
791 Example: Return the originator of last submitted bug.
793 \(debbugs-get-attribute
794 \(car \(apply 'debbugs-get-status \(debbugs-newest-bugs 1))) 'originator)"
795 (cdr (assoc attribute bug-or-message)))
797 (defun debbugs-get-message-numbers (messages)
798 "Return the message numbers of MESSAGES.
799 MESSAGES must be the result of a `debbugs-get-bug-log' call."
800 (mapcar (lambda (x) (debbugs-get-attribute x 'msg_num)) messages))
802 (defun debbugs-get-message (messages message-number)
803 "Return the message MESSAGE-NUMBER of MESSAGES.
804 MESSAGES must be the result of a `debbugs-get-bug-log' call.
806 The returned message is a list of strings. The first element are
807 the header lines of the message, the second element is the body
808 of the message. Further elements of the list, if any, are
809 attachments of the message.
811 If there is no message with MESSAGE-NUMBER, the function returns `nil'.
813 Example: Return the first message of last submitted bug.
815 \(let \(\(messages \(apply 'debbugs-get-bug-log \(debbugs-newest-bugs 1))))
816 \(debbugs-get-message messages
817 \(car \(debbugs-get-message-numbers messages))))"
819 (/= (debbugs-get-attribute (car messages) 'msg_num)
821 (setq messages (cdr messages)))
823 (append (list (debbugs-get-attribute (car messages) 'header)
824 (debbugs-get-attribute (car messages) 'body))
825 (debbugs-get-attribute (car messages) 'attachments))))
827 (defun debbugs-get-mbox (bug-number mbox-type &optional filename)
828 "Download mbox with messages of bug BUG-NUMBER from Debbugs server.
829 BUG-NUMBER is a number of bug. It must be of integer type.
831 MBOX-TYPE specifies a type of mbox and can be one of the
834 `mboxfolder': Download mbox folder.
836 `mboxmaint': Download maintainer's mbox.
838 `mboxstat', `mboxstatus': Download status mbox. The use of
839 either symbol depends on actual Debbugs server configuration.
840 For gnu.org, use the former; for debian.org - the latter.
842 FILENAME, if non-`nil', is the name of file to store mbox. If
843 FILENAME is `nil', the downloaded mbox is inserted into the
845 (let (url (mt "") bn)
846 (unless (setq url (plist-get
847 (cdr (assoc debbugs-port debbugs-servers))
849 (error "URL of bugreport script for port %s is not specified"
851 (setq bn (format "bug=%s;" (number-to-string bug-number)))
852 (unless (eq mbox-type 'mboxfolder)
853 (if (memq mbox-type '(mboxmaint mboxstat mboxstatus))
854 (setq mt (concat (symbol-name mbox-type) "=yes;"))
855 (error "Unknown mbox type: %s" mbox-type)))
856 (setq url (concat url (format "?%s%smbox=yes" bn mt)))
858 (url-copy-file url filename t)
859 (url-insert-file-contents url))))
865 ;; * SOAP interface extensions (wishlist).
866 ;; - Server-side sorting.
867 ;; - Regexp and/or wildcards search.
868 ;; - Returning message attachments.
870 ;;; debbugs.el ends here