Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv16612/src
Modified Files: namespaces.lisp xsd.lisp Log Message: added basic support for XSD complexContent combined with an extension more test code
Date: Tue Sep 27 18:25:17 2005 Author: scaekenberghe
Index: cl-soap/src/namespaces.lisp diff -u cl-soap/src/namespaces.lisp:1.7 cl-soap/src/namespaces.lisp:1.8 --- cl-soap/src/namespaces.lisp:1.7 Fri Sep 23 10:06:36 2005 +++ cl-soap/src/namespaces.lisp Tue Sep 27 18:25:17 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: namespaces.lisp,v 1.7 2005/09/23 08:06:36 scaekenberghe Exp $ +;;;; $Id: namespaces.lisp,v 1.8 2005/09/27 16:25:17 scaekenberghe Exp $ ;;;; ;;;; Definition of some standard XML namespaces commonly needed for SOAP ;;;; @@ -32,9 +32,9 @@
(defpackage :xsd (:nicknames "xsd") - (:export "schema" "element" "simpleType" "complexType" + (:export "schema" "element" "simpleType" "complexType" "complexContent" "sequence" "choice" "all" "attribute" - "restriction" "maxLength" "pattern" "list" "union" "enumeration") + "restriction" "extension" "maxLength" "pattern" "list" "union" "enumeration") (:documentation "Package for symbols in the XML Schema Definition XML Namespace"))
(defparameter *xsd-ns* (s-xml:register-namespace +xsd-ns-uri+ "xsd" :xsd)) @@ -48,7 +48,7 @@
(defpackage :xsi (:nicknames "xsi") - (:export) + (:export "null") (:documentation "Package for symbols in the XML Schema Instance XML Namespace"))
(defparameter *xsi-ns* (s-xml:register-namespace +xsi-ns-uri+ "xsi" :xsi))
Index: cl-soap/src/xsd.lisp diff -u cl-soap/src/xsd.lisp:1.15 cl-soap/src/xsd.lisp:1.16 --- cl-soap/src/xsd.lisp:1.15 Tue Sep 27 07:41:18 2005 +++ cl-soap/src/xsd.lisp Tue Sep 27 18:25:17 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: xsd.lisp,v 1.15 2005/09/27 05:41:18 scaekenberghe Exp $ +;;;; $Id: xsd.lisp,v 1.16 2005/09/27 16:25:17 scaekenberghe Exp $ ;;;; ;;;; A partial implementation of the XML Schema Definition standard ;;;; @@ -46,6 +46,9 @@ (defclass xsd-complex-type (xsd-type) ())
+(defclass xsd-complex-content (children-mixin) + ()) + (defclass xsd-compositor (children-mixin) ())
@@ -61,6 +64,9 @@ (defclass xsd-restriction () ((base :accessor get-base :initarg :base :initform nil)))
+(defclass xsd-extension (children-mixin) + ((base :accessor get-base :initarg :base :initform nil))) + (defmethod print-object ((object xsd-restriction) out) (print-unreadable-object (object out :type t :identity t) (prin1 (or (get-base object) "unknown") out))) @@ -106,11 +112,25 @@ (push (lxml->schema-element child) (get-children xsd-type))) xsd-type)) + (xsd:|complexContent| + (let* ((xsd-complex-content (make-instance 'xsd-complex-content))) + (loop :for child :in (lxml-get-children lxml) :do + (push (lxml->schema-element child) + (get-children xsd-complex-content))) + xsd-complex-content)) (xsd:|restriction| (let* ((attributes (lxml-get-attributes lxml)) (base (getf attributes :|base|)) (xsd-restriction (make-instance 'xsd-restriction :base base))) xsd-restriction)) + (xsd:|extension| + (let* ((attributes (lxml-get-attributes lxml)) + (base (getf attributes :|base|)) + (xsd-extension (make-instance 'xsd-extension :base base))) + (loop :for child :in (lxml-get-children lxml) :do + (push (lxml->schema-element child) + (get-children xsd-extension))) + xsd-extension)) (xsd:|sequence| (let ((xsd-sequence (make-instance 'xsd-sequence))) (loop :for child :in (lxml-get-children lxml) :do @@ -183,11 +203,22 @@ (get-type-in-context element (get-elements xml-schema-definition)))))
(defmethod get-members ((xsd-complex-type xsd-complex-type)) - "Return the list of members of xsd-complex-type, provided it is a sequence (for now)" + "Return the list of members of xsd-complex-type, provided it is a sequence or a complex-content (for now)" (let ((first-child (first (get-children xsd-complex-type)))) - (when (and first-child - (typep first-child 'xsd-sequence)) - (get-children first-child)))) + (cond ((and first-child (typep first-child 'xsd-sequence)) + (get-children first-child)) + ((and first-child (typep first-child 'xsd-complex-content)) + (get-members first-child))))) + +(defmethod get-members ((xsd-complex-content xsd-complex-content)) + "Return the list of members of xsd-complex-content, provided it is a base type sequence extension (for now)" + (let ((first-child (first (get-children xsd-complex-content)))) + (when (and first-child (typep first-child 'xsd-extension)) + (let ((base-members (get-members (get-base first-child))) + (first-child (first (get-children first-child)))) + (if (and first-child (typep first-child 'xsd-sequence)) + (append base-members (get-members first-child)) + base-members)))))
(defmethod get-multiplicity ((xml-schema-element xml-schema-element)) (with-slots (min-occurs max-occurs)