1 pjaol 1.3 # $RCSfile: schema.tcl,v $ 

  2 pjaol 1.2 #    Schema engine
  3           #    using an xml schema document, pass in a node name
  4           #    and data elements, ::schema::parse generates
  5           #

  6 pjaol 1.3 # Copywrite (c) Patrick O'Leary 2005, pjaol@pjaol.com

  7 pjaol 1.2 #
  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           #

 23 pjaol 1.4 # $Id: schema.tcl,v 1.3 2005/04/24 02:47:32 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 pjaol 1.4     global _docNameSpace

 39 pjaol 1.1 
 40               set _schema $doc
 41               set _result [dom createDocument a]
 42           

 43 pjaol 1.4     set node [$doc documentElement]
 44               set nodeName [$node nodeName]
 45               set _docNameSpace [lindex [split $nodeName :] 0]
 46           

 47 pjaol 1.1     set res {}
 48               set elementXSD \
 49           	[$root selectNodes \

 50 pjaol 1.4 	     "/$_docNameSpace:schema/$_docNameSpace:element\[@name='$name'\]"]

 51 pjaol 1.1 
 52               #grr stupid tdom returns "" rather than 0 or {}
 53               if {[string length $elementXSD] } {

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

 55 pjaol 1.1 		     $elementXSD $name $results]
 56               } else {
 57           	error "Invalid schema node: $name"
 58               }
 59               return $res
 60           }
 61           
 62           

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

 64 pjaol 1.1 

 65 pjaol 1.4     global _docNameSpace

 66 pjaol 1.1     if {[$nodes hasChildNodes]} {
 67           	foreach node [$nodes childNodes] {
 68           	    
 69           	    set nodeType [$node nodeName]

 70 pjaol 1.4 	    if {$nodeType == "$_docNameSpace:simpleType"} {

 71 pjaol 1.1 		

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

 73 pjaol 1.1 			    $name \
 74           			    $results]
 75           	    } else {
 76           		

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

 78 pjaol 1.1 			    $name\
 79           			    $results]
 80           	    }
 81           	}
 82               } else {
 83           	
 84           	set type ""
 85           	catch {
 86           	    set type [$node getAttribute type]
 87           	}
 88           	

 89 pjaol 1.4 	if { $type == "$_docNameSpace:simpleType" || [::schema::isNaturalType $type]} {

 90 pjaol 1.2 	    return [::schema::simpleType $nodes $name $results]

 91 pjaol 1.1 	} else {

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

 93 pjaol 1.1 	}
 94               }
 95           }
 96           
 97           
 98           
 99           

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

101 pjaol 1.1 
102               global _result

103 pjaol 1.4     global _docNameSpace
104           

105 pjaol 1.1     if {[$node hasChildNodes]} {

106 pjaol 1.4 	set restriction [$node getElementsByTagName $_docNameSpace:restriction]

107 pjaol 1.1 	set type [$restriction getAttribute base]
108               } else {
109           	set type [$node getAttribute type]
110               }
111               #could be a simpleType element from
112               #a complexType complexContent, where local attribute name
113               #overrides parent name, if no name use parent name
114               catch {
115           	set name [$node getAttribute name]
116               } err
117           
118               set element [$_result createElement $name]
119               $element setAttribute type $type
120               $element appendFromList [list "\#text" $results]
121               
122               return $element
123           }
124           
125           
126           

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

128 pjaol 1.1 

129 pjaol 1.4     global _docNameSpace
130           

131 pjaol 1.1     if {[string length $type]} {

132 pjaol 1.4 	set nodes [$node selectNodes "/$_docNameSpace:complexType\[@name='$type'\]"]

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

134 pjaol 1.1     }
135               
136               $node firstChild child

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

138 pjaol 1.1 }
139           
140           
141           

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

143 pjaol 1.1 

144 pjaol 1.4     global _docNameSpace

145 pjaol 1.1     global _result
146               set res [$_result createElement $name]
147               set name [$node nodeName]
148           

149 pjaol 1.4     if { $name == "$_docNameSpace:complexType" } {

150 pjaol 1.1 	
151           	set content [$node firstChild]
152           	set body [$content nodeName]
153           	

154 pjaol 1.4 	if {$body == "$_docNameSpace:sequence"} {

155 pjaol 1.1 	    foreach item [$content childNodes] {
156           		set thisResult [lindex $results 0]
157           		$res appendChild \

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

159 pjaol 1.1 			    $name\
160           			 $thisResult]
161           		set results [lrange $results 1 end]
162           	    }

163 pjaol 1.4 	} elseif { $body == "$_docNameSpace:attribute" } {

164 pjaol 1.1 	    set atName [$content getAttribute name]
165           	    $res setAttribute $atName $results

166 pjaol 1.4 	} elseif { $body == "$_docNameSpace:complexContent" } {

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

168 pjaol 1.1 	}
169           	
170               }
171           
172               return $res
173           }
174           
175           
176           

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

178 pjaol 1.1     error "soap.schema.complexContent not implemented yet"
179           }
180           
181           
182           

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

184 pjaol 1.1 

185 pjaol 1.4     global _docNameSpace
186               set valid "$_docNameSpace:string $_docNameSpace:Boolean $_docNameSpace:float $_docNameSpace:double\
187                          $_docNameSpace:decimal $_docNameSpace:binary $_docNameSpace:integer\
188                          $_docNameSpace:nonPositiveInteger $_docNameSpace:negativeInteger\
189                          $_docNameSpace:long $_docNameSpace:short $_docNameSpace:byte $_docNameSpace:nonNegativeInteger\
190                          $_docNameSpace:unsignedLong $_docNameSpace:unsignedInt $_docNameSpace:unsignedShort \
191                          $_docNameSpace:unsignedByte $_docNameSpace:positiveInteger $_docNameSpace:date $_docNameSpace:time"

192 pjaol 1.1 
193               return [string match "*$type*" $valid]
194           }
195           
196           
197           proc soap.getDoc { file } {
198           
199               set fh [open $file]
200               set content [read $fh]
201               close $fh
202           
203               return [dom parse $content]
204           
205           }