code.delx.au - gnu-emacs-elpa/blob - packages/debbugs-0.1/debbugs.el

   1 ;;; debbugs.el --- SOAP library to access debbugs servers
   2
   3 ;; Copyright (C) 2011 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6 ;; Keywords: comm, hypermedia
   7 ;; Package: debbugs
   8 ;; Version: 0.1
   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 functions "get_usertag" and "get_versions" are not
  31 ;; implemented (yet).
  32
  33 ;;; Code:
  34
  35 ;(setq soap-debug t message-log-max t)
  36 (require 'soap-client)
  37
  38 (defcustom debbugs-port "gnu.org"
  39   "The port instance to be applied from `debbugs-wsdl'.
  40 This corresponds to the Debbugs server to be accessed, either
  41 \"gnu.org\", or \"debian.org\"."
  42   ;; Maybe we should create an own group?
  43   :group 'emacsbug
  44   :type '(choice :tag "Debbugs server" (const "gnu.org") (const "debian.org")))
  45
  46 ;; It would be nice if we could retrieve it from the debbugs server.
  47 ;; Not supported yet.
  48 (defconst debbugs-wsdl
  49   (soap-load-wsdl
  50    (expand-file-name
  51     "Debbugs.wsdl"
  52     (if load-in-progress
  53         (file-name-directory load-file-name)
  54       default-directory)))
  55   "The WSDL object to be used describing the SOAP interface.")
  56
  57 (defun debbugs-get-bugs (&rest query)
  58   "Return a list of bug numbers which match QUERY.
  59
  60 QUERY is a keyword value sequence, whereby the values are strings.
  61 All queries are concatenated via AND.
  62
  63 Valid keywords are:
  64
  65   :package -- The value is the name of the package a bug belongs
  66   to, like \"emacs\", \"coreutils\", \"gnus\", or \"tramp\".
  67
  68   :severity -- This is the severity of the bug.  Currently,
  69   there exists the severities \"important\", \"grave\",
  70   \"normal\", \"minor\" and \"wishlist\".
  71
  72   :tag -- An arbitrary string the bug is annotated with.
  73   Usually, this is used to mark the status of the bug, like
  74   \"fixed\", \"moreinfo\", \"notabug\", \"patch\",
  75   \"unreproducible\" or \"wontfix\".
  76
  77   :owner -- This is used to identify bugs by the owner's email
  78   address.  The special email address \"me\" is used as pattern,
  79   replaced with `user-mail-address'.
  80
  81   :submitter -- With this keyword it is possible to filter bugs
  82   by the submitter's email address.  The special email address
  83   \"me\" is used as pattern, replaced with `user-mail-address'.
  84
  85   :archive -- A keyword to filter for bugs which are already
  86   archived, or not.  Valid values are \"0\" (not archived),
  87   \"1\" (archived) or \"both\".  If this keyword is not given in
  88   the query, `:archive \"0\"' is assumed by default.
  89
  90 Example:
  91
  92   \(debbugs-get-bugs :submitter \"me\" :archive \"both\")
  93   => \(5516 5551 5645 7259)"
  94
  95   (let (vec key val)
  96     ;; Check query.
  97     (while (and (consp query) (<= 2 (length query)))
  98       (setq key (pop query)
  99             val (pop query)
 100             vec (vconcat vec (list (substring (symbol-name key) 1))))
 101       (unless (and (keywordp key) (stringp val))
 102         (t (error "Wrong query: %s %s" key val)))
 103       (case key
 104         ((:package :severity :tag)
 105          ;; Value shall be one word.
 106          (if (string-match "\\`[A-Za-z]+\\'" val)
 107              (setq vec (vconcat vec (list val)))
 108            (error "Wrong %s: %s" (car (last vec)) val)))
 109         ;; Value is an email address.
 110         ((:owner :submitter)
 111          (if (string-match "\\`\\S-+\\'" val)
 112              (progn
 113                (when (string-equal "me" val)
 114                  (setq val user-mail-address))
 115                (when (string-match "<\\(.+\\)>" val)
 116                  (setq val (match-string 1 val)))
 117                (setq vec (vconcat vec (list val))))
 118            (error "Wrong %s: %s" (car (last vec)) val)))
 119         (:archive
 120          ;; Value is `0' or `1' or `both'.
 121          (if (string-match "\\`\\(0\\|1\\|both\\)\\'" val)
 122              (setq vec (vconcat vec (list val)))
 123            (error "Wrong %s: %s" (car (last vec)) val)))
 124         (t (error "Unknown key: %s" (car (last vec))))))
 125
 126     (unless (null query)
 127       (error "Unknown key: %s" (car query)))
 128
 129     (sort (car (soap-invoke debbugs-wsdl debbugs-port "get_bugs" vec)) '<)))
 130
 131 (defun debbugs-newest-bugs (amount)
 132   "Return the list of bug numbers, according to AMOUNT (a number) latest bugs."
 133   (sort (car (soap-invoke debbugs-wsdl debbugs-port "newest_bugs" amount)) '<))
 134
 135 (defun debbugs-get-status (&rest bug-numbers)
 136   "Return a list of status entries for the bugs identified by BUG-NUMBERS.
 137
 138 Every returned entry is an association list with the following attributes:
 139
 140   `bug_num': The bug number.
 141
 142   `package': A list of package names the bug belongs to.
 143
 144   `severity': The severity of the bug report. This can be
 145   \"important\", \"grave\", \"normal\", \"minor\" or \"wishlist\".
 146
 147   `tags': The status of the bug report, a list of strings.  This
 148   can be \"fixed\", \"notabug\", \"wontfix\", \"unreproducible\",
 149   \"moreinfo\" or \"patch\".
 150
 151   `pending': The string \"pending\", \"forwarded\" or \"done\".
 152
 153   `subject': Subject/Title of the bugreport.
 154
 155   `originator': Submitter of the bugreport.
 156
 157   `mergedwith': A list of bug numbers this bug was merged with.
 158
 159   `source': Source package name of the bug report.
 160
 161   `date': Date of bug creation.
 162
 163   `log_modified', `last_modified': Date of last update.
 164
 165   `found_date', `fixed_date': Date of bug report / bug fix
 166   \(empty for now).
 167
 168   `done': The email address of the worker who has closed the bug (if done).
 169
 170   `archived': `t' if the bug is archived, `nil' otherwise.
 171
 172   `unarchived': The date the bug has been unarchived, if ever.
 173
 174   `found_versions', `fixed_versions': List of version strings.
 175
 176   `forwarded': A URL or an email address.
 177
 178   `blocks': A list of bug numbers this bug blocks.
 179
 180   `blockedby': A list of bug numbers this bug is blocked by.
 181
 182   `msgid': The message id of the initial bug report.
 183
 184   `owner': Who is responsible for fixing.
 185
 186   `location': Always the string \"db-h\" or \"archive\".
 187
 188   `affects': A list of package names.
 189
 190   `summary': Arbitrary text.
 191
 192 Example:
 193
 194   \(debbugs-get-status 10)
 195
 196   => ;; Attributes with empty values are not show
 197      \(\(\(bug_num . 10)
 198        \(source . \"unknown\")
 199        \(date . 1203606305.0)
 200        \(msgid . \"<87zltuz7eh.fsf@freemail.hu>\")
 201        \(severity . \"wishlist\")
 202        \(owner . \"Magnus Henoch <mange@freemail.hu>\")
 203        \(log_modified . 1261079402.0)
 204        \(location . \"db-h\")
 205        \(subject . \"url-gw should support HTTP CONNECT proxies\")
 206        \(originator . \"Magnus Henoch <mange@freemail.hu>\")
 207        \(last_modified . 1271200046.0)
 208        \(pending . \"pending\")
 209        \(package \"emacs\")))"
 210   (let ((object
 211          (car
 212           (soap-invoke
 213            debbugs-wsdl debbugs-port "get_status"
 214            (apply 'vector bug-numbers)))))
 215     (mapcar
 216      (lambda (x)
 217        (let (y)
 218          ;; "archived" is the number 1 or 0.
 219          (setq y (assoc 'archived (cdr (assoc 'value x))))
 220          (setcdr y (= (cdr y) 1))
 221          ;; "found_versions" and "fixed_versions" are lists,
 222          ;; containing strings or numbers.
 223          (dolist (attribute '(found_versions fixed_versions))
 224            (setq y (assoc attribute (cdr (assoc 'value x))))
 225            (setcdr y (mapcar
 226                       (lambda (z) (if (numberp z) (number-to-string z) z))
 227                       (cdr y))))
 228          ;; "mergedwith" is a string, containing blank separated bug numbers.
 229          (setq y (assoc 'mergedwith (cdr (assoc 'value x))))
 230          (when (stringp (cdr y))
 231            (setcdr y (mapcar 'string-to-number (split-string (cdr y) " " t))))
 232          ;; "package" is a string, containing comma separated package names.
 233          ;; "keywords" and "tags" are strings, containing blank
 234          ;; separated package names.
 235          (dolist (attribute '(package keywords tags))
 236            (setq y (assoc attribute (cdr (assoc 'value x))))
 237            (when (stringp (cdr y))
 238              (setcdr y (split-string (cdr y) ",\\| " t))))
 239          (cdr (assoc 'value x))))
 240      object)))
 241
 242 (defun debbugs-get-bug-log (bug-number)
 243   "Return a list of messages related to BUG-NUMBER.
 244
 245 Every message is an association list with the following attributes:
 246
 247   `msg_num': The number of the message inside the bug log.  The
 248   numbers are ascending, newer messages have a higher number.
 249
 250   `header': The message header lines, as arrived at the bug tracker.
 251
 252   `body': The message body.
 253
 254   `attachments' A list of possible attachments, or `nil'.  Not
 255   implemented yet server side."
 256   (car (soap-invoke debbugs-wsdl debbugs-port "get_bug_log" bug-number)))
 257
 258 (defun debbugs-get-attribute (bug-or-message attribute)
 259   "Return the value of key ATTRIBUTE.
 260
 261 BUG-OR-MESSAGE must be list element returned by either
 262 `debbugs-get-status' or `debbugs-get-bug-log'.
 263
 264 Example: Return the originator of last submitted bug.
 265
 266 \(debbugs-get-attribute
 267   \(car \(apply 'debbugs-get-status \(debbugs-newest-bugs 1))) 'originator)"
 268   (cdr (assoc attribute bug-or-message)))
 269
 270 (defun debbugs-get-message-numbers (messages)
 271   "Return the message numbers of MESSAGES.
 272 MESSAGES must be the result of a `debbugs-get-bug-log' call."
 273   (mapcar (lambda (x) (debbugs-get-attribute x 'msg_num)) messages))
 274
 275 (defun debbugs-get-message (messages message-number)
 276   "Return the message MESSAGE-NUMBER of MESSAGES.
 277 MESSAGES must be the result of a `debbugs-get-bug-log' call.
 278
 279 The returned message is a list of strings.  The first element are
 280 the header lines of the message, the second element is the body
 281 of the message.  Further elements of the list, if any, are
 282 attachments of the message.
 283
 284 If there is no message with MESSAGE-NUMBER, the function returns `nil'.
 285
 286 Example: Return the first message of last submitted bug.
 287
 288 \(let \(\(messages \(apply 'debbugs-get-bug-log \(debbugs-newest-bugs 1))))
 289   \(debbugs-get-message messages
 290                        \(car \(debbugs-get-message-numbers messages))))"
 291   (while (and messages
 292               (/= (debbugs-get-attribute (car messages) 'msg_num)
 293                   message-number))
 294     (setq messages (cdr messages)))
 295   (when messages
 296     (append (list (debbugs-get-attribute (car messages) 'header)
 297                   (debbugs-get-attribute (car messages) 'body))
 298             (debbugs-get-attribute (car messages) 'attachments))))
 299
 300
 301 (provide 'debbugs)
 302
 303 ;;; TODO:
 304
 305 ;; * SOAP interface extensions (wishlist).
 306 ;;   - Server-side sorting.
 307 ;;   - Regexp and/or wildcards search.
 308 ;;   - Fulltext search.
 309 ;;   - Returning message attachments.
 310 ;; * Widget-oriented bug overview like webDDTs.
 311 ;; * Actions on bugs.
 312 ;; * Integration into gnus (nnir).
 313
 314 ;;; debbugs.el ends here