Check-in [ef4eb37768]
Not logged in
Home Documentation Downloads Timeline Files Branches Tags Tickets Wiki Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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: ef4eb377681fce65bf409394373a5c7e735849f4
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
Hide Diffs Unified Diffs Ignore Whitespace Patch

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

Fossil 2.10 [eb804dc674] 2019-09-19 14:14:14