diff options
| author | Ricardo Wurmus <rekado@elephly.net> | 2017-11-14 13:14:35 +0100 |
|---|---|---|
| committer | Ricardo Wurmus <rekado@elephly.net> | 2017-11-14 13:14:35 +0100 |
| commit | 386d8cc0a2c7c97e2c92b0becd59108ef7f5272c (patch) | |
| tree | bd6dae13896ce7d4f22f683de9008eaad792bda0 | |
| parent | 22f7fa4d893e9e32bd0196ae0a9616f16a7768d9 (diff) | |
debbugs: Add get-usertag operation.
* debbugs/operations.scm (get-usertag): New procedure.
* README.org: Don't promise to implement more RPCs.
| -rw-r--r-- | README.org | 1 | ||||
| -rw-r--r-- | debbugs/operations.scm | 30 |
2 files changed, 30 insertions, 1 deletions
@@ -15,7 +15,6 @@ tracker. * Missing features + TLS support (required for GNU debbugs instance) -+ more RPCs + convenience procedures for =<bug>= records (e.g. =bug-done?=) + parsing of raw values (e.g. timestamps) + monadic interface diff --git a/debbugs/operations.scm b/debbugs/operations.scm index 4bef624..a97fca0 100644 --- a/debbugs/operations.scm +++ b/debbugs/operations.scm @@ -20,6 +20,7 @@ #:use-module (debbugs soap) #:use-module (debbugs bug) #:use-module (sxml xpath) + #:use-module (sxml match) #:use-module (srfi srfi-1) #:use-module (ice-9 match)) @@ -88,3 +89,32 @@ Boolean value)." urn:Debbugs/SOAP:item)) response-body))) ;; TODO: parse into record emails)))) + +(define-public (get-usertag email) + "Return an association list of tag names to lists of bug numbers for +all bugs that have been tagged by EMAIL." + (soap-request + `(ns1:get_usertag + (@ (xmlns:ns1 . "urn:Debbugs/SOAP") + (soapenc:encodingStyle . "http://schemas.xmlsoap.org/soap/encoding/")) + (ns1:user + (@ (xsi:type "xsd:string")) ,email)) + (lambda (response-body) + (let ((response ((sxpath '(// urn:Debbugs/SOAP:get_usertagResponse *)) response-body))) + ;; The problem here is that for some usertags (e.g. usertags + ;; for "hertzog@debian.org") a map is returned (so I could use + ;; soap->scheme), but in other cases (e.g. usertags for + ;; "aj@azure.humbug.org.au") each tag is an array with bug-num + ;; items. + (sxml-match (car response) + ((urn:Debbugs/SOAP:s-gensym3 (@ (http://www.w3.org/1999/XMLSchema-instance:type "apachens:Map")) ,items ...) + (map car (soap->scheme (car response) #t))) + ((urn:Debbugs/SOAP:s-gensym3 ,tags ...) + (map (lambda (tag) + ;; For consistency make sure that the keys are strings. + (let ((pair (soap->scheme tag))) + (if (symbol? (car pair)) + (cons (symbol->string (car pair)) + (cdr pair)) + pair))) + tags))))))) |