package require Tcl 8.4
package require WS::Utils 2.4 ; # dict, lassign
package require tdom 0.8
package require http 2
package require log
package require uri

package provide WS::Client 2.5.1

namespace eval ::WS::Client {
    # register https only if not yet registered
    if {[catch { http::unregister https } lPortCmd]} {
        # not registered -> register on my own
        if {[catch {
            package require tls

        dict set serviceArr($serviceName) $item $options($item)
    }
    foreach {name value} $args {
        set name [string trimleft $name {-}]
        dict set serviceArr($serviceName) $name $value
    }

    ::log::logsubst debug {Setting Target Namespace tns1 as $target}
    if {[dict exists $serviceArr($serviceName) xns]} {
        foreach xnsItem [dict get $serviceArr($serviceName) xns] {
            lassign $xnsItem tns xns
            ::log::logsubst debug {Setting targetNamespace $tns for $xns}
            dict set serviceArr($serviceName) targetNamespace $tns $xns
        }
    }
}

###########################################################################
#

    }
    array set argument $args

    set first [string first {<} $wsdlXML]
    if {$first > 0} {
        set wsdlXML [string range $wsdlXML $first end]
    }
    ::log::logsubst debug {Parsing WSDL: $wsdlXML}

    # save parsed document node to tmpdoc
    dom parse $wsdlXML tmpdoc
    # save transformed document handle in variable wsdlDoc
    $tmpdoc xslt $::WS::Utils::xsltSchemaDom wsdlDoc
    $tmpdoc delete
    # save top node in variable wsdlNode

            ## different URL
            ##
            # This may happen, if the element namespace prefix overwrites
            # a global one, like
            # <wsdl:definitions xmlns:q1="URI1" ...>
            #   <xs:element xmlns:q1="URI2" type="q1:MessageQ1"/>
            if { [dict exists $nsDict tns $ns] && $tns ne [dict get $nsDict tns $ns] } {
                ::log::logsubst debug {Namespace prefix '$ns' with different URI '$url': $nsDict}
                return \
                    -code error \
                    -errorcode [list WS CLIENT AMBIGNSPREFIX] \
                    "element namespace prefix '$ns' used again for different URI '$url'.\
                    Sorry, this is a current implementation limitation of TCLWS."
            }
            dict set nsDict tns $ns $tns

        set inputMsgType [dict get $serviceInfo operation $operationName inputs]
        ## Petasis, 14 July 2008: If an input message has no elements, just do
        ## not add any arguments...
        set inputMsgTypeDefinition [::WS::Utils::GetServiceTypeDef Client $serviceName $inputMsgType]
        if {[dict exists $inputMsgTypeDefinition definition]} {
          set inputFields [dict keys [dict get $inputMsgTypeDefinition definition]]
         } else {
          ::log::logsubst debug {no definition found for inputMsgType $inputMsgType}
          set inputFields {}
        }
        if {$inputFields ne {}} {
            lappend argList [lsort -dictionary $inputFields]
        }
        set argList [join $argList]

        set body {
            set procName [lindex [info level 0] 0]
            set serviceName [string trim [namespace qualifiers $procName] {:}]
            set operationName [string trim [namespace tail $procName] {:}]
            set argList {}
            foreach var [namespace eval ::${serviceName}:: [list info args $operationName]] {
                lappend argList $var [set $var]
            }
            ::log::logsubst debug {::WS::Client::DoCall $serviceName $operationName $argList}
            ::WS::Client::DoCall $serviceName $operationName $argList
        }
        proc $procName $argList $body
        append procList "\n\t[list $procName $argList]"
    }
    return "$procList\n"
}

#                                   which also follows redirects.
#
#
###########################################################################
proc ::WS::Client::DoRawCall {serviceName operationName argList {headers {}}} {
    variable serviceArr

    ::log::logsubst debug {Entering [info level 0]}
    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }
    set serviceInfo $serviceArr($serviceName)

    
    if {[llength $headers]} {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
    } else {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType]]
    }

    ::log::logsubst debug {Leaving ::WS::Client::DoRawCall with {$body}}
    return $body

}

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

#                                   redirects.
#
#
###########################################################################
proc ::WS::Client::DoCall {serviceName operationName argList {headers {}}} {
    variable serviceArr

    ::log::logsubst debug {Entering [info level 0]}
    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }
    set serviceInfo $serviceArr($serviceName)

            catch {set body [$outTransform $serviceName $operationName REPLY $body]}
            RestoreSavedOptions $serviceName
        }
        set hadError [catch {parseResults $serviceName $operationName $body} results]
        if {$hadError} {
            lassign $::errorCode mainError subError
            if {$mainError eq {WSCLIENT} && $subError eq {NOSOAP}} {
                ::log::logsubst debug {\tHTTP error $body}
                set results $body
                set errorCode [list WSCLIENT HTTPERROR $body]
                set errorInfo {}
            } else {
                ::log::logsubst debug {Reply was $body}
                set errorCode $::errorCode
                set errorInfo $::errorInfo
            }
        }
    } else {
        if {$outTransform ne {}} {
            SaveAndSetOptions $serviceName
            catch {set body [$outTransform $serviceName $operationName REPLY $body]}
            RestoreSavedOptions $serviceName
        }
        SaveAndSetOptions $serviceName
        set hadError [catch {parseResults $serviceName $operationName $body} results]
        RestoreSavedOptions $serviceName
        if {$hadError} {
            ::log::logsubst debug {Reply was $body}
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }
    }
    if {$hadError} {
        ::log::log debug "Leaving (error) ::WS::Client::DoCall"
        return \
            -code error \
            -errorcode $errorCode \
            -errorinfo $errorInfo \
            $results
    } else {
        ::log::logsubst debug {Leaving ::WS::Client::DoCall with {$results}}
        return $results
    }

}

###########################################################################
#

#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::DoAsyncCall {serviceName operationName argList succesCmd errorCmd {headers {}}} {
    variable serviceArr

    ::log::logsubst debug {Entering [info level 0]}
    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }
    set serviceInfo $serviceArr($serviceName)

    if {[catch {set query [buildCallquery $serviceName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[llength $headers]} {

        ::log::logsubst info {::http::geturl $url \
                -query $query \
                -type [dict get $serviceInfo contentType] \
                -headers $headers \
                -command [list ::WS::Client::asyncCallDone $serviceName $operationName $succesCmd $errorCmd]}

        ::http::geturl $url \
            -query $query \
            -type [dict get $serviceInfo contentType] \
            -headers $headers \
            -command [list ::WS::Client::asyncCallDone $serviceName $operationName $succesCmd $errorCmd]
    } else {

        ::log::logsubst info {::http::geturl $url \
                -query $query \
                -type [dict get $serviceInfo contentType] \
                -command [list ::WS::Client::asyncCallDone $serviceName $operationName $succesCmd $errorCmd]}

        ::http::geturl $url \
            -query $query \
            -type [dict get $serviceInfo contentType] \
            -command [list ::WS::Client::asyncCallDone $serviceName $operationName $succesCmd $errorCmd]
    }
    ::log::logsubst debug {Leaving ::WS::Client::DoAsyncCall}
    return;
}

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

# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::asyncCallDone {serviceName operationName succesCmd errorCmd token} {
    ::log::logsubst debug {Entering [info level 0]}

    ##
    ## Check for errors
    ##
    set body [::http::data $token]
    ::log::logsubst info {\nReceived: $body}
    set results {}
    if {[::http::status $token] ne {ok} ||
        ( [::http::ncode $token] != 200 && $body eq {} )} {
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set hadError 1
        set errorInfo [FormatHTTPError $token]
    } else {

# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
# 2.4.2    2017-08-31  H.Oehlmann   The response node name may also be the
#                                   output name and not only the output type.
#                                   (ticket [21f41e22bc]).
# 2.4.3    2017-11-03  H.Oehlmann   Extended upper commit also to search
#                                   for multiple child nodes.
# 2.5.1    2018-05-14  H.Oehlmann   Add support to translate namespace prefixes
#                                   in attribute values or text values.
#                                   Translation dict "xnsDistantToLocalDict" is
#                                   passed to ::WS::Utils::convertTypeToDict
#                                   to translate abstract types.
#
###########################################################################
proc ::WS::Client::parseResults {serviceName operationName inXML} {
    variable serviceArr

    ::log::logsubst debug {Entering [info level 0]}

    set serviceInfo $serviceArr($serviceName)

    set expectedMsgType [dict get $serviceInfo operation $operationName outputs]
    set expectedMsgTypeBase [lindex [split $expectedMsgType {:}] end]

    set first [string first {<} $inXML]
    if {$first > 0} {
        set inXML [string range $inXML $first end]
    }
    # parse xml and save handle in variable doc and free it when out of scope
    dom parse $inXML doc

    # save top node handle in variable top and free it if out of scope
    $doc documentElement top

    set xns {
        ENV http://schemas.xmlsoap.org/soap/envelope/
        xsi "http://www.w3.org/2001/XMLSchema-instance"
        xs "http://www.w3.org/2001/XMLSchema"
    }
    foreach {prefixCur URICur} [dict get $serviceInfo targetNamespace] {
        lappend xns $prefixCur $URICur
    }
    ::log::logsubst debug {Using namespaces {$xns}}
    $doc selectNodesNamespaces $xns

    ##
    ## When arguments with tags are passed (example: abstract types),
    ## the upper "selectNodesNamespaces translation must be executed manually.
    ## Thus, we need a list of server namespace prefixes to our client namespace
    ## prefixes. (bug 584bfb77)
    ##
    # Example xml:
    # <soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
    #   xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
    #   xmlns:xsd="http://www.w3.org/2001/XMLSchema"
    #   xmlns:tns="http://www.esri.com/schemas/ArcGIS/10.3">

    set xnsDistantToLocalDict {}
    foreach attributeCur [$top attributes] {
        # attributeCur is a list of "prefix local URI",
        # which is for xmlns tags: "prefix prefix {}".
        set attributeCur [lindex $attributeCur 0]
        # Check if this is a namespace prefix
        if { ! [$top hasAttribute "xmlns:$attributeCur"] } {continue}
        set URIServer [$top getAttribute "xmlns:$attributeCur"]
        # Check if it is included in xns
        foreach {prefixCur URICur} $xns {
            if {$URIServer eq $URICur} {
                dict set xnsDistantToLocalDict $attributeCur $prefixCur
                break
            }
        }
    }
    ::log::logsubst debug {Server to Client prefix dict: $xnsDistantToLocalDict}
    
    ##
    ## Get body tag
    ##
    set body [$top selectNodes ENV:Body]
    if {![llength $body]} {
        return \
            -code error \
            -errorcode [list WS CLIENT BADREPLY $inXML] \
            "Bad reply type, no SOAP envelope received in: \n$inXML"
    }

    # This is not the case, if it was parsed with tclws prior 2.4.2
    # *** ToDo *** This security may be removed on a major release
    if {[dict exists $serviceInfo operation $operationName outputsname]} {
        lappend nodeNameCandidateList [dict get $serviceInfo operation $operationName outputsname]
    }
    
    set rootNodeList [$body childNodes]
    ::log::logsubst debug {Have [llength $rootNodeList] node under Body}
    foreach rootNodeCur $rootNodeList {
        set rootNameCur [$rootNodeCur localName]
        if {$rootNameCur eq {}} {
            set rootNameCur [$rootNodeCur nodeName]
        }
        if {$rootNameCur in $nodeNameCandidateList} {
            set rootNode $rootNodeCur
            set rootName $rootNameCur
            ::log::logsubst debug {Result root name is '$rootName'}
            break
        }
        ::log::logsubst debug {Result root name '$rootNameCur' not in candidates '$nodeNameCandidateList'}
    }
    ##
    ## Exit if there is no such node
    ##
    if {![info exists rootName]} {
        return \
            -code error \

                    continue
                }
            }

            #if {[llength $outHeaderAttrs]} {
            #    ::WS::Utils::setAttr $node $outHeaderAttrs
            #}
            ::log::logsubst debug {Calling convertTypeToDict from header node type '$outHeaderType'}
            lappend results [::WS::Utils::convertTypeToDict Client $serviceName $node $outHeaderType $headerRootNode 0 $xnsDistantToLocalDict]
        }
    }

    ##
    ## Call Utility function to build result list
    ##
    if {$rootName ne {}} {
        ::log::log debug "Calling convertTypeToDict with root node"
        set bodyData [::WS::Utils::convertTypeToDict \
                     Client $serviceName $rootNode $expectedMsgType $body 0 $xnsDistantToLocalDict]
        if {![llength $bodyData] && ([dict get $serviceInfo skipLevelWhenActionPresent] || [dict get $serviceInfo skipLevelOnReply])} {
            ::log::log debug "Calling convertTypeToDict with skipped action level (skipLevelWhenActionPresent was set)"
            set bodyData [::WS::Utils::convertTypeToDict \
                         Client $serviceName $body $expectedMsgType $body 0 $xnsDistantToLocalDict]
        }
        lappend results $bodyData
    }
    set results [join $results]
    $doc delete
    set ::errorCode {}
    set ::errorInfo {}

    ::WS::Utils::SetOption suppressNS $inSuppressNs
    set inTransform [dict get $serviceInfo inTransform]
    if {$inTransform ne {}} {
        set xml [$inTransform $serviceName $operationName REQUEST $xml $url $argList]
    }

    ::log::logsubst debug {Leaving ::WS::Client::buildCallquery with {$xml}}
    return $xml

}

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

#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::buildDocLiteralCallquery {serviceName operationName url argList} {
    variable serviceArr

    ::log::logsubst debug {Entering [info level 0]}
    set serviceInfo $serviceArr($serviceName)
    set msgType [dict get $serviceInfo operation $operationName inputs]
    set url [dict get $serviceInfo location]
    set xnsList [dict get $serviceInfo targetNamespace]

    # save the document in variable doc and free it if out of scope
    dom createDocument "SOAP-ENV:Envelope" doc

        set msgType [lindex $typeInfo 1]
    }

    if {[dict get $serviceInfo skipLevelWhenActionPresent] && [dict exists $serviceInfo operation $operationName action]} {
        set forceNs 1
        set reply $bod
    } else {
        ::log::logsubst 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::logsubst debug {Leaving ::WS::Client::buildDocLiteralCallquery with {$xml}}

    return [encoding convertto $encoding $xml]

}

###########################################################################
#

#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::buildRpcEncodedCallquery {serviceName operationName url argList} {
    variable serviceArr

    ::log::logsubst debug {Entering [info level 0]}
    set serviceInfo $serviceArr($serviceName)
    set msgType [dict get $serviceInfo operation $operationName inputs]
    set xnsList [dict get $serviceInfo targetNamespace]

    dom createDocument "SOAP-ENV:Envelope" doc
    $doc documentElement env
    $env setAttribute \

    ::WS::Utils::convertDictToEncodedType Client $serviceName $doc $reply $argList $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::logsubst debug {Leaving ::WS::Client::buildRpcEncodedCallquery with {$xml}}

    return [encoding convertto $encoding $xml]

}

###########################################################################
#

#
###########################################################################
proc ::WS::Client::buildServiceInfo {wsdlNode tnsDict {serviceInfo {}} {serviceAlias {}} {serviceNumber 1}} {
    ##
    ## Need to refactor to foreach service parseService
    ##  Service drills down to ports, which drills down to bindings and messages
    ##
    ::log::logsubst debug {Entering [info level 0]}

    ##
    ## Parse Service information
    ##
    # WSDL snippet:
    #  <definitions ...>
    #    <service name="service1">

        set serviceNameList [lrange $serviceNameList $serviceNumber-1 $serviceNumber-1]
    }

    foreach serviceNode $serviceNameList {
        lappend serviceInfo [parseService $wsdlNode $serviceNode $serviceAlias $tnsDict]
    }

    ::log::logsubst debug {Leaving ::WS::Client::buildServiceInfo with $serviceInfo}
    return $serviceInfo
}

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

#
#
###########################################################################
proc ::WS::Client::parseService {wsdlNode serviceNode serviceAlias tnsDict} {
    variable serviceArr
    variable options

    ::log::logsubst debug {Entering [info level 0]}
    if {[string length $serviceAlias]} {
        set serviceName $serviceAlias
    } else {
        set serviceName [$serviceNode getAttribute name]
    }
    set addressNodeList [$serviceNode getElementsByTagNameNS http://schemas.xmlsoap.org/wsdl/soap/ address]
    if {[llength $addressNodeList] == 1} {

    foreach {key value} [dict get $serviceInfo tnsList url] {
        dict set serviceInfo targetNamespace $value $key
    }
    set serviceArr($serviceName) $serviceInfo

    set ::WS::Utils::targetNs $tmpTargetNs

    ::log::logsubst debug {Leaving [lindex [info level 0] 0] with $serviceInfo}
    return $serviceInfo
}

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

#                                   which also follows redirects.
#
#
###########################################################################
proc ::WS::Client::DoRawRestCall {serviceName objectName operationName argList {headers {}} {location {}}} {
    variable serviceArr

    ::log::logsubst debug {Entering [info level 0]}
    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }
    set serviceInfo $serviceArr($serviceName)

    
    if {[llength $headers]} {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType] -headers $headers]
    } else {
        set body [::WS::Utils::geturl_fetchbody $url -query $query -type [dict get $serviceInfo contentType]]
    }

    ::log::logsubst debug {Leaving ::WS::Client::DoRawRestCall with {$body}}
    return $body

}

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

#                                   which also follows redirects.
#
#
###########################################################################
proc ::WS::Client::DoRestCall {serviceName objectName operationName argList {headers {}} {location {}}} {
    variable serviceArr

    ::log::logsubst debug {Entering [info level 0]}
    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }
    set serviceInfo $serviceArr($serviceName)

        parseRestResults $serviceName $objectName $operationName $body
    } results]} {
        RestoreSavedOptions $serviceName
        ::log::log debug "Leaving (error) ::WS::Client::DoRestCall"
        return -code error $results
    }
    RestoreSavedOptions $serviceName
    ::log::logsubst debug {Leaving ::WS::Client::DoRestCall with {$results}}
    return $results

}

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

proc ::WS::Client::DoRestAsyncCall {serviceName objectName operationName argList succesCmd errorCmd {headers {}}} {
    variable serviceArr

    set svcHeaders [dict get $serviceArr($serviceName) headers]
    if {[llength $svcHeaders]} {
        set headers [concat $headers $svcHeaders]
    }
    ::log::logsubst debug {Entering [info level 0]}
    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }
    set serviceInfo $serviceArr($serviceName)

    if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[llength $headers]} {

        ::log::logsubst info {::http::geturl $url \
                -query $query \
                -type [dict get $serviceInfo contentType] \
                -headers $headers \
                -command [list ::WS::Client::asyncRestCallDone $serviceName $operationName $succesCmd $errorCmd]}

        ::http::geturl $url \
            -query $query \
            -type [dict get $serviceInfo contentType] \
            -headers $headers \
            -command [list ::WS::Client::asyncRestCallDone $serviceName $operationName $succesCmd $errorCmd]
    } else {

        ::log::logsubst info {::http::geturl $url \
                -query $query \
                -type [dict get $serviceInfo contentType] \
                -command [list ::WS::Client::asyncRestCallDone $serviceName $operationName $succesCmd $errorCmd]}

        ::http::geturl $url \
            -query $query \
            -type [dict get $serviceInfo contentType] \
            -command [list ::WS::Client::asyncRestCallDone $serviceName $operationName $succesCmd $errorCmd]
    }
    ::log::log debug "Leaving ::WS::Client::DoAsyncRestCall"
    return;

#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::buildRestCallquery {serviceName objectName operationName url argList} {
    variable serviceArr

    ::log::logsubst debug {Entering [info level 0]}
    set serviceInfo $serviceArr($serviceName)
    set msgType [dict get $serviceInfo object $objectName operation $operationName inputs]
    set xnsList [dict get $serviceInfo targetNamespace]

    dom createDocument "request" doc
    $doc documentElement body
    $body setAttribute \
        "method"      $operationName
    foreach {tns target} $xnsList {
        #set tns [lindex $xns 0]
        #set target [lindex $xns 1]
        $body  setAttribute \
            xmlns:$tns $target
    }

    set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $msgType] xns]

    ::log::logsubst debug {calling [list ::WS::Utils::convertDictToType Client $serviceName $doc $body $argList $msgType]}
    set options [::WS::Utils::SetOption]
    ::WS::Utils::SetOption UseNS 0
    ::WS::Utils::SetOption genOutAttr 1
    ::WS::Utils::SetOption valueAttr {}
    ::WS::Utils::convertDictToType Client $serviceName $doc $body $argList $msgType
    set encoding [lindex [split [lindex [split [dict get $serviceInfo contentType] {;}] end] {=}] end]
    foreach {option value} $options {

    set xml [encoding convertto $encoding $xml]

    set inTransform [dict get $serviceInfo inTransform]
    if {$inTransform ne {}} {
        set xml [$inTransform $serviceName $operationName REQUEST $xml $url $argList]
    }

    ::log::logsubst debug {Leaving ::WS::Client::buildRestCallquery with {$xml}}

    return $xml

}

###########################################################################
#

#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::parseRestResults {serviceName objectName operationName inXML} {
    variable serviceArr

    ::log::logsubst debug {Entering [info level 0]}
    set first [string first {<} $inXML]
    if {$first > 0} {
        set inXML [string range $inXML $first end]
    }
    set serviceInfo $serviceArr($serviceName)
    set outTransform [dict get $serviceInfo outTransform]
    if {$outTransform ne {}} {
        set inXML [$outTransform $serviceName $operationName REPLY $inXML]
    }
    set expectedMsgType [dict get $serviceInfo object $objectName operation $operationName outputs]
    # save parsed xml handle in variable doc
    dom parse $inXML doc
    # save top node handle in variable top
    $doc documentElement top
    set xns {}
    foreach tmp [dict get $serviceInfo targetNamespace] {
        lappend xns $tmp
    }
    ::log::logsubst debug {Using namespaces {$xns}}
    set body $top
    set status [$body getAttribute status]

    ##
    ## See if it is a standard error packet
    ##
    if {$status ne {ok}} {

    ##
    ## Convert the packet to a dictionary
    ##
    set results {}
    set options [::WS::Utils::SetOption]
    ::WS::Utils::SetOption UseNS 0
    ::WS::Utils::SetOption parseInAttr 1
    ::log::logsubst debug {Calling ::WS::Utils::convertTypeToDict Client $serviceName $body $expectedMsgType $body}
    if {$expectedMsgType ne {}} {
        set node [$body childNodes]
        set nodeName [$node nodeName]
        if {$objectName ne $nodeName} {
            return \
                -code error \
                -errorcode [list WS CLIENT BADRESPONSE [list $objectName $nodeName]] \

# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::asyncRestCallDone {serviceName objectName operationName succesCmd errorCmd token} {
    ::log::logsubst debug {Entering [info level 0]}

    ##
    ## Check for errors
    ##
    set body [::http::data $token]
    ::log::logsubst info {\nReceived: $body}
    if {[::http::status $token] ne {ok} ||
        ( [::http::ncode $token] != 200 && $body eq {} )} {
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set hadError 1
        set errorInfo [FormatHTTPError $token]
    } else {
        SaveAndSetOptions $serviceName

        }
    }
}

package require tdom 0.8
package require struct::set

package provide WS::Utils 2.4.2

namespace eval ::WS {}

namespace eval ::WS::Utils {
    set ::WS::Utils::typeInfo {}
    set ::WS::Utils::currentSchema {}
    array set ::WS::Utils::importedXref {}

#                       update this segment of the file header block by
#                       adding a complete entry at the bottom of the list.
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
# 2.4.2    2018-05-14  H.Oehlmann   Add support to translate namespace prefixes
#                                   in attribute values or text values.
#                                   New parameter "xnsDistantToLocalDict".
#
###########################################################################
proc ::WS::Utils::convertTypeToDict {
        mode serviceName node type root {isArray 0} {xnsDistantToLocalDict {}}
} {
    variable typeInfo
    variable mutableTypeInfo
    variable options

    if {$options(valueAttrCompatiblityMode)} {
        set valueAttr {}
    } else {

        }
        if {[string equal $partName *] && [string equal $partType *]} {
            ##
            ## Type infomation being handled dynamically for this part
            ##
            set savedTypeInfo $typeInfo
            parseDynamicType $mode $serviceName $node $type
            set tmp [convertTypeToDict $mode $serviceName $node $type $root 0 $xnsDistantToLocalDict]
            foreach partName [dict keys $tmp] {
                dict set results $partName [dict get $tmp $partName]
            }
            set typeInfo $savedTypeInfo
            continue
        }
        set partXns $xns

                dict set results $partName $tmp
            }
            {1 0} {
                ##
                ## Non-simple non-array
                ##
                if {$options(parseInAttr)} {
                    ## Translate an abstract type from the WSDL to a type given
                    ## in the response
                    ## Example xml response from bug 584bfb772:
                    ## <soap:Envelope ...
                    ##    xmlns:tns="http://www.esri.com/schemas/ArcGIS/10.3">
                    ##  <soap:Body>
                    ##    <tns:GetServerInfoResponse>
                    ##      <Result xsi:type="tns:MapServerInfo">
                    ##      <Name>Layers</Name>
                    ##      <Description></Description>
                    ##        <FullExtent xsi:type="tns:EnvelopeN">
                    ##
                    ## The element FullExtend gets type "tns:EnvelopeN".
                    ##
                    ## xnsDistantToLocalDict
                    if {$isAbstract && [$item hasAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type]} {
                        # partType is now tns::EnvelopeN
                        set partType [XNSDistantToLocal $xnsDistantToLocalDict\
                                [$item getAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type]]
                        
                        # Remove this type attribute from the snippet.
                        # So, it is not handled in the loop below.
                        $item removeAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type
                    }
                    foreach attrList [$item attributes] {
                        catch {
                            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 [convertTypeToDict $mode $serviceName $item $partType $root 0 $xnsDistantToLocalDict]
                } else {
                    dict set results $partName [convertTypeToDict $mode $serviceName $item $partType $root  0 $xnsDistantToLocalDict]
                }
            }
            {1 1} {
                ##
                ## Non-simple array
                ##
                set partType [string trimright $partType {()}]

                                    lappend rowList $attr $attrValue
                                } else {
                                    set attrValue [$row getAttribute $attr]
                                    lappend rowList $attr $attrValue
                                }
                            }
                        }
                        lappend rowList $valueAttr [convertTypeToDict $mode $serviceName $row $partType $root 1 $xnsDistantToLocalDict]
                        lappend tmp $rowList
                    } else {
                        lappend tmp [convertTypeToDict $mode $serviceName $row $partType $root 1 $xnsDistantToLocalDict]
                    }
                }
                dict set results $partName $tmp
            }
            default {
                ##
                ## Placed here to shut up tclchecker
                ##
            }
        }
    }
    ::log::logsubst debug {Leaving ::WS::Utils::convertTypeToDict with result '$results'}
    return $results
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Utils::XNSDistantToLocal
#
# Description : Get a reference node.
#
# Arguments :
#    xnsDistantToLocalDict - Dict to translate distant to local NS prefixes
#    typeDistant - Type string with possible distant namespace prefix
#
# Returns : type with local namespace prefix
#
# Side-Effects : None
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Harald Oehlmann
#
#>>END PRIVATE<<
#
# Maintenance History - as this file is modified, please be sure that you
#                       update this segment of the file header block by
#                       adding a complete entry at the bottom of the list.
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
# 2.4.2    2017-11-03  H.Oehlmann   Initial version
#
###########################################################################
proc ::WS::Utils::XNSDistantToLocal {xnsDistantToLocalDict type} {
    set collonPos [string first ":" $type]
    # check for namespace prefix present
    if {-1 < $collonPos} {
        set prefixDistant [string range $type 0 $collonPos-1]
        if {[dict exists $xnsDistantToLocalDict $prefixDistant]} {
            set type [dict get $xnsDistantToLocalDict $prefixDistant][string range $type $collonPos end]
            log::logsubst debug {Mapped distant namespace prefix '$prefixDistant' to type '$type'}
        } else {
            log::logsubst warning {Distant type '$type' does not have a known namespace prefix ([dict keys $xnsDistantToLocalDict])}
        }
    }
    return $type
}


###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<

            set yajlType $simpleTypesJson([string trimright $itemType {()?}])
        } else {
            set yajlType "string"
        }

        ::log::logsubst debug {\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList}}
        set typeInfoList [lrange $typeInfoList 0 1]
        switch -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                set resultValue [dict get $dict $itemName]
                $doc string $itemName $yajlType $resultValue
            }

proc ::WS::Utils::convertDictToTypeNoNs {mode service doc parent dict type {enforceRequired 0}} {
    ::log::logsubst debug {Entering [info level 0]}
    # ::log::log debug "  Parent xml: [$parent asXML]"
    variable typeInfo
    variable simpleTypes
    variable options
    variable standardAttributes
    variable currentNs

    if {$options(valueAttrCompatiblityMode)} {
        set valueAttr {}
    } else {
        set valueAttr {::value}
    }
    set typeInfoList [TypeInfo $mode $service $type]

                    }
                }
            }
            {1 0} {
                ##
                ## Non-simple non-array
                ##
                $parent appendChild [$doc createElement $itemName retNode]
                if {$options(genOutAttr)} {
                    set dictList [dict keys [dict get $dict $itemName]]
                    set resultValue {}
                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {$isAbstract && [string equal $attr {::type}]} {
                            # *** HaO: useName is never defined
                            set itemType [dict get $dict $useName $attr]
                            $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $itemType
                        } elseif {[string equal $attr $valueAttr]} {
                            set resultValue [dict get $dict $itemName $attr]
                        } elseif {[string match {::*} $attr]} {
                            set baseAttr [string range $attr 2 end]
                            set attrValue [dict get $dict $itemName $attr]
                            $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:$baseAttr $attrValue
                        } else {
                            lappend attrList $attr [dict get $dict $itemName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $itemName]
                }
                if {[llength $attrList]} {
                    ::WS::Utils::setAttr $retNode $attrList
                }
                convertDictToTypeNoNs $mode $service $doc $retNode $resultValue $itemType $enforceRequired
            }
            {1 1} {
                ##
                ## Non-simple array
                ##
                set dataList [dict get $dict $itemName]
                set tmpType [string trimright $itemType {()}]
                foreach row $dataList {
                    $parent appendChild [$doc createElement $itemName retNode]
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {$isAbstract && [string equal $attr {::type}]} {
                                set tmpType [dict get $row $attr]
                                $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $tmpType

                        }
                    } else {
                        set resultValue $row
                    }
                    if {[llength $attrList]} {
                        ::WS::Utils::setAttr $retNode $attrList
                    }
                    convertDictToTypeNoNs $mode $service $doc $retNode $resultValue $tmpType $enforceRequired
                }
            }
            default {
                ##
                ## Placed here to shut up tclchecker
                ##
            }

            }
            complexType {
                $middleNode setAttribute name $typeName
                parseComplexType $mode results $serviceName $middleNode $tns
            }
            simpleContent -
            complexContent {
                ##
                ## Save simple or complex content for abstract types, which
                ## may have content type with no fields. [Bug 584bfb77]
                ## Example xml type snippet:
                ##  <xs:complexType name="Envelope" abstract="true">
                ##    <xs:annotation><xs:documentation /></xs:annotation>
                ##    <xs:complexContent mixed="false">
                ##      <xs:extension base="Geometry" />
                ##    </xs:complexContent>
                ##  </xs:complexType>
                ##  ...
                ##  <xs:complexType name="Geometry">
                ##    <xs:annotation><xs:documentation /></xs:annotation>
                ##  </xs:complexType>
                
                set isComplexContent [expr {$middle eq "complexContent"}]
                ::log::logsubst debug {isComplexContent = $isComplexContent}
                
                ##
                ## Loop over the components of the type
                ##
                foreach child [$middleNode childNodes] {
                    set parent [$child parent]
                    set contentType [$child localName]
                    ::log::logsubst debug {Content Type is {$contentType}}
                    switch -exact -- $contentType {
                        restriction {
                            set nodeFound 1

            }
        }
    }
    ::log::logsubst 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:::logsubst debug  {Defining $typeName as '$partList'}
        ##
        ## Add complex type definition, if:
        ##   *  there is a part list
        ##   *  or it is an abstract type announced as complex
        ##      (see xml snipped above about [Bug 584bfb77])
        ##      -> will set dict typeInfo client $service tns1:envelope {
        ##          definition {} xns tns1 abstract true}
        ##
        if {    ([llength $partList]  && ![string equal [lindex $partList 0] {}])
                || ($isAbstractType && [info exists isComplexContent] && $isComplexContent)
        } {
            ::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"

            array unset fieldInfoArr
            set fieldInfoArr(minOccurs) 0
            array set fieldInfoArr $fieldDef
            if {$fieldInfoArr(minOccurs) && ![info exists fieldInfoArr($field)]} {
                ##
                ## Fields was required but is missing
                ##
                set ::errorCode [list WS CHECK MISSREQFLD [list $typeName $field]]
                set result 0
            } elseif {$fieldInfoArr(minOccurs) &&
                      ($fieldInfoArr(minOccurs) > [llength $fieldInfoArr($field)])} {
                ##
                ## Fields was required and present, but not enough times
                ##
                set ::errorCode [list WS CHECK MINOCCUR [list $type $field]]
                set result 0
            } elseif {[info exists fieldInfoArr(maxOccurs)] &&
                      [string is integer fieldInfoArr(maxOccurs)] &&
                      ($fieldInfoArr(maxOccurs) < [llength $fieldInfoArr($field)])} {
                ##
                ## Fields was required and present, but too many times
                ##
                set ::errorCode [list WS CHECK MAXOCCUR [list $typeName $field]]
                set result 0
            } elseif {[info exists fieldInfoArr($field)]} {
                foreach node $fieldInfoArr($field) {
                    set result [checkTags $mode $serviceName $node $fieldInfoArr(type)]
                    if {!$result} {
                        break
                    }

    set result 0
    array set typeInfos {
        minLength 0
        maxLength -1
        fixed false
    }
    # returns indexes type, xns, ...
    array set typeInfos [GetServiceTypeDef $mode $serviceName $type]
    foreach {var value} [array get typeInfos] {
        set $var $value
    }
    set result 1

    if {$minLength >= 0 && [string length $value] < $minLength} {
        set ::errorCode [list WS CHECK VALUE_TO_SHORT [list $type $value $minLength $typeInfo]]
        set result 0
    } elseif {$maxLength >= 0 && [string length $value] > $maxLength} {
        set ::errorCode [list WS CHECK VALUE_TO_LONG [list $type $value $maxLength $typeInfo]]
        set result 0
    } elseif {[info exists enumeration] && ([lsearch -exact $enumeration $value] == -1)} {
        set errorCode [list WS CHECK VALUE_NOT_IN_ENUMERATION [list $type $value $enumeration $typeInfo]]
        set result 0
    } elseif {[info exists pattern] && (![regexp -- $pattern $value])} {
        set errorCode [list WS CHECK VALUE_NOT_MATCHES_PATTERN [list $type $value $pattern $typeInfo]]
        set result 0
    }

    return $result
}

    ##
    ## Get the type information
    ##
    set baseTypeName [string trimright $typeName {()?}]
    set typeInfo [GetServiceTypeDef $mode $serviceName $baseTypeName]
    set typeName [string trimright $typeName {?}]
    set xns [dict get $typeInfo $mode $serviceName $typeName xns]

    foreach {field fieldDef} [dict get $typeInfo definition] {
        ##
        ## Get info about this field and its type
        ##
        array unset fieldInfoArr
        set fieldInfoArr(minOccurs) 0

                  [string is integer fieldInfoArr(maxOccurs)] &&
                  ($fieldInfoArr(maxOccurs) < $valueListLenght)} {
            ##
            ## Fields was required and present, but too many times
            ##
            set minOccurs $fieldInfoArr(maxOccurs)
            return \
                -errorcode [list WS CHECK MAXOCCUR [list $typeName $field]] \
                "Field '$field' of type '$typeName' could only occur $minOccurs time(s) but occured $valueListLenght time(s)"
        } elseif {[dict exists $valueInfos $field]} {
            foreach value $valueList {
                $currentNode appendChild [$doc createElement $xns:$field retNode]
                if {$isComplex} {
                    buildTags $mode $serviceName $fieldBaseType $value $doc $retNode
                } else {

# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex -direct" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]]
package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]]
package ifneeded WS::Client 2.5.1 [list source [file join $dir ClientSide.tcl]]
package ifneeded WS::Embeded 2.4.0 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::Server 2.4.0 [list source [file join $dir ServerSide.tcl]]
package ifneeded WS::Utils 2.4.2 [list source [file join $dir Utilities.tcl]]
package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]]
package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]]