- 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> +<h3>Debugging and Reporting Errors</h3> + + 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. + + + 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. + <h3>Next Phase(s) (Future)</h3> <ul> @@ -170,6 +196,6 @@ Initial development was done by Sven Van Caekenberghe (Beta Nine) with testing by Alain Picard (Memetrics). -$Id: index.html,v 1.10 2005/10/05 13:24:08 scaekenberghe Exp $ +$Id: index.html,v 1.11 2005/10/09 08:34:43 scaekenberghe Exp $ </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

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

05 Oct '05

Update of /project/cl-soap/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv1721 Modified Files: index.html Log Message: some usability fixes Date: Wed Oct 5 15:24:08 2005 Author: scaekenberghe Index: public_html/index.html diff -u public_html/index.html:1.9 public_html/index.html:1.10 --- public_html/index.html:1.9 Sun Oct 2 18:46:35 2005 +++ public_html/index.html Wed Oct 5 15:24:08 2005 @@ -66,7 +66,7 @@ <li>Make sure ASDF works for you, add the *.asd files of the packages you just downloaded (see the <a href="http://constantly.at/lisp/asdf"/>asdf manual</a>).</li> <li>With all of the above done: - <pre>(asd:oos 'asdf:load-op :cl-soap)</pre> + <pre>(asdf:oos 'asdf:load-op :cl-soap)</pre> should load all code into your lisp image (and compile it if necessary). </li> <li>Check out the example/test code in the <tt>test</tt> directory.</li> @@ -79,7 +79,7 @@ <ul> <li>S-XML was extended to support XML Namespaces.</li> - <li>Basic, manual SOAP calls are now possible, for example: + <li>Basic, manual SOAP calls are now possible, for example (creating the package :ns1 if necessary): <pre>(defun xmethods-get-quote (symbol) "Calling http://services.xmethods.net/soap/urn:xmethods-delayed-quotes.wsdl" (let ((ns "urn:xmethods-delayed-quotes")) @@ -170,6 +170,6 @@ Initial development was done by Sven Van Caekenberghe (Beta Nine) with testing by Alain Picard (Memetrics). -$Id: index.html,v 1.9 2005/10/02 16:46:35 scaekenberghe Exp $ +$Id: index.html,v 1.10 2005/10/05 13:24:08 scaekenberghe Exp $ </body> </html>

1 0

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

03 Oct '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv23895/src Modified Files: lxml.lisp Log Message: added example sexpr-get, (setf sexpr-getf), sexpr-select and sexpr-remove Date: Mon Oct 3 14:29:21 2005 Author: scaekenberghe Index: cl-soap/src/lxml.lisp diff -u cl-soap/src/lxml.lisp:1.8 cl-soap/src/lxml.lisp:1.9 --- cl-soap/src/lxml.lisp:1.8 Fri Sep 30 21:56:00 2005 +++ cl-soap/src/lxml.lisp Mon Oct 3 14:29:21 2005 @@ -1,8 +1,8 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: lxml.lisp,v 1.8 2005/09/30 19:56:00 scaekenberghe Exp $ +;;;; $Id: lxml.lisp,v 1.9 2005/10/03 12:29:21 scaekenberghe Exp $ ;;;; -;;;; Some tools to manipulate lxml +;;;; Common utilities (mostly lxml) and some internal/experimental stuff ;;;; ;;;; Copyright (C) 2005 Sven Van Caekenberghe, Beta Nine BVBA. All Rights Reserved. ;;;; @@ -47,7 +47,7 @@ "Find all elements of a specific tag in a lxml XML DOM list" (remove-if-not #'(lambda (x) (eql (lxml-get-tag x) tag)) lxml)) -;;; internal +;;; internal shared/common code (defun actual-name (qname) "For now we ignore prefixes ;-)" @@ -58,5 +58,54 @@ (defun find-item-named (item-name sequence) (find (actual-name item-name) sequence :test #'string-equal :key #'get-name)) + +;;; manipulating sexpr (structured/nested plists with string keys) + +(defun sexpr-getf (sexpr key &optional default) + "Find the value of key in sexpr (returning default if not found)" + (cond ((null sexpr) default) + ((consp sexpr) (let ((current-key (first sexpr))) + (if (stringp current-key) + (if (string-equal current-key key) + (second sexpr) + (sexpr-getf (rest (rest sexpr)) key default)) + (error "Illegal key in sexpr: ~s" current-key)))) + (t (error "Not an sexpr: ~s" sexpr)))) + +(defun (setf sexpr-getf) (value sexpr key) + "Destructively modify the value of key in sexpr to value (add at tail if not found)" + (cond ((null sexpr) (error "Cannot destructively add to the empty list")) + ((consp sexpr) (let ((current-key (first sexpr))) + (if (stringp current-key) + (if (string-equal current-key key) + (setf (second sexpr) value) + (if (null (rest (rest sexpr))) + (setf (rest (rest sexpr)) (list key value)) + (setf (sexpr-getf (rest (rest sexpr)) key) value))) + (error "Illegal key in sexpr: ~s" current-key)) + sexpr)) + (t (error "Not an sexpr: ~s" sexpr)))) + +(defun sexpr-select (sexpr keys) + "Return a new sexpr with keys and their values retained" + (cond ((null sexpr) '()) + ((consp sexpr) (let ((current-key (first sexpr))) + (if (stringp current-key) + (if (member current-key keys :test #'string-equal) + `(,current-key ,(second sexpr) ,@(sexpr-select (rest (rest sexpr)) keys)) + (sexpr-select (rest (rest sexpr)) keys)) + (error "Illegal key in sexpr: ~s" current-key)))) + (t (error "Not an sexpr: ~s" sexpr)))) + +(defun sexpr-remove (sexpr keys) + "Return a new sexpr with keys and their values not retained" + (cond ((null sexpr) '()) + ((consp sexpr) (let ((current-key (first sexpr))) + (if (stringp current-key) + (if (member current-key keys :test #'string-equal) + (sexpr-remove (rest (rest sexpr)) keys) + `(,current-key ,(second sexpr) ,@(sexpr-remove (rest (rest sexpr)) keys))) + (error "Illegal key in sexpr: ~s" current-key)))) + (t (error "Not an sexpr: ~s" sexpr)))) ;;;; eof

1 0

[cl-soap-cvs] CVS update: public_html/google-adwords-api.html
by scaekenberghe＠common-lisp.net 03 Oct '05

03 Oct '05

Update of /project/cl-soap/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv23869 Modified Files: google-adwords-api.html Log Message: updated to latest code Date: Mon Oct 3 14:28:26 2005 Author: scaekenberghe Index: public_html/google-adwords-api.html diff -u public_html/google-adwords-api.html:1.5 public_html/google-adwords-api.html:1.6 --- public_html/google-adwords-api.html:1.5 Sun Oct 2 18:51:14 2005 +++ public_html/google-adwords-api.html Mon Oct 3 14:28:26 2005 @@ -66,13 +66,13 @@ ("getMethodCostReturn" :INT) 1 ) 1 Operation: getUsageQuotaThisMonth Input: getUsageQuotaThisMonthRequest - ("getUsageQuotaThisMonth") + ("getUsageQuotaThisMonth") 1 Output: getUsageQuotaThisMonthResponse (getUsageQuotaThisMonthResponse ("getUsageQuotaThisMonthReturn" :LONG) 1 ) 1 Operation: getOperationsQuotaThisMonth Input: getOperationsQuotaThisMonthRequest - ("getOperationsQuotaThisMonth") + ("getOperationsQuotaThisMonth") 1 Output: getOperationsQuotaThisMonthResponse (getOperationsQuotaThisMonthResponse ("getOperationsQuotaThisMonthReturn" :LONG) 1 ) 1 @@ -158,7 +158,7 @@ ("getMethodCostResponse" ("getMethodCostReturn" 1)) -((GOOGLE:|responseTime| . "393") (GOOGLE:|operations| . "1") (GOOGLE:|units| . "1"))</pre> +(("responseTime" 393) ("operations" 1) ("units" 1))</pre> Some sensitive data fields have been marked with X's. XML was beautified a little bit ;-) Note that two values are returned: the actual value and the headers. @@ -349,8 +349,8 @@ (("id" -1 "impressions" 7263 "ctr" 0.01547993 "cpc" 50000 "avgPosition" 4.537519 "notShownPerDay" 288532) ("id" -1 "impressions" 18177 "ctr" 0.012525387 "cpc" 50000 "avgPosition" 2.8274193 "notShownPerDay" 397941)))) -((GOOGLE:|responseTime| . "412") (GOOGLE:|operations| . "2") (GOOGLE:|units| . "50"))</pre> +(("responseTime" 412) ("operations" 2) ("units" 50))</pre> That is all for now! More example and testing code can be found in the project's source tree. -$Id: google-adwords-api.html,v 1.5 2005/10/02 16:51:14 scaekenberghe Exp $ +$Id: google-adwords-api.html,v 1.6 2005/10/03 12:28:26 scaekenberghe Exp $ </body> </html>

1 0

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

03 Oct '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv23835/src Modified Files: xsd.lisp Log Message: forgot multiplicity for empty elements in describe-xsd Date: Mon Oct 3 14:24:11 2005 Author: scaekenberghe Index: cl-soap/src/xsd.lisp diff -u cl-soap/src/xsd.lisp:1.23 cl-soap/src/xsd.lisp:1.24 --- cl-soap/src/xsd.lisp:1.23 Mon Oct 3 11:40:35 2005 +++ cl-soap/src/xsd.lisp Mon Oct 3 14:24:10 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: xsd.lisp,v 1.23 2005/10/03 09:40:35 scaekenberghe Exp $ +;;;; $Id: xsd.lisp,v 1.24 2005/10/03 12:24:10 scaekenberghe Exp $ ;;;; ;;;; A partial implementation of the XML Schema Definition standard ;;;; @@ -387,7 +387,7 @@ template (cond ((null contents) (indent level) - (format stream "(~s)" element-name)) + (format stream "(~s) ~a" element-name multiplicity)) ((symbolp (first contents)) (let ((primitive-type (first contents))) (case multiplicity

1 0

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

03 Oct '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv11454/src Modified Files: soap.lisp wsdl.lisp xsd.lisp Log Message: soap output headers are now interpreted in the document case Date: Mon Oct 3 11:40:41 2005 Author: scaekenberghe Index: cl-soap/src/soap.lisp diff -u cl-soap/src/soap.lisp:1.8 cl-soap/src/soap.lisp:1.9 --- cl-soap/src/soap.lisp:1.8 Fri Sep 30 21:56:49 2005 +++ cl-soap/src/soap.lisp Mon Oct 3 11:40:35 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: soap.lisp,v 1.8 2005/09/30 19:56:49 scaekenberghe Exp $ +;;;; $Id: soap.lisp,v 1.9 2005/10/03 09:40:35 scaekenberghe Exp $ ;;;; ;;;; The basic SOAP protocol ;;;; @@ -124,7 +124,7 @@ (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) (cons (lxml-get-tag x) (second x))) (rest headers))) + (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)))) Index: cl-soap/src/wsdl.lisp diff -u cl-soap/src/wsdl.lisp:1.20 cl-soap/src/wsdl.lisp:1.21 --- cl-soap/src/wsdl.lisp:1.20 Sat Oct 1 10:48:49 2005 +++ cl-soap/src/wsdl.lisp Mon Oct 3 11:40:35 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: wsdl.lisp,v 1.20 2005/10/01 08:48:49 scaekenberghe Exp $ +;;;; $Id: wsdl.lisp,v 1.21 2005/10/03 09:40:35 scaekenberghe Exp $ ;;;; ;;;; The basic WSDL protocol: we parse the generic and soap specific parts ;;;; @@ -450,7 +450,7 @@ (push binding actual-headers)))) (nreverse actual-headers))) -(defun bind-output-parts (result output-message output wsdl-document-definitions) +(defun resolve-output-parts (result output-message output wsdl-document-definitions) (declare (ignore output)) (let ((namespace (s-xml:find-namespace (get-target-namespace wsdl-document-definitions))) (result-values '())) @@ -465,7 +465,7 @@ result-values))) (part-element (let ((part-value (resolve-element part-element - result + (list result) (get-xml-schema-definition wsdl-document-definitions) namespace))) (push part-value result-values))) @@ -475,6 +475,17 @@ (first result-values) (nreverse result-values)))) +(defun resolve-output-headers (soap-output-headers headers wsdl-document-definitions) + (let ((resolved-headers '())) + (loop :for part :in soap-output-headers :do + (let* ((element (get-element part)) + (namespace (s-xml:find-namespace (get-target-namespace wsdl-document-definitions))) + (xml-schema-definition (get-xml-schema-definition wsdl-document-definitions)) + (binding (resolve-element element headers xml-schema-definition namespace))) + (when binding + (push binding resolved-headers)))) + (nreverse resolved-headers))) + (defun wsdl-soap-document-call (wsdl-document-definitions soap-end-point soap-action @@ -483,6 +494,7 @@ soap-input-body soap-input-headers soap-output-body + soap-output-headers input output headers) @@ -507,8 +519,8 @@ :|xmlns| ,input-namespace-uri)) ;; we assume there is only one result - (values (bind-output-parts result output-message output wsdl-document-definitions) - headers)))) + (values (resolve-output-parts result output-message output wsdl-document-definitions) + (resolve-output-headers soap-output-headers headers wsdl-document-definitions))))) (defun wsdl-soap-rpc-call (wsdl-document-definitions soap-end-point @@ -536,7 +548,7 @@ :soap-action soap-action) (let ((output-wrapper (intern (get-name output-message) :ns1))) (if (eql (lxml-get-tag result) output-wrapper) - (values (bind-output-parts result output-message output wsdl-document-definitions) + (values (resolve-output-parts result output-message output wsdl-document-definitions) headers) (error "Expected <~a> element" output-wrapper))))))) @@ -548,6 +560,14 @@ (header-message (get-message-named wsdl-document-definitions message-name))) (get-part-named header-message part-name))))) +(defun wsdl-soap-output-headers (wsdl-document-definitions binding-operation-output) + (let ((soap-output-headers (get-extensions-of-class binding-operation-output 'wsdl-soap-header))) + (loop :for soap-output-header :in soap-output-headers + :collect (let* ((part-name (get-part soap-output-header)) + (message-name (get-message soap-output-header)) + (header-message (get-message-named wsdl-document-definitions message-name))) + (get-part-named header-message part-name))))) + (defun wsdl-soap-call-internal (wsdl-document-definitions port operation-name @@ -566,6 +586,8 @@ (soap-input-body (get-extension-of-class binding-operation-input 'wsdl-soap-body)) (soap-input-headers (wsdl-soap-input-headers wsdl-document-definitions binding-operation-input)) (binding-operation-output (get-operation-element binding-operation 'wsdl-output)) + (soap-output-headers (wsdl-soap-output-headers wsdl-document-definitions binding-operation-output)) + (binding-operation-output (get-operation-element binding-operation 'wsdl-output)) (soap-output-body (get-extension-of-class binding-operation-output 'wsdl-soap-body)) (port-type-operation (get-operation-named port-type operation-name)) (input-message (get-message-named wsdl-document-definitions @@ -599,6 +621,7 @@ soap-input-body soap-input-headers soap-output-body + soap-output-headers input output headers)) Index: cl-soap/src/xsd.lisp diff -u cl-soap/src/xsd.lisp:1.22 cl-soap/src/xsd.lisp:1.23 --- cl-soap/src/xsd.lisp:1.22 Sat Oct 1 10:48:49 2005 +++ cl-soap/src/xsd.lisp Mon Oct 3 11:40:35 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: xsd.lisp,v 1.22 2005/10/01 08:48:49 scaekenberghe Exp $ +;;;; $Id: xsd.lisp,v 1.23 2005/10/03 09:40:35 scaekenberghe Exp $ ;;;; ;;;; A partial implementation of the XML Schema Definition standard ;;;; @@ -369,7 +369,7 @@ (defun resolve-element (element lxml xml-schema-definition namespace) (let ((template (generate-xsd-template element xml-schema-definition))) - (resolve-xsd-template template (list lxml) namespace))) + (resolve-xsd-template template lxml namespace))) ;;; Describing XSD (print the 'sexpr' format with multiplicity indicators using in input/output binding)

1 0

[cl-soap-cvs] CVS update: public_html/google-adwords-api.html
by scaekenberghe＠common-lisp.net 02 Oct '05

02 Oct '05

Update of /project/cl-soap/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv6407 Modified Files: google-adwords-api.html Log Message: some layout issues Date: Sun Oct 2 18:51:14 2005 Author: scaekenberghe Index: public_html/google-adwords-api.html diff -u public_html/google-adwords-api.html:1.4 public_html/google-adwords-api.html:1.5 --- public_html/google-adwords-api.html:1.4 Sat Oct 1 13:18:11 2005 +++ public_html/google-adwords-api.html Sun Oct 2 18:51:14 2005 @@ -85,7 +85,9 @@ (getOperationCountResponse ("getOperationCountReturn" :LONG) 1 ) 1 </pre> The input and output characteristics of each operation are described in some detail. - Example lisp template code of actual input and output are also given (along with multiplicity indication, whether elements are required, optional, can occur zero ore more times, or one or more times). + Example lisp template code of actual input and output are also given + (along with multiplicity indication, whether elements are required, optional, + can occur zero ore more times, or one or more times). Given that you understand a particular operation, you can implement it quite easily. @@ -163,7 +165,9 @@ <h4>Example 2: Calling estimateKeywordList in the TrafficEstimatorService</h4> - This more complicated example is also described in the <a href="http://www.google.com/apis/adwords/developer/index.html">introduction to the Google AdWords API</a>: estimating the traffic for keywords. Again, we first look at the interpreted WSDL: + This more complicated example is also described in the + <a href="http://www.google.com/apis/adwords/developer/index.html">introduction to the Google AdWords API</a>: + estimating the traffic for keywords. Again, we first look at the interpreted WSDL: <pre>CL-SOAP 43 > (describe-wsdl-soap (wsdl-cache-get "https://adwords.google.com:443/api/adwords/v2/TrafficEstimatorService?wsdl")) WSDL Document Definitions Service: TrafficEstimatorService @@ -264,7 +268,12 @@ <pre>CL-SOAP 192 > (estimate-keyword-list '(("flowers" "Broad" 50000) ("tree" "Broad" 50000))) ;; SOAP CALL sending: -<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xmlns:google="https://adwords.google.com/api/adwords/v2" xmlns="https://adwords.google.com/api/adwords/v2"> +<soapenv:Envelope + xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" + xmlns:xsd="http://www.w3.org/1999/XMLSchema" + xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" + xmlns:google="https://adwords.google.com/api/adwords/v2" + xmlns="https://adwords.google.com/api/adwords/v2"> <soapenv:Header> <token>XXX</token> <useragent>cl-soap-testing</useragent> @@ -342,6 +351,6 @@ ((GOOGLE:|responseTime| . "412") (GOOGLE:|operations| . "2") (GOOGLE:|units| . "50"))</pre> That is all for now! More example and testing code can be found in the project's source tree. -$Id: google-adwords-api.html,v 1.4 2005/10/01 11:18:11 scaekenberghe Exp $ +$Id: google-adwords-api.html,v 1.5 2005/10/02 16:51:14 scaekenberghe Exp $ </body> </html>

1 0

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

02 Oct '05

Update of /project/cl-soap/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv6290 Modified Files: index.html Log Message: added some corrections Date: Sun Oct 2 18:46:37 2005 Author: scaekenberghe Index: public_html/index.html diff -u public_html/index.html:1.8 public_html/index.html:1.9 --- public_html/index.html:1.8 Sat Oct 1 11:24:11 2005 +++ public_html/index.html Sun Oct 2 18:46:35 2005 @@ -96,9 +96,9 @@ (if (eql (lxml-get-tag result) 'ns1::|getQuoteResponse|) (let ((contents (lxml-find-tag :|Result| (rest result)))) (if contents - (coerce (read-from-string (second contents)) 'float) - (error "Expected a <Result> element"))) - (error "Expected a <getQuoteResponse> element")))))</pre> + (coerce (read-from-string (lxml-get-contents contents)) 'float) + (error "Expected a <Result> element"))) + (error "Expected a <getQuoteResponse> element")))))</pre> Check out the test/test-basic.lisp file for more examples. </li> <li>WSDL with SOAP bindings in url/file/stream form can now be parsed into a Common Lisp representation. Use parse-wsdl, parse-wsdl-file and parse-wsdl-url.</li> @@ -167,9 +167,9 @@ ( <a href="http://www.memetrics.com">http://www.memetrics.com</a> ) and Beta Nine BVBA, Belgium ( <a href="http://www.betanine.be">http://www.betanine.be</a> ). -Initial developers and contributors will include Sven Van Caekenberghe (Beta Nine), -Alain Picard (Memetrics), Ivan Melotte (Beta Nine) and Nicky Peeters (Beta Nine). +Initial development was done by Sven Van Caekenberghe (Beta Nine) with testing by +Alain Picard (Memetrics). -$Id: index.html,v 1.8 2005/10/01 09:24:11 scaekenberghe Exp $ +$Id: index.html,v 1.9 2005/10/02 16:46:35 scaekenberghe Exp $ </body> </html>

1 0

[cl-soap-cvs] CVS update: public_html/google-adwords-api.html
by scaekenberghe＠common-lisp.net 01 Oct '05

01 Oct '05

Update of /project/cl-soap/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv11824 Modified Files: google-adwords-api.html Log Message: more structured layout Date: Sat Oct 1 13:18:12 2005 Author: scaekenberghe Index: public_html/google-adwords-api.html diff -u public_html/google-adwords-api.html:1.3 public_html/google-adwords-api.html:1.4 --- public_html/google-adwords-api.html:1.3 Sat Oct 1 11:24:11 2005 +++ public_html/google-adwords-api.html Sat Oct 1 13:18:11 2005 @@ -26,7 +26,11 @@ ;;; apparently there are different XML Schema Defintion namespace URIs, Google is using this one: (s-xml:register-namespace "http://www.w3.org/2001/XMLSchema" "xsd" :xsd)</pre> - Next, parse the WSDL of the service that you want to access and have a look at it. +We are now ready to look at some services. + +<h4>Example 1: Calling getMethodCost in the InfoService</h4> + + Parse the WSDL of the service that you want to access and have a look at it. <pre>CL-SOAP 11 > (describe-wsdl-soap (wsdl-cache-get "https://adwords.google.com:443/api/adwords/v2/InfoService?wsdl")) WSDL Document Definitions Service: InfoService @@ -81,7 +85,7 @@ (getOperationCountResponse ("getOperationCountReturn" :LONG) 1 ) 1 </pre> The input and output characteristics of each operation are described in some detail. - Example lisp template code of actaul input and output are also given (along with multiplicity indication, whether elements are required, optional, can occur zero ore more times, or one or more times). + Example lisp template code of actual input and output are also given (along with multiplicity indication, whether elements are required, optional, can occur zero ore more times, or one or more times). Given that you understand a particular operation, you can implement it quite easily. @@ -117,6 +121,7 @@ </getMethodCost> </soapenv:Body> </soapenv:Envelope> + ;; SOAP CALL receiving: <soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" @@ -156,8 +161,9 @@ XML was beautified a little bit ;-) Note that two values are returned: the actual value and the headers. +<h4>Example 2: Calling estimateKeywordList in the TrafficEstimatorService</h4> - A more complicated example comes from the <a href="http://www.google.com/apis/adwords/developer/index.html">introduction to the Google AdWords API</a>: estimating the traffic for keywords. Again, we first look at the interpreted WSDL: + This more complicated example is also described in the <a href="http://www.google.com/apis/adwords/developer/index.html">introduction to the Google AdWords API</a>: estimating the traffic for keywords. Again, we first look at the interpreted WSDL: <pre>CL-SOAP 43 > (describe-wsdl-soap (wsdl-cache-get "https://adwords.google.com:443/api/adwords/v2/TrafficEstimatorService?wsdl")) WSDL Document Definitions Service: TrafficEstimatorService @@ -256,6 +262,7 @@ :headers (make-google-headers)))</pre> Now we can test it, passing multiple requests and receiving multiple responses: <pre>CL-SOAP 192 > (estimate-keyword-list '(("flowers" "Broad" 50000) ("tree" "Broad" 50000))) + ;; SOAP CALL sending: <soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xmlns:google="https://adwords.google.com/api/adwords/v2" xmlns="https://adwords.google.com/api/adwords/v2"> <soapenv:Header> @@ -280,6 +287,7 @@ </estimateKeywordList> </soapenv:Body> </soapenv:Envelope> + ;; SOAP CALL receiving: <soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" @@ -334,6 +342,6 @@ ((GOOGLE:|responseTime| . "412") (GOOGLE:|operations| . "2") (GOOGLE:|units| . "50"))</pre> That is all for now! More example and testing code can be found in the project's source tree. -$Id: google-adwords-api.html,v 1.3 2005/10/01 09:24:11 scaekenberghe Exp $ +$Id: google-adwords-api.html,v 1.4 2005/10/01 11:18:11 scaekenberghe Exp $ </body> </html>

1 0

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

01 Oct '05

Update of /project/cl-soap/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv646 Modified Files: google-adwords-api.html index.html Log Message: documentation update to latest state of code Date: Sat Oct 1 11:24:11 2005 Author: scaekenberghe Index: public_html/google-adwords-api.html diff -u public_html/google-adwords-api.html:1.2 public_html/google-adwords-api.html:1.3 --- public_html/google-adwords-api.html:1.2 Tue Sep 27 22:35:16 2005 +++ public_html/google-adwords-api.html Sat Oct 1 11:24:11 2005 @@ -35,110 +35,63 @@ Binding: api:InfoServiceSoapBinding SOAP style [document] Operation: getUnitCountForMethod Input: getUnitCountForMethodRequest - Element "getUnitCountForMethod" [required] - Member "service" of primitive type "string" [required] - Member "method" of primitive type "string" [required] - Member "startDate" of primitive type "date" [required] - Member "endDate" of primitive type "date" [required] - <getUnitCountForMethod> - <service>string</service> - <method>string</method> - <startDate>date</startDate> - <endDate>date</endDate> - </getUnitCountForMethod> + (getUnitCountForMethod + ("service" :STRING) 1 + ("method" :STRING) 1 + ("startDate" :DATE) 1 + ("endDate" :DATE) 1 ) 1 Output: getUnitCountForMethodResponse - Element "getUnitCountForMethodResponse" [required] - Member "getUnitCountForMethodReturn" of primitive type "long" [required] - <getUnitCountForMethodResponse> - <getUnitCountForMethodReturn>long</getUnitCountForMethodReturn> - </getUnitCountForMethodResponse> + (getUnitCountForMethodResponse + ("getUnitCountForMethodReturn" :LONG) 1 ) 1 Operation: getUnitCount Input: getUnitCountRequest - Element "getUnitCount" [required] - Member "startDate" of primitive type "date" [required] - Member "endDate" of primitive type "date" [required] - <getUnitCount> - <startDate>date</startDate> - <endDate>date</endDate> - </getUnitCount> + (getUnitCount + ("startDate" :DATE) 1 + ("endDate" :DATE) 1 ) 1 Output: getUnitCountResponse - Element "getUnitCountResponse" [required] - Member "getUnitCountReturn" of primitive type "long" [required] - <getUnitCountResponse> - <getUnitCountReturn>long</getUnitCountReturn> - </getUnitCountResponse> + (getUnitCountResponse + ("getUnitCountReturn" :LONG) 1 ) 1 Operation: getMethodCost Input: getMethodCostRequest - Element "getMethodCost" [required] - Member "service" of primitive type "string" [required] - Member "method" of primitive type "string" [required] - Member "date" of primitive type "date" [required] - <getMethodCost> - <service>string</service> - <method>string</method> - <date>date</date> - </getMethodCost> + (getMethodCost + ("service" :STRING) 1 + ("method" :STRING) 1 + ("date" :DATE) 1 ) 1 Output: getMethodCostResponse - Element "getMethodCostResponse" [required] - Member "getMethodCostReturn" of primitive type "int" [required] - <getMethodCostResponse> - <getMethodCostReturn>int</getMethodCostReturn> - </getMethodCostResponse> + (getMethodCostResponse + ("getMethodCostReturn" :INT) 1 ) 1 Operation: getUsageQuotaThisMonth Input: getUsageQuotaThisMonthRequest - Element "getUsageQuotaThisMonth" [required] - <getUsageQuotaThisMonth> - </getUsageQuotaThisMonth> + ("getUsageQuotaThisMonth") Output: getUsageQuotaThisMonthResponse - Element "getUsageQuotaThisMonthResponse" [required] - Member "getUsageQuotaThisMonthReturn" of primitive type "long" [required] - <getUsageQuotaThisMonthResponse> - <getUsageQuotaThisMonthReturn>long</getUsageQuotaThisMonthReturn> - </getUsageQuotaThisMonthResponse> + (getUsageQuotaThisMonthResponse + ("getUsageQuotaThisMonthReturn" :LONG) 1 ) 1 Operation: getOperationsQuotaThisMonth Input: getOperationsQuotaThisMonthRequest - Element "getOperationsQuotaThisMonth" [required] - <getOperationsQuotaThisMonth> - </getOperationsQuotaThisMonth> + ("getOperationsQuotaThisMonth") Output: getOperationsQuotaThisMonthResponse - Element "getOperationsQuotaThisMonthResponse" [required] - Member "getOperationsQuotaThisMonthReturn" of primitive type "long" [required] - <getOperationsQuotaThisMonthResponse> - <getOperationsQuotaThisMonthReturn>long</getOperationsQuotaThisMonthReturn> - </getOperationsQuotaThisMonthResponse> + (getOperationsQuotaThisMonthResponse + ("getOperationsQuotaThisMonthReturn" :LONG) 1 ) 1 Operation: getOperationCount Input: getOperationCountRequest - Element "getOperationCount" [required] - Member "startDate" of primitive type "date" [required] - Member "endDate" of primitive type "date" [required] - <getOperationCount> - <startDate>date</startDate> - <endDate>date</endDate> - </getOperationCount> + (getOperationCount + ("startDate" :DATE) 1 + ("endDate" :DATE) 1 ) 1 Output: getOperationCountResponse - Element "getOperationCountResponse" [required] - Member "getOperationCountReturn" of primitive type "long" [required] - <getOperationCountResponse> - <getOperationCountReturn>long</getOperationCountReturn> - </getOperationCountResponse></pre> + (getOperationCountResponse + ("getOperationCountReturn" :LONG) 1 ) 1 </pre> The input and output characteristics of each operation are described in some detail. - Example template XML code of actaul input and output are also given. + Example lisp template code of actaul input and output are also given (along with multiplicity indication, whether elements are required, optional, can occur zero ore more times, or one or more times). Given that you understand a particular operation, you can implement it quite easily. - <pre>(defun get-method-cost (service method &optional (date (get-universal-time))) + <pre>(defun get-method-cost (service method &optional (date (ut))) (wsdl-soap-call (wsdl-cache-get "https://adwords.google.com:443/api/adwords/v2/InfoService?wsdl") "getMethodCost" - :input `("service" ,service - "method" ,method - "date" ,date) - :headers `("email" ,*google-adwords-email* - "password" ,*google-adwords-password* - "useragent" ,*google-adwords-user-agent* - "token" ,*google-adwords-token* - "clientEmail" ,*google-client-email*)))</pre> + :input `("getMethodCost" ("service" ,service "method" ,method "date" ,date)) + :headers (make-google-headers)))</pre> For the Google AdWords API, some headers are required. - The method implemented above requires some parameters, specified to the framework as a simple alist. + The method implemented above requires some parameters, specified to the framework as a structured alist. With debugging enabled (using (setf *debug-stream* *output-stream*)), executing the call looks as follows: <pre>CL-SOAP 85 > (get-method-cost "InfoService" "getMethodCost") @@ -190,8 +143,7 @@ </units> </soapenv:Header> <soapenv:Body> - <getMethodCostResponse - xmlns="https://adwords.google.com/api/adwords/v2"> + <getMethodCostResponse xmlns="https://adwords.google.com/api/adwords/v2"> <getMethodCostReturn>1</getMethodCostReturn> </getMethodCostResponse> </soapenv:Body> @@ -203,8 +155,185 @@ Some sensitive data fields have been marked with X's. XML was beautified a little bit ;-) Note that two values are returned: the actual value and the headers. - Stay tuned for more complicated examples later on. -$Id: google-adwords-api.html,v 1.2 2005/09/27 20:35:16 scaekenberghe Exp $ + + A more complicated example comes from the <a href="http://www.google.com/apis/adwords/developer/index.html">introduction to the Google AdWords API</a>: estimating the traffic for keywords. Again, we first look at the interpreted WSDL: + <pre>CL-SOAP 43 > (describe-wsdl-soap (wsdl-cache-get "https://adwords.google.com:443/api/adwords/v2/TrafficEstimatorService?wsdl")) +WSDL Document Definitions + Service: TrafficEstimatorService + Port: TrafficEstimatorService + SOAP Address Location "https://adwords.google.com:443/api/adwords/v2/TrafficEstimatorService" + Binding: api:TrafficEstimatorServiceSoapBinding SOAP style [document] + Operation: estimateKeywordList + Input: estimateKeywordListRequest + (estimateKeywordList + (keywordRequests ( + ("id" :LONG) ? + ("type" :STRING) ? + ("text" :STRING) ? + ("maxCpc" :LONG) ? + ("negative" :BOOLEAN) ? ) + )) 1 + Output: estimateKeywordListResponse + (estimateKeywordListResponse + (estimateKeywordListReturn ( + ("id" :LONG) ? + ("impressions" :INT) 1 + ("ctr" :FLOAT) 1 + ("cpc" :LONG) 1 + ("avgPosition" :FLOAT) 1 + ("notShownPerDay" :INT) 1 ) + )) 1 + Operation: estimateAdGroupList + Input: estimateAdGroupListRequest + (estimateAdGroupList + (adGroupRequests ( + ("id" :INT) ? + ("maxCpc" :LONG) ? + (keywordRequests ( + ("id" :LONG) ? + ("type" :STRING) ? + ("text" :STRING) ? + ("maxCpc" :LONG) ? + ("negative" :BOOLEAN) ? ) + )) + )) 1 + Output: estimateAdGroupListResponse + (estimateAdGroupListResponse + (estimateAdGroupListReturn ( + ("id" :INT) ? + (keywordEstimates ( + ("id" :LONG) ? + ("impressions" :INT) 1 + ("ctr" :FLOAT) 1 + ("cpc" :LONG) 1 + ("avgPosition" :FLOAT) 1 + ("notShownPerDay" :INT) 1 ) + )) + )) 1 + Operation: estimateCampaignList + Input: estimateCampaignListRequest + (estimateCampaignList + (campaignRequests ( + ("id" :INT) ? + ("optInSearchNetwork" :BOOLEAN) ? + ("optInContentNetwork" :BOOLEAN) ? + (geoTargeting + ("countries" (:STRING) * ) + ("regions" (:STRING) * ) + ("metros" (:STRING) * ) + ("cities" (:STRING) * )) ? + (languageTargeting + ("languages" (:STRING) * )) ? + (adGroupRequests ( + ("id" :INT) ? + ("maxCpc" :LONG) ? + (keywordRequests ( + ("id" :LONG) ? + ("type" :STRING) ? + ("text" :STRING) ? + ("maxCpc" :LONG) ? + ("negative" :BOOLEAN) ? ) + )) + )) + )) 1 + Output: estimateCampaignListResponse + (estimateCampaignListResponse + (estimateCampaignListReturn ( + ("id" :INT) ? + (adGroupEstimates ( + ("id" :INT) ? + (keywordEstimates ( + ("id" :LONG) ? + ("impressions" :INT) 1 + ("ctr" :FLOAT) 1 + ("cpc" :LONG) 1 + ("avgPosition" :FLOAT) 1 + ("notShownPerDay" :INT) 1 ) + )) + )) + )) 1</pre> + Next we define our little lisp function: + <pre>(defun estimate-keyword-list (keywords) + "((text type max-cpc)*) where type is Broad|Phrase|Exact" + (wsdl-soap-call (wsdl-cache-get "https://adwords.google.com:443/api/adwords/v2/TrafficEstimatorService?wsdl") + "estimateKeywordList" + :input `("estimateKeywordList" + ("keywordRequests" + ,(mapcar #'(lambda (keyword) + (destructuring-bind (text type max-cpc) + keyword + `("text" ,text "type" ,type "maxCpc" ,max-cpc))) + keywords))) + :headers (make-google-headers)))</pre> + Now we can test it, passing multiple requests and receiving multiple responses: + <pre>CL-SOAP 192 > (estimate-keyword-list '(("flowers" "Broad" 50000) ("tree" "Broad" 50000))) +;; SOAP CALL sending: +<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xmlns:google="https://adwords.google.com/api/adwords/v2" xmlns="https://adwords.google.com/api/adwords/v2"> + <soapenv:Header> + <token>XXX</token> + <useragent>cl-soap-testing</useragent> + <password>XXX</password> + <clientEmail>sven(a)beta9.be</clientEmail> + <email>svc(a)mac.com</email> + </soapenv:Header> + <soapenv:Body> + <estimateKeywordList> + <keywordRequests> + <type>Broad</type> + <text>flowers</text> + <maxCpc>50000</maxCpc> + </keywordRequests> + <keywordRequests> + <type>Broad</type> + <text>tree</text> + <maxCpc>50000</maxCpc> + </keywordRequests> + </estimateKeywordList> + </soapenv:Body> +</soapenv:Envelope> +;; SOAP CALL receiving: +<soapenv:Envelope + xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" + xmlns:xsd="http://www.w3.org/1999/XMLSchema" + xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"> + <soapenv:Header> + <responseTime + soapenv:actor="http://schemas.xmlsoap.org/soap/actor/next" + soapenv:mustUnderstand="0" + xmlns="https://adwords.google.com/api/adwords/v2"> + 412 + </responseTime> + <operations + soapenv:actor="http://schemas.xmlsoap.org/soap/actor/next" + soapenv:mustUnderstand="0" + xmlns="https://adwords.google.com/api/adwords/v2"> + 2 + </operations> + <units + soapenv:actor="http://schemas.xmlsoap.org/soap/actor/next" + soapenv:mustUnderstand="0" + xmlns="https://adwords.google.com/api/adwords/v2"> + 50 + </units> + </soapenv:Header> + <soapenv:Body> + <estimateKeywordListResponse xmlns="https://adwords.google.com/api/adwords/v2"> + <estimateKeywordListReturn> + <avgPosition>4.537519</avgPosition> + <cpc>50000</cpc> + <ctr>0.01547993</ctr> + <id>-1</id> + <impressions>7263</impressions> + <notShownPerDay>288532</notShownPerDay> + </estimateKeywordListReturn> + <estimateKeywordListReturn> + <avgPosition>2.8274193</avgPosition> + <cpc>50000</cpc> + <ctr>0.012525387</ctr> + <id>-1</id> + <impressions>18177</impressions> + <notShownPerDay>397941</notShownPerDay> + </estimateKeywordListReturn> + </estimateKeywordListResponse> + </soapenv:Body> +</soapenv:Envelope> + +("estimateKeywordListResponse" + ("estimateKeywordListReturn" + (("id" -1 "impressions" 7263 "ctr" 0.01547993 "cpc" 50000 "avgPosition" 4.537519 "notShownPerDay" 288532) + ("id" -1 "impressions" 18177 "ctr" 0.012525387 "cpc" 50000 "avgPosition" 2.8274193 "notShownPerDay" 397941)))) + +((GOOGLE:|responseTime| . "412") (GOOGLE:|operations| . "2") (GOOGLE:|units| . "50"))</pre> + That is all for now! More example and testing code can be found in the project's source tree. +$Id: google-adwords-api.html,v 1.3 2005/10/01 09:24:11 scaekenberghe Exp $ </body> </html> Index: public_html/index.html diff -u public_html/index.html:1.7 public_html/index.html:1.8 --- public_html/index.html:1.7 Tue Sep 27 22:28:32 2005 +++ public_html/index.html Sat Oct 1 11:24:11 2005 @@ -78,7 +78,7 @@ Currently, phase 1 (and then some) has been implemented. <ul> - <li>S-XML was extended to support XML Namespaces</li> + <li>S-XML was extended to support XML Namespaces.</li> <li>Basic, manual SOAP calls are now possible, for example: <pre>(defun xmethods-get-quote (symbol) "Calling http://services.xmethods.net/soap/urn:xmethods-delayed-quotes.wsdl" @@ -122,13 +122,13 @@ "getRate" :input `("country1" ,country1 "country2" ,country2)))</pre> </li> - <li>Https support in http-client.lisp was added for LispWorks</li> - <li>The general function soap-call was extended to handle headers (input and output headers)</li> - <li>The function wsdl-soap-call now handles document based SOAP calls too</li> - <li>Partial support for XML Schema Defintion types definition in WSDL has been implemented</li> + <li>Https support in http-client.lisp was added for LispWorks.</li> + <li>The general function soap-call was extended to handle headers (input and output headers).</li> + <li>The function wsdl-soap-call now handles document based SOAP calls too.</li> + <li>Partial support for XML Schema Defintion types definition in WSDL has been implemented. To simplify the general XSD spec (which we don't need, does anybody ?), we are using a simplified template representation internally.</li> <li>The target of being able to talk to the Google AdWords API has been reached! A separate document, <a href="google-adwords-api.html">Google AdWords API</a> describes this in more detail - and with some verbose examples</li> + and with some verbose examples.</li> <li>Lot's of work remains to be done! All help is welcome.</li> </ul> @@ -170,6 +170,6 @@ Initial developers and contributors will include Sven Van Caekenberghe (Beta Nine), Alain Picard (Memetrics), Ivan Melotte (Beta Nine) and Nicky Peeters (Beta Nine). -$Id: index.html,v 1.7 2005/09/27 20:28:32 scaekenberghe Exp $ +$Id: index.html,v 1.8 2005/10/01 09:24:11 scaekenberghe Exp $ </body> </html>

1 0

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

01 Oct '05

Update of /project/cl-soap/cvsroot/cl-soap/test In directory common-lisp.net:/tmp/cvs-serv30878/test Modified Files: development.lisp Log Message: describe-xsd has been rewritten using the new template system Date: Sat Oct 1 10:48:50 2005 Author: scaekenberghe Index: cl-soap/test/development.lisp diff -u cl-soap/test/development.lisp:1.1 cl-soap/test/development.lisp:1.2 --- cl-soap/test/development.lisp:1.1 Fri Sep 30 21:59:26 2005 +++ cl-soap/test/development.lisp Sat Oct 1 10:48:50 2005 @@ -1,6 +1,6 @@ ;;;; -*- Mode: LISP -*- ;;;; -;;;; $Id: development.lisp,v 1.1 2005/09/30 19:59:26 scaekenberghe Exp $ +;;;; $Id: development.lisp,v 1.2 2005/10/01 08:48:50 scaekenberghe Exp $ ;;;; ;;;; Development scratch pad ;;;; @@ -324,5 +324,128 @@ (values nil nil) (error "Expected a <~a> element" tag-name))))) (t (error "Cannot resolve element ~s of type ~s" element element-type))))) + +;;; Describing XSD (with pre-rendering of XML) + +(defmethod describe-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)) "optional") + ((and (eql min-occurs 1) (eql max-occurs 1)) "required") + ((and (eql min-occurs 1) (eql max-occurs :unbounded)) "one or more") + ((and (zerop min-occurs) (eql max-occurs :unbounded)) "zero or more") + (t (format nil "min:~d-max:~d" min-occurs max-occurs))))) + +(defmethod multiplicity-suffix ((xml-schema-element xml-schema-element)) + (with-slots (min-occurs max-occurs) + xml-schema-element + (cond ((and (zerop min-occurs) (eql max-occurs 1)) "?") + ((and (eql min-occurs 1) (eql max-occurs 1)) "") + ((and (eql min-occurs 1) (eql max-occurs :unbounded)) "+") + ((and (zerop min-occurs) (eql max-occurs :unbounded)) "*") + (t (format nil "~d:~d" min-occurs max-occurs))))) + +(defun pre-render-xsd-type (xml-schema-definition type-name &key (level 0) (stream *standard-output*)) + (let* ((type-element (get-element-named xml-schema-definition type-name)) + (type (get-element-type xml-schema-definition type-element))) + (if (typep type 'xsd-complex-type) + (let ((members (get-members type xml-schema-definition))) + (loop :for member :in members :do + (let ((member-name (get-name member)) + (member-type (get-type member))) + (indent level stream) + (if (xsd-primitive-type-name-p member-type) + (format stream " <~a>~a</~a>~a~%" + member-name member-type member-name (multiplicity-suffix member)) + (progn + (format stream " <~a>~%" member-name) + (pre-render-xsd-type xml-schema-definition member-type + :level (1+ level) :stream stream) + (indent level stream) + (format stream " </~a>~a~%" member-name (multiplicity-suffix member))))))) + (if (xsd-primitive-type-name-p type) + (progn + (indent level stream) + (format stream " ~a~%" type)) + (error "unexpected type"))))) + +(defun describe-xsd-type (xml-schema-definition type-name &key (level 0) (stream *standard-output*)) + (let* ((type-element (get-element-named xml-schema-definition type-name)) + (type (get-element-type xml-schema-definition type-element))) + (if (typep type 'xsd-complex-type) + (let ((members (get-members type xml-schema-definition))) + (loop :for member :in members :do + (let ((member-name (get-name member)) + (member-type (get-type member))) + (indent level stream) + (if (xsd-primitive-type-name-p member-type) + (format stream " Member ~s of primitive type ~s [~a]~@[ nillable~]~%" + member-name member-type (describe-multiplicity member) (get-nillable member)) + (progn + (format stream " Member ~s [~a]~@[ nillable~]~%" member-name + (describe-multiplicity member) (get-nillable member)) + (describe-xsd-type xml-schema-definition member-type + :level (1+ level) :stream stream)))))) + (if (xsd-primitive-type-name-p type) + (progn + (indent level stream) + (format stream " primitive type ~a~%" type)) + (error "unexpected type"))))) + +(defun describe-xsd-element (xml-schema-definition element &key (level 0) (stream *standard-output*)) + (unless (typep element 'xml-schema-element) + (setf element (get-element-named xml-schema-definition element))) + (let* ((element-type (get-element-type xml-schema-definition element)) + (element-name (get-name element))) + (if (xsd-primitive-type-name-p element-type) + (progn + (indent level stream) + (format stream "Element ~s of primitive type ~s [~a]~@[ nillable~]~%" + element-name element-type (describe-multiplicity element) (get-nillable element)) + (indent level stream) + (format stream " <~a>~a</~a>~a~%" + element-name element-type element-name (multiplicity-suffix element))) + (let ((members (get-members element-type xml-schema-definition))) + (indent level stream) + (format stream "Element ~s [~a]~@[ nillable~]~%" element-name + (describe-multiplicity element) (get-nillable element)) + (loop :for member :in members :do + (let ((member-name (get-name member)) + (member-type (get-type member))) + (indent level stream) + (if (xsd-primitive-type-name-p member-type) + (format stream " Member ~s of primitive type ~s [~a]~@[ nillable~]~%" + member-name member-type (describe-multiplicity member) (get-nillable member)) + (progn + (format stream " Member ~s [~a]~@[ nillable~]~%" member-name + (describe-multiplicity member) (get-nillable member)) + (describe-xsd-type xml-schema-definition member-type + :level (1+ level) :stream stream))))) + (indent level stream) + (format stream " <~a>~%" element-name) + (loop :for member :in members :do + (let ((member-name (get-name member)) + (member-type (get-type member))) + (indent level stream) + (if (xsd-primitive-type-name-p member-type) + (format stream " <~a>~a</~a>~a~%" + member-name member-type member-name (multiplicity-suffix member)) + (progn + (format stream " <~a>~%" member-name) + (pre-render-xsd-type xml-schema-definition member-type :level (1+ level) :stream stream) + (indent level stream) + (format stream " </~a>~a~%" member-name (multiplicity-suffix member)))))) + (indent level stream) + (format stream " </~a>~a~%" element-name (multiplicity-suffix element)))))) + +(defun describe-xsd (xml-schema-definition &key (stream *standard-output*)) + "Print a high-level description of the top-level elements in xml-schema-definition" + (format stream "XML Schema Definition with target-namespace URI ~s~%" + (get-target-namespace xml-schema-definition)) + (loop :for element :in (get-elements xml-schema-definition) :do + (when (typep element 'xml-schema-element) + (describe-xsd-element xml-schema-definition element + :level 1 :stream stream))) + (values)) ;;;; eof

1 0

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

01 Oct '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv30878/src Modified Files: wsdl.lisp xsd.lisp Log Message: describe-xsd has been rewritten using the new template system Date: Sat Oct 1 10:48:49 2005 Author: scaekenberghe Index: cl-soap/src/wsdl.lisp diff -u cl-soap/src/wsdl.lisp:1.19 cl-soap/src/wsdl.lisp:1.20 --- cl-soap/src/wsdl.lisp:1.19 Fri Sep 30 19:12:17 2005 +++ cl-soap/src/wsdl.lisp Sat Oct 1 10:48:49 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: wsdl.lisp,v 1.19 2005/09/30 17:12:17 scaekenberghe Exp $ +;;;; $Id: wsdl.lisp,v 1.20 2005/10/01 08:48:49 scaekenberghe Exp $ ;;;; ;;;; The basic WSDL protocol: we parse the generic and soap specific parts ;;;; @@ -376,8 +376,7 @@ (cond ((get-type part) (format stream " of type: ~a~%" (get-type part))) ((get-element part) - (describe-xsd-element xml-schema-definition (get-element part) - :level 5 :stream stream)))) + (describe-xsd-element (get-element part) xml-schema-definition stream 5)))) (defun describe-wsdl-soap (wsdl-document-definitions &key (stream *standard-output*)) "Print a high-level description of the services/ports/operations in wsdl-document-definitions" Index: cl-soap/src/xsd.lisp diff -u cl-soap/src/xsd.lisp:1.21 cl-soap/src/xsd.lisp:1.22 --- cl-soap/src/xsd.lisp:1.21 Fri Sep 30 21:58:05 2005 +++ cl-soap/src/xsd.lisp Sat Oct 1 10:48:49 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: xsd.lisp,v 1.21 2005/09/30 19:58:05 scaekenberghe Exp $ +;;;; $Id: xsd.lisp,v 1.22 2005/10/01 08:48:49 scaekenberghe Exp $ ;;;; ;;;; A partial implementation of the XML Schema Definition standard ;;;; @@ -226,132 +226,6 @@ (defmethod is-plural-p ((xml-schema-element xml-schema-element)) (eql (get-max-occurs xml-schema-element) :unbounded)) -;;; Describing XSD (with pre-rendering of XML) - -(defun indent (n &optional (stream *standard-output*)) - (loop :repeat n :do (write-char #\space stream) (write-char #\space stream))) - -(defmethod describe-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)) "optional") - ((and (eql min-occurs 1) (eql max-occurs 1)) "required") - ((and (eql min-occurs 1) (eql max-occurs :unbounded)) "one or more") - ((and (zerop min-occurs) (eql max-occurs :unbounded)) "zero or more") - (t (format nil "min:~d-max:~d" min-occurs max-occurs))))) - -(defmethod multiplicity-suffix ((xml-schema-element xml-schema-element)) - (with-slots (min-occurs max-occurs) - xml-schema-element - (cond ((and (zerop min-occurs) (eql max-occurs 1)) "?") - ((and (eql min-occurs 1) (eql max-occurs 1)) "") - ((and (eql min-occurs 1) (eql max-occurs :unbounded)) "+") - ((and (zerop min-occurs) (eql max-occurs :unbounded)) "*") - (t (format nil "~d:~d" min-occurs max-occurs))))) - -(defun pre-render-xsd-type (xml-schema-definition type-name &key (level 0) (stream *standard-output*)) - (let* ((type-element (get-element-named xml-schema-definition type-name)) - (type (get-element-type xml-schema-definition type-element))) - (if (typep type 'xsd-complex-type) - (let ((members (get-members type xml-schema-definition))) - (loop :for member :in members :do - (let ((member-name (get-name member)) - (member-type (get-type member))) - (indent level stream) - (if (xsd-primitive-type-name-p member-type) - (format stream " <~a>~a</~a>~a~%" - member-name member-type member-name (multiplicity-suffix member)) - (progn - (format stream " <~a>~%" member-name) - (pre-render-xsd-type xml-schema-definition member-type - :level (1+ level) :stream stream) - (indent level stream) - (format stream " </~a>~a~%" member-name (multiplicity-suffix member))))))) - (if (xsd-primitive-type-name-p type) - (progn - (indent level stream) - (format stream " ~a~%" type)) - (error "unexpected type"))))) - -(defun describe-xsd-type (xml-schema-definition type-name &key (level 0) (stream *standard-output*)) - (let* ((type-element (get-element-named xml-schema-definition type-name)) - (type (get-element-type xml-schema-definition type-element))) - (if (typep type 'xsd-complex-type) - (let ((members (get-members type xml-schema-definition))) - (loop :for member :in members :do - (let ((member-name (get-name member)) - (member-type (get-type member))) - (indent level stream) - (if (xsd-primitive-type-name-p member-type) - (format stream " Member ~s of primitive type ~s [~a]~@[ nillable~]~%" - member-name member-type (describe-multiplicity member) (get-nillable member)) - (progn - (format stream " Member ~s [~a]~@[ nillable~]~%" member-name - (describe-multiplicity member) (get-nillable member)) - (describe-xsd-type xml-schema-definition member-type - :level (1+ level) :stream stream)))))) - (if (xsd-primitive-type-name-p type) - (progn - (indent level stream) - (format stream " primitive type ~a~%" type)) - (error "unexpected type"))))) - -(defun describe-xsd-element (xml-schema-definition element &key (level 0) (stream *standard-output*)) - (unless (typep element 'xml-schema-element) - (setf element (get-element-named xml-schema-definition element))) - (let* ((element-type (get-element-type xml-schema-definition element)) - (element-name (get-name element))) - (if (xsd-primitive-type-name-p element-type) - (progn - (indent level stream) - (format stream "Element ~s of primitive type ~s [~a]~@[ nillable~]~%" - element-name element-type (describe-multiplicity element) (get-nillable element)) - (indent level stream) - (format stream " <~a>~a</~a>~a~%" - element-name element-type element-name (multiplicity-suffix element))) - (let ((members (get-members element-type xml-schema-definition))) - (indent level stream) - (format stream "Element ~s [~a]~@[ nillable~]~%" element-name - (describe-multiplicity element) (get-nillable element)) - (loop :for member :in members :do - (let ((member-name (get-name member)) - (member-type (get-type member))) - (indent level stream) - (if (xsd-primitive-type-name-p member-type) - (format stream " Member ~s of primitive type ~s [~a]~@[ nillable~]~%" - member-name member-type (describe-multiplicity member) (get-nillable member)) - (progn - (format stream " Member ~s [~a]~@[ nillable~]~%" member-name - (describe-multiplicity member) (get-nillable member)) - (describe-xsd-type xml-schema-definition member-type - :level (1+ level) :stream stream))))) - (indent level stream) - (format stream " <~a>~%" element-name) - (loop :for member :in members :do - (let ((member-name (get-name member)) - (member-type (get-type member))) - (indent level stream) - (if (xsd-primitive-type-name-p member-type) - (format stream " <~a>~a</~a>~a~%" - member-name member-type member-name (multiplicity-suffix member)) - (progn - (format stream " <~a>~%" member-name) - (pre-render-xsd-type xml-schema-definition member-type :level (1+ level) :stream stream) - (indent level stream) - (format stream " </~a>~a~%" member-name (multiplicity-suffix member)))))) - (indent level stream) - (format stream " </~a>~a~%" element-name (multiplicity-suffix element)))))) - -(defun describe-xsd (xml-schema-definition &key (stream *standard-output*)) - "Print a high-level description of the top-level elements in xml-schema-definition" - (format stream "XML Schema Definition with target-namespace URI ~s~%" - (get-target-namespace xml-schema-definition)) - (loop :for element :in (get-elements xml-schema-definition) :do - (when (typep element 'xml-schema-element) - (describe-xsd-element xml-schema-definition element - :level 1 :stream stream))) - (values)) - ;;; Template Generation (converting the XSD model to something simpler ;-) ;; an XSD element template looks like this: @@ -496,6 +370,61 @@ (defun resolve-element (element lxml xml-schema-definition namespace) (let ((template (generate-xsd-template element xml-schema-definition))) (resolve-xsd-template template (list lxml) namespace))) + +;;; Describing XSD (print the 'sexpr' format with multiplicity indicators using in input/output binding) + +(defun indent (n &optional (stream *standard-output*)) + (format stream "~&") + (loop :repeat n + :do (write-char #\space stream) (write-char #\space stream))) + +(defun describe-xsd-template-members (members &optional (stream *standard-output*) (level 0)) + (loop :for member :in members :do + (describe-xsd-template member stream (1+ level)))) + +(defun describe-xsd-template (template &optional (stream *standard-output*) (level 0)) + (destructuring-bind (multiplicity element-name &rest contents) + template + (cond ((null contents) + (indent level) + (format stream "(~s)" element-name)) + ((symbolp (first contents)) + (let ((primitive-type (first contents))) + (case multiplicity + ((1 ?) + (indent level) + (format stream "(~s ~s) ~a " element-name primitive-type multiplicity)) + ((+ *) + (indent level) + (format stream "(~s (~s) ~a )" element-name primitive-type multiplicity))))) + (t + (case multiplicity + ((1 ?) + (indent level) + (format stream "(~a" element-name) + (describe-xsd-template-members contents stream level) + (format stream ") ~a " multiplicity)) + ((+ *) + (indent level) + (format stream "(~a (" element-name) + (describe-xsd-template-members contents stream level) + (format stream ") ~a )" multiplicity))))))) + +(defun describe-xsd-element (element xml-schema-definition &optional (stream *standard-output*) (level 0)) + (let ((template (generate-xsd-template element xml-schema-definition))) + (describe-xsd-template template stream level)) + (format stream "~&") + (values)) + +(defun describe-xsd (xml-schema-definition &optional (stream *standard-output*)) + "Print a high-level description of the top-level elements in xml-schema-definition" + (format stream "XML Schema Definition with target-namespace URI ~s~%" + (get-target-namespace xml-schema-definition)) + (loop :for element :in (get-elements xml-schema-definition) :do + (when (typep element 'xml-schema-element) + (describe-xsd-element element xml-schema-definition stream 1))) + (format stream "~&") + (values)) ;;; Primitive Types/Values (types are identified :keywords)

1 0

[cl-soap-cvs] CVS update: cl-soap/test/development.lisp
by scaekenberghe＠common-lisp.net 30 Sep '05

30 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/test In directory common-lisp.net:/tmp/cvs-serv9408/test Added Files: development.lisp Log Message: moved from src to test Date: Fri Sep 30 21:59:26 2005 Author: scaekenberghe

1 0

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

30 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv9408/src Removed Files: development.lisp Log Message: moved from src to test Date: Fri Sep 30 21:59:26 2005 Author: scaekenberghe

1 0

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

30 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv9383/src Modified Files: xsd.lisp Log Message: various bugfixes Date: Fri Sep 30 21:58:05 2005 Author: scaekenberghe Index: cl-soap/src/xsd.lisp diff -u cl-soap/src/xsd.lisp:1.20 cl-soap/src/xsd.lisp:1.21 --- cl-soap/src/xsd.lisp:1.20 Fri Sep 30 21:21:43 2005 +++ cl-soap/src/xsd.lisp Fri Sep 30 21:58:05 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: xsd.lisp,v 1.20 2005/09/30 19:21:43 scaekenberghe Exp $ +;;;; $Id: xsd.lisp,v 1.21 2005/09/30 19:58:05 scaekenberghe Exp $ ;;;; ;;;; A partial implementation of the XML Schema Definition standard ;;;; @@ -358,6 +358,7 @@ ;; ELT = ( <multiplicity> "element-name" [ :primitive | ELT* ] ) ;; where <multiplicity> is 1, ?, + or * and :primitive is a XSD primitive type keyword ;; 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) (with-slots (min-occurs max-occurs) @@ -464,29 +465,33 @@ template (let* ((tag (intern element-name (s-xml:get-package namespace))) (children (lxml-find-tags tag lxml))) - (if (symbolp (first contents)) - (let ((primitive-type (first contents))) - (case multiplicity - ((1 ?) (if children - (resolve-xsd-template-primitive element-name primitive-type (second (first children))) - (when (eql multiplicity 1) - (error "Required element ~s not bound" element-name)))) - ((+ *) (if children - (loop :for child :in children - :collect (resolve-xsd-template-primitive element-name primitive-type (second child))) - (when (eql multiplicity +) - (error "Required repeating element ~s not bound correctly" element-name)))))) - (case multiplicity - ((1 ?) (if children - `(,element-name ,(resolve-xsd-template-members contents (first children) namespace)) - (when (eql multiplicity 1) - (error "Required element ~s not bound" element-name)))) - ((+ *) (if children - `(,element-name - ,(loop :for child :in children - :collect (resolve-xsd-template-members contents child namespace))) - (when (eql multiplicity +) - (error "Required repeating element ~s not bound correctly" element-name))))))))) + (cond ((null contents) `(,element-name)) + ((symbolp (first contents)) + (let ((primitive-type (first contents))) + (case multiplicity + ((1 ?) (if children + (resolve-xsd-template-primitive element-name primitive-type + (lxml-get-contents (first children))) + (when (eql multiplicity 1) + (error "Required element ~s not bound" element-name)))) + ((+ *) (if children + (loop :for child :in children + :collect (resolve-xsd-template-primitive element-name primitive-type + (lxml-get-contents child))) + (when (eql multiplicity +) + (error "Required repeating element ~s not bound correctly" element-name))))))) + (t + (case multiplicity + ((1 ?) (if children + `(,element-name ,(resolve-xsd-template-members contents (first children) namespace)) + (when (eql multiplicity 1) + (error "Required element ~s not bound" element-name)))) + ((+ *) (if children + `(,element-name + ,(loop :for child :in children + :collect (resolve-xsd-template-members contents child namespace))) + (when (eql multiplicity +) + (error "Required repeating element ~s not bound correctly" element-name)))))))))) (defun resolve-element (element lxml xml-schema-definition namespace) (let ((template (generate-xsd-template element xml-schema-definition)))

1 0

[cl-soap-cvs] CVS update: cl-soap/test/test-xsd.lisp
by scaekenberghe＠common-lisp.net 30 Sep '05

30 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/test In directory common-lisp.net:/tmp/cvs-serv9362/test Modified Files: test-xsd.lisp Log Message: removed some obsolete tests Date: Fri Sep 30 21:57:20 2005 Author: scaekenberghe Index: cl-soap/test/test-xsd.lisp diff -u cl-soap/test/test-xsd.lisp:1.2 cl-soap/test/test-xsd.lisp:1.3 --- cl-soap/test/test-xsd.lisp:1.2 Fri Sep 30 19:12:20 2005 +++ cl-soap/test/test-xsd.lisp Fri Sep 30 21:57:20 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: test-xsd.lisp,v 1.2 2005/09/30 17:12:20 scaekenberghe Exp $ +;;;; $Id: test-xsd.lisp,v 1.3 2005/09/30 19:57:20 scaekenberghe Exp $ ;;;; ;;;; Some (internal) test on the implementatin of the XML Schema Definition ;;;; @@ -113,34 +113,6 @@ *google-adwords-ns*))) (let ((schema (get-xml-schema-definition - (wsdl-cache-get "https://adwords.google.com:443/api/adwords/v2/CampaignService?wsdl"))) - (binding '("id" - 5631435 - "name" - "Campaign #1" - "status" - "Active" - "startDate" - 3335857874 - "endDate" - 3502857599 - "dailyBudget" - 1000000 - "optInSearchNetwork" - T - "optInContentNetwork" - T - "languageTargeting" - (("languages" "en") ("languages" "nl")) - "geoTargeting" - (("countries" "BE") ("countries" "NL"))))) - (pprint (bind-type "Campaign" - binding - nil - schema - *google-adwords-ns*))) - -(let ((schema (get-xml-schema-definition (wsdl-cache-get"https://adwords.google.com:443/api/adwords/v2/TrafficEstimatorService?wsdl"))) (binding `("estimateKeywordList" ("keywordRequests" @@ -153,15 +125,6 @@ binding schema *google-adwords-ns*))) - -(let ((schema (get-xml-schema-definition - (wsdl-cache-get"https://adwords.google.com:443/api/adwords/v2/TrafficEstimatorService?wsdl"))) - (binding '("text" "flowers" "type" "Broad" "maxCpc" 50000))) - (pprint (bind-type "KeywordRequest" - binding - nil - schema - *google-adwords-ns*))) (defun test-1 () (let* ((schema (get-xml-schema-definition

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

cl-soap-cvs