October 2005 - cl-soap-cvs@common-lisp.net

[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