[cl-soap-cvs] CVS update: cl-soap/src/namespaces.lisp cl-soap/src/xsd.lisp

[Sven Van Caekenberghe]

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)