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