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

[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