;;; debbugs.el --- SOAP library to access debbugs servers
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, hypermedia
;; Package: debbugs
-;; Version: 0.2
+;; Version: 0.4
;; This file is part of GNU Emacs.
;;; Commentary:
-;; This package provides some basic functions to access a debbugs SOAP
+;; This package provides basic functions to access a Debbugs SOAP
;; server (see <http://wiki.debian.org/DebbugsSoapInterface>).
-;; The SOAP functions "get_usertag" and "get_versions" are not
-;; implemented (yet).
+;; The function "get_versions" is not implemented (yet). "search_est"
+;; is an extension on <http://debbugs.gnu.org>.
;;; Code:
:status \"open\"
:severity \"grave\"
:status \"forwarded\"
- :severity \"serious\"))"
+ :severity \"serious\")"
(let (vec kw key val)
;; Check query.
\(debbugs-get-status 10)
- => ;; Attributes with empty values are not show
+ => ;; Attributes with empty values are not shown
\(\(\(bug_num . 10)
\(source . \"unknown\")
\(date . 1203606305.0)
(cdr (assoc 'value x))))
object))))
+(defun debbugs-get-usertag (&rest query)
+ "Return a list of bug numbers which match QUERY.
+
+QUERY is a sequence of keyword-value pairs where the values are
+strings, i.e. :KEYWORD \"VALUE\" [:KEYWORD \"VALUE\"]*
+
+Valid keywords are:
+
+ :user -- The value is the name of the package a bug belongs to,
+ like \"emacs\", \"coreutils\", \"gnus\", or \"tramp\". It can
+ also be an email address of a user who has applied a user tag.
+ The special email address \"me\" is used as pattern, replaced
+ with `user-mail-address'. There must be at least one such
+ entry; it is recommended to have exactly one.
+
+ :tag -- A string applied as user tag. Often, it is a
+ subproduct identification, like \"cedet\" or \"tramp\" for the
+ package \"emacs\".
+
+If there is no :tag entry, no bug numbers will be returned but a list of
+existing user tags for :user.
+
+Example:
+
+ \(debbugs-get-usertag :user \"emacs\")
+
+ => (\"www\" \"solaris\" \"ls-lisp\" \"cygwin\")
+
+ \(debbugs-get-usertag :user \"emacs\" :tag \"www\" :tag \"cygwin\")
+
+ => (807 1223 5637)"
+
+ (let (user tags kw key val object result)
+ ;; Check query.
+ (while (and (consp query) (<= 2 (length query)))
+ (setq kw (pop query)
+ val (pop query))
+ (unless (and (keywordp kw) (stringp val))
+ (error "Wrong query: %s %s" kw val))
+ (setq key (substring (symbol-name kw) 1))
+ (case kw
+ ((:user)
+ ;; Value shall be one word. Extract email address, if existing.
+ (if (string-match "\\`\\S-+\\'" val)
+ (progn
+ (when (string-equal "me" val)
+ (setq val user-mail-address))
+ (when (string-match "<\\(.+\\)>" val)
+ (setq val (match-string 1 val)))
+ (add-to-list 'user val))
+ (error "Wrong %s: %s" key val)))
+ ((:tag)
+ ;; Value shall be one word.
+ (if (string-match "\\`\\S-+\\'" val)
+ (add-to-list 'tags val)
+ (error "Wrong %s: %s" key val)))
+ (t (error "Unknown key: %s" kw))))
+
+ (unless (null query)
+ (error "Unknown key: %s" (car query)))
+ (unless (= (length user) 1)
+ (error "There must be exactly one :user entry"))
+
+ (setq
+ object
+ (car (soap-invoke debbugs-wsdl debbugs-port "get_usertag" (car user))))
+
+ (if (null tags)
+ ;; Return the list of existing tags.
+ (mapcar (lambda (x) (symbol-name (car x))) object)
+
+ ;; Return bug numbers.
+ (dolist (elt object result)
+ (when (member (symbol-name (car elt)) tags)
+ (setq result (append (cdr elt) result)))))))
+
(defun debbugs-get-bug-log (bug-number)
"Return a list of messages related to BUG-NUMBER.
(defun debbugs-get-mbox (bug-number mbox-type &optional filename)
"Download mbox with messages of bug BUG-NUMBER from Debbugs server.
-BUG-NUMBER is a number of bug. It must be of integer type.
+BUG-NUMBER is a number of bug. It must be of integer type.
MBOX-TYPE specifies a type of mbox and can be one of the
following symbols:
`mboxmaint': Download maintainer's mbox.
- `mboxstat', `mboxstatus': Download status mbox. The use of
- either symbol depends on actual Debbugs server
- configuration. For gnu.org, use the former; for debian.org -
- the latter.
+ `mboxstat', `mboxstatus': Download status mbox. The use of
+ either symbol depends on actual Debbugs server configuration.
+ For gnu.org, use the former; for debian.org - the latter.
-FILENAME, if non-nil, is the name of file to store mbox. If
-FILENAME is nil, the downloaded mbox is inserted into the current
-buffer."
+FILENAME, if non-`nil', is the name of file to store mbox. If
+FILENAME is `nil', the downloaded mbox is inserted into the
+current buffer."
(let (url (mt "") bn)
(unless (setq url (plist-get
(cdr (assoc debbugs-port debbugs-servers))
;; * SOAP interface extensions (wishlist).
;; - Server-side sorting.
;; - Regexp and/or wildcards search.
-;; - Fulltext search.
;; - Returning message attachments.
;;; debbugs.el ends here