1 pjaol 1.2 #$Id: schema.tcl,v 1.1.1.1 2005/01/16 00:03:32 pjaol Exp $

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

141 pjaol 1.2 
142           
143           proc soap.getDoc { file } {
144           
145               set fh [open $file]
146               set content [read $fh]
147               close $fh
148           
149               return [dom parse $content]
150           
151           }