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 |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
ef4eb377681fce65bf409394373a5c7e |
| User & Date: | gerald 2013-08-22 03:25:17.238 |
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 |
}
}
package require log
package require tdom 0.8
package require struct::set
| | | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 |
}
}
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 {}
|
| ︙ | ︙ | |||
168 169 170 171 172 173 174 |
} ::WS::Utils::xsltSchemaDom
set currentNs {}
}
| | > | 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 |
} ::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<<
#
|
| ︙ | ︙ | |||
1257 1258 1259 1260 1261 1262 1263 |
if {[lindex $typeList 1]} {
dict set typeInfo maxOccurs unbounded
}
return $typeInfo
}
| | > | 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 |
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<<
#
|
| ︙ | ︙ | |||
1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 |
# ------- ---------- ---------- -------------------------------------------
# 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)} {
| > | 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 |
# ------- ---------- ---------- -------------------------------------------
# 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)} {
|
| ︙ | ︙ | |||
1708 1709 1710 1711 1712 1713 1714 |
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 {
| > | > > > > > > | > > > > > | 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 |
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
|
| ︙ | ︙ | |||
1756 1757 1758 1759 1760 1761 1762 |
if {$options(useTypeNs) && [string equal $itemXns xs]} {
set itemXns $xns
}
if {$options(nsOnChangeOnly) && [string equal $itemXns $currentNs]} {
set itemXns {}
}
foreach key [dict keys $itemDef] {
| | | 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 |
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 ()]
|
| ︙ | ︙ | |||
1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 |
# ------- ---------- ---------- -------------------------------------------
# 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 {
| > > > | > > > > > | | 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 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 |
# ------- ---------- ---------- -------------------------------------------
# 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 baseType [string trimright $itemType ()]
if {$options(genOutAttr) && [dict exists $typeInfo $mode $service $baseType abstract]} {
set isAbstract [dict get $typeInfo $mode $service $baseType abstract]
}
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} {
|
| ︙ | ︙ | |||
2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 |
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.
| > | 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 |
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.
|
| ︙ | ︙ | |||
2218 2219 2220 2221 2222 2223 2224 |
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 {
| > | > > > > | > > > | 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 |
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]
|
| ︙ | ︙ | |||
3048 3049 3050 3051 3052 3053 3054 |
set nodeFound 1
set partList [concat $partList $tmp]
}
}
choice -
sequence -
all {
| | > > > > > | 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 |
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 {
|
| ︙ | ︙ | |||
3202 3203 3204 3205 3206 3207 3208 |
#
###########################################################################
proc ::WS::Utils::partList {mode node serviceName dictVar tns {occurs {}}} {
variable currentSchema
variable unkownRef
variable nsList
variable defaultType
| | > | 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 |
#
###########################################################################
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 -
|
| ︙ | ︙ | |||
3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 |
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
| > | 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 |
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
|
| ︙ | ︙ | |||
3306 3307 3308 3309 3310 3311 3312 |
}
::log::log debug "\t\t\t part name is {$partName} type is {$partType}"
} else {
##
## See if really a complex definition
##
if {[$element hasChildNodes]} {
| | | | | | > > > > > > > | | | 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 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 |
}
::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 {[string length $occurs]} {
set partMax [$element getAttribute maxOccurs 1]
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}"
}
|
| ︙ | ︙ | |||
3734 3735 3736 3737 3738 3739 3740 |
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"
}
}
| | > | 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 |
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<<
#
|
| ︙ | ︙ | |||
3855 3856 3857 3858 3859 3860 3861 |
set value [$currNode asText]
set result [checkValue $mode $serviceName $baseTypeName $value]
}
return $result
}
| | > | 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 |
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<<
#
|
| ︙ | ︙ | |||
3929 3930 3931 3932 3933 3934 3935 |
set errorCode [list WS CHECK VALUE_NOT_MATCHES_PATTERN [list $key $value $pattern $typeInfo]]
set result 0
}
return $result
}
| | > | 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 |
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<<
#
|
| ︙ | ︙ | |||
4228 4229 4230 4231 4232 4233 4234 | # # Version Date Programmer Comments / Changes / Reasons # ------- ---------- ---------- ------------------------------------------- # 1 07/06/2006 G.Lester Initial version # # ########################################################################### | | | > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | > | 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 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 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 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 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 |
#
# 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 {}
##
## Check for circular reference
##
if {[info exists generatedTypes([list $mode $serviceName $type])]} {
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]
set isArray [lindex $typeInfoList end]
::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} {
lappend tmp [format {Simple array element #%d} $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<<
#
|
| ︙ | ︙ |