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