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)