Check-in [300b2b5c3a]
Not logged in

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

Overview
Comment:Add support to translate distant namespace prefixes in attribute values or text values to local correspondances, required for abstract types. Ticket [584bfb77]: client.tcl 2.5.1, utilities.tcl 2.4.2
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug584bfb7727-abstract-type
Files: files | file ages | folders
SHA3-256:300b2b5c3a2f833f24163c89d9bc6695d4f13b0faaac6f64d8fecff3fbe1831c
User & Date: oehhar 2018-05-14 14:52:02
References
2018-05-14 15:06 Ticket [584bfb7727] WS::Client returns nonsense for abstract types status still Review with 1 other change artifact: 9e2af91732 user: oehhar
2018-05-14 15:00 Review ticket [584bfb7727]. artifact: 2d075fb725 user: oehhar
Context
2018-05-28 11:16
Add support to translate distant namespace prefixes in attribute values or text values to local correspondances, required for abstract types. Ticket [584bfb77]: client.tcl 2.5.1, utilities.tcl 2.4.2 check-in: e406ab9e21 user: oehhar tags: trunk
2018-05-14 14:52
Add support to translate distant namespace prefixes in attribute values or text values to local correspondances, required for abstract types. Ticket [584bfb77]: client.tcl 2.5.1, utilities.tcl 2.4.2 Closed-Leaf check-in: 300b2b5c3a user: oehhar tags: bug584bfb7727-abstract-type
2018-02-20 21:31
First step to parse complex abstract type in wsdl. Bug [584bfb7727] check-in: 6975d0e818 user: oehhar tags: bug584bfb7727-abstract-type
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to ClientSide.tcl.

    43     43   package require Tcl 8.4
    44     44   package require WS::Utils 2.4 ; # dict, lassign
    45     45   package require tdom 0.8
    46     46   package require http 2
    47     47   package require log
    48     48   package require uri
    49     49   
    50         -package provide WS::Client 2.5.0
           50  +package provide WS::Client 2.5.1
    51     51   
    52     52   namespace eval ::WS::Client {
    53     53       # register https only if not yet registered
    54     54       if {[catch { http::unregister https } lPortCmd]} {
    55     55           # not registered -> register on my own
    56     56           if {[catch {
    57     57               package require tls
................................................................................
   339    339           dict set serviceArr($serviceName) $item $options($item)
   340    340       }
   341    341       foreach {name value} $args {
   342    342           set name [string trimleft $name {-}]
   343    343           dict set serviceArr($serviceName) $name $value
   344    344       }
   345    345   
   346         -    ::log::log debug "Setting Target Namespace tns1 as $target"
          346  +    ::log::logsubst debug {Setting Target Namespace tns1 as $target}
   347    347       if {[dict exists $serviceArr($serviceName) xns]} {
   348    348           foreach xnsItem [dict get $serviceArr($serviceName) xns] {
   349    349               lassign $xnsItem tns xns
   350         -            ::log::log debug "Setting targetNamespace $tns for $xns"
          350  +            ::log::logsubst debug {Setting targetNamespace $tns for $xns}
   351    351               dict set serviceArr($serviceName) targetNamespace $tns $xns
   352    352           }
   353    353       }
   354    354   }
   355    355   
   356    356   ###########################################################################
   357    357   #
................................................................................
  1153   1153       }
  1154   1154       array set argument $args
  1155   1155   
  1156   1156       set first [string first {<} $wsdlXML]
  1157   1157       if {$first > 0} {
  1158   1158           set wsdlXML [string range $wsdlXML $first end]
  1159   1159       }
  1160         -    ::log::log debug [list "Parsing WSDL" $wsdlXML]
         1160  +    ::log::logsubst debug {Parsing WSDL: $wsdlXML}
  1161   1161   
  1162   1162       # save parsed document node to tmpdoc
  1163   1163       dom parse $wsdlXML tmpdoc
  1164   1164       # save transformed document handle in variable wsdlDoc
  1165   1165       $tmpdoc xslt $::WS::Utils::xsltSchemaDom wsdlDoc
  1166   1166       $tmpdoc delete
  1167   1167       # save top node in variable wsdlNode
................................................................................
  1256   1256               ## different URL
  1257   1257               ##
  1258   1258               # This may happen, if the element namespace prefix overwrites
  1259   1259               # a global one, like
  1260   1260               # <wsdl:definitions xmlns:q1="URI1" ...>
  1261   1261               #   <xs:element xmlns:q1="URI2" type="q1:MessageQ1"/>
  1262   1262               if { [dict exists $nsDict tns $ns] && $tns ne [dict get $nsDict tns $ns] } {
  1263         -                ::log::log debug "Namespace prefix '$ns' with different URI '$url': $nsDict"
         1263  +                ::log::logsubst debug {Namespace prefix '$ns' with different URI '$url': $nsDict}
  1264   1264                   return \
  1265   1265                       -code error \
  1266   1266                       -errorcode [list WS CLIENT AMBIGNSPREFIX] \
  1267   1267                       "element namespace prefix '$ns' used again for different URI '$url'.\
  1268   1268                       Sorry, this is a current implementation limitation of TCLWS."
  1269   1269               }
  1270   1270               dict set nsDict tns $ns $tns
................................................................................
  1385   1385           set inputMsgType [dict get $serviceInfo operation $operationName inputs]
  1386   1386           ## Petasis, 14 July 2008: If an input message has no elements, just do
  1387   1387           ## not add any arguments...
  1388   1388           set inputMsgTypeDefinition [::WS::Utils::GetServiceTypeDef Client $serviceName $inputMsgType]
  1389   1389           if {[dict exists $inputMsgTypeDefinition definition]} {
  1390   1390             set inputFields [dict keys [dict get $inputMsgTypeDefinition definition]]
  1391   1391            } else {
  1392         -          ::log::log debug "no definition found for inputMsgType $inputMsgType"
         1392  +          ::log::logsubst debug {no definition found for inputMsgType $inputMsgType}
  1393   1393             set inputFields {}
  1394   1394           }
  1395   1395           if {$inputFields ne {}} {
  1396   1396               lappend argList [lsort -dictionary $inputFields]
  1397   1397           }
  1398   1398           set argList [join $argList]
  1399   1399   
................................................................................
  1401   1401               set procName [lindex [info level 0] 0]
  1402   1402               set serviceName [string trim [namespace qualifiers $procName] {:}]
  1403   1403               set operationName [string trim [namespace tail $procName] {:}]
  1404   1404               set argList {}
  1405   1405               foreach var [namespace eval ::${serviceName}:: [list info args $operationName]] {
  1406   1406                   lappend argList $var [set $var]
  1407   1407               }
  1408         -            ::log::log debug [list ::WS::Client::DoCall $serviceName $operationName $argList]
         1408  +            ::log::logsubst debug {::WS::Client::DoCall $serviceName $operationName $argList}
  1409   1409               ::WS::Client::DoCall $serviceName $operationName $argList
  1410   1410           }
  1411   1411           proc $procName $argList $body
  1412   1412           append procList "\n\t[list $procName $argList]"
  1413   1413       }
  1414   1414       return "$procList\n"
  1415   1415   }
................................................................................
  1464   1464   #                                   which also follows redirects.
  1465   1465   #
  1466   1466   #
  1467   1467   ###########################################################################
  1468   1468   proc ::WS::Client::DoRawCall {serviceName operationName argList {headers {}}} {
  1469   1469       variable serviceArr
  1470   1470   
  1471         -    ::log::log debug "Entering ::WS::Client::DoRawCall {$serviceName $operationName $argList}"
         1471  +    ::log::logsubst debug {Entering [info level 0]}
  1472   1472       if {![info exists serviceArr($serviceName)]} {
  1473   1473           return \
  1474   1474               -code error \
  1475   1475               -errorcode [list WS CLIENT UNKSRV $serviceName] \
  1476   1476               "Unknown service '$serviceName'"
  1477   1477       }
  1478   1478       set serviceInfo $serviceArr($serviceName)
................................................................................
  1508   1508       
  1509   1509       if {[llength $headers]} {
  1510   1510           set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
  1511   1511       } else {
  1512   1512           set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType]]
  1513   1513       }
  1514   1514   
  1515         -    ::log::log debug "Leaving ::WS::Client::DoRawCall with {$body}"
         1515  +    ::log::logsubst debug {Leaving ::WS::Client::DoRawCall with {$body}}
  1516   1516       return $body
  1517   1517   
  1518   1518   }
  1519   1519   
  1520   1520   ###########################################################################
  1521   1521   #
  1522   1522   # Public Procedure Header - as this procedure is modified, please be sure
................................................................................
  1568   1568   #                                   redirects.
  1569   1569   #
  1570   1570   #
  1571   1571   ###########################################################################
  1572   1572   proc ::WS::Client::DoCall {serviceName operationName argList {headers {}}} {
  1573   1573       variable serviceArr
  1574   1574   
  1575         -    ::log::log debug "Entering ::WS::Client::DoCall {$serviceName $operationName $argList}"
         1575  +    ::log::logsubst debug {Entering [info level 0]}
  1576   1576       if {![info exists serviceArr($serviceName)]} {
  1577   1577           return \
  1578   1578               -code error \
  1579   1579               -errorcode [list WS CLIENT UNKSRV $serviceName] \
  1580   1580               "Unknown service '$serviceName'"
  1581   1581       }
  1582   1582       set serviceInfo $serviceArr($serviceName)
................................................................................
  1629   1629               catch {set body [$outTransform $serviceName $operationName REPLY $body]}
  1630   1630               RestoreSavedOptions $serviceName
  1631   1631           }
  1632   1632           set hadError [catch {parseResults $serviceName $operationName $body} results]
  1633   1633           if {$hadError} {
  1634   1634               lassign $::errorCode mainError subError
  1635   1635               if {$mainError eq {WSCLIENT} && $subError eq {NOSOAP}} {
  1636         -                ::log::log debug "\tHTTP error $body"
         1636  +                ::log::logsubst debug {\tHTTP error $body}
  1637   1637                   set results $body
  1638   1638                   set errorCode [list WSCLIENT HTTPERROR $body]
  1639   1639                   set errorInfo {}
  1640   1640               } else {
  1641         -                ::log::log debug "Reply was $body"
         1641  +                ::log::logsubst debug {Reply was $body}
  1642   1642                   set errorCode $::errorCode
  1643   1643                   set errorInfo $::errorInfo
  1644   1644               }
  1645   1645           }
  1646   1646       } else {
  1647   1647           if {$outTransform ne {}} {
  1648   1648               SaveAndSetOptions $serviceName
................................................................................
  1649   1649               catch {set body [$outTransform $serviceName $operationName REPLY $body]}
  1650   1650               RestoreSavedOptions $serviceName
  1651   1651           }
  1652   1652           SaveAndSetOptions $serviceName
  1653   1653           set hadError [catch {parseResults $serviceName $operationName $body} results]
  1654   1654           RestoreSavedOptions $serviceName
  1655   1655           if {$hadError} {
  1656         -            ::log::log debug "Reply was $body"
         1656  +            ::log::logsubst debug {Reply was $body}
  1657   1657               set errorCode $::errorCode
  1658   1658               set errorInfo $::errorInfo
  1659   1659           }
  1660   1660       }
  1661   1661       if {$hadError} {
  1662   1662           ::log::log debug "Leaving (error) ::WS::Client::DoCall"
  1663   1663           return \
  1664   1664               -code error \
  1665   1665               -errorcode $errorCode \
  1666   1666               -errorinfo $errorInfo \
  1667   1667               $results
  1668   1668       } else {
  1669         -        ::log::log debug "Leaving ::WS::Client::DoCall with {$results}"
         1669  +        ::log::logsubst debug {Leaving ::WS::Client::DoCall with {$results}}
  1670   1670           return $results
  1671   1671       }
  1672   1672   
  1673   1673   }
  1674   1674   
  1675   1675   ###########################################################################
  1676   1676   #
................................................................................
  1775   1775   #       1  07/06/2006  G.Lester     Initial version
  1776   1776   #
  1777   1777   #
  1778   1778   ###########################################################################
  1779   1779   proc ::WS::Client::DoAsyncCall {serviceName operationName argList succesCmd errorCmd {headers {}}} {
  1780   1780       variable serviceArr
  1781   1781   
  1782         -    ::log::log debug "Entering ::WS::Client::DoAsyncCall [list $serviceName $operationName $argList $succesCmd $errorCmd $headers]"
         1782  +    ::log::logsubst debug {Entering [info level 0]}
  1783   1783       if {![info exists serviceArr($serviceName)]} {
  1784   1784           return \
  1785   1785               -code error \
  1786   1786               -errorcode [list WS CLIENT UNKSRV $serviceName] \
  1787   1787               "Unknown service '$serviceName'"
  1788   1788       }
  1789   1789       set serviceInfo $serviceArr($serviceName)
................................................................................
  1801   1801       if {[catch {set query [buildCallquery $serviceName $operationName $url $argList]} err]} {
  1802   1802           RestoreSavedOptions $serviceName
  1803   1803           return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
  1804   1804       } else {
  1805   1805           RestoreSavedOptions $serviceName
  1806   1806       }
  1807   1807       if {[llength $headers]} {
  1808         -        ::log::log info [list \
  1809         -            ::http::geturl $url \
         1808  +        ::log::logsubst info {::http::geturl $url \
  1810   1809                   -query $query \
  1811   1810                   -type [dict get $serviceInfo contentType] \
  1812   1811                   -headers $headers \
  1813         -                -command [list ::WS::Client::asyncCallDone $serviceName $operationName $succesCmd $errorCmd] \
  1814         -        ]
         1812  +                -command [list ::WS::Client::asyncCallDone $serviceName $operationName $succesCmd $errorCmd]}
  1815   1813           ::http::geturl $url \
  1816   1814               -query $query \
  1817   1815               -type [dict get $serviceInfo contentType] \
  1818   1816               -headers $headers \
  1819   1817               -command [list ::WS::Client::asyncCallDone $serviceName $operationName $succesCmd $errorCmd]
  1820   1818       } else {
  1821         -        ::log::log info [list \
  1822         -            ::http::geturl $url \
         1819  +        ::log::logsubst info {::http::geturl $url \
  1823   1820                   -query $query \
  1824   1821                   -type [dict get $serviceInfo contentType] \
  1825         -                -command [list ::WS::Client::asyncCallDone $serviceName $operationName $succesCmd $errorCmd] \
  1826         -        ]
         1822  +                -command [list ::WS::Client::asyncCallDone $serviceName $operationName $succesCmd $errorCmd]}
  1827   1823           ::http::geturl $url \
  1828   1824               -query $query \
  1829   1825               -type [dict get $serviceInfo contentType] \
  1830   1826               -command [list ::WS::Client::asyncCallDone $serviceName $operationName $succesCmd $errorCmd]
  1831   1827       }
  1832         -    ::log::log debug "Leaving ::WS::Client::DoAsyncCall"
         1828  +    ::log::logsubst debug {Leaving ::WS::Client::DoAsyncCall}
  1833   1829       return;
  1834   1830   }
  1835   1831   
  1836   1832   ###########################################################################
  1837   1833   #
  1838   1834   # Public Procedure Header - as this procedure is modified, please be sure
  1839   1835   #                           that you update this header block. Thanks.
................................................................................
  2042   2038   # Version     Date     Programmer   Comments / Changes / Reasons
  2043   2039   # -------  ----------  ----------   -------------------------------------------
  2044   2040   #       1  07/06/2006  G.Lester     Initial version
  2045   2041   #
  2046   2042   #
  2047   2043   ###########################################################################
  2048   2044   proc ::WS::Client::asyncCallDone {serviceName operationName succesCmd errorCmd token} {
  2049         -    ::log::log debug "Entering ::WS::Client::asyncCallDone {$serviceName $operationName $succesCmd $errorCmd $token}"
         2045  +    ::log::logsubst debug {Entering [info level 0]}
  2050   2046   
  2051   2047       ##
  2052   2048       ## Check for errors
  2053   2049       ##
  2054   2050       set body [::http::data $token]
  2055         -    ::log::log info "\nReceived: $body"
         2051  +    ::log::logsubst info {\nReceived: $body}
  2056   2052       set results {}
  2057   2053       if {[::http::status $token] ne {ok} ||
  2058   2054           ( [::http::ncode $token] != 200 && $body eq {} )} {
  2059   2055           set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
  2060   2056           set hadError 1
  2061   2057           set errorInfo [FormatHTTPError $token]
  2062   2058       } else {
................................................................................
  2134   2130   # -------  ----------  ----------   -------------------------------------------
  2135   2131   #       1  07/06/2006  G.Lester     Initial version
  2136   2132   # 2.4.2    2017-08-31  H.Oehlmann   The response node name may also be the
  2137   2133   #                                   output name and not only the output type.
  2138   2134   #                                   (ticket [21f41e22bc]).
  2139   2135   # 2.4.3    2017-11-03  H.Oehlmann   Extended upper commit also to search
  2140   2136   #                                   for multiple child nodes.
  2141         -#
         2137  +# 2.5.1    2018-05-14  H.Oehlmann   Add support to translate namespace prefixes
         2138  +#                                   in attribute values or text values.
         2139  +#                                   Translation dict "xnsDistantToLocalDict" is
         2140  +#                                   passed to ::WS::Utils::convertTypeToDict
         2141  +#                                   to translate abstract types.
  2142   2142   #
  2143   2143   ###########################################################################
  2144   2144   proc ::WS::Client::parseResults {serviceName operationName inXML} {
  2145   2145       variable serviceArr
  2146   2146   
  2147         -    ::log::log debug "In parseResults $serviceName $operationName {$inXML}"
         2147  +    ::log::logsubst debug {Entering [info level 0]}
  2148   2148   
  2149   2149       set serviceInfo $serviceArr($serviceName)
  2150   2150   
  2151   2151       set expectedMsgType [dict get $serviceInfo operation $operationName outputs]
  2152   2152       set expectedMsgTypeBase [lindex [split $expectedMsgType {:}] end]
  2153   2153   
  2154   2154       set first [string first {<} $inXML]
  2155   2155       if {$first > 0} {
  2156   2156           set inXML [string range $inXML $first end]
  2157   2157       }
  2158   2158       # parse xml and save handle in variable doc and free it when out of scope
  2159   2159       dom parse $inXML doc
         2160  +
  2160   2161       # save top node handle in variable top and free it if out of scope
  2161   2162       $doc documentElement top
         2163  +
  2162   2164       set xns {
  2163   2165           ENV http://schemas.xmlsoap.org/soap/envelope/
  2164   2166           xsi "http://www.w3.org/2001/XMLSchema-instance"
  2165   2167           xs "http://www.w3.org/2001/XMLSchema"
  2166   2168       }
  2167         -    foreach tmp [dict get $serviceInfo targetNamespace] {
  2168         -        lappend xns $tmp
         2169  +    foreach {prefixCur URICur} [dict get $serviceInfo targetNamespace] {
         2170  +        lappend xns $prefixCur $URICur
  2169   2171       }
  2170         -    ::log::log debug "Using namespaces {$xns}"
         2172  +    ::log::logsubst debug {Using namespaces {$xns}}
  2171   2173       $doc selectNodesNamespaces $xns
         2174  +
         2175  +    ##
         2176  +    ## When arguments with tags are passed (example: abstract types),
         2177  +    ## the upper "selectNodesNamespaces translation must be executed manually.
         2178  +    ## Thus, we need a list of server namespace prefixes to our client namespace
         2179  +    ## prefixes. (bug 584bfb77)
         2180  +    ##
         2181  +    # Example xml:
         2182  +    # <soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
         2183  +    #   xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
         2184  +    #   xmlns:xsd="http://www.w3.org/2001/XMLSchema"
         2185  +    #   xmlns:tns="http://www.esri.com/schemas/ArcGIS/10.3">
         2186  +
         2187  +    set xnsDistantToLocalDict {}
         2188  +    foreach attributeCur [$top attributes] {
         2189  +        # attributeCur is a list of "prefix local URI",
         2190  +        # which is for xmlns tags: "prefix prefix {}".
         2191  +        set attributeCur [lindex $attributeCur 0]
         2192  +        # Check if this is a namespace prefix
         2193  +        if { ! [$top hasAttribute "xmlns:$attributeCur"] } {continue}
         2194  +        set URIServer [$top getAttribute "xmlns:$attributeCur"]
         2195  +        # Check if it is included in xns
         2196  +        foreach {prefixCur URICur} $xns {
         2197  +            if {$URIServer eq $URICur} {
         2198  +                dict set xnsDistantToLocalDict $attributeCur $prefixCur
         2199  +                break
         2200  +            }
         2201  +        }
         2202  +    }
         2203  +    ::log::logsubst debug {Server to Client prefix dict: $xnsDistantToLocalDict}
         2204  +    
         2205  +    ##
         2206  +    ## Get body tag
         2207  +    ##
  2172   2208       set body [$top selectNodes ENV:Body]
  2173   2209       if {![llength $body]} {
  2174   2210           return \
  2175   2211               -code error \
  2176   2212               -errorcode [list WS CLIENT BADREPLY $inXML] \
  2177   2213               "Bad reply type, no SOAP envelope received in: \n$inXML"
  2178   2214       }
................................................................................
  2221   2257       # This is not the case, if it was parsed with tclws prior 2.4.2
  2222   2258       # *** ToDo *** This security may be removed on a major release
  2223   2259       if {[dict exists $serviceInfo operation $operationName outputsname]} {
  2224   2260           lappend nodeNameCandidateList [dict get $serviceInfo operation $operationName outputsname]
  2225   2261       }
  2226   2262       
  2227   2263       set rootNodeList [$body childNodes]
  2228         -    ::log::log debug "Have [llength $rootNodeList] node under Body"
         2264  +    ::log::logsubst debug {Have [llength $rootNodeList] node under Body}
  2229   2265       foreach rootNodeCur $rootNodeList {
  2230   2266           set rootNameCur [$rootNodeCur localName]
  2231   2267           if {$rootNameCur eq {}} {
  2232   2268               set rootNameCur [$rootNodeCur nodeName]
  2233   2269           }
  2234   2270           if {$rootNameCur in $nodeNameCandidateList} {
  2235   2271               set rootNode $rootNodeCur
  2236   2272               set rootName $rootNameCur
  2237         -            ::log::log debug "Result root name is '$rootName'"
         2273  +            ::log::logsubst debug {Result root name is '$rootName'}
  2238   2274               break
  2239   2275           }
  2240         -        ::log::log debug "Result root name '$rootNameCur' not in candidates '$nodeNameCandidateList'"
         2276  +        ::log::logsubst debug {Result root name '$rootNameCur' not in candidates '$nodeNameCandidateList'}
  2241   2277       }
  2242   2278       ##
  2243   2279       ## Exit if there is no such node
  2244   2280       ##
  2245   2281       if {![info exists rootName]} {
  2246   2282           return \
  2247   2283               -code error \
................................................................................
  2294   2330                       continue
  2295   2331                   }
  2296   2332               }
  2297   2333   
  2298   2334               #if {[llength $outHeaderAttrs]} {
  2299   2335               #    ::WS::Utils::setAttr $node $outHeaderAttrs
  2300   2336               #}
  2301         -            ::log::log debug "Calling [list ::WS::Utils::convertTypeToDict Client $serviceName $node $outHeaderType $headerRootNode]"
  2302         -            lappend results [::WS::Utils::convertTypeToDict Client $serviceName $node $outHeaderType $headerRootNode]
         2337  +            ::log::logsubst debug {Calling convertTypeToDict from header node type '$outHeaderType'}
         2338  +            lappend results [::WS::Utils::convertTypeToDict Client $serviceName $node $outHeaderType $headerRootNode 0 $xnsDistantToLocalDict]
  2303   2339           }
  2304   2340       }
  2305         -    ::log::log debug "Calling [list ::WS::Utils::convertTypeToDict Client $serviceName $rootNode $expectedMsgType $body]"
         2341  +    ##
         2342  +    ## Call Utility function to build result list
         2343  +    ##
  2306   2344       if {$rootName ne {}} {
         2345  +        ::log::log debug "Calling convertTypeToDict with root node"
  2307   2346           set bodyData [::WS::Utils::convertTypeToDict \
  2308         -                         Client $serviceName $rootNode $expectedMsgType $body]
         2347  +                     Client $serviceName $rootNode $expectedMsgType $body 0 $xnsDistantToLocalDict]
  2309   2348           if {![llength $bodyData] && ([dict get $serviceInfo skipLevelWhenActionPresent] || [dict get $serviceInfo skipLevelOnReply])} {
  2310         -            ::log::log debug "Calling [list ::WS::Utils::convertTypeToDict Client $serviceName $rootNode $expectedMsgType $body] -- skipLevelWhenActionPresent was set"
         2349  +            ::log::log debug "Calling convertTypeToDict with skipped action level (skipLevelWhenActionPresent was set)"
  2311   2350               set bodyData [::WS::Utils::convertTypeToDict \
  2312         -                         Client $serviceName $body $expectedMsgType $body]
         2351  +                         Client $serviceName $body $expectedMsgType $body 0 $xnsDistantToLocalDict]
  2313   2352           }
  2314   2353           lappend results $bodyData
  2315   2354       }
  2316   2355       set results [join $results]
  2317   2356       $doc delete
  2318   2357       set ::errorCode {}
  2319   2358       set ::errorInfo {}
................................................................................
  2391   2430   
  2392   2431       ::WS::Utils::SetOption suppressNS $inSuppressNs
  2393   2432       set inTransform [dict get $serviceInfo inTransform]
  2394   2433       if {$inTransform ne {}} {
  2395   2434           set xml [$inTransform $serviceName $operationName REQUEST $xml $url $argList]
  2396   2435       }
  2397   2436   
  2398         -    ::log::log debug "Leaving ::WS::Client::buildCallquery with {$xml}"
         2437  +    ::log::logsubst debug {Leaving ::WS::Client::buildCallquery with {$xml}}
  2399   2438       return $xml
  2400   2439   
  2401   2440   }
  2402   2441   
  2403   2442   ###########################################################################
  2404   2443   #
  2405   2444   # Private Procedure Header - as this procedure is modified, please be sure
................................................................................
  2439   2478   #       1  07/06/2006  G.Lester     Initial version
  2440   2479   #
  2441   2480   #
  2442   2481   ###########################################################################
  2443   2482   proc ::WS::Client::buildDocLiteralCallquery {serviceName operationName url argList} {
  2444   2483       variable serviceArr
  2445   2484   
  2446         -    ::log::log debug "Entering [info level 0]"
         2485  +    ::log::logsubst debug {Entering [info level 0]}
  2447   2486       set serviceInfo $serviceArr($serviceName)
  2448   2487       set msgType [dict get $serviceInfo operation $operationName inputs]
  2449   2488       set url [dict get $serviceInfo location]
  2450   2489       set xnsList [dict get $serviceInfo targetNamespace]
  2451   2490   
  2452   2491       # save the document in variable doc and free it if out of scope
  2453   2492       dom createDocument "SOAP-ENV:Envelope" doc
................................................................................
  2522   2561           set msgType [lindex $typeInfo 1]
  2523   2562       }
  2524   2563   
  2525   2564       if {[dict get $serviceInfo skipLevelWhenActionPresent] && [dict exists $serviceInfo operation $operationName action]} {
  2526   2565           set forceNs 1
  2527   2566           set reply $bod
  2528   2567       } else {
  2529         -        ::log::log debug "$bod appendChild \[$doc createElement $xns:$msgType reply\]"
         2568  +        ::log::logsubst debug {$bod appendChild \[$doc createElement $xns:$msgType reply\]}
  2530   2569           $bod appendChild [$doc createElement $xns:$msgType reply]
  2531   2570           set forceNs 0
  2532   2571       }
  2533   2572   
  2534   2573       ::WS::Utils::convertDictToType Client $serviceName $doc $reply $argList $xns:$msgType $forceNs
  2535   2574   
  2536   2575       set encoding [lindex [split [lindex [split [dict get $serviceInfo contentType] {:}] end] {=}] end]
  2537   2576       set xml [format {<?xml version="1.0"  encoding="%s"?>} $encoding]
  2538   2577       append xml "\n" [$doc asXML -indent none -doctypeDeclaration 0]
  2539   2578       $doc delete
  2540   2579   
  2541         -    ::log::log debug "Leaving ::WS::Client::buildDocLiteralCallquery with {$xml}"
         2580  +    ::log::logsubst debug {Leaving ::WS::Client::buildDocLiteralCallquery with {$xml}}
  2542   2581   
  2543   2582       return [encoding convertto $encoding $xml]
  2544   2583   
  2545   2584   }
  2546   2585   
  2547   2586   ###########################################################################
  2548   2587   #
................................................................................
  2583   2622   #       1  07/06/2006  G.Lester     Initial version
  2584   2623   #
  2585   2624   #
  2586   2625   ###########################################################################
  2587   2626   proc ::WS::Client::buildRpcEncodedCallquery {serviceName operationName url argList} {
  2588   2627       variable serviceArr
  2589   2628   
  2590         -    ::log::log debug "Entering [info level 0]"
         2629  +    ::log::logsubst debug {Entering [info level 0]}
  2591   2630       set serviceInfo $serviceArr($serviceName)
  2592   2631       set msgType [dict get $serviceInfo operation $operationName inputs]
  2593   2632       set xnsList [dict get $serviceInfo targetNamespace]
  2594   2633   
  2595   2634       dom createDocument "SOAP-ENV:Envelope" doc
  2596   2635       $doc documentElement env
  2597   2636       $env setAttribute \
................................................................................
  2632   2671   
  2633   2672       ::WS::Utils::convertDictToEncodedType Client $serviceName $doc $reply $argList $msgType
  2634   2673   
  2635   2674       set encoding [lindex [split [lindex [split [dict get $serviceInfo contentType] {;}] end] {=}] end]
  2636   2675       set xml [format {<?xml version="1.0"  encoding="%s"?>} $encoding]
  2637   2676       append xml "\n" [$doc asXML -indent none -doctypeDeclaration 0]
  2638   2677       $doc delete
  2639         -    ::log::log debug "Leaving ::WS::Client::buildRpcEncodedCallquery with {$xml}"
         2678  +    ::log::logsubst debug {Leaving ::WS::Client::buildRpcEncodedCallquery with {$xml}}
  2640   2679   
  2641   2680       return [encoding convertto $encoding $xml]
  2642   2681   
  2643   2682   }
  2644   2683   
  2645   2684   ###########################################################################
  2646   2685   #
................................................................................
  2687   2726   #
  2688   2727   ###########################################################################
  2689   2728   proc ::WS::Client::buildServiceInfo {wsdlNode tnsDict {serviceInfo {}} {serviceAlias {}} {serviceNumber 1}} {
  2690   2729       ##
  2691   2730       ## Need to refactor to foreach service parseService
  2692   2731       ##  Service drills down to ports, which drills down to bindings and messages
  2693   2732       ##
  2694         -    ::log::log debug [list "Entering ::WS::Client::buildServiceInfo with doc" $wsdlNode]
         2733  +    ::log::logsubst debug {Entering [info level 0]}
  2695   2734   
  2696   2735       ##
  2697   2736       ## Parse Service information
  2698   2737       ##
  2699   2738       # WSDL snippet:
  2700   2739       #  <definitions ...>
  2701   2740       #    <service name="service1">
................................................................................
  2727   2766           set serviceNameList [lrange $serviceNameList $serviceNumber-1 $serviceNumber-1]
  2728   2767       }
  2729   2768   
  2730   2769       foreach serviceNode $serviceNameList {
  2731   2770           lappend serviceInfo [parseService $wsdlNode $serviceNode $serviceAlias $tnsDict]
  2732   2771       }
  2733   2772   
  2734         -    ::log::log debug [list "Leaving ::WS::Client::buildServiceInfo with" $serviceInfo]
         2773  +    ::log::logsubst debug {Leaving ::WS::Client::buildServiceInfo with $serviceInfo}
  2735   2774       return $serviceInfo
  2736   2775   }
  2737   2776   
  2738   2777   ###########################################################################
  2739   2778   #
  2740   2779   # Private Procedure Header - as this procedure is modified, please be sure
  2741   2780   #                            that you update this header block. Thanks.
................................................................................
  2776   2815   #
  2777   2816   #
  2778   2817   ###########################################################################
  2779   2818   proc ::WS::Client::parseService {wsdlNode serviceNode serviceAlias tnsDict} {
  2780   2819       variable serviceArr
  2781   2820       variable options
  2782   2821   
  2783         -    ::log::log debug "Entering [info level 0]"
         2822  +    ::log::logsubst debug {Entering [info level 0]}
  2784   2823       if {[string length $serviceAlias]} {
  2785   2824           set serviceName $serviceAlias
  2786   2825       } else {
  2787   2826           set serviceName [$serviceNode getAttribute name]
  2788   2827       }
  2789   2828       set addressNodeList [$serviceNode getElementsByTagNameNS http://schemas.xmlsoap.org/wsdl/soap/ address]
  2790   2829       if {[llength $addressNodeList] == 1} {
................................................................................
  2841   2880       foreach {key value} [dict get $serviceInfo tnsList url] {
  2842   2881           dict set serviceInfo targetNamespace $value $key
  2843   2882       }
  2844   2883       set serviceArr($serviceName) $serviceInfo
  2845   2884   
  2846   2885       set ::WS::Utils::targetNs $tmpTargetNs
  2847   2886   
  2848         -    ::log::log debug "Leaving [lindex [info level 0] 0] with $serviceInfo"
         2887  +    ::log::logsubst debug {Leaving [lindex [info level 0] 0] with $serviceInfo}
  2849   2888       return $serviceInfo
  2850   2889   }
  2851   2890   
  2852   2891   ###########################################################################
  2853   2892   #
  2854   2893   # Private Procedure Header - as this procedure is modified, please be sure
  2855   2894   #                            that you update this header block. Thanks.
................................................................................
  3440   3479   #                                   which also follows redirects.
  3441   3480   #
  3442   3481   #
  3443   3482   ###########################################################################
  3444   3483   proc ::WS::Client::DoRawRestCall {serviceName objectName operationName argList {headers {}} {location {}}} {
  3445   3484       variable serviceArr
  3446   3485   
  3447         -    ::log::log debug "Entering [info level 0]"
         3486  +    ::log::logsubst debug {Entering [info level 0]}
  3448   3487       if {![info exists serviceArr($serviceName)]} {
  3449   3488           return \
  3450   3489               -code error \
  3451   3490               -errorcode [list WS CLIENT UNKSRV $serviceName] \
  3452   3491               "Unknown service '$serviceName'"
  3453   3492       }
  3454   3493       set serviceInfo $serviceArr($serviceName)
................................................................................
  3491   3530       
  3492   3531       if {[llength $headers]} {
  3493   3532           set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
  3494   3533       } else {
  3495   3534           set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType]]
  3496   3535       }
  3497   3536   
  3498         -    ::log::log debug "Leaving ::WS::Client::DoRawRestCall with {$body}"
         3537  +    ::log::logsubst debug {Leaving ::WS::Client::DoRawRestCall with {$body}}
  3499   3538       return $body
  3500   3539   
  3501   3540   }
  3502   3541   
  3503   3542   ###########################################################################
  3504   3543   #
  3505   3544   # Public Procedure Header - as this procedure is modified, please be sure
................................................................................
  3551   3590   #                                   which also follows redirects.
  3552   3591   #
  3553   3592   #
  3554   3593   ###########################################################################
  3555   3594   proc ::WS::Client::DoRestCall {serviceName objectName operationName argList {headers {}} {location {}}} {
  3556   3595       variable serviceArr
  3557   3596   
  3558         -    ::log::log debug "Entering [info level 0]"
         3597  +    ::log::logsubst debug {Entering [info level 0]}
  3559   3598       if {![info exists serviceArr($serviceName)]} {
  3560   3599           return \
  3561   3600               -code error \
  3562   3601               -errorcode [list WS CLIENT UNKSRV $serviceName] \
  3563   3602               "Unknown service '$serviceName'"
  3564   3603       }
  3565   3604       set serviceInfo $serviceArr($serviceName)
................................................................................
  3614   3653           parseRestResults $serviceName $objectName $operationName $body
  3615   3654       } results]} {
  3616   3655           RestoreSavedOptions $serviceName
  3617   3656           ::log::log debug "Leaving (error) ::WS::Client::DoRestCall"
  3618   3657           return -code error $results
  3619   3658       }
  3620   3659       RestoreSavedOptions $serviceName
  3621         -    ::log::log debug "Leaving ::WS::Client::DoRestCall with {$results}"
         3660  +    ::log::logsubst debug {Leaving ::WS::Client::DoRestCall with {$results}}
  3622   3661       return $results
  3623   3662   
  3624   3663   }
  3625   3664   
  3626   3665   ###########################################################################
  3627   3666   #
  3628   3667   # Public Procedure Header - as this procedure is modified, please be sure
................................................................................
  3681   3720   proc ::WS::Client::DoRestAsyncCall {serviceName objectName operationName argList succesCmd errorCmd {headers {}}} {
  3682   3721       variable serviceArr
  3683   3722   
  3684   3723       set svcHeaders [dict get $serviceArr($serviceName) headers]
  3685   3724       if {[llength $svcHeaders]} {
  3686   3725           set headers [concat $headers $svcHeaders]
  3687   3726       }
  3688         -    ::log::log debug "Entering ::WS::Client::DoAsyncRestCall [list $serviceName $objectName $operationName $argList $succesCmd $errorCmd $headers]"
         3727  +    ::log::logsubst debug {Entering [info level 0]}
  3689   3728       if {![info exists serviceArr($serviceName)]} {
  3690   3729           return \
  3691   3730               -code error \
  3692   3731               -errorcode [list WS CLIENT UNKSRV $serviceName] \
  3693   3732               "Unknown service '$serviceName'"
  3694   3733       }
  3695   3734       set serviceInfo $serviceArr($serviceName)
................................................................................
  3707   3746       if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} {
  3708   3747           RestoreSavedOptions $serviceName
  3709   3748           return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
  3710   3749       } else {
  3711   3750           RestoreSavedOptions $serviceName
  3712   3751       }
  3713   3752       if {[llength $headers]} {
  3714         -        ::log::log info [list \
  3715         -            ::http::geturl $url \
         3753  +        ::log::logsubst info {::http::geturl $url \
  3716   3754                   -query $query \
  3717   3755                   -type [dict get $serviceInfo contentType] \
  3718   3756                   -headers $headers \
  3719         -                -command [list ::WS::Client::asyncRestCallDone $serviceName $operationName $succesCmd $errorCmd] \
  3720         -        ]
         3757  +                -command [list ::WS::Client::asyncRestCallDone $serviceName $operationName $succesCmd $errorCmd]}
  3721   3758           ::http::geturl $url \
  3722   3759               -query $query \
  3723   3760               -type [dict get $serviceInfo contentType] \
  3724   3761               -headers $headers \
  3725   3762               -command [list ::WS::Client::asyncRestCallDone $serviceName $operationName $succesCmd $errorCmd]
  3726   3763       } else {
  3727         -        ::log::log info [list \
  3728         -            ::http::geturl $url \
         3764  +        ::log::logsubst info {::http::geturl $url \
  3729   3765                   -query $query \
  3730   3766                   -type [dict get $serviceInfo contentType] \
  3731         -                -command [list ::WS::Client::asyncRestCallDone $serviceName $operationName $succesCmd $errorCmd] \
  3732         -        ]
         3767  +                -command [list ::WS::Client::asyncRestCallDone $serviceName $operationName $succesCmd $errorCmd]}
  3733   3768           ::http::geturl $url \
  3734   3769               -query $query \
  3735   3770               -type [dict get $serviceInfo contentType] \
  3736   3771               -command [list ::WS::Client::asyncRestCallDone $serviceName $operationName $succesCmd $errorCmd]
  3737   3772       }
  3738   3773       ::log::log debug "Leaving ::WS::Client::DoAsyncRestCall"
  3739   3774       return;
................................................................................
  3778   3813   #       1  07/06/2006  G.Lester     Initial version
  3779   3814   #
  3780   3815   #
  3781   3816   ###########################################################################
  3782   3817   proc ::WS::Client::buildRestCallquery {serviceName objectName operationName url argList} {
  3783   3818       variable serviceArr
  3784   3819   
  3785         -    ::log::log debug "Entering [info level 0]"
         3820  +    ::log::logsubst debug {Entering [info level 0]}
  3786   3821       set serviceInfo $serviceArr($serviceName)
  3787   3822       set msgType [dict get $serviceInfo object $objectName operation $operationName inputs]
  3788   3823       set xnsList [dict get $serviceInfo targetNamespace]
  3789   3824   
  3790   3825       dom createDocument "request" doc
  3791   3826       $doc documentElement body
  3792   3827       $body setAttribute \
................................................................................
  3796   3831           #set target [lindex $xns 1]
  3797   3832           $body  setAttribute \
  3798   3833               xmlns:$tns $target
  3799   3834       }
  3800   3835   
  3801   3836       set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $msgType] xns]
  3802   3837   
  3803         -    ::log::log debug "calling [list ::WS::Utils::convertDictToType Client $serviceName $doc $body $argList $msgType]"
         3838  +    ::log::logsubst debug {calling [list ::WS::Utils::convertDictToType Client $serviceName $doc $body $argList $msgType]}
  3804   3839       set options [::WS::Utils::SetOption]
  3805   3840       ::WS::Utils::SetOption UseNS 0
  3806   3841       ::WS::Utils::SetOption genOutAttr 1
  3807   3842       ::WS::Utils::SetOption valueAttr {}
  3808   3843       ::WS::Utils::convertDictToType Client $serviceName $doc $body $argList $msgType
  3809   3844       set encoding [lindex [split [lindex [split [dict get $serviceInfo contentType] {;}] end] {=}] end]
  3810   3845       foreach {option value} $options {
................................................................................
  3818   3853       set xml [encoding convertto $encoding $xml]
  3819   3854   
  3820   3855       set inTransform [dict get $serviceInfo inTransform]
  3821   3856       if {$inTransform ne {}} {
  3822   3857           set xml [$inTransform $serviceName $operationName REQUEST $xml $url $argList]
  3823   3858       }
  3824   3859   
  3825         -    ::log::log debug "Leaving ::WS::Client::buildRestCallquery with {$xml}"
         3860  +    ::log::logsubst debug {Leaving ::WS::Client::buildRestCallquery with {$xml}}
  3826   3861   
  3827   3862       return $xml
  3828   3863   
  3829   3864   }
  3830   3865   
  3831   3866   ###########################################################################
  3832   3867   #
................................................................................
  3871   3906   #       1  07/06/2006  G.Lester     Initial version
  3872   3907   #
  3873   3908   #
  3874   3909   ###########################################################################
  3875   3910   proc ::WS::Client::parseRestResults {serviceName objectName operationName inXML} {
  3876   3911       variable serviceArr
  3877   3912   
  3878         -    ::log::log debug "In parseResults $serviceName $operationName {$inXML}"
         3913  +    ::log::logsubst debug {Entering [info level 0]}
  3879   3914       set first [string first {<} $inXML]
  3880   3915       if {$first > 0} {
  3881   3916           set inXML [string range $inXML $first end]
  3882   3917       }
  3883   3918       set serviceInfo $serviceArr($serviceName)
  3884   3919       set outTransform [dict get $serviceInfo outTransform]
  3885   3920       if {$outTransform ne {}} {
................................................................................
  3890   3925       dom parse $inXML doc
  3891   3926       # save top node handle in variable top
  3892   3927       $doc documentElement top
  3893   3928       set xns {}
  3894   3929       foreach tmp [dict get $serviceInfo targetNamespace] {
  3895   3930           lappend xns $tmp
  3896   3931       }
  3897         -    ::log::log debug "Using namespaces {$xns}"
         3932  +    ::log::logsubst debug {Using namespaces {$xns}}
  3898   3933       set body $top
  3899   3934       set status [$body getAttribute status]
  3900   3935   
  3901   3936       ##
  3902   3937       ## See if it is a standard error packet
  3903   3938       ##
  3904   3939       if {$status ne {ok}} {
................................................................................
  3917   3952       ##
  3918   3953       ## Convert the packet to a dictionary
  3919   3954       ##
  3920   3955       set results {}
  3921   3956       set options [::WS::Utils::SetOption]
  3922   3957       ::WS::Utils::SetOption UseNS 0
  3923   3958       ::WS::Utils::SetOption parseInAttr 1
  3924         -    ::log::log debug "Calling [list ::WS::Utils::convertTypeToDict Client $serviceName $body $expectedMsgType $body]"
         3959  +    ::log::logsubst debug {Calling ::WS::Utils::convertTypeToDict Client $serviceName $body $expectedMsgType $body}
  3925   3960       if {$expectedMsgType ne {}} {
  3926   3961           set node [$body childNodes]
  3927   3962           set nodeName [$node nodeName]
  3928   3963           if {$objectName ne $nodeName} {
  3929   3964               return \
  3930   3965                   -code error \
  3931   3966                   -errorcode [list WS CLIENT BADRESPONSE [list $objectName $nodeName]] \
................................................................................
  3984   4019   # Version     Date     Programmer   Comments / Changes / Reasons
  3985   4020   # -------  ----------  ----------   -------------------------------------------
  3986   4021   #       1  07/06/2006  G.Lester     Initial version
  3987   4022   #
  3988   4023   #
  3989   4024   ###########################################################################
  3990   4025   proc ::WS::Client::asyncRestCallDone {serviceName objectName operationName succesCmd errorCmd token} {
  3991         -    ::log::log debug "Entering ::WS::Client::asyncCallDone {$serviceName $objectName $operationName $succesCmd $errorCmd $token}"
         4026  +    ::log::logsubst debug {Entering [info level 0]}
  3992   4027   
  3993   4028       ##
  3994   4029       ## Check for errors
  3995   4030       ##
  3996   4031       set body [::http::data $token]
  3997         -    ::log::log info "\nReceived: $body"
         4032  +    ::log::logsubst info {\nReceived: $body}
  3998   4033       if {[::http::status $token] ne {ok} ||
  3999   4034           ( [::http::ncode $token] != 200 && $body eq {} )} {
  4000   4035           set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
  4001   4036           set hadError 1
  4002   4037           set errorInfo [FormatHTTPError $token]
  4003   4038       } else {
  4004   4039           SaveAndSetOptions $serviceName

ServerSide.tcl became executable.


Changes to Utilities.tcl.

    75     75           }
    76     76       }
    77     77   }
    78     78   
    79     79   package require tdom 0.8
    80     80   package require struct::set
    81     81   
    82         -package provide WS::Utils 2.4.1
           82  +package provide WS::Utils 2.4.2
    83     83   
    84     84   namespace eval ::WS {}
    85     85   
    86     86   namespace eval ::WS::Utils {
    87     87       set ::WS::Utils::typeInfo {}
    88     88       set ::WS::Utils::currentSchema {}
    89     89       array set ::WS::Utils::importedXref {}
................................................................................
  1378   1378   #                       update this segment of the file header block by
  1379   1379   #                       adding a complete entry at the bottom of the list.
  1380   1380   #
  1381   1381   # Version     Date     Programmer   Comments / Changes / Reasons
  1382   1382   # -------  ----------  ----------   -------------------------------------------
  1383   1383   #       1  07/06/2006  G.Lester     Initial version
  1384   1384   #
         1385  +# 2.4.2    2018-05-14  H.Oehlmann   Add support to translate namespace prefixes
         1386  +#                                   in attribute values or text values.
         1387  +#                                   New parameter "xnsDistantToLocalDict".
  1385   1388   #
  1386   1389   ###########################################################################
  1387         -proc ::WS::Utils::convertTypeToDict {mode serviceName node type root {isArray 0}} {
         1390  +proc ::WS::Utils::convertTypeToDict {
         1391  +        mode serviceName node type root {isArray 0} {xnsDistantToLocalDict {}}
         1392  +} {
  1388   1393       variable typeInfo
  1389   1394       variable mutableTypeInfo
  1390   1395       variable options
  1391   1396   
  1392   1397       if {$options(valueAttrCompatiblityMode)} {
  1393   1398           set valueAttr {}
  1394   1399       } else {
................................................................................
  1445   1450           }
  1446   1451           if {[string equal $partName *] && [string equal $partType *]} {
  1447   1452               ##
  1448   1453               ## Type infomation being handled dynamically for this part
  1449   1454               ##
  1450   1455               set savedTypeInfo $typeInfo
  1451   1456               parseDynamicType $mode $serviceName $node $type
  1452         -            set tmp [convertTypeToDict $mode $serviceName $node $type $root]
         1457  +            set tmp [convertTypeToDict $mode $serviceName $node $type $root 0 $xnsDistantToLocalDict]
  1453   1458               foreach partName [dict keys $tmp] {
  1454   1459                   dict set results $partName [dict get $tmp $partName]
  1455   1460               }
  1456   1461               set typeInfo $savedTypeInfo
  1457   1462               continue
  1458   1463           }
  1459   1464           set partXns $xns
................................................................................
  1602   1607                   dict set results $partName $tmp
  1603   1608               }
  1604   1609               {1 0} {
  1605   1610                   ##
  1606   1611                   ## Non-simple non-array
  1607   1612                   ##
  1608   1613                   if {$options(parseInAttr)} {
         1614  +                    ## Translate an abstract type from the WSDL to a type given
         1615  +                    ## in the response
         1616  +                    ## Example xml response from bug 584bfb772:
         1617  +                    ## <soap:Envelope ...
         1618  +                    ##    xmlns:tns="http://www.esri.com/schemas/ArcGIS/10.3">
         1619  +                    ##  <soap:Body>
         1620  +                    ##    <tns:GetServerInfoResponse>
         1621  +                    ##      <Result xsi:type="tns:MapServerInfo">
         1622  +                    ##      <Name>Layers</Name>
         1623  +                    ##      <Description></Description>
         1624  +                    ##        <FullExtent xsi:type="tns:EnvelopeN">
         1625  +                    ##
         1626  +                    ## The element FullExtend gets type "tns:EnvelopeN".
         1627  +                    ##
         1628  +                    ## xnsDistantToLocalDict
  1609   1629                       if {$isAbstract && [$item hasAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type]} {
  1610         -                        set partType [$item getAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type]
         1630  +                        # partType is now tns::EnvelopeN
         1631  +                        set partType [XNSDistantToLocal $xnsDistantToLocalDict\
         1632  +                                [$item getAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type]]
         1633  +                        
         1634  +                        # Remove this type attribute from the snippet.
         1635  +                        # So, it is not handled in the loop below.
  1611   1636                           $item removeAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type
  1612   1637                       }
  1613   1638                       foreach attrList [$item attributes] {
  1614   1639                           catch {
  1615   1640                               lassign $attrList attr nsAlias nsUrl
  1616   1641                               if {[string equal $nsUrl $xsiNsUrl]} {
  1617   1642                                   set attrValue [$item getAttribute ${nsAlias}:$attr]
................................................................................
  1621   1646                                   dict set results $partName $attr $attrValue
  1622   1647                               } else {
  1623   1648                                   set attrValue [$item getAttribute $attr]
  1624   1649                                   dict set results $partName $attr $attrValue
  1625   1650                               }
  1626   1651                           }
  1627   1652                       }
  1628         -                    dict set results $partName $valueAttr [convertTypeToDict $mode $serviceName $item $partType $root]
         1653  +                    dict set results $partName $valueAttr [convertTypeToDict $mode $serviceName $item $partType $root 0 $xnsDistantToLocalDict]
  1629   1654                   } else {
  1630         -                    dict set results $partName [convertTypeToDict $mode $serviceName $item $partType $root]
         1655  +                    dict set results $partName [convertTypeToDict $mode $serviceName $item $partType $root  0 $xnsDistantToLocalDict]
  1631   1656                   }
  1632   1657               }
  1633   1658               {1 1} {
  1634   1659                   ##
  1635   1660                   ## Non-simple array
  1636   1661                   ##
  1637   1662                   set partType [string trimright $partType {()}]
................................................................................
  1654   1679                                       lappend rowList $attr $attrValue
  1655   1680                                   } else {
  1656   1681                                       set attrValue [$row getAttribute $attr]
  1657   1682                                       lappend rowList $attr $attrValue
  1658   1683                                   }
  1659   1684                               }
  1660   1685                           }
  1661         -                        lappend rowList $valueAttr [convertTypeToDict $mode $serviceName $row $partType $root 1]
         1686  +                        lappend rowList $valueAttr [convertTypeToDict $mode $serviceName $row $partType $root 1 $xnsDistantToLocalDict]
  1662   1687                           lappend tmp $rowList
  1663   1688                       } else {
  1664         -                        lappend tmp [convertTypeToDict $mode $serviceName $row $partType $root 1]
         1689  +                        lappend tmp [convertTypeToDict $mode $serviceName $row $partType $root 1 $xnsDistantToLocalDict]
  1665   1690                       }
  1666   1691                   }
  1667   1692                   dict set results $partName $tmp
  1668   1693               }
  1669   1694               default {
  1670   1695                   ##
  1671   1696                   ## Placed here to shut up tclchecker
  1672   1697                   ##
  1673   1698               }
  1674   1699           }
  1675   1700       }
  1676         -    ::log::logsubst debug {Leaving ::WS::Utils::convertTypeToDict with $results}
         1701  +    ::log::logsubst debug {Leaving ::WS::Utils::convertTypeToDict with result '$results'}
  1677   1702       return $results
  1678   1703   }
         1704  +
         1705  +###########################################################################
         1706  +#
         1707  +# Private Procedure Header - as this procedure is modified, please be sure
         1708  +#                            that you update this header block. Thanks.
         1709  +#
         1710  +#>>BEGIN PRIVATE<<
         1711  +#
         1712  +# Procedure Name : ::WS::Utils::XNSDistantToLocal
         1713  +#
         1714  +# Description : Get a reference node.
         1715  +#
         1716  +# Arguments :
         1717  +#    xnsDistantToLocalDict - Dict to translate distant to local NS prefixes
         1718  +#    typeDistant - Type string with possible distant namespace prefix
         1719  +#
         1720  +# Returns : type with local namespace prefix
         1721  +#
         1722  +# Side-Effects : None
         1723  +#
         1724  +# Exception Conditions : None
         1725  +#
         1726  +# Pre-requisite Conditions : None
         1727  +#
         1728  +# Original Author : Harald Oehlmann
         1729  +#
         1730  +#>>END PRIVATE<<
         1731  +#
         1732  +# Maintenance History - as this file is modified, please be sure that you
         1733  +#                       update this segment of the file header block by
         1734  +#                       adding a complete entry at the bottom of the list.
         1735  +#
         1736  +# Version     Date     Programmer   Comments / Changes / Reasons
         1737  +# -------  ----------  ----------   -------------------------------------------
         1738  +# 2.4.2    2017-11-03  H.Oehlmann   Initial version
         1739  +#
         1740  +###########################################################################
         1741  +proc ::WS::Utils::XNSDistantToLocal {xnsDistantToLocalDict type} {
         1742  +    set collonPos [string first ":" $type]
         1743  +    # check for namespace prefix present
         1744  +    if {-1 < $collonPos} {
         1745  +        set prefixDistant [string range $type 0 $collonPos-1]
         1746  +        if {[dict exists $xnsDistantToLocalDict $prefixDistant]} {
         1747  +            set type [dict get $xnsDistantToLocalDict $prefixDistant][string range $type $collonPos end]
         1748  +            log::logsubst debug {Mapped distant namespace prefix '$prefixDistant' to type '$type'}
         1749  +        } else {
         1750  +            log::logsubst warning {Distant type '$type' does not have a known namespace prefix ([dict keys $xnsDistantToLocalDict])}
         1751  +        }
         1752  +    }
         1753  +    return $type
         1754  +}
         1755  +
  1679   1756   
  1680   1757   ###########################################################################
  1681   1758   #
  1682   1759   # Private Procedure Header - as this procedure is modified, please be sure
  1683   1760   #                            that you update this header block. Thanks.
  1684   1761   #
  1685   1762   #>>BEGIN PRIVATE<<
................................................................................
  2152   2229               set yajlType $simpleTypesJson([string trimright $itemType {()?}])
  2153   2230           } else {
  2154   2231               set yajlType "string"
  2155   2232           }
  2156   2233   
  2157   2234           ::log::logsubst debug {\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList}}
  2158   2235           set typeInfoList [lrange $typeInfoList 0 1]
  2159         -        switch $typeInfoList {
         2236  +        switch -- $typeInfoList {
  2160   2237               {0 0} {
  2161   2238                   ##
  2162   2239                   ## Simple non-array
  2163   2240                   ##
  2164   2241                   set resultValue [dict get $dict $itemName]
  2165   2242                   $doc string $itemName $yajlType $resultValue
  2166   2243               }
................................................................................
  2250   2327   proc ::WS::Utils::convertDictToTypeNoNs {mode service doc parent dict type {enforceRequired 0}} {
  2251   2328       ::log::logsubst debug {Entering [info level 0]}
  2252   2329       # ::log::log debug "  Parent xml: [$parent asXML]"
  2253   2330       variable typeInfo
  2254   2331       variable simpleTypes
  2255   2332       variable options
  2256   2333       variable standardAttributes
         2334  +    variable currentNs
  2257   2335   
  2258   2336       if {$options(valueAttrCompatiblityMode)} {
  2259   2337           set valueAttr {}
  2260   2338       } else {
  2261   2339           set valueAttr {::value}
  2262   2340       }
  2263   2341       set typeInfoList [TypeInfo $mode $service $type]
................................................................................
  2357   2435                       }
  2358   2436                   }
  2359   2437               }
  2360   2438               {1 0} {
  2361   2439                   ##
  2362   2440                   ## Non-simple non-array
  2363   2441                   ##
  2364         -                $parent appendChild [$doc createElement $itemName retnode]
         2442  +                $parent appendChild [$doc createElement $itemName retNode]
  2365   2443                   if {$options(genOutAttr)} {
  2366   2444                       set dictList [dict keys [dict get $dict $itemName]]
  2367   2445                       set resultValue {}
  2368   2446                       foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
  2369   2447                           if {$isAbstract && [string equal $attr {::type}]} {
         2448  +                            # *** HaO: useName is never defined
  2370   2449                               set itemType [dict get $dict $useName $attr]
  2371   2450                               $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $itemType
  2372   2451                           } elseif {[string equal $attr $valueAttr]} {
  2373   2452                               set resultValue [dict get $dict $itemName $attr]
  2374   2453                           } elseif {[string match {::*} $attr]} {
  2375   2454                               set baseAttr [string range $attr 2 end]
  2376   2455                               set attrValue [dict get $dict $itemName $attr]
................................................................................
  2381   2460                       }
  2382   2461                   } else {
  2383   2462                       set resultValue [dict get $dict $itemName]
  2384   2463                   }
  2385   2464                   if {[llength $attrList]} {
  2386   2465                       ::WS::Utils::setAttr $retNode $attrList
  2387   2466                   }
  2388         -                convertDictToTypeNoNs $mode $service $doc $retnode $resultValue $itemType $enforceRequired
         2467  +                convertDictToTypeNoNs $mode $service $doc $retNode $resultValue $itemType $enforceRequired
  2389   2468               }
  2390   2469               {1 1} {
  2391   2470                   ##
  2392   2471                   ## Non-simple array
  2393   2472                   ##
  2394   2473                   set dataList [dict get $dict $itemName]
  2395   2474                   set tmpType [string trimright $itemType {()}]
  2396   2475                   foreach row $dataList {
  2397         -                    $parent appendChild [$doc createElement $itemName retnode]
         2476  +                    $parent appendChild [$doc createElement $itemName retNode]
  2398   2477                       if {$options(genOutAttr)} {
  2399   2478                           set dictList [dict keys $row]
  2400   2479                           set resultValue {}
  2401   2480                           foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
  2402   2481                               if {$isAbstract && [string equal $attr {::type}]} {
  2403   2482                                   set tmpType [dict get $row $attr]
  2404   2483                                   $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $tmpType
................................................................................
  2414   2493                           }
  2415   2494                       } else {
  2416   2495                           set resultValue $row
  2417   2496                       }
  2418   2497                       if {[llength $attrList]} {
  2419   2498                           ::WS::Utils::setAttr $retNode $attrList
  2420   2499                       }
  2421         -                    convertDictToTypeNoNs $mode $service $doc $retnode $resultValue $tmpType $enforceRequired
         2500  +                    convertDictToTypeNoNs $mode $service $doc $retNode $resultValue $tmpType $enforceRequired
  2422   2501                   }
  2423   2502               }
  2424   2503               default {
  2425   2504                   ##
  2426   2505                   ## Placed here to shut up tclchecker
  2427   2506                   ##
  2428   2507               }
................................................................................
  4183   4262               array unset fieldInfoArr
  4184   4263               set fieldInfoArr(minOccurs) 0
  4185   4264               array set fieldInfoArr $fieldDef
  4186   4265               if {$fieldInfoArr(minOccurs) && ![info exists fieldInfoArr($field)]} {
  4187   4266                   ##
  4188   4267                   ## Fields was required but is missing
  4189   4268                   ##
  4190         -                set ::errorCode [list WS CHECK MISSREQFLD [list $type $field]]
         4269  +                set ::errorCode [list WS CHECK MISSREQFLD [list $typeName $field]]
  4191   4270                   set result 0
  4192   4271               } elseif {$fieldInfoArr(minOccurs) &&
  4193   4272                         ($fieldInfoArr(minOccurs) > [llength $fieldInfoArr($field)])} {
  4194   4273                   ##
  4195   4274                   ## Fields was required and present, but not enough times
  4196   4275                   ##
  4197   4276                   set ::errorCode [list WS CHECK MINOCCUR [list $type $field]]
................................................................................
  4198   4277                   set result 0
  4199   4278               } elseif {[info exists fieldInfoArr(maxOccurs)] &&
  4200   4279                         [string is integer fieldInfoArr(maxOccurs)] &&
  4201   4280                         ($fieldInfoArr(maxOccurs) < [llength $fieldInfoArr($field)])} {
  4202   4281                   ##
  4203   4282                   ## Fields was required and present, but too many times
  4204   4283                   ##
  4205         -                set ::errorCode [list WS CHECK MAXOCCUR [list $type $field]]
         4284  +                set ::errorCode [list WS CHECK MAXOCCUR [list $typeName $field]]
  4206   4285                   set result 0
  4207   4286               } elseif {[info exists fieldInfoArr($field)]} {
  4208   4287                   foreach node $fieldInfoArr($field) {
  4209   4288                       set result [checkTags $mode $serviceName $node $fieldInfoArr(type)]
  4210   4289                       if {!$result} {
  4211   4290                           break
  4212   4291                       }
................................................................................
  4275   4354   
  4276   4355       set result 0
  4277   4356       array set typeInfos {
  4278   4357           minLength 0
  4279   4358           maxLength -1
  4280   4359           fixed false
  4281   4360       }
         4361  +    # returns indexes type, xns, ...
  4282   4362       array set typeInfos [GetServiceTypeDef $mode $serviceName $type]
  4283   4363       foreach {var value} [array get typeInfos] {
  4284   4364           set $var $value
  4285   4365       }
  4286   4366       set result 1
  4287   4367   
  4288   4368       if {$minLength >= 0 && [string length $value] < $minLength} {
  4289         -        set ::errorCode [list WS CHECK VALUE_TO_SHORT [list $key $value $minLength $typeInfo]]
         4369  +        set ::errorCode [list WS CHECK VALUE_TO_SHORT [list $type $value $minLength $typeInfo]]
  4290   4370           set result 0
  4291   4371       } elseif {$maxLength >= 0 && [string length $value] > $maxLength} {
  4292         -        set ::errorCode [list WS CHECK VALUE_TO_LONG [list $key $value $maxLength $typeInfo]]
         4372  +        set ::errorCode [list WS CHECK VALUE_TO_LONG [list $type $value $maxLength $typeInfo]]
  4293   4373           set result 0
  4294   4374       } elseif {[info exists enumeration] && ([lsearch -exact $enumeration $value] == -1)} {
  4295         -        set errorCode [list WS CHECK VALUE_NOT_IN_ENUMERATION [list $key $value $enumerationVals $typeInfo]]
         4375  +        set errorCode [list WS CHECK VALUE_NOT_IN_ENUMERATION [list $type $value $enumeration $typeInfo]]
  4296   4376           set result 0
  4297   4377       } elseif {[info exists pattern] && (![regexp -- $pattern $value])} {
  4298         -        set errorCode [list WS CHECK VALUE_NOT_MATCHES_PATTERN [list $key $value $pattern $typeInfo]]
         4378  +        set errorCode [list WS CHECK VALUE_NOT_MATCHES_PATTERN [list $type $value $pattern $typeInfo]]
  4299   4379           set result 0
  4300   4380       }
  4301   4381   
  4302   4382       return $result
  4303   4383   }
  4304   4384   
  4305   4385   
................................................................................
  4351   4431   
  4352   4432       ##
  4353   4433       ## Get the type information
  4354   4434       ##
  4355   4435       set baseTypeName [string trimright $typeName {()?}]
  4356   4436       set typeInfo [GetServiceTypeDef $mode $serviceName $baseTypeName]
  4357   4437       set typeName [string trimright $typeName {?}]
  4358         -    set xns [dict get $typeInfo $mode $service $type xns]
         4438  +    set xns [dict get $typeInfo $mode $serviceName $typeName xns]
  4359   4439   
  4360   4440       foreach {field fieldDef} [dict get $typeInfo definition] {
  4361   4441           ##
  4362   4442           ## Get info about this field and its type
  4363   4443           ##
  4364   4444           array unset fieldInfoArr
  4365   4445           set fieldInfoArr(minOccurs) 0
................................................................................
  4399   4479                     [string is integer fieldInfoArr(maxOccurs)] &&
  4400   4480                     ($fieldInfoArr(maxOccurs) < $valueListLenght)} {
  4401   4481               ##
  4402   4482               ## Fields was required and present, but too many times
  4403   4483               ##
  4404   4484               set minOccurs $fieldInfoArr(maxOccurs)
  4405   4485               return \
  4406         -                -errorcode [list WS CHECK MAXOCCUR [list $type $field]] \
         4486  +                -errorcode [list WS CHECK MAXOCCUR [list $typeName $field]] \
  4407   4487                   "Field '$field' of type '$typeName' could only occur $minOccurs time(s) but occured $valueListLenght time(s)"
  4408   4488           } elseif {[dict exists $valueInfos $field]} {
  4409   4489               foreach value $valueList {
  4410   4490                   $currentNode appendChild [$doc createElement $xns:$field retNode]
  4411   4491                   if {$isComplex} {
  4412   4492                       buildTags $mode $serviceName $fieldBaseType $value $doc $retNode
  4413   4493                   } else {

Changes to pkgIndex.tcl.

     6      6   # information so that packages will be loaded automatically
     7      7   # in response to "package require" commands.  When this
     8      8   # script is sourced, the variable $dir must contain the
     9      9   # full path name of this file's directory.
    10     10   
    11     11   package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]]
    12     12   package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]]
    13         -package ifneeded WS::Client 2.5.0 [list source [file join $dir ClientSide.tcl]]
           13  +package ifneeded WS::Client 2.5.1 [list source [file join $dir ClientSide.tcl]]
    14     14   package ifneeded WS::Embeded 2.4.0 [list source [file join $dir Embedded.tcl]]
    15     15   package ifneeded WS::Server 2.4.0 [list source [file join $dir ServerSide.tcl]]
    16         -package ifneeded WS::Utils 2.4.1 [list source [file join $dir Utilities.tcl]]
           16  +package ifneeded WS::Utils 2.4.2 [list source [file join $dir Utilities.tcl]]
    17     17   package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]]
    18     18   package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]]