Check-in [ac002ddf8b]
Not logged in

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

Overview
Comment:Fix for bug [a949d84bb5] -- Schema elements of xs:any not handled correctly
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:ac002ddf8b31e07189a60b444acde880c2f52818
User & Date: gerald 2013-05-27 23:46:00
Context
2013-05-28 18:48
More fixes for bug [a949d84bb5] -- Schema elements of xs:any not handled correctly. check-in: 57d9181a02 user: gerald tags: trunk
2013-05-27 23:46
Fix for bug [a949d84bb5] -- Schema elements of xs:any not handled correctly check-in: ac002ddf8b user: gerald tags: trunk
2013-04-25 20:16
Add target namespace to client request check-in: 67ef52d7cb user: gerald tags: trunk, Release_2.3.4
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to Utilities.tcl.

1362
1363
1364
1365
1366
1367
1368

1369
1370
1371
1372
1373
1374
1375
....
1425
1426
1427
1428
1429
1430
1431

1432
1433
1434
1435
1436
1437
1438
....
1439
1440
1441
1442
1443
1444
1445



1446

1447



1448

1449
1450
1451
1452
1453
1454

1455
1456
1457
1458
1459
1460
1461
....
1465
1466
1467
1468
1469
1470
1471



1472

1473
1474



1475

1476
1477
1478
1479
1480
1481
1482
....
1749
1750
1751
1752
1753
1754
1755



1756

1757
1758
1759
1760
1761
1762
1763
....
1784
1785
1786
1787
1788
1789
1790



1791

1792
1793
1794
1795
1796
1797
1798
....
2888
2889
2890
2891
2892
2893
2894

2895
2896
2897
2898

2899
2900
2901
2902
2903
2904
2905
....
3012
3013
3014
3015
3016
3017
3018

3019
3020
3021
3022
3023
3024
3025
....
3036
3037
3038
3039
3040
3041
3042

3043



3044
3045
3046




3047
3048
3049
3050
3051
3052
3053
....
3067
3068
3069
3070
3071
3072
3073

3074
3075
3076
3077

3078




3079
3080

3081
3082
3083
3084
3085
3086
3087
3088
....
3128
3129
3130
3131
3132
3133
3134

3135
3136
3137
3138
3139
3140

3141
3142
3143
3144
3145
3146
3147
....
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
....
3270
3271
3272
3273
3274
3275
3276

3277
3278
3279
3280
3281
3282
3283
....
3323
3324
3325
3326
3327
3328
3329



3330
3331
3332
3333
3334
3335
3336
            }
            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]"
................................................................................
            set isAbstract [dict get $typeInfo $mode $serviceName $partType abstract]
        }
        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##

                if {$options(parseInAttr)} {
                    foreach attrList [$item attributes] {
                        lassign $attrList attr nsAlias nsUrl
                        if {[string equal $nsUrl $xsiNsUrl]} {
                            set attrValue [$item getAttribute ${nsAlias}:$attr]
                            dict set results $partName ::$attr $attrValue
                        } elseif {![string equal $nsAlias {}]} {
................................................................................
                            set attrValue [$item getAttribute ${nsAlias}:$attr]
                            dict set results $partName $attr $attrValue
                        } else {
                            set attrValue [$item getAttribute $attr]
                            dict set results $partName $attr $attrValue
                        }
                    }



                    dict set results $partName $valueAttr [$item asText]

                } else {



                    dict set results $partName [$item asText]

                }
            }
            {0 1} {
                ##
                ## Simple array
                ##

                set tmp {}
                foreach row $item {
                    if {$options(parseInAttr)} {
                        set rowList {}
                        foreach attrList [$row attributes] {
                            lassign $attrList attr nsAlias nsUrl
                            if {[string equal $nsUrl $xsiNsUrl]} {
................................................................................
                                set attrValue [$row getAttribute ${nsAlias}:$attr]
                                lappend rowList $attr $attrValue
                            } else {
                                set attrValue [$row getAttribute $attr]
                                lappend rowList $attr $attrValue
                            }
                        }



                        lappend rowList $valueAttr [$row asText]

                        lappend tmp $rowList
                    } else {



                        lappend tmp [$row asText]

                    }
                }
                dict set results $partName $tmp
            }
            {1 0} {
                ##
                ## Non-simple non-array
................................................................................
                        } else {
                            lappend attrList $attr [dict get $dict $useName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $useName]
                }



                $retNode appendChild [$doc createTextNode $resultValue]

                if {[llength $attrList]} {
                    ::WS::Utils::setAttr $retNode $attrList
                }
            }
            {0 1} {
                ##
                ## Simple array
................................................................................
                            } else {
                                lappend attrList $attr [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
                    }



                    $retNode appendChild [$doc createTextNode $resultValue]

                    if {[llength $attrList]} {
                        ::WS::Utils::setAttr $retNode $attrList
                    }
                }
            }
            {1 0} {
                ##
................................................................................
#
###########################################################################
proc ::WS::Utils::parseComplexType {mode dictVar serviceName node tns} {
    upvar 1 $dictVar results
    variable currentSchema
    variable nsList
    variable unkownRef


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

    set isAbstractType false

    set typeName $tns:[$node getAttribute name]
    ::log::log debug "Complex Type is $typeName"
    if {[$node hasAttribute abstract]} {
        set isAbstractType [$node getAttribute abstract]
        ::log::log debug "\t Abstract type = $isAbstractType"
    }
    #if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $typeName]]} {
................................................................................
                parseComplexType $mode results $serviceName $middleNode $tns
            }
            simpleContent -
            complexContent {
                foreach child [$middleNode childNodes] {
                    set parent [$child parent]
                    set contentType [$child localName]

                    switch -exact -- $contentType {
                        restriction {
                            set nodeFound 1
                            set restriction $child
                            set element [$child selectNodes -namespaces $nsList xs:attribute]
                            set typeInfoList [list baseType [$restriction getAttribute base]]
                            array unset attrArr
................................................................................
                            set partName item
                            set partType [getQualifiedType $results $attrArr(arrayType) $tns]
                            set partType [string map {{[]} {()}} $partType]
                            lappend partList $partName [list type [string trimright ${partType} {()}]() comment $comment allowAny 1]
                            set nodeFound 1
                        }
                        extension {

                            set tmp [partList $mode $child $serviceName results $tns]



                            if {[llength $tmp]} {
                                set nodeFound 1
                                set partList [concat $partList $tmp]




                            } else {
                                ::log:::log debug  "Unknown extension!"
                                return
                            }
                        }
                        default {
                            ##
................................................................................
                if {!$nodeFound} {
                    parseElementalType $mode results $serviceName $node $tns
                    return
                }
            }
        }
    }

    if {[llength $partList] || $isAbstractType} {
        #dict set results types $tns:$typeName $partList
        dict set results types $typeName $partList
        ::log:::log debug  "Defining $typeName"

        ::WS::Utils::ServiceTypeDef $mode $serviceName $typeName $partList $tns $isAbstractType




    } elseif {!$nodeFound} {
        #puts "Defined $typeName as simple type"

        ::WS::Utils::ServiceSimpleTypeDef $mode $serviceName $typeName [list base string comment {}] $tns
    } else {
        set xml [string trim [$node asXML]]
        return \
            -code error \
            -errorcode [list WS $mode BADCPXTYPDEF [list $typeName $xml]] \
            "Bad complex type definition for '$typeName' :: '$xml'"
    }
................................................................................
#
#
###########################################################################
proc ::WS::Utils::partList {mode node serviceName dictVar tns {occurs {}}} {
    variable currentSchema
    variable unkownRef
    variable nsList

    upvar 1 $dictVar results

    set partList {}
    set middle [$node localName]
    ::log::log debug "Entering [info level 0] -- for $middle"
    switch -exact -- $middle {

        attribute {
            ##
            ## Do Nothing
            ##
        }
        element {
            catch {
................................................................................
                            ##
                        }
                    }
                }
                set baseInfo [GetServiceTypeDef $mode $serviceName $baseName]
                ::log::log debug "\t baseInfo is {$baseInfo}"
                if {[llength $baseInfo] == 0} {
                    ::log::log debug "\t Unknown refrence '$baseName'"
                    set unkownRef($baseName) 1
                    return;
                }
                catch {set partList [concat $partList [dict get $baseInfo definition]]}
            } else {
                ::log::log debug "\t Simple type"
            }
................................................................................
                    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}"
                    }
                }
            }
            if {!$elementsFound} {

                return
            }
        }
        complexContent {
            set contentType [[$node childNodes] localName]
            switch -exact -- $contentType {
                restriction {
................................................................................
            parseSimpleType $mode results $serviceName $node $tns
            return
        }
        default {
            parseElementalType $mode results $serviceName $node $tns
            return
        }



    }
    return $partList
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure







>







 







>







 







>
>
>
|
>

>
>
>
|
>






>







 







>
>
>
|
>


>
>
>
|
>







 







>
>
>
|
>







 







>
>
>
|
>







 







>




>







 







>







 







>
|
>
>
>
|


>
>
>
>







 







>




>
|
>
>
>
>


>
|







 







>






>







 







|







 







>







 







>
>
>







1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
....
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
....
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
....
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
....
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
....
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
....
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
....
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
....
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
....
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
....
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
....
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
....
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
....
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
            }
            set typeInfo $savedTypeInfo
            continue
        }
        set partXns $xns
        catch {set partXns  [dict get $typeInfo $mode $serviceName $partType xns]}
        set typeInfoList [TypeInfo $mode $serviceName $partType]
        set tmpTypeInfo [::WS::Utils::GetServiceTypeDef $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]"
................................................................................
            set isAbstract [dict get $typeInfo $mode $serviceName $partType abstract]
        }
        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                set baseType [dict get $tmpTypeInfo base]
                if {$options(parseInAttr)} {
                    foreach attrList [$item attributes] {
                        lassign $attrList attr nsAlias nsUrl
                        if {[string equal $nsUrl $xsiNsUrl]} {
                            set attrValue [$item getAttribute ${nsAlias}:$attr]
                            dict set results $partName ::$attr $attrValue
                        } elseif {![string equal $nsAlias {}]} {
................................................................................
                            set attrValue [$item getAttribute ${nsAlias}:$attr]
                            dict set results $partName $attr $attrValue
                        } else {
                            set attrValue [$item getAttribute $attr]
                            dict set results $partName $attr $attrValue
                        }
                    }
                    if {[string equal $baseType {XML}]} {
                        dict set results $partName $valueAttr [$item asXML]
                    } else {
                        dict set results $partName $valueAttr [$item asText]
                    }
                } else {
                    if {[string equal $baseType {XML}]} {
                        dict set results $partName [$item asXML]
                    } else {
                        dict set results $partName [$item asText]
                    }
                }
            }
            {0 1} {
                ##
                ## Simple array
                ##
                set baseType [dict get $tmpTypeInfo base]
                set tmp {}
                foreach row $item {
                    if {$options(parseInAttr)} {
                        set rowList {}
                        foreach attrList [$row attributes] {
                            lassign $attrList attr nsAlias nsUrl
                            if {[string equal $nsUrl $xsiNsUrl]} {
................................................................................
                                set attrValue [$row getAttribute ${nsAlias}:$attr]
                                lappend rowList $attr $attrValue
                            } else {
                                set attrValue [$row getAttribute $attr]
                                lappend rowList $attr $attrValue
                            }
                        }
                        if {[string equal $baseType {XML}]} {
                            lappend rowList $valueAttr [$row asXML]
                        } else {
                            lappend rowList $valueAttr [$row asText]
                        }
                        lappend tmp $rowList
                    } else {
                        if {[string equal $baseType {XML}]} {
                            lappend tmp [$row asXML]
                        } else {
                            lappend tmp [$row asText]
                        }
                    }
                }
                dict set results $partName $tmp
            }
            {1 0} {
                ##
                ## Non-simple non-array
................................................................................
                        } else {
                            lappend attrList $attr [dict get $dict $useName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $useName]
                }
                if {[string equal [dict get $tmpInfo base] {XML}]} {
                    $retNode appendXML $resultValue
                } else {
                    $retNode appendChild [$doc createTextNode $resultValue]
                }
                if {[llength $attrList]} {
                    ::WS::Utils::setAttr $retNode $attrList
                }
            }
            {0 1} {
                ##
                ## Simple array
................................................................................
                            } else {
                                lappend attrList $attr [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
                    }
                    if {[string equal [dict get $tmpInfo base] {XML}]} {
                        $retNode appendXML $resultValue
                    } else {
                        $retNode appendChild [$doc createTextNode $resultValue]
                    }
                    if {[llength $attrList]} {
                        ::WS::Utils::setAttr $retNode $attrList
                    }
                }
            }
            {1 0} {
                ##
................................................................................
#
###########################################################################
proc ::WS::Utils::parseComplexType {mode dictVar serviceName node tns} {
    upvar 1 $dictVar results
    variable currentSchema
    variable nsList
    variable unkownRef
    variable defaultType

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

    set isAbstractType false
    set defaultType string
    set typeName $tns:[$node getAttribute name]
    ::log::log debug "Complex Type is $typeName"
    if {[$node hasAttribute abstract]} {
        set isAbstractType [$node getAttribute abstract]
        ::log::log debug "\t Abstract type = $isAbstractType"
    }
    #if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $typeName]]} {
................................................................................
                parseComplexType $mode results $serviceName $middleNode $tns
            }
            simpleContent -
            complexContent {
                foreach child [$middleNode childNodes] {
                    set parent [$child parent]
                    set contentType [$child localName]
                    ::log::log debug "Conent Type is {$contentType}"
                    switch -exact -- $contentType {
                        restriction {
                            set nodeFound 1
                            set restriction $child
                            set element [$child selectNodes -namespaces $nsList xs:attribute]
                            set typeInfoList [list baseType [$restriction getAttribute base]]
                            array unset attrArr
................................................................................
                            set partName item
                            set partType [getQualifiedType $results $attrArr(arrayType) $tns]
                            set partType [string map {{[]} {()}} $partType]
                            lappend partList $partName [list type [string trimright ${partType} {()}]() comment $comment allowAny 1]
                            set nodeFound 1
                        }
                        extension {
                            ::log::log debug "Calling partList for $contentType of $typeName"
                            if {[catch {set tmp [partList $mode $child $serviceName results $tns]} msg]} {
                                ::log::log debug "Error in partList {$msg}, errorInfo: $errorInfo"
                            }
                            ::log::log debug "partList for $contentType of $typeName is {$tmp}"
                            if {[llength $tmp]  && ![string equal [lindex $tmp 0] {}]} {
                                set nodeFound 1
                                set partList [concat $partList $tmp]
                            } elseif {[llength $tmp]} {
                                ##
                                ## Found extension, but it is an empty type
                                ##
                            } else {
                                ::log:::log debug  "Unknown extension!"
                                return
                            }
                        }
                        default {
                            ##
................................................................................
                if {!$nodeFound} {
                    parseElementalType $mode results $serviceName $node $tns
                    return
                }
            }
        }
    }
    ::log::log debug "at end of foreach {$typeName} with {$partList}"
    if {[llength $partList] || $isAbstractType} {
        #dict set results types $tns:$typeName $partList
        dict set results types $typeName $partList
        ::log:::log debug  "Defining $typeName"
        if {[llength $partList]  && ![string equal [lindex $partList 0] {}]} {
            ::WS::Utils::ServiceTypeDef $mode $serviceName $typeName $partList $tns $isAbstractType
        } else {
            ::WS::Utils::ServiceSimpleTypeDef $mode $serviceName $typeName [list base $defaultType comment {}] $tns
        }

    } elseif {!$nodeFound} {
        #puts "Defined $typeName as simple type"
        #::WS::Utils::ServiceTypeDef $mode $serviceName $typeName $partList $tns $isAbstractType
        ::WS::Utils::ServiceSimpleTypeDef $mode $serviceName $typeName [list base $defaultType comment {}] $tns
    } else {
        set xml [string trim [$node asXML]]
        return \
            -code error \
            -errorcode [list WS $mode BADCPXTYPDEF [list $typeName $xml]] \
            "Bad complex type definition for '$typeName' :: '$xml'"
    }
................................................................................
#
#
###########################################################################
proc ::WS::Utils::partList {mode node serviceName dictVar tns {occurs {}}} {
    variable currentSchema
    variable unkownRef
    variable nsList
    variable defaultType
    upvar 1 $dictVar results

    set partList {}
    set middle [$node localName]
    ::log::log debug "Entering [info level 0] -- for $middle"
    switch -exact -- $middle {
        anyAttribute -
        attribute {
            ##
            ## Do Nothing
            ##
        }
        element {
            catch {
................................................................................
                            ##
                        }
                    }
                }
                set baseInfo [GetServiceTypeDef $mode $serviceName $baseName]
                ::log::log debug "\t baseInfo is {$baseInfo}"
                if {[llength $baseInfo] == 0} {
                    ::log::log debug "\t Unknown reference '$baseName'"
                    set unkownRef($baseName) 1
                    return;
                }
                catch {set partList [concat $partList [dict get $baseInfo definition]]}
            } else {
                ::log::log debug "\t Simple type"
            }
................................................................................
                    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}"
                    }
                }
            }
            if {!$elementsFound} {
                set defaultType XML
                return
            }
        }
        complexContent {
            set contentType [[$node childNodes] localName]
            switch -exact -- $contentType {
                restriction {
................................................................................
            parseSimpleType $mode results $serviceName $node $tns
            return
        }
        default {
            parseElementalType $mode results $serviceName $node $tns
            return
        }
    }
    if {[llength $partList] == 0} {
        set partList {{}}
    }
    return $partList
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure