]> code.delx.au - gnu-emacs-elpa/blob - packages/debbugs/debbugs.el
Merge branch 'master' of github.com:leoliu/ggtags
[gnu-emacs-elpa] / packages / debbugs / debbugs.el
1 ;;; debbugs.el --- SOAP library to access debbugs servers
2
3 ;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
4
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
6 ;; Keywords: comm, hypermedia
7 ;; Package: debbugs
8 ;; Version: 0.8
9
10 ;; This file is not part of GNU Emacs.
11
12 ;; This program is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
16
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25 ;;; Commentary:
26
27 ;; This package provides basic functions to access a Debbugs SOAP
28 ;; server (see <http://wiki.debian.org/DebbugsSoapInterface>).
29
30 ;; The function "get_versions" is not implemented (yet). "search_est"
31 ;; is an extension on <http://debbugs.gnu.org>.
32
33 ;;; Code:
34
35 ;(setq soap-debug t message-log-max t)
36 (require 'soap-client)
37 (eval-when-compile (require 'cl))
38
39 (defgroup debbugs nil
40 "Debbugs library"
41 :group 'hypermedia)
42
43 (defcustom debbugs-servers
44 '(("gnu.org"
45 :wsdl "http://debbugs.gnu.org/cgi/soap.cgi?WSDL"
46 :bugreport-url "http://debbugs.gnu.org/cgi/bugreport.cgi")
47 ("debian.org"
48 :wsdl "http://bugs.debian.org/cgi-bin/soap.cgi?WSDL"
49 :bugreport-url "http://bugs.debian.org/cgi-bin/bugreport.cgi"))
50 "*List of Debbugs server specifiers.
51 Each entry is a list that contains a string identifying the port
52 name and the server parameters in keyword-value form. Allowed
53 keywords are:
54
55 `:wsdl' -- Location of WSDL. The value is a string with URL that
56 should return the WSDL specification of Debbugs/SOAP service.
57
58 `:bugreport-url' -- URL of the server script that returns mboxes
59 with bug logs.
60
61 The list initially contains two predefined and configured Debbugs
62 servers: \"gnu.org\" and \"debian.org\"."
63 :group 'debbugs
64 :link '(custom-manual "(debbugs)Debbugs server specifiers")
65 :type '(choice
66 (const nil)
67 (repeat
68 (cons :tag "Server"
69 (string :tag "Port name")
70 (checklist :tag "Options" :greedy t
71 (group :inline t
72 (const :format "" :value :wsdl)
73 (string :tag "WSDL"))
74 (group :inline t
75 (const :format "" :value :bugreport-url)
76 (string :tag "Bugreport URL")))))))
77
78 (defcustom debbugs-port "gnu.org"
79 "The port instance to be applied from `debbugs-wsdl'.
80 This corresponds to the Debbugs server to be accessed, either
81 \"gnu.org\", or \"debian.org\", or user defined port name."
82 ;; Maybe we should create an own group?
83 :group 'debbugs
84 :type '(choice :tag "Debbugs server" (const "gnu.org") (const "debian.org")
85 (string :tag "user defined port name")))
86
87 ;; It would be nice if we could retrieve it from the debbugs server.
88 ;; Not supported yet.
89 (defconst debbugs-wsdl
90 (soap-load-wsdl
91 (expand-file-name
92 "Debbugs.wsdl"
93 (if load-in-progress
94 (file-name-directory load-file-name)
95 default-directory)))
96 "The WSDL object to be used describing the SOAP interface.")
97
98 (defun debbugs-get-bugs (&rest query)
99 "Return a list of bug numbers which match QUERY.
100
101 QUERY is a sequence of keyword-value pairs where the values are
102 strings, i.e. :KEYWORD \"VALUE\" [:KEYWORD \"VALUE\"]*
103
104 The keyword-value pair is a subquery. The keywords are allowed to
105 have multiple occurrence within the query at any place. The
106 subqueries with the same keyword form the logical subquery, which
107 returns the union of bugs of every subquery it contains.
108
109 The result of the QUERY is an intersection of results of all
110 subqueries.
111
112 Valid keywords are:
113
114 :package -- The value is the name of the package a bug belongs
115 to, like \"emacs\", \"coreutils\", \"gnus\", or \"tramp\".
116
117 :src -- This is used to retrieve bugs that belong to source
118 with given name.
119
120 :severity -- This is the severity of the bug. The exact set of
121 allowed values depends on the Debbugs port. Examples are
122 \"normal\", \"minor\", \"wishlist\" etc.
123
124 :tag -- An arbitrary string the bug is annotated with.
125 Usually, this is used to mark the status of the bug, like
126 \"fixed\", \"moreinfo\", \"notabug\", \"patch\",
127 \"unreproducible\" or \"wontfix\". The exact set of tags
128 depends on the Debbugs port.
129
130 :owner -- This is used to identify bugs by the owner's email
131 address. The special email address \"me\" is used as pattern,
132 replaced with `user-mail-address'.
133
134 :submitter -- With this keyword it is possible to filter bugs
135 by the submitter's email address. The special email address
136 \"me\" is used as pattern, replaced with `user-mail-address'.
137
138 :maint -- This is used to find bugs of the packages which are
139 maintained by the person with the given email address. The
140 special email address \"me\" is used as pattern, replaced with
141 `user-mail-address'.
142
143 :correspondent -- This allows to find bug reports where the
144 person with the given email address has participated. The
145 special email address \"me\" is used as pattern, replaced with
146 `user-mail-address'.
147
148 :affects -- With this keyword it is possible to find bugs which
149 affect the package with the given name. The bugs are chosen by
150 the value of field `affects' in bug's status. The returned bugs
151 do not necessary belong to this package.
152
153 :status -- Status of bug. Valid values are \"done\",
154 \"forwarded\" and \"open\".
155
156 :archive -- A keyword to filter for bugs which are already
157 archived, or not. Valid values are \"0\" (not archived),
158 \"1\" (archived) or \"both\". If this keyword is not given in
159 the query, `:archive \"0\"' is assumed by default.
160
161 Example. Get all opened and forwarded release critical bugs for
162 the packages which are maintained by \"me\" and which have a
163 patch:
164
165 \(debbugs-get-bugs :maint \"me\" :tag \"patch\"
166 :severity \"critical\"
167 :status \"open\"
168 :severity \"grave\"
169 :status \"forwarded\"
170 :severity \"serious\")"
171
172 (let (vec kw key val)
173 ;; Check query.
174 (while (and (consp query) (<= 2 (length query)))
175 (setq kw (pop query)
176 val (pop query))
177 (unless (and (keywordp kw) (stringp val))
178 (error "Wrong query: %s %s" kw val))
179 (setq key (substring (symbol-name kw) 1))
180 (case kw
181 ((:package :severity :tag :src :affects)
182 ;; Value shall be one word.
183 (if (string-match "\\`\\S-+\\'" val)
184 (setq vec (vconcat vec (list key val)))
185 (error "Wrong %s: %s" key val)))
186 ((:owner :submitter :maint :correspondent)
187 ;; Value is an email address.
188 (if (string-match "\\`\\S-+\\'" val)
189 (progn
190 (when (string-equal "me" val)
191 (setq val user-mail-address))
192 (when (string-match "<\\(.+\\)>" val)
193 (setq val (match-string 1 val)))
194 (setq vec (vconcat vec (list key val))))
195 (error "Wrong %s: %s" key val)))
196 (:status
197 ;; Possible values: "done", "forwarded" and "open"
198 (if (string-match "\\`\\(done\\|forwarded\\|open\\)\\'" val)
199 (setq vec (vconcat vec (list key val)))
200 (error "Wrong %s: %s" key val)))
201 (:archive
202 ;; Value is `0' or `1' or `both'.
203 (if (string-match "\\`\\(0\\|1\\|both\\)\\'" val)
204 (setq vec (vconcat vec (list key val)))
205 (error "Wrong %s: %s" key val)))
206 (t (error "Unknown key: %s" kw))))
207
208 (unless (null query)
209 (error "Unknown key: %s" (car query)))
210 (sort (car (soap-invoke debbugs-wsdl debbugs-port "get_bugs" vec)) '<)))
211
212 (defun debbugs-newest-bugs (amount)
213 "Return the list of bug numbers, according to AMOUNT (a number) latest bugs."
214 (sort (car (soap-invoke debbugs-wsdl debbugs-port "newest_bugs" amount)) '<))
215
216 (defun debbugs-get-status (&rest bug-numbers)
217 "Return a list of status entries for the bugs identified by BUG-NUMBERS.
218
219 Every returned entry is an association list with the following attributes:
220
221 `bug_num': The bug number.
222
223 `package': A list of package names the bug belongs to.
224
225 `severity': The severity of the bug report. This can be
226 \"important\", \"grave\", \"normal\", \"minor\" or \"wishlist\".
227
228 `tags': The status of the bug report, a list of strings. This
229 can be \"fixed\", \"notabug\", \"wontfix\", \"unreproducible\",
230 \"moreinfo\" or \"patch\".
231
232 `pending': The string \"pending\", \"forwarded\" or \"done\".
233
234 `subject': Subject/Title of the bugreport.
235
236 `originator': Submitter of the bugreport.
237
238 `mergedwith': A list of bug numbers this bug was merged with.
239 If it is a single bug, then this attribute contains just a
240 number.
241
242 `source': Source package name of the bug report.
243
244 `date': Date of bug creation.
245
246 `log_modified', `last_modified': Date of last update.
247
248 `found_date', `fixed_date': Date of bug report / bug fix
249 \(empty for now).
250
251 `done': The email address of the worker who has closed the bug (if done).
252
253 `archived': `t' if the bug is archived, `nil' otherwise.
254
255 `unarchived': The date the bug has been unarchived, if ever.
256
257 `found_versions', `fixed_versions': List of version strings.
258
259 `forwarded': A URL or an email address.
260
261 `blocks': A list of bug numbers this bug blocks.
262
263 `blockedby': A list of bug numbers this bug is blocked by.
264
265 `msgid': The message id of the initial bug report.
266
267 `owner': Who is responsible for fixing.
268
269 `location': Always the string \"db-h\" or \"archive\".
270
271 `affects': A list of package names.
272
273 `summary': Arbitrary text.
274
275 Example:
276
277 \(debbugs-get-status 10)
278
279 => ;; Attributes with empty values are not shown
280 \(\(\(bug_num . 10)
281 \(source . \"unknown\")
282 \(date . 1203606305.0)
283 \(msgid . \"<87zltuz7eh.fsf@freemail.hu>\")
284 \(severity . \"wishlist\")
285 \(owner . \"Magnus Henoch <mange@freemail.hu>\")
286 \(log_modified . 1261079402.0)
287 \(location . \"db-h\")
288 \(subject . \"url-gw should support HTTP CONNECT proxies\")
289 \(originator . \"Magnus Henoch <mange@freemail.hu>\")
290 \(last_modified . 1271200046.0)
291 \(pending . \"pending\")
292 \(package \"emacs\")))"
293 (when bug-numbers
294 (let ((object
295 (car
296 (soap-invoke
297 debbugs-wsdl debbugs-port "get_status"
298 (apply 'vector bug-numbers)))))
299 (mapcar
300 (lambda (x)
301 (let (y)
302 ;; "archived" is the number 1 or 0.
303 (setq y (assoc 'archived (cdr (assoc 'value x))))
304 (setcdr y (= (cdr y) 1))
305 ;; "found_versions" and "fixed_versions" are lists,
306 ;; containing strings or numbers.
307 (dolist (attribute '(found_versions fixed_versions))
308 (setq y (assoc attribute (cdr (assoc 'value x))))
309 (setcdr y (mapcar
310 (lambda (z) (if (numberp z) (number-to-string z) z))
311 (cdr y))))
312 ;; "mergedwith", "blocks" and "blockedby are strings,
313 ;; containing blank separated bug numbers.
314 (dolist (attribute '(mergedwith blocks blockedby))
315 (setq y (assoc attribute (cdr (assoc 'value x))))
316 (when (stringp (cdr y))
317 (setcdr y (mapcar
318 'string-to-number (split-string (cdr y) " " t)))))
319 ;; "package" is a string, containing comma separated
320 ;; package names. "keywords" and "tags" are strings,
321 ;; containing blank separated package names.
322 (dolist (attribute '(package keywords tags))
323 (setq y (assoc attribute (cdr (assoc 'value x))))
324 (when (stringp (cdr y))
325 (setcdr y (split-string (cdr y) ",\\| " t))))
326 (cdr (assoc 'value x))))
327 object))))
328
329 (defun debbugs-get-usertag (&rest query)
330 "Return a list of bug numbers which match QUERY.
331
332 QUERY is a sequence of keyword-value pairs where the values are
333 strings, i.e. :KEYWORD \"VALUE\" [:KEYWORD \"VALUE\"]*
334
335 Valid keywords are:
336
337 :user -- The value is the name of the package a bug belongs to,
338 like \"emacs\", \"coreutils\", \"gnus\", or \"tramp\". It can
339 also be an email address of a user who has applied a user tag.
340 The special email address \"me\" is used as pattern, replaced
341 with `user-mail-address'. There must be at least one such
342 entry; it is recommended to have exactly one.
343
344 :tag -- A string applied as user tag. Often, it is a
345 subproduct identification, like \"cedet\" or \"tramp\" for the
346 package \"emacs\".
347
348 If there is no :tag entry, no bug numbers will be returned but a list of
349 existing user tags for :user.
350
351 Example:
352
353 \(debbugs-get-usertag :user \"emacs\")
354
355 => (\"www\" \"solaris\" \"ls-lisp\" \"cygwin\")
356
357 \(debbugs-get-usertag :user \"emacs\" :tag \"www\" :tag \"cygwin\")
358
359 => (807 1223 5637)"
360
361 (let (user tags kw key val object result)
362 ;; Check query.
363 (while (and (consp query) (<= 2 (length query)))
364 (setq kw (pop query)
365 val (pop query))
366 (unless (and (keywordp kw) (stringp val))
367 (error "Wrong query: %s %s" kw val))
368 (setq key (substring (symbol-name kw) 1))
369 (case kw
370 ((:user)
371 ;; Value shall be one word. Extract email address, if existing.
372 (if (string-match "\\`\\S-+\\'" val)
373 (progn
374 (when (string-equal "me" val)
375 (setq val user-mail-address))
376 (when (string-match "<\\(.+\\)>" val)
377 (setq val (match-string 1 val)))
378 (pushnew val user :test #'equal))
379 (error "Wrong %s: %s" key val)))
380 ((:tag)
381 ;; Value shall be one word.
382 (if (string-match "\\`\\S-+\\'" val)
383 (pushnew val tags :test #'equal)
384 (error "Wrong %s: %s" key val)))
385 (t (error "Unknown key: %s" kw))))
386
387 (unless (null query)
388 (error "Unknown key: %s" (car query)))
389 (unless (= (length user) 1)
390 (error "There must be exactly one :user entry"))
391
392 (setq
393 object
394 (car (soap-invoke debbugs-wsdl debbugs-port "get_usertag" (car user))))
395
396 (if (null tags)
397 ;; Return the list of existing tags.
398 (mapcar (lambda (x) (symbol-name (car x))) object)
399
400 ;; Return bug numbers.
401 (dolist (elt object result)
402 (when (member (symbol-name (car elt)) tags)
403 (setq result (append (cdr elt) result)))))))
404
405 (defun debbugs-get-bug-log (bug-number)
406 "Return a list of messages related to BUG-NUMBER.
407
408 Every message is an association list with the following attributes:
409
410 `msg_num': The number of the message inside the bug log. The
411 numbers are ascending, newer messages have a higher number.
412
413 `header': The message header lines, as arrived at the bug tracker.
414
415 `body': The message body.
416
417 `attachments' A list of possible attachments, or `nil'. Not
418 implemented yet server side."
419 (car (soap-invoke debbugs-wsdl debbugs-port "get_bug_log" bug-number)))
420
421 (defun debbugs-search-est (&rest query)
422 "Return the result of a full text search according to QUERY.
423
424 QUERY is a sequence of lists of keyword-value pairs where the
425 values are strings or numbers, i.e. :KEYWORD \"VALUE\" [:KEYWORD
426 VALUE]*
427
428 Every sublist of the QUERY forms a hyperestraier condition. A
429 detailed description of hyperestraier conditions can be found at
430 URL `http://fallabs.com/hyperestraier/uguide-en.html#searchcond'.
431
432 The following conditions are possible:
433
434 \[:phrase SEARCH-PHRASE :skip NUMBER :max NUMBER\]
435
436 The string SEARCH-PHRASE forms the search on the database. It
437 contains words to be searched for, combined by operators like
438 AND, ANDNOT and OR. If there is no operator between the words,
439 AND is used by default. The phrase keyword and value can also
440 be omitted, this is useful in combination with other conditions.
441
442 :skip and :max are optional. They specify, how many hits are
443 skipped, and how many maximal hits are returned. This can be
444 used for paged results. Per default, :skip is 0 and :max is 10.
445
446 There must be exactly one such condition.
447
448 \[ATTRIBUTE VALUE+ :operation OPERATION :order ORDER\]
449
450 ATTRIBUTE is one of the following keywords:
451
452 :status -- Status of bug. Valid values are \"done\",
453 \"forwarded\" and \"open\".
454
455 :subject, :@title -- The subject of a message or the title of
456 the bug, a string.
457
458 :date, :@cdate -- The submission or modification dates of a
459 message, a number.
460
461 :submitter, :@author -- The email address of the submitter of a
462 bug or the author of a message belonging to this bug, a string.
463 The special email address \"me\" is used as pattern, replaced
464 with `user-mail-address'.
465
466 :package -- The value is the name of the package a bug belongs
467 to, like \"emacs\", \"coreutils\", \"gnus\", or \"tramp\".
468
469 :tags -- An arbitrary string the bug is annotated with.
470
471 :severity -- This is the severity of the bug. The exact set of
472 allowed values depends on the Debbugs port. Examples are
473 \"normal\", \"minor\", \"wishlist\" etc.
474
475 :operator defines the comparison operator to be applied to
476 ATTRIBUTE. For string attributes this could be \"STREQ\" \(is
477 equal to the string), \"STRNE\" \(is not equal to the string),
478 \"STRINC\" \(includes the string), \"STRBW\" \(begins with the
479 string), \"STREW\" \(ends with the string), \"STRAND\"
480 \(includes all tokens in the string), \"STROR\" \(includes at
481 least one token in the string), \"STROREQ\" \(is equal to at
482 least one token in the string) or \"STRRX\" \(matches regular
483 expressions of the string). For operators with tokens, several
484 values for ATTRIBUTE shall be used.
485
486 Numbers can be compared by the operators \"NUMEQ\" \(is equal
487 to the number), \"NUMNE\" \(is not equal to the number),
488 \"NUMGT\" \(is greater than the number), \"NUMGE\" \(is greater
489 than or equal to the number), \"NUMLT\" \(is less than the
490 number), \"NUMLE\" \(is less than or equal to the number) or
491 \"NUMBT\" \(is between the two numbers). In the last case,
492 there must be two values for ATTRIBUTE.
493
494 If an operator is leaded by \"!\", the meaning is inverted. If
495 a string operator is leaded by \"I\", the case of the value is
496 ignored.
497
498 The optional :order can be specified only in one condition. It
499 means, that ATTRIBUTE is used for sorting the results. The
500 following order operators exist: \"STRA\" \(ascending by
501 string), \"STRD\" \(descending by string), \"NUMA\" \(ascending
502 by number) or \"NUMD\" \(descending by number).
503
504 A special case is an :order, where there is no corresponding
505 attribute value and no operator. In this case, ATTRIBUTE is
506 not used for the search.
507
508 The result of the QUERY is a list of association lists with the
509 same attributes as in the conditions. Additional attributes are
510
511 `id': The bug number.
512
513 `msg_num': The number of the message inside the bug log.
514
515 `snippet': The surrounding text found by the search. For the
516 syntax of the snippet, consult the hyperestraier user guide.
517
518 Examples:
519
520 \(debbugs-search-est
521 '\(:phrase \"armstrong AND debbugs\" :skip 10 :max 2)
522 '\(:severity \"normal\" :operator \"STRINC\")
523 '\(:date :order \"NUMA\"))
524
525 => \(\(\(msg_num . 21)
526 \(date . 1229208302)
527 \(@author . \"Glenn Morris <rgm@gnu.org>\")
528 \(@title . \"Re: bug#1567: Mailing an archived bug\")
529 \(id . 1567)
530 \(severity . \"normal\")
531 \(@cdate . \"Wed, 17 Dec 2008 14:34:50 -0500\")
532 \(snippet . \"...\")
533 \(subject . \"Mailing an archived bug\")
534 \(package . \"debbugs.gnu.org\"))
535 ...)
536
537 ;; Show all messages from me between 2011-08-01 and 2011-08-31.
538 \(debbugs-search-est
539 '\(:max 20)
540 '\(:@author \"me\" :operator \"ISTRINC\")
541 `\(:date
542 ,\(floor \(float-time \(encode-time 0 0 0 1 8 2011)))
543 ,\(floor \(float-time \(encode-time 0 0 0 31 8 2011)))
544 :operator \"NUMBT\"))"
545
546 (let (args result)
547 ;; Compile search arguments.
548 (dolist (elt query)
549 (let (vec kw key val
550 phrase-cond attr-cond)
551
552 ;; Phrase is mandatory, even if empty.
553 (when (and (or (member :skip elt) (member :max elt))
554 (not (member :phrase elt)))
555 (setq vec (vector "phrase" "")))
556
557 ;; Parse condition.
558 (while (consp elt)
559 (setq kw (pop elt))
560 (unless (keywordp kw)
561 (error "Wrong keyword: %s" kw))
562 (setq key (substring (symbol-name kw) 1))
563 (cl-case kw
564 ;; Phrase condition.
565 (:phrase
566 ;; It shouldn't happen in an attribute condition.
567 (if attr-cond
568 (error "Wrong keyword: %s" kw))
569 (setq phrase-cond t val (pop elt))
570 ;; Value is a string.
571 (if (stringp val)
572 (setq vec (vconcat vec (list key val)))
573 (error "Wrong %s: %s" key val)))
574
575 ((:skip :max)
576 ;; It shouldn't happen in an attribute condition.
577 (if attr-cond
578 (error "Wrong keyword: %s" kw))
579 (setq phrase-cond t val (pop elt))
580 ;; Value is a number.
581 (if (numberp val)
582 (setq vec (vconcat vec (list key (number-to-string val))))
583 (error "Wrong %s: %s" key val)))
584
585 ;; Attribute condition.
586 ((:submitter :@author)
587 ;; It shouldn't happen in a phrase condition.
588 (if phrase-cond
589 (error "Wrong keyword: %s" kw))
590 (if (not (stringp (car elt)))
591 (setq vec (vconcat vec (list key "")))
592 ;; Value is an email address.
593 (while (and (stringp (car elt))
594 (string-match "\\`\\S-+\\'" (car elt)))
595 (when (string-equal "me" (car elt))
596 (setcar elt user-mail-address))
597 (when (string-match "<\\(.+\\)>" (car elt))
598 (setcar elt (match-string 1 (car elt))))
599 (let ((x (pop elt)))
600 (unless (member x val)
601 (setq val (append val (list x))))))
602 (setq vec
603 (vconcat vec (list key (mapconcat 'identity val " "))))))
604
605 (:status
606 ;; It shouldn't happen in a phrase condition.
607 (if phrase-cond
608 (error "Wrong keyword: %s" kw))
609 (setq attr-cond t)
610 (if (not (stringp (car elt)))
611 (setq vec (vconcat vec (list key "")))
612 ;; Possible values: "done", "forwarded" and "open"
613 (while (and (stringp (car elt))
614 (string-match
615 "\\`\\(done\\|forwarded\\|open\\)\\'" (car elt)))
616 (let ((x (pop elt)))
617 (unless (member x val)
618 (setq val (append val (list x))))))
619 (setq vec
620 (vconcat vec (list key (mapconcat 'identity val " "))))))
621
622 ((:subject :package :tags :severity :@title)
623 ;; It shouldn't happen in a phrase condition.
624 (if phrase-cond
625 (error "Wrong keyword: %s" kw))
626 (setq attr-cond t)
627 (if (not (stringp (car elt)))
628 (setq vec (vconcat vec (list key "")))
629 ;; Just a string.
630 (while (stringp (car elt))
631 (let ((x (pop elt)))
632 (unless (member x val)
633 (setq val (append val (list x))))))
634 (setq vec
635 (vconcat vec (list key (mapconcat 'identity val " "))))))
636
637 ((:date :@cdate)
638 ;; It shouldn't happen in a phrase condition.
639 (if phrase-cond
640 (error "Wrong keyword: %s" kw))
641 (setq attr-cond t)
642 (if (not (numberp (car elt)))
643 (setq vec (vconcat vec (list key "")))
644 ;; Just a number.
645 (while (numberp (car elt))
646 (let ((x (pop elt)))
647 (unless (member x val)
648 (setq val (append val (list x))))))
649 (setq vec
650 (vconcat
651 vec (list key (mapconcat 'number-to-string val " "))))))
652
653 ((:operator :order)
654 ;; It shouldn't happen in a phrase condition.
655 (if phrase-cond
656 (error "Wrong keyword: %s" kw))
657 (setq attr-cond t val (pop elt))
658 ;; Value is a number.
659 (if (stringp val)
660 (setq vec (vconcat vec (list key val)))
661 (error "Wrong %s: %s" key val)))
662
663 (t (error "Unknown key: %s" kw))))
664
665 (setq args (vconcat args (list vec)))))
666
667 (setq result
668 (car (soap-invoke debbugs-wsdl debbugs-port "search_est" args)))
669 ;; The result contains lists (key value). We transform it into
670 ;; cons cells (key . value).
671 (dolist (elt1 result result)
672 (dolist (elt2 elt1)
673 (setcdr elt2 (cadr elt2))))))
674
675 (defun debbugs-get-attribute (bug-or-message attribute)
676 "Return the value of key ATTRIBUTE.
677
678 BUG-OR-MESSAGE must be list element returned by either
679 `debbugs-get-status' or `debbugs-get-bug-log'.
680
681 Example: Return the originator of last submitted bug.
682
683 \(debbugs-get-attribute
684 \(car \(apply 'debbugs-get-status \(debbugs-newest-bugs 1))) 'originator)"
685 (cdr (assoc attribute bug-or-message)))
686
687 (defun debbugs-get-message-numbers (messages)
688 "Return the message numbers of MESSAGES.
689 MESSAGES must be the result of a `debbugs-get-bug-log' call."
690 (mapcar (lambda (x) (debbugs-get-attribute x 'msg_num)) messages))
691
692 (defun debbugs-get-message (messages message-number)
693 "Return the message MESSAGE-NUMBER of MESSAGES.
694 MESSAGES must be the result of a `debbugs-get-bug-log' call.
695
696 The returned message is a list of strings. The first element are
697 the header lines of the message, the second element is the body
698 of the message. Further elements of the list, if any, are
699 attachments of the message.
700
701 If there is no message with MESSAGE-NUMBER, the function returns `nil'.
702
703 Example: Return the first message of last submitted bug.
704
705 \(let \(\(messages \(apply 'debbugs-get-bug-log \(debbugs-newest-bugs 1))))
706 \(debbugs-get-message messages
707 \(car \(debbugs-get-message-numbers messages))))"
708 (while (and messages
709 (/= (debbugs-get-attribute (car messages) 'msg_num)
710 message-number))
711 (setq messages (cdr messages)))
712 (when messages
713 (append (list (debbugs-get-attribute (car messages) 'header)
714 (debbugs-get-attribute (car messages) 'body))
715 (debbugs-get-attribute (car messages) 'attachments))))
716
717 (defun debbugs-get-mbox (bug-number mbox-type &optional filename)
718 "Download mbox with messages of bug BUG-NUMBER from Debbugs server.
719 BUG-NUMBER is a number of bug. It must be of integer type.
720
721 MBOX-TYPE specifies a type of mbox and can be one of the
722 following symbols:
723
724 `mboxfolder': Download mbox folder.
725
726 `mboxmaint': Download maintainer's mbox.
727
728 `mboxstat', `mboxstatus': Download status mbox. The use of
729 either symbol depends on actual Debbugs server configuration.
730 For gnu.org, use the former; for debian.org - the latter.
731
732 FILENAME, if non-`nil', is the name of file to store mbox. If
733 FILENAME is `nil', the downloaded mbox is inserted into the
734 current buffer."
735 (let (url (mt "") bn)
736 (unless (setq url (plist-get
737 (cdr (assoc debbugs-port debbugs-servers))
738 :bugreport-url))
739 (error "URL of bugreport script for port %s is not specified"
740 debbugs-port))
741 (setq bn (format "bug=%s;" (number-to-string bug-number)))
742 (unless (eq mbox-type 'mboxfolder)
743 (if (memq mbox-type '(mboxmaint mboxstat mboxstatus))
744 (setq mt (concat (symbol-name mbox-type) "=yes;"))
745 (error "Unknown mbox type: %s" mbox-type)))
746 (setq url (concat url (format "?%s%smbox=yes" bn mt)))
747 (if filename
748 (url-copy-file url filename t)
749 (url-insert-file-contents url))))
750
751 (provide 'debbugs)
752
753 ;;; TODO:
754
755 ;; * SOAP interface extensions (wishlist).
756 ;; - Server-side sorting.
757 ;; - Regexp and/or wildcards search.
758 ;; - Returning message attachments.
759
760 ;;; debbugs.el ends here