- cl-soap-cvs@common-lisp.net - mailman3.common-lisp.net

[cl-soap-cvs] CVS cl-soap/src
by scaekenberghe 14 Apr '08

14 Apr '08

Update of /project/cl-soap/cvsroot/cl-soap/src In directory clnet:/tmp/cvs-serv28246/src Modified Files: wsdl.lisp Log Message: Added option to override endpoint in wsdl-soap-call (contributed by Daniel Janus) --- /project/cl-soap/cvsroot/cl-soap/src/wsdl.lisp 2005/10/05 13:24:38 1.22 +++ /project/cl-soap/cvsroot/cl-soap/src/wsdl.lisp 2008/04/14 13:41:47 1.23 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: wsdl.lisp,v 1.22 2005/10/05 13:24:38 scaekenberghe Exp $ +;;;; $Id: wsdl.lisp,v 1.23 2008/04/14 13:41:47 scaekenberghe Exp $ ;;;; ;;;; The basic WSDL protocol: we parse the generic and soap specific parts ;;;; @@ -576,8 +576,9 @@ operation-name input output - headers) - (let* ((address-location-url (get-location (get-extension port))) + headers + &optional endpoint-address) + (let* ((address-location-url (or endpoint-address (get-location (get-extension port)))) (soap-end-point (make-soap-end-point address-location-url)) (binding (get-binding-named wsdl-document-definitions (get-binding port))) (soap-binding (get-extension-of-class binding 'wsdl-soap-binding)) @@ -645,7 +646,8 @@ port-name input output - headers) + headers + endpoint) "Use WSDL to make a SOAP call of operation/port/service using input/output/headers" (let* ((wsdl-document-definitions (etypecase wsdl (wsdl-document-definitions wsdl) @@ -662,6 +664,7 @@ operation-name input output - headers))) + headers + endpoint))) ;;;; eof

1 0

[cl-soap-cvs] CVS update: cl-soap/test/all-tests.lisp
by scaekenberghe＠common-lisp.net 05 Jan '06

05 Jan '06

Update of /project/cl-soap/cvsroot/cl-soap/test In directory common-lisp.net:/tmp/cvs-serv6744/test Added Files: all-tests.lisp Log Message: some support for releases (incl asdf-install) Date: Thu Jan 5 17:24:39 2006 Author: scaekenberghe

1 0

[cl-soap-cvs] CVS update: cl-soap/Makefile
by scaekenberghe＠common-lisp.net 05 Jan '06

05 Jan '06

Update of /project/cl-soap/cvsroot/cl-soap In directory common-lisp.net:/tmp/cvs-serv6744 Added Files: Makefile Log Message: some support for releases (incl asdf-install) Date: Thu Jan 5 17:24:39 2006 Author: scaekenberghe

1 0

[cl-soap-cvs] CVS update: public_html/index.html
by scaekenberghe＠common-lisp.net 09 Oct '05

09 Oct '05

Update of /project/cl-soap/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv25150 Modified Files: index.html Log Message: added a section on debugging and reporting errors Date: Sun Oct 9 10:34:44 2005 Author: scaekenberghe Index: public_html/index.html diff -u public_html/index.html:1.10 public_html/index.html:1.11 --- public_html/index.html:1.10 Wed Oct 5 15:24:08 2005 +++ public_html/index.html Sun Oct 9 10:34:43 2005 @@ -132,6 +132,32 @@ <li>Lot's of work remains to be done! All help is welcome.</li> </ul> </p> +<h3>Debugging and Reporting Errors</h3> +<p> + Common Lisp is a way better environment to develop and experiment with something like SOAP + than more mainstream languages like C, C++, Java or C#. + The listener, debugger and inspector are your friends! + To help in debugging, the following features were added to CL-SOAP. + The global variable <tt>cl-soap:*debug-stream*</tt> is the main toggle to enable debugging. + When NIL, debugging is disabled. + Otherwise, set it to some stream where you want debugging output to be written to. + For example, in a listener, do <tt>(setf *debug-stream* *standard-output*)</tt>. + This will result in the outgoing and incoming literal XML being written to that stream. + Furthermore, on each call, two more globals will be assigned: + <tt>cl-soap:*last-soap-call-xml*</tt> and <tt>cl-soap:*last-soap-result-xml*</tt> + will contain the LXML DOM representation of the XML of the outgoing SOAP call envelope + and of the incoming SOAP result envelope respectively. Since this is a DOM representation, + it is actually equal to what CL-SOAP produced before handing it off to S-XML to be rendered + and to what the S-XML parser produced (so it is already an interpretation) respectively. + A little convenience function called <tt>(cl-soap:report-soap-call)</tt> will pretty print + these last two variables. +</p> +<p> + When reporting problems with CL-SOAP, please include a listener transcript produced with + debugging enabled, with a full backtrace (in LispWorks issue a :bb for example) and a call to (report-soap-call). + Also, if you want the CL-SOAP team or community to be able to help you, it will help + enormeously if the service that you are calling is available on the internet. +</p> <h3>Next Phase(s) (Future)</h3> <p> <ul> @@ -170,6 +196,6 @@ Initial development was done by Sven Van Caekenberghe (Beta Nine) with testing by Alain Picard (Memetrics). <p> -<p>$Id: index.html,v 1.10 2005/10/05 13:24:08 scaekenberghe Exp $</p> +<p>$Id: index.html,v 1.11 2005/10/09 08:34:43 scaekenberghe Exp $</p> </body> </html>

1 0

[cl-soap-cvs] CVS update: cl-soap/test/test-google-adwords.lisp cl-soap/test/test-xsd.lisp
by scaekenberghe＠common-lisp.net 06 Oct '05

06 Oct '05

Update of /project/cl-soap/cvsroot/cl-soap/test In directory common-lisp.net:/tmp/cvs-serv27824/test Modified Files: test-google-adwords.lisp test-xsd.lisp Log Message: added a solution to the 'subtype' problem: using a special purpose member called xsi:|type| to indicate a concrete subtype for abstract types Date: Thu Oct 6 13:09:41 2005 Author: scaekenberghe Index: cl-soap/test/test-google-adwords.lisp diff -u cl-soap/test/test-google-adwords.lisp:1.13 cl-soap/test/test-google-adwords.lisp:1.14 --- cl-soap/test/test-google-adwords.lisp:1.13 Fri Sep 30 19:12:20 2005 +++ cl-soap/test/test-google-adwords.lisp Thu Oct 6 13:09:40 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: test-google-adwords.lisp,v 1.13 2005/09/30 17:12:20 scaekenberghe Exp $ +;;;; $Id: test-google-adwords.lisp,v 1.14 2005/10/06 11:09:40 scaekenberghe Exp $ ;;;; ;;;; Some tests on the Google AdWords API (not publically available) ;;;; @@ -77,6 +77,8 @@ :input `("getMethodCost" ("service" ,service "method" ,method "date" ,date)) :headers (make-google-headers))) +#+nil (get-method-cost "InfoService" "getMethodCost") + (defun get-unit-count (&optional (start-date (ut)) (end-date start-date)) (wsdl-soap-call (wsdl-cache-get "https://adwords.google.com:443/api/adwords/v2/InfoService?wsdl") "getUnitCount" @@ -102,6 +104,8 @@ keywords))) :headers (make-google-headers))) +#+nil (estimate-keyword-list '(("flowers" "Broad" 50000) ("trees" "Broad" 50000))) + (defun get-all-adgroups (campaign-id) (wsdl-soap-call (wsdl-cache-get "https://adwords.google.com:443/api/adwords/v2/AdGroupService?wsdl") "getAllAdGroups" Index: cl-soap/test/test-xsd.lisp diff -u cl-soap/test/test-xsd.lisp:1.3 cl-soap/test/test-xsd.lisp:1.4 --- cl-soap/test/test-xsd.lisp:1.3 Fri Sep 30 21:57:20 2005 +++ cl-soap/test/test-xsd.lisp Thu Oct 6 13:09:41 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: test-xsd.lisp,v 1.3 2005/09/30 19:57:20 scaekenberghe Exp $ +;;;; $Id: test-xsd.lisp,v 1.4 2005/10/06 11:09:41 scaekenberghe Exp $ ;;;; ;;;; Some (internal) test on the implementatin of the XML Schema Definition ;;;; @@ -139,6 +139,7 @@ '(("flowers" "Broad" 50000) ("tree" "Broad" 100000))))))) (bind-xsd-template template binding + schema *google-adwords-ns*))) (defun test-2 () @@ -160,5 +161,23 @@ (resolve-xsd-template template (list lxml) *google-adwords-ns*))) + +(defun test-3 () + (let* ((schema (get-xml-schema-definition + (wsdl-cache-get "https://adwords.google.com:443/api/adwords/v2/ReportService?wsdl"))) + (template (generate-xsd-template "scheduleReportJob" schema)) + (binding `("scheduleReportJob" + ("job" + (xsi:|type| "UrlReportJob" + "name" "test123" + "startDate" ,(ut) + "endDate" ,(ut) + "clientAccounts" (100 200) + "adWordsType" "SearchOnly" + "campaigns" (101 201)))))) + (bind-xsd-template template + binding + schema + *google-adwords-ns*))) ;;;; eof

1 0

[cl-soap-cvs] CVS update: cl-soap/src/xsd.lisp
by scaekenberghe＠common-lisp.net 06 Oct '05

06 Oct '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv27824/src Modified Files: xsd.lisp Log Message: added a solution to the 'subtype' problem: using a special purpose member called xsi:|type| to indicate a concrete subtype for abstract types Date: Thu Oct 6 13:09:39 2005 Author: scaekenberghe Index: cl-soap/src/xsd.lisp diff -u cl-soap/src/xsd.lisp:1.25 cl-soap/src/xsd.lisp:1.26 --- cl-soap/src/xsd.lisp:1.25 Wed Oct 5 15:24:38 2005 +++ cl-soap/src/xsd.lisp Thu Oct 6 13:09:39 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: xsd.lisp,v 1.25 2005/10/05 13:24:38 scaekenberghe Exp $ +;;;; $Id: xsd.lisp,v 1.26 2005/10/06 11:09:39 scaekenberghe Exp $ ;;;; ;;;; A partial implementation of the XML Schema Definition standard ;;;; @@ -237,7 +237,10 @@ ;; all element types are resolved into primitives or sequences of sub elements ;; elements without contents are also possible -(defun get-xsd-template-multiplicity (xml-schema-element) +(defmethod get-xsd-template-multiplicity ((xsd-type xsd-type)) + :xsd-type) + +(defmethod get-xsd-template-multiplicity ((xml-schema-element xml-schema-element)) (with-slots (min-occurs max-occurs) xml-schema-element (cond ((and (zerop min-occurs) (eql max-occurs 1)) '?) @@ -280,15 +283,26 @@ (let ((primitive-value (lisp->xsd-primitive value primitive-type))) `(,tag ,primitive-value))) -(defun bind-xsd-template-members (tag members bindings namespace) - (let ((bound-members '())) - (loop :for member :in members :do - (let ((member-binding (bind-xsd-template member bindings namespace))) - (when member-binding - (push member-binding bound-members)))) - `(,tag ,@(reduce #'append (nreverse bound-members))))) +(defun bind-xsd-template-members (tag members bindings schema namespace) + (let ((xsi-type (get-name-binding 'xsi::|type| bindings)) + (bound-members '())) + (cond (xsi-type + (let ((type-template (generate-xsd-template xsi-type schema))) + (if (eql (first type-template) :xsd-type) + (loop :for member :in (rest (rest type-template)) :do + (let ((member-binding (bind-xsd-template member bindings schema namespace))) + (when member-binding + (push member-binding bound-members)))) + (error "Could not resolve explicit (sub)type ~s" xsi-type)) + `((,tag xsi::|type| ,xsi-type) ,@(reduce #'append (nreverse bound-members))))) + (t + (loop :for member :in members :do + (let ((member-binding (bind-xsd-template member bindings schema namespace))) + (when member-binding + (push member-binding bound-members)))) + `(,tag ,@(reduce #'append (nreverse bound-members))))))) -(defun bind-xsd-template (template bindings namespace) +(defun bind-xsd-template (template bindings schema namespace) (destructuring-bind (multiplicity element-name &rest contents) template (let ((tag (intern element-name (s-xml:get-package namespace)))) @@ -310,18 +324,18 @@ (t (case multiplicity ((1 ?) (if boundp - `(,(bind-xsd-template-members tag contents value namespace)) + `(,(bind-xsd-template-members tag contents value schema namespace)) (when (eql multiplicity 1) (error "Required element ~s not bound" element-name)))) ((+ *) (if (and boundp value) (loop :for elt-value :in value - :collect (bind-xsd-template-members tag contents elt-value namespace)) + :collect (bind-xsd-template-members tag contents elt-value schema namespace)) (when (eql multiplicity +) (error "Required repeating element ~s not bound correctly" element-name))))))))))) (defun bind-element (element bindings xml-schema-definition namespace) (let ((template (generate-xsd-template element xml-schema-definition))) - (reduce #'append (bind-xsd-template template bindings namespace)))) + (reduce #'append (bind-xsd-template template bindings xml-schema-definition namespace)))) ;;; Resolving Templates (combining a template with an lxml list to generate an s-expr)

1 0

[cl-soap-cvs] CVS update: cl-soap/src/lxml.lisp
by scaekenberghe＠common-lisp.net 06 Oct '05

06 Oct '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv27797/src Modified Files: lxml.lisp Log Message: actual-name will leave symbols alone Date: Thu Oct 6 13:07:29 2005 Author: scaekenberghe Index: cl-soap/src/lxml.lisp diff -u cl-soap/src/lxml.lisp:1.9 cl-soap/src/lxml.lisp:1.10 --- cl-soap/src/lxml.lisp:1.9 Mon Oct 3 14:29:21 2005 +++ cl-soap/src/lxml.lisp Thu Oct 6 13:07:29 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: lxml.lisp,v 1.9 2005/10/03 12:29:21 scaekenberghe Exp $ +;;;; $Id: lxml.lisp,v 1.10 2005/10/06 11:07:29 scaekenberghe Exp $ ;;;; ;;;; Common utilities (mostly lxml) and some internal/experimental stuff ;;;; @@ -50,11 +50,13 @@ ;;; internal shared/common code (defun actual-name (qname) - "For now we ignore prefixes ;-)" - (multiple-value-bind (prefix identifier) - (s-xml:split-identifier qname) - (declare (ignore prefix)) - identifier)) + "For now we ignore prefixes ;-) - symbols are untouched" + (if (stringp qname) + (multiple-value-bind (prefix identifier) + (s-xml:split-identifier qname) + (declare (ignore prefix)) + identifier) + qname)) (defun find-item-named (item-name sequence) (find (actual-name item-name) sequence :test #'string-equal :key #'get-name))

1 0

[cl-soap-cvs] CVS update: cl-soap/src/namespaces.lisp
by scaekenberghe＠common-lisp.net 06 Oct '05

06 Oct '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv27780/src Modified Files: namespaces.lisp Log Message: exporting 'type' from :xsi Date: Thu Oct 6 13:06:57 2005 Author: scaekenberghe Index: cl-soap/src/namespaces.lisp diff -u cl-soap/src/namespaces.lisp:1.8 cl-soap/src/namespaces.lisp:1.9 --- cl-soap/src/namespaces.lisp:1.8 Tue Sep 27 18:25:17 2005 +++ cl-soap/src/namespaces.lisp Thu Oct 6 13:06:56 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: namespaces.lisp,v 1.8 2005/09/27 16:25:17 scaekenberghe Exp $ +;;;; $Id: namespaces.lisp,v 1.9 2005/10/06 11:06:56 scaekenberghe Exp $ ;;;; ;;;; Definition of some standard XML namespaces commonly needed for SOAP ;;;; @@ -48,7 +48,7 @@ (defpackage :xsi (:nicknames "xsi") - (:export "null") + (:export "null" "type") (:documentation "Package for symbols in the XML Schema Instance XML Namespace")) (defparameter *xsi-ns* (s-xml:register-namespace +xsi-ns-uri+ "xsi" :xsi))

1 0

[cl-soap-cvs] CVS update: cl-soap/src/soap.lisp
by scaekenberghe＠common-lisp.net 06 Oct '05

06 Oct '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv15005/src Modified Files: soap.lisp Log Message: OK, the last changed introduced some nasty bug - sorry Date: Thu Oct 6 10:07:59 2005 Author: scaekenberghe Index: cl-soap/src/soap.lisp diff -u cl-soap/src/soap.lisp:1.10 cl-soap/src/soap.lisp:1.11 --- cl-soap/src/soap.lisp:1.10 Wed Oct 5 15:24:38 2005 +++ cl-soap/src/soap.lisp Thu Oct 6 10:07:58 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: soap.lisp,v 1.10 2005/10/05 13:24:38 scaekenberghe Exp $ +;;;; $Id: soap.lisp,v 1.11 2005/10/06 08:07:58 scaekenberghe Exp $ ;;;; ;;;; The basic SOAP protocol ;;;; @@ -106,11 +106,11 @@ :header-attributes header-attributes :body-attributes body-attributes)) (call-xml (s-xml:print-xml-string call-soap-envelope :pretty t)) - result-xml result-soap-envelope) + result-soap-envelope) (when *debug-stream* (setf *last-soap-call-xml* call-soap-envelope) (format *debug-stream* ";; SOAP CALL sending: ~a~%" call-xml)) - (multiple-value-bind (result code) + (multiple-value-bind (result-xml code) (do-http-request (get-url server-end-point) :method :POST :headers `(("SOAPAction" . ,(or soap-action "")))

1 0

[cl-soap-cvs] CVS update: cl-soap/src/http-client.lisp cl-soap/src/soap.lisp cl-soap/src/wsdl.lisp cl-soap/src/xsd.lisp
by scaekenberghe＠common-lisp.net 05 Oct '05

05 Oct '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv1749/src Modified Files: http-client.lisp soap.lisp wsdl.lisp xsd.lisp Log Message: added some code to handle non 200 http responses Date: Wed Oct 5 15:24:38 2005 Author: scaekenberghe Index: cl-soap/src/http-client.lisp diff -u cl-soap/src/http-client.lisp:1.6 cl-soap/src/http-client.lisp:1.7 --- cl-soap/src/http-client.lisp:1.6 Mon Sep 26 13:08:42 2005 +++ cl-soap/src/http-client.lisp Wed Oct 5 15:24:38 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: http-client.lisp,v 1.6 2005/09/26 11:08:42 scaekenberghe Exp $ +;;;; $Id: http-client.lisp,v 1.7 2005/10/05 13:24:38 scaekenberghe Exp $ ;;;; ;;;; A basic HTTP client, somewhat API compatible with portableaserve's do-http-request ;;;; Copied from another project (basic authorization support removed) @@ -228,7 +228,7 @@ headers proxy state) - "Execute an HTTP request" + "Execute an HTTP request, returns (values body code headers uri kept-alive-p)" (declare (ignore proxy)) (assert (member method '(:get :put :post :delete :head))) (setf uri (puri:parse-uri uri)) Index: cl-soap/src/soap.lisp diff -u cl-soap/src/soap.lisp:1.9 cl-soap/src/soap.lisp:1.10 --- cl-soap/src/soap.lisp:1.9 Mon Oct 3 11:40:35 2005 +++ cl-soap/src/soap.lisp Wed Oct 5 15:24:38 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: soap.lisp,v 1.9 2005/10/03 09:40:35 scaekenberghe Exp $ +;;;; $Id: soap.lisp,v 1.10 2005/10/05 13:24:38 scaekenberghe Exp $ ;;;; ;;;; The basic SOAP protocol ;;;; @@ -110,28 +110,30 @@ (when *debug-stream* (setf *last-soap-call-xml* call-soap-envelope) (format *debug-stream* ";; SOAP CALL sending: ~a~%" call-xml)) - (setf result-xml (do-http-request (get-url server-end-point) - :method :POST - :headers `(("SOAPAction" . ,(or soap-action ""))) - :content-type "text/xml" - :content call-xml)) - (when *debug-stream* - (format *debug-stream* ";; SOAP CALL receiving: ~a~%" result-xml)) - (setf result-soap-envelope (s-xml:parse-xml-string result-xml)) - (when *debug-stream* - (setf *last-soap-result-xml* result-soap-envelope)) - (if (eql (lxml-get-tag result-soap-envelope) 'soapenv:|Envelope|) - (let ((headers (lxml-find-tag 'soapenv:|Header| (rest result-soap-envelope))) - (body (lxml-find-tag 'soapenv:|Body| (rest result-soap-envelope)))) - ;; simply return header key/value pairs as an alist - (setf headers (mapcar #'(lambda (x) (list (lxml-get-tag x) (lxml-get-contents x))) (rest headers))) - ;; only the first child of the body is returned, unless it is a fault - (if body - (let ((fault (lxml-find-tag 'soapenv:|Fault| (rest body)))) - (if fault - (error (lxml->standard-soap-fault fault)) - (values (second body) headers))) - (error "No body found in SOAP Envelope"))) - (error "No SOAP Envelope found")))) + (multiple-value-bind (result code) + (do-http-request (get-url server-end-point) + :method :POST + :headers `(("SOAPAction" . ,(or soap-action ""))) + :content-type "text/xml" + :content call-xml) + (declare (ignore code)) + (when *debug-stream* + (format *debug-stream* ";; SOAP CALL receiving: ~a~%" result-xml)) + (setf result-soap-envelope (s-xml:parse-xml-string result-xml)) + (when *debug-stream* + (setf *last-soap-result-xml* result-soap-envelope)) + (if (eql (lxml-get-tag result-soap-envelope) 'soapenv:|Envelope|) + (let ((headers (lxml-find-tag 'soapenv:|Header| (rest result-soap-envelope))) + (body (lxml-find-tag 'soapenv:|Body| (rest result-soap-envelope)))) + ;; simply return header key/value pairs as an alist + (setf headers (mapcar #'(lambda (x) (list (lxml-get-tag x) (lxml-get-contents x))) (rest headers))) + ;; only the first child of the body is returned, unless it is a fault + (if body + (let ((fault (lxml-find-tag 'soapenv:|Fault| (rest body)))) + (if fault + (error (lxml->standard-soap-fault fault)) + (values (second body) headers))) + (error "No body found in SOAP Envelope"))) + (error "No SOAP Envelope found"))))) ;;;; eof Index: cl-soap/src/wsdl.lisp diff -u cl-soap/src/wsdl.lisp:1.21 cl-soap/src/wsdl.lisp:1.22 --- cl-soap/src/wsdl.lisp:1.21 Mon Oct 3 11:40:35 2005 +++ cl-soap/src/wsdl.lisp Wed Oct 5 15:24:38 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: wsdl.lisp,v 1.21 2005/10/03 09:40:35 scaekenberghe Exp $ +;;;; $Id: wsdl.lisp,v 1.22 2005/10/05 13:24:38 scaekenberghe Exp $ ;;;; ;;;; The basic WSDL protocol: we parse the generic and soap specific parts ;;;; @@ -297,9 +297,12 @@ (parse-wsdl in))) (defun parse-wsdl-url (url) - (let ((buffer (do-http-request url))) - (with-input-from-string (in buffer) - (parse-wsdl in)))) + (multiple-value-bind (buffer code) + (do-http-request url) + (if (eql code 200) + (with-input-from-string (in buffer) + (parse-wsdl in)) + (error "Could not retrieve URL ~s, got a ~s code" url code)))) ;; A simple caching mechanism for WSDL's by URL Index: cl-soap/src/xsd.lisp diff -u cl-soap/src/xsd.lisp:1.24 cl-soap/src/xsd.lisp:1.25 --- cl-soap/src/xsd.lisp:1.24 Mon Oct 3 14:24:10 2005 +++ cl-soap/src/xsd.lisp Wed Oct 5 15:24:38 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: xsd.lisp,v 1.24 2005/10/03 12:24:10 scaekenberghe Exp $ +;;;; $Id: xsd.lisp,v 1.25 2005/10/05 13:24:38 scaekenberghe Exp $ ;;;; ;;;; A partial implementation of the XML Schema Definition standard ;;;; @@ -149,9 +149,12 @@ (parse-xsd in))) (defun parse-xsd-url (url) - (let ((buffer (do-http-request url))) - (with-input-from-string (in buffer) - (parse-xsd in)))) + (multiple-value-bind (buffer code) + (do-http-request url) + (if (eql code 200) + (with-input-from-string (in buffer) + (parse-xsd in)) + (error "Could not retrieve URL ~s, got a ~s code" url code)))) ;;; Interpreting the XSD model

1 0