[cl-soap-cvs] CVS update: cl-soap/src/wsdl.lisp cl-soap/src/xsd.lisp
Sven Van Caekenberghe
scaekenberghe at common-lisp.net
Thu Sep 22 20:37:16 UTC 2005
Update of /project/cl-soap/cvsroot/cl-soap/src
In directory common-lisp.net:/tmp/cvs-serv18906/src
Modified Files:
wsdl.lisp xsd.lisp
Log Message:
now using xsd element/type description in describe-wsdl-soap
Date: Thu Sep 22 22:37:15 2005
Author: scaekenberghe
Index: cl-soap/src/wsdl.lisp
diff -u cl-soap/src/wsdl.lisp:1.11 cl-soap/src/wsdl.lisp:1.12
--- cl-soap/src/wsdl.lisp:1.11 Thu Sep 22 17:29:59 2005
+++ cl-soap/src/wsdl.lisp Thu Sep 22 22:37:15 2005
@@ -1,6 +1,6 @@
;;;; -*- mode: lisp -*-
;;;;
-;;;; $Id: wsdl.lisp,v 1.11 2005/09/22 15:29:59 scaekenberghe Exp $
+;;;; $Id: wsdl.lisp,v 1.12 2005/09/22 20:37:15 scaekenberghe Exp $
;;;;
;;;; The basic WSDL protocol: we parse the generic and soap specific parts
;;;;
@@ -346,21 +346,33 @@
;; Describing WSDL
-(defun describe-wsdl-soap (wsdl-document-definitions)
+(defun describe-wsdl-soap-part (part xml-schema-definition &key (stream *standard-output*) style)
+ (when (equal style "rpc")
+ (format stream " Part: ~a" (get-name part)))
+ (cond ((get-type part)
+ (format stream " of type: ~a~%" (get-type part)))
+ ((get-element part)
+ (describe-xsd-element xml-schema-definition (get-element part)
+ :level 5 :stream stream))))
+
+(defun describe-wsdl-soap (wsdl-document-definitions &key (stream *standard-output*))
"Print a high-level description of the services/ports/operations in wsdl-document-definitions"
- (format t "WSDL Document Definitions~@[ named ~a~]~%" (get-name wsdl-document-definitions))
+ (format stream "WSDL Document Definitions~@[ named ~a~]~%" (get-name wsdl-document-definitions))
(loop :for service :in (get-services wsdl-document-definitions) :do
- (format t " Service: ~a~%" (get-name service))
+ (format stream " Service: ~a~%" (get-name service))
(loop :for port :in (get-ports service) :do
- (format t " Port: ~a~%" (get-name port))
- (format t " SOAP Address Location ~s~%" (get-location (get-extension port)))
+ (format stream " Port: ~a~%" (get-name port))
+ (format stream " SOAP Address Location ~s~%" (get-location (get-extension port)))
(let* ((binding-name (get-binding port))
(binding (get-binding-named wsdl-document-definitions binding-name))
+ (soap-binding (get-extension-of-class binding 'wsdl-soap-binding))
+ (style (get-style soap-binding))
(port-type-name (get-type binding))
- (port-type (get-port-type-named wsdl-document-definitions port-type-name)))
- (format t " Binding: ~a~%" binding-name)
+ (port-type (get-port-type-named wsdl-document-definitions port-type-name))
+ (xml-schema-definition (first (get-types wsdl-document-definitions))))
+ (format stream " Binding: ~a SOAP style [~a]~%" binding-name style)
(loop :for operation :in (get-operations binding) :do
- (format t " Operation: ~a~%" (get-name operation))
+ (format stream " Operation: ~a~%" (get-name operation))
(let* ((operation-details (get-operation-named port-type (get-name operation)))
(input-element (get-operation-element operation-details 'wsdl-input))
(output-element (get-operation-element operation-details 'wsdl-output))
@@ -368,14 +380,12 @@
(get-message input-element)))
(output-message (get-message-named wsdl-document-definitions
(get-message output-element))))
- (format t " Input: ~a~%" (get-name input-message))
+ (format stream " Input: ~a~%" (get-name input-message))
(loop :for part :in (get-parts input-message) :do
- (format t " Part: ~a ~@[(type ~a)~]~@[(element ~a)~]~%"
- (get-name part) (get-type part) (get-element part)))
- (format t " Output: ~a~%" (get-name output-message))
+ (describe-wsdl-soap-part part xml-schema-definition :stream stream :style style))
+ (format stream " Output: ~a~%" (get-name output-message))
(loop :for part :in (get-parts output-message) :do
- (format t " Part: ~a ~@[(type ~a)~]~@[(element ~a)~]~%"
- (get-name part) (get-type part) (get-element part))))))))
+ (describe-wsdl-soap-part part xml-schema-definition :stream stream :style style)))))))
(values))
;; Using WSDL to make structured SOAP calls
Index: cl-soap/src/xsd.lisp
diff -u cl-soap/src/xsd.lisp:1.5 cl-soap/src/xsd.lisp:1.6
--- cl-soap/src/xsd.lisp:1.5 Thu Sep 22 17:30:00 2005
+++ cl-soap/src/xsd.lisp Thu Sep 22 22:37:15 2005
@@ -1,6 +1,6 @@
;;;; -*- mode: lisp -*-
;;;;
-;;;; $Id: xsd.lisp,v 1.5 2005/09/22 15:30:00 scaekenberghe Exp $
+;;;; $Id: xsd.lisp,v 1.6 2005/09/22 20:37:15 scaekenberghe Exp $
;;;;
;;;; A partial implementation of the XML Schema Definition standard
;;;;
@@ -77,12 +77,12 @@
(xml-schema-element (make-instance 'xml-schema-element
:name name
:type type
- :min-occurs (if min-occurs (parse-integer min-occurs) 0)
+ :min-occurs (if min-occurs (parse-integer min-occurs) 1)
:max-occurs (if max-occurs
(if (equal max-occurs "unbounded")
:unbounded
(parse-integer max-occurs))
- :unbounded))))
+ 1))))
(loop :for child :in (lxml-get-children lxml) :do
(push (lxml->schema-element child)
(get-children xml-schema-element)))
@@ -185,8 +185,8 @@
;;; Describing XSD (with pre-rendering of XML)
-(defun indent (n)
- (loop :repeat n :do (write-char #\space) (write-char #\space)))
+(defun indent (n &optional (stream *standard-output*))
+ (loop :repeat n :do (write-char #\space stream) (write-char #\space stream)))
(defmethod describe-multiplicity ((xml-schema-element xml-schema-element))
(with-slots (min-occurs max-occurs)
@@ -206,7 +206,7 @@
((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 level)
+(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-name)))
(if (typep type-element 'xsd-complex-type)
@@ -214,22 +214,22 @@
(loop :for member :in members :do
(let ((member-name (get-name member))
(member-type (get-type member)))
- (indent level)
+ (indent level stream)
(if (xsd-primitive-type-name-p member-type)
- (format t " <~a>~a</~a>~a~%"
+ (format stream " <~a>~a</~a>~a~%"
member-name member-type member-name (multiplicity-suffix member))
(progn
- (format t " <~a>~%" member-name)
- (pre-render-xsd-type xml-schema-definition member-type (1+ level))
- (indent level)
- (format t " </~a>~a~%" member-name (multiplicity-suffix member)))))))
+ (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)
- (format t " ~a~%" type))
+ (indent level stream)
+ (format stream " ~a~%" type))
(error "unexpected type")))))
-(defun describe-xsd-type (xml-schema-definition type-name level)
+(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-name)))
(if (typep type-element 'xsd-complex-type)
@@ -237,66 +237,68 @@
(loop :for member :in members :do
(let ((member-name (get-name member))
(member-type (get-type member)))
- (indent level)
+ (indent level stream)
(if (xsd-primitive-type-name-p member-type)
- (format t " Member ~s of primitive type ~s [~a]~%"
+ (format stream " Member ~s of primitive type ~s [~a]~%"
member-name member-type (describe-multiplicity member))
(progn
- (format t " Member ~s [~a]~%" member-name (describe-multiplicity member))
- (describe-xsd-type xml-schema-definition member-type (1+ level)))))))
+ (format stream " Member ~s [~a]~%" member-name (describe-multiplicity member))
+ (describe-xsd-type xml-schema-definition member-type :level (1+ level) :stream stream))))))
(if (xsd-primitive-type-name-p type)
(progn
- (indent level)
- (format t " primitive type ~a~%" type))
+ (indent level stream)
+ (format stream " primitive type ~a~%" type))
(error "unexpected type")))))
-(defun describe-xsd-element (xml-schema-definition element level)
+(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-name (get-name element))
(element-type (get-element-type xml-schema-definition element-name)))
(if (xsd-primitive-type-name-p element-type)
(progn
- (indent level)
- (format t "Element ~s of primitive type ~s [~a]~%"
+ (indent level stream)
+ (format stream "Element ~s of primitive type ~s [~a]~%"
element-name element-type (describe-multiplicity element))
- (indent level)
- (format t " <~a>~a</~a>~a~%" element-name element-type element-name (multiplicity-suffix 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)))
- (indent level)
- (format t "Element ~s [~a]~%" element-name (describe-multiplicity element))
+ (indent level stream)
+ (format stream "Element ~s [~a]~%" element-name (describe-multiplicity element))
(loop :for member :in members :do
(let ((member-name (get-name member))
(member-type (get-type member)))
- (indent level)
+ (indent level stream)
(if (xsd-primitive-type-name-p member-type)
- (format t " Member ~s of primitive type ~s [~a]~%"
+ (format stream " Member ~s of primitive type ~s [~a]~%"
member-name member-type (describe-multiplicity member))
(progn
- (format t " Member ~s [~a]~%" member-name (describe-multiplicity member))
- (describe-xsd-type xml-schema-definition member-type (1+ level))))))
- (indent level)
- (format t " <~a>~%" element-name)
+ (format stream " Member ~s [~a]~%" member-name (describe-multiplicity 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)
+ (indent level stream)
(if (xsd-primitive-type-name-p member-type)
- (format t " <~a>~a</~a>~a~%"
+ (format stream " <~a>~a</~a>~a~%"
member-name member-type member-name (multiplicity-suffix member))
(progn
- (format t " <~a>~%" member-name)
- (pre-render-xsd-type xml-schema-definition member-type (1+ level))
- (indent level)
- (format t " </~a>~a~%" member-name (multiplicity-suffix member))))))
- (indent level)
- (format t " </~a>~a~%" element-name (multiplicity-suffix element))))))
+ (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)
+(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 t "XML Schema Definition with target-namespace URI ~s~%"
+ (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 1)))
+ (describe-xsd-element xml-schema-definition element :level 1 :stream stream)))
(values))
;;; Primitive Types/Values (types are keywords)
More information about the Cl-soap-cvs
mailing list