1 pjaol 1.1 #$Id: schema.tcl,v 1.3 2005/04/23 18:38:22 pjaol Exp $
  2           
  3           proc soap.schema { doc name {results} } {
  4           
  5               set root [$doc documentElement]
  6           
  7               global _schema
  8               global _result
  9           
 10               set _schema $doc
 11               set _result [dom createDocument a]
 12           
 13               set res {}
 14               set elementXSD \
 15           	[$root selectNodes \
 16           	     "/xs:schema/xs:element\[@name='$name'\]"]
 17           
 18               #grr stupid tdom returns "" rather than 0 or {}
 19               if {[string length $elementXSD] } {
 20           	set res [soap.schema.parseElements \
 21           		     $elementXSD $name $results]
 22 pjaol 1.1     } else {
 23           	error "Invalid schema node: $name"
 24               }
 25               return $res
 26           }
 27           
 28           
 29           proc soap.schema.parseElements { nodes name {results {}} } {
 30           
 31               if {[$nodes hasChildNodes]} {
 32           	foreach node [$nodes childNodes] {
 33           	    
 34           	    set nodeType [$node nodeName]
 35           	    if {$nodeType == "xs:simpleType"} {
 36           		
 37           		return [soap.schema.simpleType $nodes \
 38           			    $name \
 39           			    $results]
 40           	    } else {
 41           		
 42           		return [soap.schema.complexType $nodes\
 43 pjaol 1.1 			    $name\
 44           			    $results]
 45           	    }
 46           	}
 47               } else {
 48           	
 49           	set type ""
 50           	catch {
 51           	    set type [$node getAttribute type]
 52           	}
 53           	
 54           	if { $type == "xs:simpleType" || [soap.isNaturalType $type]} {
 55           	    return [soap.schema.simpleType $nodes $name $results]
 56           	} else {
 57           	    return [soap.schema.complexType $nodes $name $results $type]
 58           	}
 59               }
 60           }
 61           
 62           
 63           
 64 pjaol 1.1 
 65           proc soap.schema.simpleType { node name {results} } {
 66           
 67               global _result
 68               if {[$node hasChildNodes]} {
 69           	set restriction [$node getElementsByTagName xs:restriction]
 70           	set type [$restriction getAttribute base]
 71               } else {
 72           	set type [$node getAttribute type]
 73               }
 74               #could be a simpleType element from
 75               #a complexType complexContent, where local attribute name
 76               #overrides parent name, if no name use parent name
 77               catch {
 78           	set name [$node getAttribute name]
 79               } err
 80           
 81               set element [$_result createElement $name]
 82               $element setAttribute type $type
 83               $element appendFromList [list "\#text" $results]
 84               
 85 pjaol 1.1     return $element
 86           }
 87           
 88           
 89           
 90           proc soap.schema.complexType { node name {results {}} {type {}} } {
 91           
 92               if {[string length $type]} {
 93           	set nodes [$node selectNodes "/xs:complexType\[@name='$type'\]"]
 94           	return [soap.schema.complexTypeContent $nodes $name $results]
 95               }
 96               
 97               $node firstChild child
 98               return [soap.schema.complexTypeContent $child $name $results]
 99           }
100           
101           
102           
103           proc soap.schema.complexTypeContent { node name {results {}}} {
104           
105               global _result
106 pjaol 1.1     set res [$_result createElement $name]
107               set name [$node nodeName]
108           
109               if { $name == "xs:complexType" } {
110           	
111           	set content [$node firstChild]
112           	set body [$content nodeName]
113           	
114           	if {$body == "xs:sequence"} {
115           	    foreach item [$content childNodes] {
116           		set thisResult [lindex $results 0]
117           		$res appendChild \
118           		    [soap.schema.parseElements $item\
119           			    $name\
120           			 $thisResult]
121           		set results [lrange $results 1 end]
122           	    }
123           	} elseif { $body == "xs:attribute" } {
124           	    set atName [$content getAttribute name]
125           	    $res setAttribute $atName $results
126           	} elseif { $body == "xs:complexContent" } {
127 pjaol 1.1 	    soap.schema.complexContent $content $name $results
128           	}
129           	
130               }
131           
132               return $res
133           }
134           
135           
136           
137           proc soap.schema.complexContent { node name {results {}}} {
138               error "soap.schema.complexContent not implemented yet"
139           }
140           
141           
142           
143           proc soap.isNaturalType { type } {
144           
145               set valid "xs:string xs:Boolean xs:float xs:double\
146                          xs:decimal xs:binary xs:integer\
147                          xs:nonPositiveInteger xs:negativeInteger\
148 pjaol 1.1                xs:long xs:short xs:byte xs:nonNegativeInteger\
149                          xs:unsignedLong xs:unsignedInt xs:unsignedShort \
150                          xs:unsignedByte xs:positiveInteger xs:date xs:time"
151           
152               return [string match "*$type*" $valid]
153           }
154           
155           
156           proc soap.getDoc { file } {
157           
158               set fh [open $file]
159               set content [read $fh]
160               close $fh
161           
162               return [dom parse $content]
163           
164           }