1 pjaol 1.2 # $RCSfile: $ 
  2           #    Schema engine
  3           #    using an xml schema document, pass in a node name
  4           #    and data elements, ::schema::parse generates
  5           #
  6           # Copywrite (c) Patrick O'Leary 2005
  7           #
  8           # License: released under the gnu license
  9           # This program is free software; you can redistribute it and/or
 10           # modify it under the terms of the GNU General Public License
 11           # as published by the Free Software Foundation; either version 2
 12           # of the License, or (at your option) any later version.
 13           #
 14           # This program is distributed in the hope that it will be useful,
 15           # but WITHOUT ANY WARRANTY; without even the implied warranty of
 16           # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 17           # GNU General Public License for more details.
 18           #
 19           # You should have received a copy of the GNU General Public License
 20           # along with this program; if not, write to the Free Software
 21           # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
 22 pjaol 1.2 #
 23           # $Id: schema.tcl,v 1.1 2005/04/23 18:57:01 pjaol Exp $

 24 pjaol 1.1 

 25 pjaol 1.2 package provide schema 1.0
 26           package require tdom
 27           
 28           namespace eval ::schema:: {}
 29           
 30           
 31           #
 32           proc ::schema::parse { doc name {results} } {

 33 pjaol 1.1 
 34               set root [$doc documentElement]
 35           
 36               global _schema
 37               global _result
 38           
 39               set _schema $doc
 40               set _result [dom createDocument a]
 41           
 42               set res {}
 43               set elementXSD \
 44           	[$root selectNodes \
 45           	     "/xs:schema/xs:element\[@name='$name'\]"]
 46           
 47               #grr stupid tdom returns "" rather than 0 or {}
 48               if {[string length $elementXSD] } {

 49 pjaol 1.2 	set res [::schema::parseElements \

 50 pjaol 1.1 		     $elementXSD $name $results]
 51               } else {
 52           	error "Invalid schema node: $name"
 53               }
 54               return $res
 55           }
 56           
 57           

 58 pjaol 1.2 proc ::schema::parseElements { nodes name {results {}} } {

 59 pjaol 1.1 
 60               if {[$nodes hasChildNodes]} {
 61           	foreach node [$nodes childNodes] {
 62           	    
 63           	    set nodeType [$node nodeName]
 64           	    if {$nodeType == "xs:simpleType"} {
 65           		

 66 pjaol 1.2 		return [::schema::simpleType $nodes \

 67 pjaol 1.1 			    $name \
 68           			    $results]
 69           	    } else {
 70           		

 71 pjaol 1.2 		return [::schema::complexType $nodes\

 72 pjaol 1.1 			    $name\
 73           			    $results]
 74           	    }
 75           	}
 76               } else {
 77           	
 78           	set type ""
 79           	catch {
 80           	    set type [$node getAttribute type]
 81           	}
 82           	

 83 pjaol 1.2 	if { $type == "xs:simpleType" || [::schema::isNaturalType $type]} {
 84           	    return [::schema::simpleType $nodes $name $results]

 85 pjaol 1.1 	} else {

 86 pjaol 1.2 	    return [::schema::complexType $nodes $name $results $type]

 87 pjaol 1.1 	}
 88               }
 89           }
 90           
 91           
 92           
 93           

 94 pjaol 1.2 proc ::schema::simpleType { node name {results} } {

 95 pjaol 1.1 
 96               global _result
 97               if {[$node hasChildNodes]} {
 98           	set restriction [$node getElementsByTagName xs:restriction]
 99           	set type [$restriction getAttribute base]
100               } else {
101           	set type [$node getAttribute type]
102               }
103               #could be a simpleType element from
104               #a complexType complexContent, where local attribute name
105               #overrides parent name, if no name use parent name
106               catch {
107           	set name [$node getAttribute name]
108               } err
109           
110               set element [$_result createElement $name]
111               $element setAttribute type $type
112               $element appendFromList [list "\#text" $results]
113               
114               return $element
115           }
116 pjaol 1.1 
117           
118           

119 pjaol 1.2 proc ::schema::complexType { node name {results {}} {type {}} } {

120 pjaol 1.1 
121               if {[string length $type]} {
122           	set nodes [$node selectNodes "/xs:complexType\[@name='$type'\]"]

123 pjaol 1.2 	return [::schema::complexTypeContent $nodes $name $results]

124 pjaol 1.1     }
125               
126               $node firstChild child

127 pjaol 1.2     return [::schema::complexTypeContent $child $name $results]

128 pjaol 1.1 }
129           
130           
131           

132 pjaol 1.2 proc ::schema::complexTypeContent { node name {results {}}} {

133 pjaol 1.1 
134               global _result
135               set res [$_result createElement $name]
136               set name [$node nodeName]
137           
138               if { $name == "xs:complexType" } {
139           	
140           	set content [$node firstChild]
141           	set body [$content nodeName]
142           	
143           	if {$body == "xs:sequence"} {
144           	    foreach item [$content childNodes] {
145           		set thisResult [lindex $results 0]
146           		$res appendChild \

147 pjaol 1.2 		    [::schema::parseElements $item\

148 pjaol 1.1 			    $name\
149           			 $thisResult]
150           		set results [lrange $results 1 end]
151           	    }
152           	} elseif { $body == "xs:attribute" } {
153           	    set atName [$content getAttribute name]
154           	    $res setAttribute $atName $results
155           	} elseif { $body == "xs:complexContent" } {

156 pjaol 1.2 	    ::schema::complexContent $content $name $results

157 pjaol 1.1 	}
158           	
159               }
160           
161               return $res
162           }
163           
164           
165           

166 pjaol 1.2 proc ::schema::complexContent { node name {results {}}} {

167 pjaol 1.1     error "soap.schema.complexContent not implemented yet"
168           }
169           
170           
171           

172 pjaol 1.2 proc ::schema::isNaturalType { type } {

173 pjaol 1.1 
174               set valid "xs:string xs:Boolean xs:float xs:double\
175                          xs:decimal xs:binary xs:integer\
176                          xs:nonPositiveInteger xs:negativeInteger\
177                          xs:long xs:short xs:byte xs:nonNegativeInteger\
178                          xs:unsignedLong xs:unsignedInt xs:unsignedShort \
179                          xs:unsignedByte xs:positiveInteger xs:date xs:time"
180           
181               return [string match "*$type*" $valid]
182           }
183           
184           
185           proc soap.getDoc { file } {
186           
187               set fh [open $file]
188               set content [read $fh]
189               close $fh
190           
191               return [dom parse $content]
192           
193           }