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)