Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Corrections on generating XML for simple types to avoid double leveling in some cases and adding name space qualifiers when it should not have. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
ef4eb377681fce65bf409394373a5c7e |
| User & Date: | gerald 2013-08-22 03:25:17 |
Context
| 2013-10-03 21:47 | Add documentation for ::WS::Utils::GenerateTemplateDict. check-in: 6d391b11b5 user: gerald tags: trunk | |
| 2013-08-22 03:25 | Corrections on generating XML for simple types to avoid double leveling in some cases and adding name space qualifiers when it should not have. check-in: ef4eb37768 user: gerald tags: trunk | |
| 2013-08-17 01:22 | Updated license files. check-in: a84ca21e46 user: gerald tags: trunk, Release_2.3.7 | |
Changes
Changes to Utilities.tcl.
55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 ... 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 .... 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 .... 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 .... 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 .... 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 .... 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 .... 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 .... 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 .... 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 .... 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 .... 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 .... 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 .... 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 .... 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 .... 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 .... 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 .... 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 .... 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 .... 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 .... 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 .... 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 .... 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 |
} } package require log package require tdom 0.8 package require struct::set package provide WS::Utils 2.3.7 namespace eval ::WS {} namespace eval ::WS::Utils { set ::WS::Utils::typeInfo {} set ::WS::Utils::currentSchema {} array set ::WS::Utils::importedXref {} ................................................................................ } ::WS::Utils::xsltSchemaDom set currentNs {} } ########################################################################### # # Public Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. # #>>BEGIN PUBLIC<< # ................................................................................ if {[lindex $typeList 1]} { dict set typeInfo maxOccurs unbounded } return $typeInfo } ########################################################################### # # Private Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. # #>>BEGIN PRIVATE<< # ................................................................................ # ------- ---------- ---------- ------------------------------------------- # 1 07/06/2006 G.Lester Initial version # # ########################################################################### proc ::WS::Utils::convertDictToType {mode service doc parent dict type {forceNs 0}} { ::log::log debug "Entering ::WS::Utils::convertDictToType $mode $service $doc $parent {$dict} $type" variable typeInfo variable simpleTypes variable options variable standardAttributes variable currentNs if {!$options(UseNS)} { ................................................................................ set typeName $type } set itemList {} if {[lindex $typeInfoList 0] && [dict exists $typeInfo $mode $service $typeName definition]} { set itemList [dict get $typeInfo $mode $service $typeName definition] set xns [dict get $typeInfo $mode $service $typeName xns] } else { set xns $simpleTypes($mode,$service,$typeName) set itemList [list $typeName {type string}] } if {[info exists mutableTypeInfo([list $mode $service $typeName])]} { set typeName [(*)[lindex mutableTypeInfo([list $mode $service $type]) 0] $mode $service $type $xns $dict] set typeInfoList [TypeInfo $mode $service $typeName] if {[lindex $typeInfoList 0]} { set itemList [dict get $typeInfo $mode $service $typeName definition] set xns [dict get $typeInfo $mode $service $typeName xns] } else { set xns $simpleTypes($mode,$service,$typeName) set itemList [list $type {type string}] } } ::log::log debug "\titemList is {$itemList} in $xns" set entryNs $currentNs if {!$forceNs} { set currentNs $xns ................................................................................ if {$options(useTypeNs) && [string equal $itemXns xs]} { set itemXns $xns } if {$options(nsOnChangeOnly) && [string equal $itemXns $currentNs]} { set itemXns {} } foreach key [dict keys $itemDef] { if {[lsearch -exact $standardAttributes $key] == -1} { lappend attrList $key [dict get $itemDef $key] ::log::log debug "key = {$key} standardAttributes = {$standardAttributes}" } } ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList} itemXns = {$itemXns} tmpInfo = {$tmpInfo} attrList = {$attrList}" set isAbstract false set baseType [string trimright $itemType ()] ................................................................................ # ------- ---------- ---------- ------------------------------------------- # 1 07/06/2006 G.Lester Initial version # # ########################################################################### proc ::WS::Utils::convertDictToTypeNoNs {mode service doc parent dict type} { ::log::log debug "Entering ::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent {$dict} $type" variable typeInfo variable simpleTypes variable options if {$options(valueAttrCompatiblityMode)} { set valueAttr {} } else { set valueAttr {::value} } set typeInfoList [TypeInfo $mode $service $type] if {[lindex $typeInfoList 0]} { set itemList [dict get $typeInfo $mode $service $type definition] set xns [dict get $typeInfo $mode $service $type xns] } else { set xns $simpleTypes($mode,$service,$type) set itemList [list $type {type string}] } ::log::log debug "\titemList is {$itemList}" foreach {itemName itemDef} $itemList { ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef}" set itemType [dict get $itemDef type] set isAbstract false ................................................................................ } set typeInfoList [TypeInfo $mode $service $itemType] if {![dict exists $dict $itemName]} { continue } set attrList {} foreach key [dict keys $itemDef] { if {[lsearch -exact $standardAttributes $key] == -1} { lappend attrList $key [dict get $itemDef $key] ::log::log debug "key = {$key} standardAttributes = {$standardAttributes}" } } ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList}" switch -exact -- $typeInfoList { {0 0} { ................................................................................ default { ## ## Placed here to shut up tclchecker ## } } } return; } ########################################################################### # # Private Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. ................................................................................ set typeInfoList [TypeInfo $mode $service $type] ::log::log debug "\t typeInfoList = {$typeInfoList}" if {[lindex $typeInfoList 0]} { set itemList [dict get $typeInfo $mode $service $type definition] set xns [dict get $typeInfo $mode $service $type xns] } else { set xns $simpleTypes($mode,$service,$type) set itemList [list $type {type string}] } if {[info exists mutableTypeInfo([list $mode $service $type])]} { set type [(*)[lindex mutableTypeInfo([list $mode $service $type]) 0] $mode $service $type $xns $dict] set typeInfoList [TypeInfo $mode $service $type] if {[lindex $typeInfoList 0]} { set itemList [dict get $typeInfo $mode $service $type definition] set xns [dict get $typeInfo $mode $service $type xns] } else { set xns $simpleTypes($mode,$service,$type) set itemList [list $type {type string}] } } ::log::log debug "\titemList is {$itemList} in $xns" foreach {itemName itemDef} $itemList { set itemType [dict get $itemList $itemName type] set typeInfoList [TypeInfo $mode $service $itemType] ................................................................................ set nodeFound 1 set partList [concat $partList $tmp] } } choice - sequence - all { set elementList [$middleNode selectNodes -namespaces $nsList xs:element] set partMax [$middleNode getAttribute maxOccurs 1] set tmp [partList $mode $middleNode $serviceName results $tns $partMax] if {[llength $tmp]} { ::log::log debug "\tadding {$tmp} to partslist" set nodeFound 1 set partList [concat $partList $tmp] } elseif {!$nodeFound} { ::WS::Utils::ServiceSimpleTypeDef $mode $serviceName $typeName [list base string comment $comment] $tns return } } complexType { $middleNode setAttribute name $typeName parseComplexType $mode results $serviceName $middleNode $tns } simpleContent - complexContent { ................................................................................ # ########################################################################### proc ::WS::Utils::partList {mode node serviceName dictVar tns {occurs {}}} { variable currentSchema variable unkownRef variable nsList variable defaultType variable options upvar 1 $dictVar results set partList {} set middle [$node localName] ::log::log debug "Entering [info level 0] -- for $middle" switch -exact -- $middle { anyAttribute - ................................................................................ all { set elementList [$node selectNodes -namespaces $nsList xs:element] set elementsFound 0 ::log::log debug "\telement list is {$elementList}" foreach element $elementList { ::log::log debug "\t\tprocessing $element ([$element nodeName])" set comment {} if {[catch { set elementsFound 1 set attrName name set isRef 0 if {![$element hasAttribute name]} { set attrName ref set isRef 1 ................................................................................ } ::log::log debug "\t\t\t part name is {$partName} type is {$partType}" } else { ## ## See if really a complex definition ## if {[$element hasChildNodes]} { set isComplex 0 foreach child [$element childNodes] { if {[string equal [$child localName] {annotation}]} { set comment [string trim [$child asText]] } else { set isComplex 1 } } if {$isComplex} { set partType $partName parseComplexType $mode results $serviceName $element $tns } else { set partType [getQualifiedType $results [$element getAttribute type string] $tns] } } else { set partType [getQualifiedType $results [$element getAttribute type string] $tns] } } ................................................................................ if {$partMax < $occurs} { set partMax $occurs } } else { set partMax [$element getAttribute maxOccurs 1] } if {$partMax <= 1} { lappend partList $partName [list type $partType comment $comment] } else { lappend partList $partName [list type [string trimright ${partType} {()}]() comment $comment] } } msg]} { ::log::log error "\tError processing {$msg} for [$element asXML]" if {$isRef} { ::log::log error "\t\t Was a reference. Additionally information is:" ::log::log error "\t\t\t part name is {$partName} type is {$partType} with {$partTypeInfo}" } ................................................................................ ServiceSimpleTypeDef $mode $serviceName $tns:$typeName $partList $tns dict set results simpletypes $tns:$typeName $partList } else { ::log::log debug "\t type already exists as $tns:$typeName" } } ########################################################################### # # Private Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. # #>>BEGIN PRIVATE<< # ................................................................................ set value [$currNode asText] set result [checkValue $mode $serviceName $baseTypeName $value] } return $result } ########################################################################### # # Private Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. # #>>BEGIN PRIVATE<< # ................................................................................ set errorCode [list WS CHECK VALUE_NOT_MATCHES_PATTERN [list $key $value $pattern $typeInfo]] set result 0 } return $result } ########################################################################### # # Private Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. # #>>BEGIN PRIVATE<< # ................................................................................ # # Version Date Programmer Comments / Changes / Reasons # ------- ---------- ---------- ------------------------------------------- # 1 07/06/2006 G.Lester Initial version # # ########################################################################### proc ::WS::Utils::_generateTemplateDict {mode serviceName type arraySize} { variable typeInfo variable mutableTypeInfo variable options variable generatedTypes ::log::log debug "Entering [info level 0]" set results {} ................................................................................ set results {<** Circular Reference **>} ::log::log debug "Leaving [info level 0] with {$results}" return $results } else { set generatedTypes([list $mode $serviceName $type]) 1 } set typeDefInfo [dict get $typeInfo $mode $serviceName $type] ::log::log debug "\t type def = {$typeDefInfo}" set xns [dict get $typeDefInfo xns] ## ## Check for mutable type ## if {[info exists mutableTypeInfo([list $mode $serviceName $type])]} { set results {<** Mutable Type **>} ::log::log debug "Leaving [info level 0] with {$results}" return $results } set partsList [dict keys [dict get $typeDefInfo definition]] ::log::log debug "\t partsList is {$partsList}" foreach partName $partsList { set partType [dict get $typeDefInfo definition $partName type] set partXns $xns catch {set partXns [dict get $typeInfo $mode $serviceName $partType xns]} set typeInfoList [TypeInfo $mode $serviceName $partType] ................................................................................ ::log::log debug "\tpartName $partName partType $partType xns $xns typeInfoList $typeInfoList" switch -exact -- $typeInfoList { {0 0} { ## ## Simple non-array ## dict set results $partName {Simple non-array} } {0 1} { ## ## Simple array ## set tmp {} for {set row 1} {$row <= $arraySize} {incr row} { ................................................................................ } dict set results $partName $tmp } {1 0} { ## ## Non-simple non-array ## dict set results $partName [_generateTemplateDict $mode $serviceName $partType $arraySize] } {1 1} { ## ## Non-simple array ## set partType [string trimright $partType {()}] set tmp [list] set isRecursive [info exists generatedTypes([list $mode $serviceName $partType])] for {set row 1} {$row <= $arraySize} {incr row} { if {$isRecursive} { lappend tmp $partName {<** Circular Reference **>} } else { unset -nocomplain -- generatedTypes([list $mode $serviceName $partType]) lappend tmp [_generateTemplateDict $mode $serviceName $partType $arraySize] } } dict set results $partName $tmp } default { ## ## Placed here to shut up tclchecker ................................................................................ } } ::log::log debug "Leaving [info level 0] with {$results}" return $results } ########################################################################### # # Private Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. # #>>BEGIN PRIVATE<< # |
| | > | > > > | > > > > > > | > > > > > | > > > | > > > > > | > > | > > > > | > > > | > > > > > | > > | | | | | > > > > > > > | | | > | > | > | | > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | > |
55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 ... 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 .... 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 .... 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 .... 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 .... 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 .... 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 .... 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 .... 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 .... 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 .... 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 .... 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 .... 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 .... 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 .... 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 .... 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 .... 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 .... 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 .... 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 .... 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 .... 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 .... 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 .... 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 |
} } package require log package require tdom 0.8 package require struct::set package provide WS::Utils 2.3.8 namespace eval ::WS {} namespace eval ::WS::Utils { set ::WS::Utils::typeInfo {} set ::WS::Utils::currentSchema {} array set ::WS::Utils::importedXref {} ................................................................................ } ::WS::Utils::xsltSchemaDom set currentNs {} } ########################################################################### # # Public Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. # #>>BEGIN PUBLIC<< # ................................................................................ if {[lindex $typeList 1]} { dict set typeInfo maxOccurs unbounded } return $typeInfo } ########################################################################### # # Private Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. # #>>BEGIN PRIVATE<< # ................................................................................ # ------- ---------- ---------- ------------------------------------------- # 1 07/06/2006 G.Lester Initial version # # ########################################################################### proc ::WS::Utils::convertDictToType {mode service doc parent dict type {forceNs 0}} { ::log::log debug "Entering ::WS::Utils::convertDictToType $mode $service $doc $parent {$dict} $type" # ::log::log debug " Parent xml: [$parent asXML]" variable typeInfo variable simpleTypes variable options variable standardAttributes variable currentNs if {!$options(UseNS)} { ................................................................................ set typeName $type } set itemList {} if {[lindex $typeInfoList 0] && [dict exists $typeInfo $mode $service $typeName definition]} { set itemList [dict get $typeInfo $mode $service $typeName definition] set xns [dict get $typeInfo $mode $service $typeName xns] } else { if {[info exists simpleTypes($mode,$service,$typeName)]} { set xns [dict get $simpleTypes($mode,$service,$typeName) xns] } elseif {[info exists simpleTypes($mode,$service,$currentNs:$typeName)]} { set xns [dict get $simpleTypes($mode,$service,$currentNs:$typeName) xns] } else { error "Simple type cannot be found: $typeName" } set itemList [list $typeName {type string}] } if {[info exists mutableTypeInfo([list $mode $service $typeName])]} { set typeName [(*)[lindex mutableTypeInfo([list $mode $service $type]) 0] $mode $service $type $xns $dict] set typeInfoList [TypeInfo $mode $service $typeName] if {[lindex $typeInfoList 0]} { set itemList [dict get $typeInfo $mode $service $typeName definition] set xns [dict get $typeInfo $mode $service $typeName xns] } else { if {[info exists simpleTypes($mode,$service,$typeName)]} { set xns [dict get $simpleTypes($mode,$service,$typeName) xns] } elseif {[info exists simpleTypes($mode,$service,$currentNs:$typeName)]} { set xns [dict get $simpleTypes($mode,$service,$currentNs:$typeName) xns] } else { error "Simple type cannot be found: $typeName" } set itemList [list $type {type string}] } } ::log::log debug "\titemList is {$itemList} in $xns" set entryNs $currentNs if {!$forceNs} { set currentNs $xns ................................................................................ if {$options(useTypeNs) && [string equal $itemXns xs]} { set itemXns $xns } if {$options(nsOnChangeOnly) && [string equal $itemXns $currentNs]} { set itemXns {} } foreach key [dict keys $itemDef] { if {[lsearch -exact $standardAttributes $key] == -1 && $key ne "isList" && $key ne "xns"} { lappend attrList $key [dict get $itemDef $key] ::log::log debug "key = {$key} standardAttributes = {$standardAttributes}" } } ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList} itemXns = {$itemXns} tmpInfo = {$tmpInfo} attrList = {$attrList}" set isAbstract false set baseType [string trimright $itemType ()] ................................................................................ # ------- ---------- ---------- ------------------------------------------- # 1 07/06/2006 G.Lester Initial version # # ########################################################################### proc ::WS::Utils::convertDictToTypeNoNs {mode service doc parent dict type} { ::log::log debug "Entering ::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent {$dict} $type" # ::log::log debug " Parent xml: [$parent asXML]" variable typeInfo variable simpleTypes variable options variable standardAttributes if {$options(valueAttrCompatiblityMode)} { set valueAttr {} } else { set valueAttr {::value} } set typeInfoList [TypeInfo $mode $service $type] if {[lindex $typeInfoList 0]} { set itemList [dict get $typeInfo $mode $service $type definition] set xns [dict get $typeInfo $mode $service $type xns] } else { if {[info exists simpleTypes($mode,$service,$type)]} { set xns [dict get $simpleTypes($mode,$service,$type) xns] } elseif {[info exists simpleTypes($mode,$service,$currentNs:$type)]} { set xns [dict get $simpleTypes($mode,$service,$currentNs:$type) xns] } else { error "Simple type cannot be found: $type" } set itemList [list $type {type string}] } ::log::log debug "\titemList is {$itemList}" foreach {itemName itemDef} $itemList { ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef}" set itemType [dict get $itemDef type] set isAbstract false ................................................................................ } set typeInfoList [TypeInfo $mode $service $itemType] if {![dict exists $dict $itemName]} { continue } set attrList {} foreach key [dict keys $itemDef] { if {[lsearch -exact $standardAttributes $key] == -1 && $key ne "isList" && $key ne "xns"} { lappend attrList $key [dict get $itemDef $key] ::log::log debug "key = {$key} standardAttributes = {$standardAttributes}" } } ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList}" switch -exact -- $typeInfoList { {0 0} { ................................................................................ default { ## ## Placed here to shut up tclchecker ## } } } # ::log::log debug "Leaving ::WS::Utils::convertDictToTypeNoNs with xml: [$parent asXML]" return; } ########################################################################### # # Private Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. ................................................................................ set typeInfoList [TypeInfo $mode $service $type] ::log::log debug "\t typeInfoList = {$typeInfoList}" if {[lindex $typeInfoList 0]} { set itemList [dict get $typeInfo $mode $service $type definition] set xns [dict get $typeInfo $mode $service $type xns] } else { if {[info exists simpleTypes($mode,$service,$type)]} { set xns [dict get $simpleTypes($mode,$service,$type) xns] } else { error "Simple type cannot be found: $type" } set itemList [list $type {type string}] } if {[info exists mutableTypeInfo([list $mode $service $type])]} { set type [(*)[lindex mutableTypeInfo([list $mode $service $type]) 0] $mode $service $type $xns $dict] set typeInfoList [TypeInfo $mode $service $type] if {[lindex $typeInfoList 0]} { set itemList [dict get $typeInfo $mode $service $type definition] set xns [dict get $typeInfo $mode $service $type xns] } else { if {[info exists simpleTypes($mode,$service,$type)]} { set xns [dict get $simpleTypes($mode,$service,$type) xns] } else { error "Simple type cannot be found: $type" } set itemList [list $type {type string}] } } ::log::log debug "\titemList is {$itemList} in $xns" foreach {itemName itemDef} $itemList { set itemType [dict get $itemList $itemName type] set typeInfoList [TypeInfo $mode $service $itemType] ................................................................................ set nodeFound 1 set partList [concat $partList $tmp] } } choice - sequence - all { # set elementList [$middleNode selectNodes -namespaces $nsList xs:element] set partMax [$middleNode getAttribute maxOccurs 1] set tmp [partList $mode $middleNode $serviceName results $tns $partMax] if {[llength $tmp]} { ::log::log debug "\tadding {$tmp} to partslist" set nodeFound 1 set partList [concat $partList $tmp] } elseif {!$nodeFound} { ::WS::Utils::ServiceSimpleTypeDef $mode $serviceName $typeName [list base string comment $comment] $tns return } # simpleType { # $middleNode setAttribute name [$node getAttribute name] # parseSimpleType $mode results $serviceName $middleNode $tns # return # } } complexType { $middleNode setAttribute name $typeName parseComplexType $mode results $serviceName $middleNode $tns } simpleContent - complexContent { ................................................................................ # ########################################################################### proc ::WS::Utils::partList {mode node serviceName dictVar tns {occurs {}}} { variable currentSchema variable unkownRef variable nsList variable defaultType variable options variable simpleTypes upvar 1 $dictVar results set partList {} set middle [$node localName] ::log::log debug "Entering [info level 0] -- for $middle" switch -exact -- $middle { anyAttribute - ................................................................................ all { set elementList [$node selectNodes -namespaces $nsList xs:element] set elementsFound 0 ::log::log debug "\telement list is {$elementList}" foreach element $elementList { ::log::log debug "\t\tprocessing $element ([$element nodeName])" set comment {} set additional_defininition_elements {} if {[catch { set elementsFound 1 set attrName name set isRef 0 if {![$element hasAttribute name]} { set attrName ref set isRef 1 ................................................................................ } ::log::log debug "\t\t\t part name is {$partName} type is {$partType}" } else { ## ## See if really a complex definition ## if {[$element hasChildNodes]} { set isComplex 0; set isSimple 0 foreach child [$element childNodes] { switch -exact -- [$child localName] { annotation {set comment [string trim [$child asText]]} simpleType {set isSimple 1} default {set isComplex 1} } } if {$isComplex} { set partType $partName parseComplexType $mode results $serviceName $element $tns } elseif {$isSimple} { set partType $partName parseComplexType $mode results $serviceName $element $tns if {[info exists simpleTypes($mode,$serviceName,$tns:$partName)]} { set additional_defininition_elements $simpleTypes($mode,$serviceName,$tns:$partName) set partType [dict get $additional_defininition_elements baseType] } } else { set partType [getQualifiedType $results [$element getAttribute type string] $tns] } } else { set partType [getQualifiedType $results [$element getAttribute type string] $tns] } } ................................................................................ if {$partMax < $occurs} { set partMax $occurs } } else { set partMax [$element getAttribute maxOccurs 1] } if {$partMax <= 1} { lappend partList $partName [concat [list type $partType comment $comment] $additional_defininition_elements] } else { lappend partList $partName [concat [list type [string trimright ${partType} {()}]() comment $comment] $additional_defininition_elements] } } msg]} { ::log::log error "\tError processing {$msg} for [$element asXML]" if {$isRef} { ::log::log error "\t\t Was a reference. Additionally information is:" ::log::log error "\t\t\t part name is {$partName} type is {$partType} with {$partTypeInfo}" } ................................................................................ ServiceSimpleTypeDef $mode $serviceName $tns:$typeName $partList $tns dict set results simpletypes $tns:$typeName $partList } else { ::log::log debug "\t type already exists as $tns:$typeName" } } ########################################################################### # # Private Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. # #>>BEGIN PRIVATE<< # ................................................................................ set value [$currNode asText] set result [checkValue $mode $serviceName $baseTypeName $value] } return $result } ########################################################################### # # Private Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. # #>>BEGIN PRIVATE<< # ................................................................................ set errorCode [list WS CHECK VALUE_NOT_MATCHES_PATTERN [list $key $value $pattern $typeInfo]] set result 0 } return $result } ########################################################################### # # Private Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. # #>>BEGIN PRIVATE<< # ................................................................................ # # Version Date Programmer Comments / Changes / Reasons # ------- ---------- ---------- ------------------------------------------- # 1 07/06/2006 G.Lester Initial version # # ########################################################################### proc ::WS::Utils::_generateTemplateDict {mode serviceName type arraySize {xns {}}} { variable typeInfo variable mutableTypeInfo variable options variable generatedTypes ::log::log debug "Entering [info level 0]" set results {} ................................................................................ set results {<** Circular Reference **>} ::log::log debug "Leaving [info level 0] with {$results}" return $results } else { set generatedTypes([list $mode $serviceName $type]) 1 } # set typeDefInfo [dict get $typeInfo $mode $serviceName $type] set typeDefInfo [GetServiceTypeDef $mode $serviceName $type] if {![llength $typeDefInfo]} { ## We failed to locate the type. try with the last known xns... set typeDefInfo [GetServiceTypeDef $mode $serviceName ${xns}:$type] } ::log::log debug "\t type def = {$typeDefInfo}" set xns [dict get $typeDefInfo xns] ## ## Check for mutable type ## if {[info exists mutableTypeInfo([list $mode $serviceName $type])]} { set results {<** Mutable Type **>} ::log::log debug "Leaving [info level 0] with {$results}" return $results } if {![dict exists $typeDefInfo definition]} { ## This is a simple type, simulate a type definition... if {![dict exists $typeDefInfo type]} { if {[dict exists $typeDefInfo baseType]} { dict set typeDefInfo type [dict get $typeDefInfo baseType] } else { dict set typeDefInfo type xs:string } } set typeDefInfo [dict create definition [dict create $type $typeDefInfo]] } set partsList [dict keys [dict get $typeDefInfo definition]] ::log::log debug "\t partsList is {$partsList}" foreach partName $partsList { set partType [dict get $typeDefInfo definition $partName type] set partXns $xns catch {set partXns [dict get $typeInfo $mode $serviceName $partType xns]} set typeInfoList [TypeInfo $mode $serviceName $partType] ................................................................................ ::log::log debug "\tpartName $partName partType $partType xns $xns typeInfoList $typeInfoList" switch -exact -- $typeInfoList { {0 0} { ## ## Simple non-array ## set msg {Simple non-array} ## Is there an enumenration? foreach attr {enumeration type comment} { if {[dict exists $typeDefInfo definition $partName $attr]} { set value [dict get $typeDefInfo definition $partName $attr] set value [string map {\{ ( \} ) \" '} $value] append msg ", $attr=\{$value\}" } } dict set results $partName $msg } {0 1} { ## ## Simple array ## set tmp {} for {set row 1} {$row <= $arraySize} {incr row} { ................................................................................ } dict set results $partName $tmp } {1 0} { ## ## Non-simple non-array ## dict set results $partName [_generateTemplateDict $mode $serviceName $partType $arraySize $xns] } {1 1} { ## ## Non-simple array ## set partType [string trimright $partType {()}] set tmp [list] set isRecursive [info exists generatedTypes([list $mode $serviceName $partType])] for {set row 1} {$row <= $arraySize} {incr row} { if {$isRecursive} { lappend tmp $partName {<** Circular Reference **>} } else { unset -nocomplain -- generatedTypes([list $mode $serviceName $partType]) lappend tmp [_generateTemplateDict $mode $serviceName $partType $arraySize $xns] } } dict set results $partName $tmp } default { ## ## Placed here to shut up tclchecker ................................................................................ } } ::log::log debug "Leaving [info level 0] with {$results}" return $results } ########################################################################### # # Private Procedure Header - as this procedure is modified, please be sure # that you update this header block. Thanks. # #>>BEGIN PRIVATE<< # |