1 pjaol 1.3 #$Id: schema.tcl,v 1.2 2005/04/05 01:04:04 pjaol Exp $

  2 pjaol 1.1 
  3           proc soap.schema { doc name {results} } {

  4 pjaol 1.3 

  5 pjaol 1.1     set root [$doc documentElement]

  6 pjaol 1.3 

  7 pjaol 1.1     global _schema

  8 pjaol 1.3     global _result
  9           

 10 pjaol 1.1     set _schema $doc

 11 pjaol 1.3     set _result [dom createDocument a]
 12           
 13               set res {}

 14 pjaol 1.1     set elementXSD \
 15           	[$root selectNodes \
 16           	     "/xs:schema/xs:element\[@name='$name'\]"]

 17 pjaol 1.3 
 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               } else {
 23           	error "Invalid schema node: $name"
 24               }

 25 pjaol 1.1     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           			    $name\
 44           			    $results]
 45           	    }
 46 pjaol 1.1 	}
 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           
 65           proc soap.schema.simpleType { node name {results} } {
 66           

 67 pjaol 1.3     global _result

 68 pjaol 1.1     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 pjaol 1.3     set element [$_result createElement $name]

 82 pjaol 1.1     $element setAttribute type $type
 83               $element appendFromList [list "\#text" $results]
 84               
 85               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 pjaol 1.1 proc soap.schema.complexTypeContent { node name {results {}}} {
104           

105 pjaol 1.3     global _result
106               set res [$_result createElement $name]

107 pjaol 1.1     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           	    soap.schema.complexContent $content $name $results
128 pjaol 1.1 	}
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                          xs:long xs:short xs:byte xs:nonNegativeInteger\
149 pjaol 1.1                xs:unsignedLong xs:unsignedInt xs:unsignedShort \
150                          xs:unsignedByte xs:positiveInteger xs:date xs:time"
151           
152               return [string match "*$type*" $valid]
153           }

154 pjaol 1.2 
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           }