Check-in [496530e891]
Not logged in
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:Fix a interaction bug with skipLevelWhenActionPresent and nsOnChangeOnly.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | Release_2.3.3
Files: files | file ages | folders
SHA1: 496530e891eac6f68d9bf2d7a8db38d32c01dd4d
User & Date: gerald 2013-04-20 03:49:08
Context
2013-04-25 20:16
Add target namespace to client request check-in: 67ef52d7cb user: gerald tags: trunk, Release_2.3.4
2013-04-20 03:49
Fix a interaction bug with skipLevelWhenActionPresent and nsOnChangeOnly. check-in: 496530e891 user: gerald tags: trunk, Release_2.3.3
2013-04-19 21:44
Fixed bug to get qualified namespace. check-in: 7ae81cabfb user: gerald tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ClientSide.tcl.

287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
....
2145
2146
2147
2148
2149
2150
2151

2152
2153
2154
2155

2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
    variable serviceArr
    variable options

    set serviceInfo $serviceArr($serviceName)
    set validOptionList [array names options]
    lappend validOptionList location targetNamespace
    if {[lsearch -exact $validOptionList $item] == -1} {
        return -code error "Uknown option '$item'"
    }

    if {![string equal $value {}]} {
        dict set serviceInfo $item $value
        set serviceArr($serviceName) $serviceInfo
    }

................................................................................
    set typeInfo [split $msgType {:}]
    if {[llength $typeInfo] != 1} {
        set xns [lindex $typeInfo 0]
        set msgType [lindex $typeInfo 1]
    }

    if {[dict get $serviceInfo skipLevelWhenActionPresent] && [dict exists $serviceInfo operation $operationName action]} {

        set reply $bod
    } else {
        ::log::log debug "$bod appendChild \[$doc createElement $xns:$msgType reply\]"
        $bod appendChild [$doc createElement $xns:$msgType reply]

    }

    ::WS::Utils::convertDictToType Client $serviceName $doc $reply $argList $xns:$msgType

    set encoding [lindex [split [lindex [split [dict get $serviceInfo contentType] {:}] end] {=}] end]
    set xml [format {<?xml version="1.0"  encoding="%s"?>} $encoding]
    append xml "\n" [$doc asXML -indent none -doctypeDeclaration 0]
    $doc delete

    ::log::log debug "Leaving ::WS::Client::buildDocLiteralCallquery with {$xml}"






|







 







>




>


|







287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
....
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
    variable serviceArr
    variable options

    set serviceInfo $serviceArr($serviceName)
    set validOptionList [array names options]
    lappend validOptionList location targetNamespace
    if {[lsearch -exact $validOptionList $item] == -1} {
        return -code error "Uknown option '$item' -- must be one of: [join $validOptionList {, }]"
    }

    if {![string equal $value {}]} {
        dict set serviceInfo $item $value
        set serviceArr($serviceName) $serviceInfo
    }

................................................................................
    set typeInfo [split $msgType {:}]
    if {[llength $typeInfo] != 1} {
        set xns [lindex $typeInfo 0]
        set msgType [lindex $typeInfo 1]
    }

    if {[dict get $serviceInfo skipLevelWhenActionPresent] && [dict exists $serviceInfo operation $operationName action]} {
        set forceNs 1
        set reply $bod
    } else {
        ::log::log debug "$bod appendChild \[$doc createElement $xns:$msgType reply\]"
        $bod appendChild [$doc createElement $xns:$msgType reply]
        set forceNs 0
    }

    ::WS::Utils::convertDictToType Client $serviceName $doc $reply $argList $xns:$msgType $forceNs

    set encoding [lindex [split [lindex [split [dict get $serviceInfo contentType] {:}] end] {=}] end]
    set xml [format {<?xml version="1.0"  encoding="%s"?>} $encoding]
    append xml "\n" [$doc asXML -indent none -doctypeDeclaration 0]
    $doc delete

    ::log::log debug "Leaving ::WS::Client::buildDocLiteralCallquery with {$xml}"

Changes to Utilities.tcl.

1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
....
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
....
1676
1677
1678
1679
1680
1681
1682


1683

1684
1685
1686
1687
1688
1689
1690
....
1890
1891
1892
1893
1894
1895
1896

1897
1898
1899
1900
1901
1902
1903
                ::log::log debug "Trying #3 [list $node selectNodes $partName]"
                if {[catch {llength [set item [$node selectNodes $partName]]} len] || ($len == 0)} {
                    ::log::log debug "Trying #4 -- search of children"
                    set item {}
                    set matchList [list $partXns:$partName  $xns:$partName $partName]
                    foreach childNode [$node childNodes] {
                        set nodeType [$childNode nodeType]
                        ::log::log debug "\t\t Looking at [$childNode localName] ($allowAny,$isArray,$nodeType,$partName)"
                        # From SOAP1.1 Spec:
                        #    Within an array value, element names are not significant
                        # for distinguishing accessors. Elements may have any name.
                        # Here we don't need check the element name, just simple check
                        # it's a element node
                        if {$allowAny  || ($arrayOverride && [string equal $nodeType "ELEMENT_NODE"])} {
                            ::log::log debug "\t\t Found $partName [$childNode asXML]"
................................................................................
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToType {mode service doc parent dict type} {
    ::log::log debug "Entering ::WS::Utils::convertDictToType $mode $service $doc $parent {$dict} $type"
    variable typeInfo
    variable simpleTypes
    variable options
    variable standardAttributes
    variable currentNs

................................................................................
            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 currentNs $xns

    set fieldList {}
    foreach {itemName itemDef} $itemList {
        set baseName [lindex [split $itemName {:}] end]
        lappend fieldList $itemName
        set itemType [dict get $itemDef type]
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} itemType ={$itemType}"
        set typeInfoList [TypeInfo $mode $service $itemType]
................................................................................
        #if {$options(genOutAttr)} {
        #    set dictList [dict keys $dict]
        #    foreach attr [lindex [::struct::set intersect3 $fieldList $dictList] end] {
        #        $parent setAttribute $attr [dict get $dict $attr]
        #    }
        #}
    }

    ::log::log debug "Leaving ::WS::Utils::convertDictToType with xml: [$parent asXML]"
    return;
}

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






|







 







|







 







>
>
|
>







 







>







1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
....
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
....
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
....
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
                ::log::log debug "Trying #3 [list $node selectNodes $partName]"
                if {[catch {llength [set item [$node selectNodes $partName]]} len] || ($len == 0)} {
                    ::log::log debug "Trying #4 -- search of children"
                    set item {}
                    set matchList [list $partXns:$partName  $xns:$partName $partName]
                    foreach childNode [$node childNodes] {
                        set nodeType [$childNode nodeType]
                        ::log::log debug "\t\t Looking at {[$childNode localName],[$childNode nodeName]} ($allowAny,$isArray,$nodeType,$partName)"
                        # From SOAP1.1 Spec:
                        #    Within an array value, element names are not significant
                        # for distinguishing accessors. Elements may have any name.
                        # Here we don't need check the element name, just simple check
                        # it's a element node
                        if {$allowAny  || ($arrayOverride && [string equal $nodeType "ELEMENT_NODE"])} {
                            ::log::log debug "\t\t Found $partName [$childNode asXML]"
................................................................................
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       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

................................................................................
            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
    }
    set fieldList {}
    foreach {itemName itemDef} $itemList {
        set baseName [lindex [split $itemName {:}] end]
        lappend fieldList $itemName
        set itemType [dict get $itemDef type]
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} itemType ={$itemType}"
        set typeInfoList [TypeInfo $mode $service $itemType]
................................................................................
        #if {$options(genOutAttr)} {
        #    set dictList [dict keys $dict]
        #    foreach attr [lindex [::struct::set intersect3 $fieldList $dictList] end] {
        #        $parent setAttribute $attr [dict get $dict $attr]
        #    }
        #}
    }
    set currentNs $entryNs
    ::log::log debug "Leaving ::WS::Utils::convertDictToType with xml: [$parent asXML]"
    return;
}

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