Skip to content
Browse files

Add trace-xml-response and encoded-request

Both behave similarly to CALL and ENCODER, but print or return the relevant
info instead of decoding it.

Original idea and patch by Cyrus Harmon.
  • Loading branch information...
1 parent 85bb304 commit 3a7261dd79b205e7d7264cf6392692373ec074ab Andreas Fuchs committed Dec 4, 2007
Showing with 17 additions and 4 deletions.
  1. +16 −4 client.lisp
  2. +1 −0 package.lisp
View
20 client.lisp
@@ -4,19 +4,31 @@
(subtypep (stream-element-type stream) 'character))
(defun call (uri function parameters &rest drakma-args)
+ (apply #'call-with-encoder uri (apply 'encoder function parameters)
+ #'decode-response
+ drakma-args))
+
+(defun trace-xml-response (output-stream uri function parameters
+ &rest drakma-args)
(apply #'call-with-encoder uri (apply 'encoder function parameters)
+ (lambda (stream)
+ (let ((buffer
+ (make-array 1024 :element-type (stream-element-type stream))))
+ (loop for nchars = (read-sequence buffer stream)
+ do (write-sequence buffer output-stream :end nchars)
+ while (= nchars (length buffer)))))
drakma-args))
-(defun call-with-encoder (uri encoder &rest drakma-args
+(defun call-with-encoder (uri encoder decoder &rest drakma-args
&key protocol cookie-jar basic-authorization
user-agent proxy proxy-basic-authentication
additional-headers redirect read-timeout
- write-timeout)
+ write-timeout connect-timeout)
;; need the keyword args for the invocation protocol only, so...
(declare (ignore protocol cookie-jar basic-authorization
user-agent proxy proxy-basic-authentication
additional-headers redirect read-timeout
- write-timeout))
+ write-timeout connect-timeout))
(multiple-value-bind (body-or-stream status-code headers uri stream must-close
reason-phrase)
(apply #'drakma:http-request uri
@@ -30,7 +42,7 @@
(unwind-protect
(case status-code
(200
- (decode-response stream))
+ (funcall decoder stream))
(t
(error 'http-error :status-code status-code :reason reason-phrase
:headers headers)))
View
1 package.lisp
@@ -3,6 +3,7 @@
(:nicknames #:xml-rpc #:xrpc)
(:export #:encoder #:call #:call-with-encoder
#:encode-time #:decode-time
+ #:trace-xml-response #:encoded-request
;; server:
#:cxml-rpc-method-handler #:define-xrpc-method
#:invoke-method #:lookup-method #:lookup-method-signature

0 comments on commit 3a7261d

Please sign in to comment.
Something went wrong with that request. Please try again.