Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv22402/src

Modified Files: wsdl.lisp Log Message: renamed bind-header to bind-input-headers now using bind-element in bind-input-headers

Date: Mon Sep 26 12:52:45 2005 Author: scaekenberghe

Index: cl-soap/src/wsdl.lisp diff -u cl-soap/src/wsdl.lisp:1.16 cl-soap/src/wsdl.lisp:1.17 --- cl-soap/src/wsdl.lisp:1.16 Mon Sep 26 12:41:50 2005 +++ cl-soap/src/wsdl.lisp Mon Sep 26 12:52:45 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: wsdl.lisp,v 1.16 2005/09/26 10:41:50 scaekenberghe Exp $ +;;;; $Id: wsdl.lisp,v 1.17 2005/09/26 10:52:45 scaekenberghe Exp $ ;;;; ;;;; The basic WSDL protocol: we parse the generic and soap specific parts ;;;; @@ -421,25 +421,18 @@ (t (error "Cannot resolve input binding ~a:~a" (get-name input-message) (get-name part)))))) (nreverse actual-input-parameters)))

-(defun bind-headers (soap-input-headers headers wsdl-document-definitions) - ;; default namespace! +(defun bind-input-headers (soap-input-headers headers wsdl-document-definitions) (let ((actual-headers '())) (loop :for part :in soap-input-headers :do - (let* ((value (get-name-binding (get-name part) headers)) - (element (get-element-named wsdl-document-definitions (get-element part))) - (type (get-element-type (get-xml-schema-definition wsdl-document-definitions) - (get-name element)))) - (if value - (push `(,(intern (get-name part) :keyword) - ,(if (xsd-primitive-type-name-p type) - (lisp->xsd-primitive value (intern-xsd-type-name type)) - (error "Non-primitive header type ~a not allowed" type))) - actual-headers) - (error "No input header binding found for ~a" (get-name part))))) + (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 (bind-element element headers xml-schema-definition namespace))) + (when binding + (push binding actual-headers)))) (nreverse actual-headers)))

(defun bind-output-parts (result output-message output wsdl-document-definitions) - ;; namespaces! (declare (ignore output)) (let ((namespace (s-xml:find-namespace (get-target-namespace wsdl-document-definitions))) (result-values '())) @@ -488,7 +481,7 @@ (error "The case where input and output namespaces differ is not yet supported")) (multiple-value-bind (result headers) (soap-call soap-end-point - (bind-headers soap-input-headers headers wsdl-document-definitions) + (bind-input-headers soap-input-headers headers wsdl-document-definitions) ;; we assume there is only one parameter (first (bind-input-parts input-message input wsdl-document-definitions)) :soap-action soap-action @@ -532,14 +525,12 @@ (error "Expected <~a> element" output-wrapper)))))))

(defun wsdl-soap-input-headers (wsdl-document-definitions binding-operation-input) - (let ((soap-input-headers (get-extensions-of-class binding-operation-input 'wsdl-soap-header)) - (parts '())) - (loop :for soap-input-header :in soap-input-headers :do - (let* ((part-name (get-part soap-input-header)) - (header-message (get-message-named wsdl-document-definitions (get-message soap-input-header)))) - (push (get-part-named header-message part-name) - parts))) - (nreverse parts))) + (let ((soap-input-headers (get-extensions-of-class binding-operation-input 'wsdl-soap-header))) + (loop :for soap-input-header :in soap-input-headers + :collect (let* ((part-name (get-part soap-input-header)) + (message-name (get-message soap-input-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