[cl-soap-cvs] CVS update: cl-soap/src/soap.lisp cl-soap/src/wsdl.lisp cl-soap/src/xsd.lisp
Sven Van Caekenberghe
scaekenberghe at common-lisp.net
Mon Oct 3 09:40:50 UTC 2005
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)
More information about the Cl-soap-cvs
mailing list