code.delx.au - gnu-emacs-elpa/blob - packages/debbugs/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.2
   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 (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
 240   `source': Source package name of the bug report.
 241
 242   `date': Date of bug creation.
 243
 244   `log_modified', `last_modified': Date of last update.
 245
 246   `found_date', `fixed_date': Date of bug report / bug fix
 247   \(empty for now).
 248
 249   `done': The email address of the worker who has closed the bug (if done).
 250
 251   `archived': `t' if the bug is archived, `nil' otherwise.
 252
 253   `unarchived': The date the bug has been unarchived, if ever.
 254
 255   `found_versions', `fixed_versions': List of version strings.
 256
 257   `forwarded': A URL or an email address.
 258
 259   `blocks': A list of bug numbers this bug blocks.
 260
 261   `blockedby': A list of bug numbers this bug is blocked by.
 262
 263   `msgid': The message id of the initial bug report.
 264
 265   `owner': Who is responsible for fixing.
 266
 267   `location': Always the string \"db-h\" or \"archive\".
 268
 269   `affects': A list of package names.
 270
 271   `summary': Arbitrary text.
 272
 273 Example:
 274
 275   \(debbugs-get-status 10)
 276
 277   => ;; Attributes with empty values are not show
 278      \(\(\(bug_num . 10)
 279        \(source . \"unknown\")
 280        \(date . 1203606305.0)
 281        \(msgid . \"<87zltuz7eh.fsf@freemail.hu>\")
 282        \(severity . \"wishlist\")
 283        \(owner . \"Magnus Henoch <mange@freemail.hu>\")
 284        \(log_modified . 1261079402.0)
 285        \(location . \"db-h\")
 286        \(subject . \"url-gw should support HTTP CONNECT proxies\")
 287        \(originator . \"Magnus Henoch <mange@freemail.hu>\")
 288        \(last_modified . 1271200046.0)
 289        \(pending . \"pending\")
 290        \(package \"emacs\")))"
 291   (when bug-numbers
 292     (let ((object
 293            (car
 294             (soap-invoke
 295              debbugs-wsdl debbugs-port "get_status"
 296              (apply 'vector bug-numbers)))))
 297       (mapcar
 298        (lambda (x)
 299          (let (y)
 300            ;; "archived" is the number 1 or 0.
 301            (setq y (assoc 'archived (cdr (assoc 'value x))))
 302            (setcdr y (= (cdr y) 1))
 303            ;; "found_versions" and "fixed_versions" are lists,
 304            ;; containing strings or numbers.
 305            (dolist (attribute '(found_versions fixed_versions))
 306              (setq y (assoc attribute (cdr (assoc 'value x))))
 307              (setcdr y (mapcar
 308                         (lambda (z) (if (numberp z) (number-to-string z) z))
 309                         (cdr y))))
 310            ;; "mergedwith" is a string, containing blank separated bug numbers.
 311            (setq y (assoc 'mergedwith (cdr (assoc 'value x))))
 312            (when (stringp (cdr y))
 313              (setcdr y (mapcar 'string-to-number (split-string (cdr y) " " t))))
 314            ;; "package" is a string, containing comma separated
 315            ;; package names.  "keywords" and "tags" are strings,
 316            ;; containing blank separated package names.
 317            (dolist (attribute '(package keywords tags))
 318              (setq y (assoc attribute (cdr (assoc 'value x))))
 319              (when (stringp (cdr y))
 320                (setcdr y (split-string (cdr y) ",\\| " t))))
 321            (cdr (assoc 'value x))))
 322        object))))
 323
 324 (defun debbugs-get-bug-log (bug-number)
 325   "Return a list of messages related to BUG-NUMBER.
 326
 327 Every message is an association list with the following attributes:
 328
 329   `msg_num': The number of the message inside the bug log.  The
 330   numbers are ascending, newer messages have a higher number.
 331
 332   `header': The message header lines, as arrived at the bug tracker.
 333
 334   `body': The message body.
 335
 336   `attachments' A list of possible attachments, or `nil'.  Not
 337   implemented yet server side."
 338   (car (soap-invoke debbugs-wsdl debbugs-port "get_bug_log" bug-number)))
 339
 340 (defun debbugs-search-est (&rest query)
 341   "Return the result of a full text search according to QUERY.
 342
 343 QUERY is a sequence of lists of keyword-value pairs where the
 344 values are strings or numbers, i.e. :KEYWORD \"VALUE\" [:KEYWORD
 345 VALUE]*
 346
 347 Every sublist of the QUERY forms a hyperestraier condition.  A
 348 detailed description of hyperestraier conditions can be found at
 349 URL `http://fallabs.com/hyperestraier/uguide-en.html#searchcond'.
 350
 351 The following conditions are possible:
 352
 353 \[:phrase SEARCH-PHRASE :skip NUMBER :max NUMBER\]
 354
 355   The string SEARCH-PHRASE forms the search on the database.  It
 356   contains words to be searched for, combined by operators like
 357   AND, ANDNOT and OR.  If there is no operator between the words,
 358   AND is used by default.  The phrase keyword and value can also
 359   be omitted, this is useful in combination with other conditions.
 360
 361   :skip and :max are optional.  They specify, how many hits are
 362   skipped, and how many maximal hits are returned.  This can be
 363   used for paged results.  Per default, :skip is 0 and :max is 10.
 364
 365   There must be exactly one such condition.
 366
 367 \[ATTRIBUTE VALUE+ :operation OPERATION :order ORDER\]
 368
 369   ATTRIBUTE is one of the following keywords:
 370
 371   :status --  Status of bug.  Valid values are \"done\",
 372   \"forwarded\" and \"open\".
 373
 374   :subject, :@title -- The subject of a message or the title of
 375   the bug, a string.
 376
 377   :date, :@cdate -- The submission or modification dates of a
 378   message, a number.
 379
 380   :submitter, :@author -- The email address of the submitter of a
 381   bug or the author of a message belonging to this bug, a string.
 382   The special email address \"me\" is used as pattern, replaced
 383   with `user-mail-address'.
 384
 385   :package -- The value is the name of the package a bug belongs
 386   to, like \"emacs\", \"coreutils\", \"gnus\", or \"tramp\".
 387
 388   :tags -- An arbitrary string the bug is annotated with.
 389
 390   :severity -- This is the severity of the bug.  The exact set of
 391   allowed values depends on the Debbugs port.  Examples are
 392   \"normal\", \"minor\", \"wishlist\" etc.
 393
 394   :operator defines the comparison operator to be applied to
 395   ATTRIBUTE.  For string attributes this could be \"STREQ\" \(is
 396   equal to the string), \"STRNE\" \(is not equal to the string),
 397   \"STRINC\" \(includes the string), \"STRBW\" \(begins with the
 398   string), \"STREW\" \(ends with the string), \"STRAND\"
 399   \(includes all tokens in the string), \"STROR\" \(includes at
 400   least one token in the string), \"STROREQ\" \(is equal to at
 401   least one token in the string) or \"STRRX\" \(matches regular
 402   expressions of the string).  For operators with tokens, several
 403   values for ATTRIBUTE shall be used.
 404
 405   Numbers can be compared by the operators \"NUMEQ\" \(is equal
 406   to the number), \"NUMNE\" \(is not equal to the number),
 407   \"NUMGT\" \(is greater than the number), \"NUMGE\" \(is greater
 408   than or equal to the number), \"NUMLT\" \(is less than the
 409   number), \"NUMLE\" \(is less than or equal to the number) or
 410   \"NUMBT\" \(is between the two numbers).  In the last case,
 411   there must be two values for ATTRIBUTE.
 412
 413   If an operator is leaded by \"!\", the meaning is inverted.  If
 414   a string operator is leaded by \"I\", the case of the value is
 415   ignored.
 416
 417   The optional :order can be specified only in one condition.  It
 418   means, that ATTRIBUTE is used for sorting the results.  The
 419   following order operators exist: \"STRA\" \(ascending by
 420   string), \"STRD\" \(descending by string), \"NUMA\" \(ascending
 421   by number) or \"NUMD\" \(descending by number).
 422
 423   A special case is an :order, where there is no corresponding
 424   attribute value and no operator.  In this case, ATTRIBUTE is
 425   not used for the search.
 426
 427 The result of the QUERY is a list of association lists with the
 428 same attributes as in the conditions.  Additional attributes are
 429
 430   `id': The bug number.
 431
 432   `msg_num': The number of the message inside the bug log.
 433
 434   `snippet': The surrounding text found by the search.  For the
 435   syntax of the snippet, consult the hyperestraier user guide.
 436
 437 Examples:
 438
 439   \(debbugs-search-est
 440     '\(:phrase \"armstrong AND debbugs\" :skip 10 :max 2)
 441     '\(:severity \"normal\" :operator \"STRINC\")
 442     '\(:date :order \"NUMA\"))
 443
 444   => \(\(\(msg_num . 21)
 445        \(date . 1229208302)
 446        \(@author . \"Glenn Morris <rgm@gnu.org>\")
 447        \(@title . \"Re: bug#1567: Mailing an archived bug\")
 448        \(id . 1567)
 449        \(severity . \"normal\")
 450        \(@cdate . \"Wed, 17 Dec 2008 14:34:50 -0500\")
 451        \(snippet . \"...\")
 452        \(subject . \"Mailing an archived bug\")
 453        \(package . \"debbugs.gnu.org\"))
 454       ...)
 455
 456   ;; Show all messages from me between 2011-08-01 and 2011-08-31.
 457   \(debbugs-search-est
 458     '\(:max 20)
 459     '\(:@author \"me\" :operator \"ISTRINC\")
 460     `\(:date
 461       ,\(floor \(float-time \(encode-time 0 0 0  1 8 2011)))
 462       ,\(floor \(float-time \(encode-time 0 0 0 31 8 2011)))
 463       :operator \"NUMBT\"))"
 464
 465   (let (args result)
 466     ;; Compile search arguments.
 467     (dolist (elt query)
 468       (let (vec kw key val
 469             phrase-cond attr-cond)
 470
 471         ;; Phrase is mandatory, even if empty.
 472         (when (and (or  (member :skip elt) (member :max elt))
 473                    (not (member :phrase elt)))
 474           (setq vec (vector "phrase" "")))
 475
 476         ;; Parse condition.
 477         (while (consp elt)
 478           (setq kw (pop elt))
 479           (unless (keywordp kw)
 480             (error "Wrong keyword: %s" kw))
 481           (setq key (substring (symbol-name kw) 1))
 482           (case kw
 483             ;; Phrase condition.
 484             (:phrase
 485              ;; It shouldn't happen in an attribute condition.
 486              (if attr-cond
 487                  (error "Wrong keyword: %s" kw))
 488              (setq phrase-cond t val (pop elt))
 489              ;; Value is a string.
 490              (if (stringp val)
 491                  (setq vec (vconcat vec (list key val)))
 492                (error "Wrong %s: %s" key val)))
 493
 494             ((:skip :max)
 495              ;; It shouldn't happen in an attribute condition.
 496              (if attr-cond
 497                  (error "Wrong keyword: %s" kw))
 498              (setq phrase-cond t val (pop elt))
 499              ;; Value is a number.
 500              (if (numberp val)
 501                  (setq vec (vconcat vec (list key (number-to-string val))))
 502                (error "Wrong %s: %s" key val)))
 503
 504             ;; Attribute condition.
 505             ((:submitter :@author)
 506              ;; It shouldn't happen in a phrase condition.
 507              (if phrase-cond
 508                  (error "Wrong keyword: %s" kw))
 509              (if (not (stringp (car elt)))
 510                  (setq vec (vconcat vec (list key "")))
 511                ;; Value is an email address.
 512                (while (and (stringp (car elt))
 513                            (string-match "\\`\\S-+\\'" (car elt)))
 514                  (when (string-equal "me" (car elt))
 515                    (setcar elt user-mail-address))
 516                  (when (string-match "<\\(.+\\)>" (car elt))
 517                    (setcar elt (match-string 1 (car elt))))
 518                  (add-to-list 'val (pop elt) 'append))
 519                (setq vec
 520                      (vconcat vec (list key (mapconcat 'identity val " "))))))
 521
 522             (:status
 523              ;; It shouldn't happen in a phrase condition.
 524              (if phrase-cond
 525                  (error "Wrong keyword: %s" kw))
 526              (setq attr-cond t)
 527              (if (not (stringp (car elt)))
 528                  (setq vec (vconcat vec (list key "")))
 529                ;; Possible values: "done", "forwarded" and "open"
 530                (while  (and (stringp (car elt))
 531                             (string-match
 532                              "\\`\\(done\\|forwarded\\|open\\)\\'" (car elt)))
 533                  (add-to-list 'val (pop elt) 'append))
 534                (setq vec
 535                      (vconcat vec (list key (mapconcat 'identity val " "))))))
 536
 537             ((:subject :package :tags :severity :@title)
 538              ;; It shouldn't happen in a phrase condition.
 539              (if phrase-cond
 540                  (error "Wrong keyword: %s" kw))
 541              (setq attr-cond t)
 542              (if (not (stringp (car elt)))
 543                  (setq vec (vconcat vec (list key "")))
 544                ;; Just a string.
 545                (while (stringp (car elt))
 546                  (add-to-list 'val (pop elt) 'append))
 547                (setq vec
 548                      (vconcat vec (list key (mapconcat 'identity val " "))))))
 549
 550             ((:date :@cdate)
 551              ;; It shouldn't happen in a phrase condition.
 552              (if phrase-cond
 553                  (error "Wrong keyword: %s" kw))
 554              (setq attr-cond t)
 555              (if (not (numberp (car elt)))
 556                  (setq vec (vconcat vec (list key "")))
 557                ;; Just a number.
 558                (while (numberp (car elt))
 559                  (add-to-list 'val (pop elt) 'append))
 560                (setq vec
 561                      (vconcat
 562                       vec (list key (mapconcat 'number-to-string val " "))))))
 563
 564             ((:operator :order)
 565              ;; It shouldn't happen in a phrase condition.
 566              (if phrase-cond
 567                  (error "Wrong keyword: %s" kw))
 568              (setq attr-cond t val (pop elt))
 569              ;; Value is a number.
 570              (if (stringp val)
 571                  (setq vec (vconcat vec (list key val)))
 572                (error "Wrong %s: %s" key val)))
 573
 574             (t (error "Unknown key: %s" kw))))
 575
 576         (setq args (vconcat args (list vec)))))
 577
 578     (setq result
 579           (car (soap-invoke debbugs-wsdl debbugs-port "search_est" args)))
 580     ;; The result contains lists (key value).  We transform it into
 581     ;; cons cells (key . value).
 582     (dolist (elt1 result result)
 583       (dolist (elt2 elt1)
 584         (setcdr elt2 (cadr elt2))))))
 585
 586 (defun debbugs-get-attribute (bug-or-message attribute)
 587   "Return the value of key ATTRIBUTE.
 588
 589 BUG-OR-MESSAGE must be list element returned by either
 590 `debbugs-get-status' or `debbugs-get-bug-log'.
 591
 592 Example: Return the originator of last submitted bug.
 593
 594 \(debbugs-get-attribute
 595   \(car \(apply 'debbugs-get-status \(debbugs-newest-bugs 1))) 'originator)"
 596   (cdr (assoc attribute bug-or-message)))
 597
 598 (defun debbugs-get-message-numbers (messages)
 599   "Return the message numbers of MESSAGES.
 600 MESSAGES must be the result of a `debbugs-get-bug-log' call."
 601   (mapcar (lambda (x) (debbugs-get-attribute x 'msg_num)) messages))
 602
 603 (defun debbugs-get-message (messages message-number)
 604   "Return the message MESSAGE-NUMBER of MESSAGES.
 605 MESSAGES must be the result of a `debbugs-get-bug-log' call.
 606
 607 The returned message is a list of strings.  The first element are
 608 the header lines of the message, the second element is the body
 609 of the message.  Further elements of the list, if any, are
 610 attachments of the message.
 611
 612 If there is no message with MESSAGE-NUMBER, the function returns `nil'.
 613
 614 Example: Return the first message of last submitted bug.
 615
 616 \(let \(\(messages \(apply 'debbugs-get-bug-log \(debbugs-newest-bugs 1))))
 617   \(debbugs-get-message messages
 618                        \(car \(debbugs-get-message-numbers messages))))"
 619   (while (and messages
 620               (/= (debbugs-get-attribute (car messages) 'msg_num)
 621                   message-number))
 622     (setq messages (cdr messages)))
 623   (when messages
 624     (append (list (debbugs-get-attribute (car messages) 'header)
 625                   (debbugs-get-attribute (car messages) 'body))
 626             (debbugs-get-attribute (car messages) 'attachments))))
 627
 628 (defun debbugs-get-mbox (bug-number mbox-type &optional filename)
 629   "Download mbox with messages of bug BUG-NUMBER from Debbugs server.
 630 BUG-NUMBER is a number of bug. It must be of integer type.
 631
 632 MBOX-TYPE specifies a type of mbox and can be one of the
 633 following symbols:
 634
 635    `mboxfolder': Download mbox folder.
 636
 637    `mboxmaint': Download maintainer's mbox.
 638
 639    `mboxstat', `mboxstatus': Download status mbox. The use of
 640    either symbol depends on actual Debbugs server
 641    configuration. For gnu.org, use the former; for debian.org -
 642    the latter.
 643
 644 FILENAME, if non-nil, is the name of file to store mbox. If
 645 FILENAME is nil, the downloaded mbox is inserted into the current
 646 buffer."
 647   (let (url (mt "") bn)
 648     (unless (setq url (plist-get
 649                        (cdr (assoc debbugs-port debbugs-servers))
 650                        :bugreport-url))
 651       (error "URL of bugreport script for port %s is not specified"
 652              debbugs-port))
 653     (setq bn (format "bug=%s;" (number-to-string bug-number)))
 654     (unless (eq mbox-type 'mboxfolder)
 655       (if (memq mbox-type '(mboxmaint mboxstat mboxstatus))
 656           (setq mt (concat (symbol-name mbox-type) "=yes;"))
 657         (error "Unknown mbox type: %s" mbox-type)))
 658     (setq url (concat url (format "?%s%smbox=yes" bn mt)))
 659     (if filename
 660         (url-copy-file url filename t)
 661       (url-insert-file-contents url))))
 662
 663 (provide 'debbugs)
 664
 665 ;;; TODO:
 666
 667 ;; * SOAP interface extensions (wishlist).
 668 ;;   - Server-side sorting.
 669 ;;   - Regexp and/or wildcards search.
 670 ;;   - Fulltext search.
 671 ;;   - Returning message attachments.
 672
 673 ;;; debbugs.el ends here