Check-in [835687e82e]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix for bug [5c28604989] -- REFs in WSDL to Elements handled incorrectly.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 835687e82eb0ba88ce8c1cf64232650f5114dc40
User & Date: gerald 2012-08-15 13:13:07
Context
2012-08-26 00:16
Correction to handle expected, but missing reply headers (i.e. the SOAP Header element is missing enterly).

Also made a correction to handle a complex type that extends another type but does not add any elements or attributes. check-in: 3c5e0ef7f8 user: gerald tags: trunk

2012-08-15 13:13
Fix for bug [5c28604989] -- REFs in WSDL to Elements handled incorrectly. check-in: 835687e82e user: gerald tags: trunk
2012-08-15 03:31
Fix for bug [00485c1c92] -- request xml invalid because of double header elements added a new client side option, skipHeaderLevel check-in: fbce1cb930 user: gerald tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to Utilities.tcl.

1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
....
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
....
1389
1390
1391
1392
1393
1394
1395
1396
1397

1398
1399
1400
1401
1402
1403
1404
....
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
....
2745
2746
2747
2748
2749
2750
2751





2752
2753
2754
2755
2756
2757
2758
....
2786
2787
2788
2789
2790
2791
2792







2793

2794
2795
2796
2797
2798
2799
2800
2801
....
3196
3197
3198
3199
3200
3201
3202




3203
3204
3205
3206
3207
3208
3209
....
3226
3227
3228
3229
3230
3231
3232



3233
3234
3235
3236
3237







3238

3239







3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251

3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
....
3336
3337
3338
3339
3340
3341
3342


3343
3344
3345
3346
3347
3348
3349
....
3388
3389
3390
3391
3392
3393
3394




3395
3396
3397
3398
3399
3400
3401
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::convertTypeToDict {mode serviceName node type root} {
    variable typeInfo
    variable mutableTypeInfo
    variable options

    ::log::log debug [list ::WS::Utils::convertTypeToDict $mode $serviceName $node $type $root]
    if {[dict exists $typeInfo $mode $serviceName $type]} {
        set typeName $type
................................................................................
            }
            set typeInfo $savedTypeInfo
            continue
        }
        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"
        ##
        ## Try for fully qualified name
        ##
        ::log::log debug "Trying #1 [list $node selectNodes $partXns:$partName]"
        if {[catch {llength [set item [$node selectNodes $partXns:$partName]]} len] || ($len == 0)} {
            ::log::log debug "Trying #2 [list $node selectNodes $xns:$partName]"
................................................................................
            ::log::log debug "\t\t Found [llength $item] $partName"
        }
        set origItemList $item
        set newItemList {}
        foreach item $origItemList {
            if {[$item hasAttribute href]} {
                set oldXML [$item asXML]
                set item [GetReferenceNode $root [$item getAttribute href]]
                ::log::log debug "\t\t Replacing: $oldXML"

                ::log::log debug "\t\t With: [$item asXML]"
            }
            lappend newItemList $item
        }
        set item $newItemList
        switch -exact -- $typeInfoList {
            {0 0} {
................................................................................
                    if {$options(parseInAttr)} {
                        set rowList {}
                        foreach attr [$row attributes] {
                            if {[llength $attr] == 1} {
                                lappend rowList $attr [$row getAttribute $attr]
                            }
                        }
                        lappend rowList {} [convertTypeToDict $mode $serviceName $row $partType $root]
                        lappend tmp $rowList
                    } else {
                        lappend tmp [convertTypeToDict $mode $serviceName $row $partType $root]
                    }
                }
                dict set results $partName $tmp
            }
            default {
                ##
                ## Placed here to shut up tclchecker
................................................................................
    variable currentSchema
    variable nsList
    variable unkownRef

    ::log::log debug "Entering [info level 0]"

    set typeName $tns:[$node getAttribute name]





    set partList {}
    set nodeFound 0
    array set attrArr {}
    set comment {}
    set middleNodeList [$node childNodes]
    foreach middleNode $middleNodeList {
        set commentNodeList [$middleNode selectNodes -namespaces $nsList xs:annotation]
................................................................................
                        ## Convert the reference to the local tns space
                        ##
                        set partType  [getQualifiedType $results $partType $tns]
                        set refTypeInfo [GetServiceTypeDef $mode $serviceName $partType]
                        set refTypeInfo [dict get $refTypeInfo definition]
                        set tmpList [dict keys $refTypeInfo]
                        if {[llength $tmpList] == 1} {







                            set partName [lindex [dict keys $refTypeInfo] 0]

                            set partType [dict get $refTypeInfo $partName type]
                        }
                        lappend partList $partName [list type $partType]
                    }]} {
                        lappend unkownRef($partType) $typeName
                        return \
                            -code error \
                            -errorcode [list WS $mode UNKREF [list $typeName $partType]] \
................................................................................
    ::log::log debug "Entering [info level 0]"

    set attributeName name
    if {![$node hasAttribute $attributeName]} {
        set attributeName ref
    }
    set typeName [$node getAttribute $attributeName]




    set typeType ""
    if {[$node hasAttribute type]} {
        set typeType [getQualifiedType $results [$node getAttribute type string] $tns]
    }
    ::log::log debug "Elemental Type is $typeName"
    set partList {}
    set partType {}
................................................................................
                }
                ##
                ## Convert the reference to the local tns space
                ##
                set partType  [getQualifiedType $results $partType $tns]
                set refTypeInfo [GetServiceTypeDef $mode $serviceName $partType]
                log::log debug "looking up ref {$partType} got {$refTypeInfo}"



                if {[dict exists $refTypeInfo definition]} {
                    set refTypeInfo [dict get $refTypeInfo definition]
                }
                set tmpList [dict keys $refTypeInfo]
                if {[llength $tmpList] == 1} {







                    set partName [lindex [dict keys $refTypeInfo] 0]

                    set partType [dict get $refTypeInfo $partName type]







                }
            } msg]} {
                lappend unkownRef($partType) $typeName
                log::log error "Unknown ref {$partType,$typeName} error: {$msg} trace: $::errorInfo"
                return \
                    -code error \
                    -errorcode [list WS $mode UNKREF [list $typeName $partType]] \
                    "Unknown forward type reference {$partType} in {$typeName}"
            }
        } else {
            ::log::log debug "\t\t has no ref has {[$element attributes]}"
            set childList [$element selectNodes -namespaces $nsList xs:complexType/xs:sequence/xs:element]

            if {[llength $childList]} {
                ##
                ## Element defines another element layer
                ##
                set partName [$element getAttribute name]
                set partType $partName
                parseElementalType $mode results $serviceName $element $tns
            } else {
                set partName [$element getAttribute name]
                if {[$element hasAttribute type]} {
                    set partType [getQualifiedType $results [$element getAttribute type] $tns]
                } else {
                    set partType xs:string
                }

            }
        }
        set partMax [$element getAttribute maxOccurs -1]
        ::log::log debug "\t\t part is {$partName} {$partType} {$partMax}"

        if {[string equal $partMax -1]} {
            set partMax [[$element parent] getAttribute maxOccurs -1]
        }
        if {[string equal $partMax 1]} {
            lappend partList $partName [list type $partType comment {}]
        } else {
................................................................................
    } else {
        if {![dict exists $results types $tns:$typeName]} {
            set partList [list base string comment {} xns $tns]
            ::WS::Utils::ServiceSimpleTypeDef $mode $serviceName $tns:$typeName  $partList $tns
            dict set results simpletypes $tns:$typeName $partList
        }
    }


     ::log::log debug "\t returning"
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
................................................................................
    variable nsList

    ::log::log debug "Entering [info level 0]"

    set typeName [$node getAttribute name]
    set isList no
    ::log::log debug "Simple Type is $typeName"




    #puts "Simple Type is $typeName"
    set restrictionNode [$node selectNodes -namespaces $nsList xs:restriction]
    if {[string equal $restrictionNode {}]} {
        set restrictionNode [$node selectNodes -namespaces $nsList xs:list/xs:simpleType/xs:restriction]
    }
    if {[string equal $restrictionNode {}]} {
        set restrictionNode [$node selectNodes -namespaces $nsList xs:list]






|







 







<







 







<

>







 







|


|







 







>
>
>
>
>







 







>
>
>
>
>
>
>
|
>
|







 







>
>
>
>







 







>
>
>





>
>
>
>
>
>
>
|
>
|
>
>
>
>
>
>
>



|






|

>





|












|







 







>
>







 







>
>
>
>







1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
....
1340
1341
1342
1343
1344
1345
1346

1347
1348
1349
1350
1351
1352
1353
....
1388
1389
1390
1391
1392
1393
1394

1395
1396
1397
1398
1399
1400
1401
1402
1403
....
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
....
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
....
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
....
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
....
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
....
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
....
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::convertTypeToDict {mode serviceName node type root {isArray 0}} {
    variable typeInfo
    variable mutableTypeInfo
    variable options

    ::log::log debug [list ::WS::Utils::convertTypeToDict $mode $serviceName $node $type $root]
    if {[dict exists $typeInfo $mode $serviceName $type]} {
        set typeName $type
................................................................................
            }
            set typeInfo $savedTypeInfo
            continue
        }
        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"
        ##
        ## Try for fully qualified name
        ##
        ::log::log debug "Trying #1 [list $node selectNodes $partXns:$partName]"
        if {[catch {llength [set item [$node selectNodes $partXns:$partName]]} len] || ($len == 0)} {
            ::log::log debug "Trying #2 [list $node selectNodes $xns:$partName]"
................................................................................
            ::log::log debug "\t\t Found [llength $item] $partName"
        }
        set origItemList $item
        set newItemList {}
        foreach item $origItemList {
            if {[$item hasAttribute href]} {
                set oldXML [$item asXML]

                ::log::log debug "\t\t Replacing: $oldXML"
                set item [GetReferenceNode $root [$item getAttribute href]]
                ::log::log debug "\t\t With: [$item asXML]"
            }
            lappend newItemList $item
        }
        set item $newItemList
        switch -exact -- $typeInfoList {
            {0 0} {
................................................................................
                    if {$options(parseInAttr)} {
                        set rowList {}
                        foreach attr [$row attributes] {
                            if {[llength $attr] == 1} {
                                lappend rowList $attr [$row getAttribute $attr]
                            }
                        }
                        lappend rowList {} [convertTypeToDict $mode $serviceName $row $partType $root 1]
                        lappend tmp $rowList
                    } else {
                        lappend tmp [convertTypeToDict $mode $serviceName $row $partType $root 1]
                    }
                }
                dict set results $partName $tmp
            }
            default {
                ##
                ## Placed here to shut up tclchecker
................................................................................
    variable currentSchema
    variable nsList
    variable unkownRef

    ::log::log debug "Entering [info level 0]"

    set typeName $tns:[$node getAttribute name]
    ::log::log debug "Complex Type is $typeName"
    if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $typeName]]} {
        ::log::log debug "\t Type $typeName is already defined -- leaving"
        return
    }
    set partList {}
    set nodeFound 0
    array set attrArr {}
    set comment {}
    set middleNodeList [$node childNodes]
    foreach middleNode $middleNodeList {
        set commentNodeList [$middleNode selectNodes -namespaces $nsList xs:annotation]
................................................................................
                        ## Convert the reference to the local tns space
                        ##
                        set partType  [getQualifiedType $results $partType $tns]
                        set refTypeInfo [GetServiceTypeDef $mode $serviceName $partType]
                        set refTypeInfo [dict get $refTypeInfo definition]
                        set tmpList [dict keys $refTypeInfo]
                        if {[llength $tmpList] == 1} {
                            ##
                            ## See if the reference is to an element or a type
                            ##
                            if {![dict exists $results elements $partType]} {
                                ##
                                ## To at type, so redefine the name
                                ##
                                set partName [lindex [dict keys $refTypeInfo] 0]
                            }
                            set partType [getQualifiedType $results [dict get $refTypeInfo $partName type] $tns]
                        }
                        lappend partList $partName [list type $partType]
                    }]} {
                        lappend unkownRef($partType) $typeName
                        return \
                            -code error \
                            -errorcode [list WS $mode UNKREF [list $typeName $partType]] \
................................................................................
    ::log::log debug "Entering [info level 0]"

    set attributeName name
    if {![$node hasAttribute $attributeName]} {
        set attributeName ref
    }
    set typeName [$node getAttribute $attributeName]
    if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $tns:$typeName]]} {
        ::log::log debug "\t Type $tns:$typeName is already defined -- leaving"
        return
    }
    set typeType ""
    if {[$node hasAttribute type]} {
        set typeType [getQualifiedType $results [$node getAttribute type string] $tns]
    }
    ::log::log debug "Elemental Type is $typeName"
    set partList {}
    set partType {}
................................................................................
                }
                ##
                ## Convert the reference to the local tns space
                ##
                set partType  [getQualifiedType $results $partType $tns]
                set refTypeInfo [GetServiceTypeDef $mode $serviceName $partType]
                log::log debug "looking up ref {$partType} got {$refTypeInfo}"
                if {![llength $refTypeInfo]} {
                    error "lookup failed"
                }
                if {[dict exists $refTypeInfo definition]} {
                    set refTypeInfo [dict get $refTypeInfo definition]
                }
                set tmpList [dict keys $refTypeInfo]
                if {[llength $tmpList] == 1} {
                    ##
                    ## See if the reference is to an element or a type
                    ##
                    if {![dict exists $results elements $partType]} {
                        ##
                        ## To at type, so redefine the name
                        ##
                        set partName [lindex [dict keys $refTypeInfo] 0]
                    }
                    if {[dict exists $refTypeInfo $partName type]} {
                        set partType [getQualifiedType $results [dict get $refTypeInfo $partName type] $tns]
                    } else {
                        ##
                        ## Not a simple element, so point type to type of same name as element
                        ##
                        set partType [getQualifiedType $results $partName $tns]
                    }
                }
            } msg]} {
                lappend unkownRef($partType) $typeName
                log::log debug "Unknown ref {$partType,$typeName} error: {$msg} trace: $::errorInfo"
                return \
                    -code error \
                    -errorcode [list WS $mode UNKREF [list $typeName $partType]] \
                    "Unknown forward type reference {$partType} in {$typeName}"
            }
        } else {
            ::log::log debug "\t\t\t has no ref has {[$element attributes]}"
            set childList [$element selectNodes -namespaces $nsList xs:complexType/xs:sequence/xs:element]
            ::log::log debug "\t\t\ has no ref has [llength $childList]"
            if {[llength $childList]} {
                ##
                ## Element defines another element layer
                ##
                set partName [$element getAttribute name]
                set partType [getQualifiedType $results $partName $tns]
                parseElementalType $mode results $serviceName $element $tns
            } else {
                set partName [$element getAttribute name]
                if {[$element hasAttribute type]} {
                    set partType [getQualifiedType $results [$element getAttribute type] $tns]
                } else {
                    set partType xs:string
                }

            }
        }
        set partMax [$element getAttribute maxOccurs -1]
        ::log::log debug "\t\t\t part is {$partName} {$partType} {$partMax}"

        if {[string equal $partMax -1]} {
            set partMax [[$element parent] getAttribute maxOccurs -1]
        }
        if {[string equal $partMax 1]} {
            lappend partList $partName [list type $partType comment {}]
        } else {
................................................................................
    } else {
        if {![dict exists $results types $tns:$typeName]} {
            set partList [list base string comment {} xns $tns]
            ::WS::Utils::ServiceSimpleTypeDef $mode $serviceName $tns:$typeName  $partList $tns
            dict set results simpletypes $tns:$typeName $partList
        }
    }
    dict set results elements $tns:$typeName 1

     ::log::log debug "\t returning"
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
................................................................................
    variable nsList

    ::log::log debug "Entering [info level 0]"

    set typeName [$node getAttribute name]
    set isList no
    ::log::log debug "Simple Type is $typeName"
    if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $tns:$typeName]]} {
        ::log::log debug "\t Type $tns:$typeName is already defined -- leaving"
        return
    }
    #puts "Simple Type is $typeName"
    set restrictionNode [$node selectNodes -namespaces $nsList xs:restriction]
    if {[string equal $restrictionNode {}]} {
        set restrictionNode [$node selectNodes -namespaces $nsList xs:list/xs:simpleType/xs:restriction]
    }
    if {[string equal $restrictionNode {}]} {
        set restrictionNode [$node selectNodes -namespaces $nsList xs:list]