Artifact Content

Not logged in

Artifact 347dd564d720a7fd669be56c71a19cfedc091e9f:

Attachment "ClientSide.tcl" to ticket [2c3ef042cf] added by anonymous 2013-12-27 23:33:03.
###############################################################################
##                                                                           ##
##  Copyright (c) 2006-2008, Gerald W. Lester                                ##
##  Copyright (c) 2008, Georgios Petasis                                     ##
##  Copyright (c) 2006, Visiprise Software, Inc                              ##
##  Copyright (c) 2006, Arnulf Wiedemann                                     ##
##  Copyright (c) 2006, Colin McCormack                                      ##
##  Copyright (c) 2006, Rolf Ade                                             ##
##  Copyright (c) 2001-2006, Pat Thoyts                                      ##
##  All rights reserved.                                                     ##
##                                                                           ##
##  Redistribution and use in source and binary forms, with or without       ##
##  modification, are permitted provided that the following conditions       ##
##  are met:                                                                 ##
##                                                                           ##
##    * Redistributions of source code must retain the above copyright       ##
##      notice, this list of conditions and the following disclaimer.        ##
##    * Redistributions in binary form must reproduce the above              ##
##      copyright notice, this list of conditions and the following          ##
##      disclaimer in the documentation and/or other materials provided      ##
##      with the distribution.                                               ##
##    * Neither the name of the Visiprise Software, Inc nor the names        ##
##      of its contributors may be used to endorse or promote products       ##
##      derived from this software without specific prior written            ##
##      permission.                                                          ##
##                                                                           ##
##  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS      ##
##  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT        ##
##  LIMITED  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS       ##
##  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE           ##
##  COPYRIGHT OWNER OR  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,     ##
##  INCIDENTAL, SPECIAL,  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,    ##
##  BUT NOT LIMITED TO,  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;        ##
##  LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER         ##
##  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT       ##
##  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR  OTHERWISE) ARISING IN       ##
##  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF  ADVISED OF THE         ##
##  POSSIBILITY OF SUCH DAMAGE.                                              ##
##                                                                           ##
###############################################################################

package require WS::Utils 1.4.0
#package require Tcl 8.5
if {![llength [info command dict]]} {
    package require dict
}
# Until we get the package ready
if {![llength [info command dom]]} {
    set ext [info sharedlibextension]
    if {[catch {uplevel #0 load $::hms::home/publiclib/tdom$ext} retResult]} {
        return -code error $retResult
    }
}

#package require tdom 0.8

package require http 2
package require log
package require uri

catch {
    package require tls
    http::register https 443 ::tls::socket
}

package provide WS::Client 1.4.0

namespace eval ::WS::Client {
    ##
    ## serviceArr is indexed by service name and contains a dictionary that
    ## defines the service.  The dictionary has the following structure:
    ##   targetNamespace - the target namespace
    ##   operList - list of operations
    ##   objList  - list of operations
    ##   headers  - list of http headers
    ##   types    - dictionary of types
    ##   service  - dictionary containing general information about the service, formatted:
    ##      name     -- the name of the service
    ##      location -- the url
    ##      style    -- style of call (e.g. rpc/encoded, document/literal)
    ##
    ## For style of rpc/encoded, document/literal
    ##   operations - dictionary with information about the operations.  The key
    ##               is the operations name and each with the following structure:
    ##      soapRequestHeader -- list of SOAP Request Headers
    ##      soapReplyHeader   -- list of SOAP Reply Headers
    ##      action            -- SOAP Action Header
    ##      inputs            -- list of fields with type info
    ##      outputs           -- return type
    ##      style             -- style of call (e.g. rpc/encoded, document/literal)
    ##
    ## For style of rest
    ##   object - dictionary with informat about objects.  The key is the object
    ##            name each with the following strucutre:
    ##     operations -- dictionary with information about the operations.  The key
    ##                   is the operations name and each with the following structure:
    ##       inputs            --- list of fields with type info
    ##       outputs           --- return type
    ##
    ## Note -- all type information is formated suitable to be passed
    ##         to ::WS::Utils::ServiceTypeDef
    ##
    array set ::WS::Client::serviceArr {}
    set ::WS::Client::currentBaseUrl {}
    array set ::WS::Client::options {
        skipLevelWhenActionPresent 0
        suppressTargetNS 0
    }
}


###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::CreateService
#
# Description : Define a service
#
# Arguments :
#       serviceName - Service name to add namespace to
#       type        - The type of service, currently only REST is supported
#       url         - URL of namespace file to import
#       args        - Optional arguments:
#                       -header httpHeaderList
#
# Returns :     The local alias (tns)
#
# Side-Effects :        None
#
# Exception Conditions :        None
#
# Pre-requisite Conditions :    None
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  04/14/2009  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::CreateService {serviceName type url args} {
    variable serviceArr
    variable options

    dict set serviceArr($serviceName) types {}
    dict set serviceArr($serviceName) operList {}
    dict set serviceArr($serviceName) objList {}
    dict set serviceArr($serviceName) headers {}
    dict set serviceArr($serviceName) targetNamespace tns1 $url
    dict set serviceArr($serviceName) name $serviceName
    dict set serviceArr($serviceName) location $url
    dict set serviceArr($serviceName) style $type
    dict set serviceArr($serviceName) inTransform {}
    dict set serviceArr($serviceName) outTransform {}
    dict set serviceArr($serviceName) skipLevelWhenActionPresent $options(skipLevelWhenActionPresent)
    dict set serviceArr($serviceName) suppressTargetNS $options(suppressTargetNS)
    foreach {name value} $args {
        set name [string trimleft $name {-}]
        dict set serviceArr($serviceName) $name $value
    }

    if {[dict exists $serviceArr($serviceName) xns]} {
        set xns [dict get $serviceArr($serviceName) xns]
        ::log::log debug [list Setting targetNamespae to $xns]
        dict set serviceArr($serviceName) targetNamespace $xns
    }
}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::Config
#
# Description : Configure a service information
#
# Arguments :
#       serviceName - Service name to add namespace to
#       item        - The item to configure
#       value       - Optional, the new value
#
# Returns :     The value of the option
#
# Side-Effects :        None
#
# Exception Conditions :        None
#
# Pre-requisite Conditions :    None
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  04/14/2009  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::Config {serviceName item {value {}}} {
    variable serviceArr

    set serviceInfo $serviceArr($serviceName)
    switch -exact -- $item {
        suppressTargetNS -
        skipLevelWhenActionPresent -
        location -
        targetNamespace {
            ##
            ## Valid, so do nothing
            ##
        }
        default {
            return -code error "Uknown option '$item'"
        }
    }

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

    return [dict get $serviceInfo $item]

}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::SetServiceTransforms
#
# Description : Define a service's transforms
#               Transform signature is:
#                   cmd serviceName operationName transformType xml {url {}} {argList {}}
#               where transformType is REQUEST or REPLY
#               and url and argList will only be present for transformType == REQUEST
#
# Arguments :
#       serviceName  - Service name to add namespace to
#       inTransform  - Input transform, defaults to {}
#       outTransform - Output transform, defaults to {}
#
# Returns :     None
#
# Side-Effects :        None
#
# Exception Conditions :        None
#
# Pre-requisite Conditions :    None
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  04/14/2009  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::SetServiceTransforms {serviceName {inTransform {}} {outTransform {}}} {
    variable serviceArr

    dict set serviceArr($serviceName) inTransform $inTransform
    dict set serviceArr($serviceName) outTransform $outTransform

    return;
}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::GetServiceTransforms
#
# Description : Define a service's transforms
#
# Arguments :
#       serviceName  - Service name to add namespace to
#
# Returns :     List of two elements: inTransform outTransform
#
# Side-Effects :        None
#
# Exception Conditions :        None
#
# Pre-requisite Conditions :    None
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  04/14/2009  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::GetServiceTransforms {serviceName} {
    variable serviceArr

    set inTransform [dict get serviceArr($serviceName) inTransform]
    set outTransform [dict get serviceArr($serviceName) outTransform]

    return [list $inTransform $outTransform]
}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::DefineRestMethod
#
# Description : Define a method
#
# Arguments :
#       serviceName - Service name to add namespace to
#       methodName  - The name of the method to add
#       inputArgs   - List of input argument definitions where each argument
#                       definition is of the format: name typeInfo
#       returnType  - The type, if any returned by the procedure.  Format is:
#                       xmlTag typeInfo
#
#  where, typeInfo is of the format {type typeName comment commentString}
#
# Returns :     The current service definition
#
# Side-Effects :        None
#
# Exception Conditions :        None
#
# Pre-requisite Conditions :    None
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  04/14/2009  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::DefineRestMethod {serviceName objectName operationName inputArgs returnType {location {}}} {
    variable serviceArr

    if {[lsearch -exact  [dict get $serviceArr($serviceName) objList] $objectName] == -1} {
        dict lappend serviceArr($serviceName) objList $objectName
    }
    if {![llength $location]} {
        set location [dict get $serviceArr($serviceName) location]
    }

    if {![string equal $inputArgs {}]} {
        set inType $objectName.$operationName.Request
        ::WS::Utils::ServiceTypeDef Client $serviceName $inType $inputArgs
    } else {
        set inType {}
    }
    if {![string equal $returnType {}]} {
        set outType $objectName.$operationName.Results
        ::WS::Utils::ServiceTypeDef Client $serviceName $outType $returnType
    } else {
        set outType {}
    }

    dict set serviceArr($serviceName) object $objectName location $location
    dict set serviceArr($serviceName) object $objectName operation $operationName inputs $inType
    dict set serviceArr($serviceName) object $objectName operation $operationName outputs $outType

}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::ImportNamespace
#
# Description : Import and additional namespace into the service
#
# Arguments :
#       serviceName - Service name to add namespace to
#       url         - URL of namespace file to import
#
# Returns :     The local alias (tns)
#
# Side-Effects :        None
#
# Exception Conditions :        None
#
# Pre-requisite Conditions :    None
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  01/30/2009  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::ImportNamespace {serviceName url} {
    variable serviceArr

    switch -exact -- [dict get [::uri::split $url] scheme] {
        file {
            upvar #0 [::uri::geturl $url] token
            set xml $token(data)
            unset token
        }
        http {
            set token [::http::geturl $url]
            ::http::wait $token
            set ncode [::http::ncode $token]
            set xml [::http::data $token]
            ::http::cleanup $token
            if {$ncode != 200} {
                return \
                    -code error \
                    -errorcode [list WS CLIENT HTTPFAIL $url] \
                    "HTTP get of import file failed '$url'"
            }
        }
        default {
            return \
                -code error \
                -errorcode [list WS CLIENT UNKURLTYP $url] \
                "Unknown URL type '$url'"
        }
    }
    set tnsCount [llength [dict get $serviceArr($serviceName) targetNamespace]]
    set serviceInfo $serviceArr($serviceName)
    ::WS::Utils::ProcessImportXml Client $url $xml $serviceName serviceInfo tnsCount
    set serviceArr($serviceName) $serviceInfo
    set result {}
    foreach pair [dict get $serviceArr($serviceName) targetNamespace] {
        if {[string equal [lindex $pair 1] $url]} {
            set result [lindex $pair 0]
        }
    }
    return $result
}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::GetOperationList
#
# Description : Import and additional namespace into the service
#
# Arguments :
#       serviceName - Service name to add namespace to
#
# Returns :     A list of operations names.
#
# Side-Effects :        None
#
# Exception Conditions :        None
#
# Pre-requisite Conditions :    None
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  01/30/2009  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::GetOperationList {serviceName {object {}}} {
    variable serviceArr

    if {[string equal $object {}]} {
        return [dict get $serviceArr($serviceName) operList]
    } else {
        return [dict get $serviceArr($serviceName) operation $object inputs]
    }

}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::AddInputHeader
#
# Description : Import and additional namespace into the service
#
# Arguments :
#       serviceName - Service name to of the oepration
#       operation   - name of operation to add an input header to
#       headerType  - the type name to add as a header
#       attrList    - list of name value pairs of attributes and their
#                     values to add to the XML
#
# Returns :     Nothing
#
# Side-Effects :        None
#
# Exception Conditions :        None
#
# Pre-requisite Conditions :    None
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  01/30/2009  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::AddInputHeader {serviceName operationName headerType {attrList {}}} {
    variable serviceArr

    set serviceInfo $serviceArr($serviceName)
    set soapRequestHeader [dict get $serviceInfo operation $operationName soapRequestHeader]
    lappend soapRequestHeader [list $headerType $attrList]
    dict set serviceInfo operation $operationName soapRequestHeader $soapRequestHeader
    set serviceArr($serviceName) $serviceInfo
    return ;

}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::AddOutputHeader
#
# Description : Import and additional namespace into the service
#
# Arguments :
#       serviceName - Service name to of the oepration
#       operation   - name of operation to add an output header to
#       headerType  - the type name to add as a header
#       attrList    - list of name value pairs of attributes and their
#                     values to add to the XML
#
# Returns :     Nothing
#
# Side-Effects :        None
#
# Exception Conditions :        None
#
# Pre-requisite Conditions :    None
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  01/30/2009  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::AddOutputHeader {serviceName operation headerType} {
    variable serviceArr

    set serviceInfo $serviceArr($serviceName)
    set soapReplyHeader [dict get $serviceInfo operation $operationName soapReplyHeader]
    lappend soapReplyHeader $headerType
    dict set serviceInfo operation $operationName soapReplyHeader $soapReplyHeader
    set serviceArr($serviceName) $serviceInfo
    return ;

}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::LoadParsedWsdl
#
# Description : Load a saved service definition in
#
# Arguments :
#       serviceInfo - parsed service definition, as returned from
#                     ::WS::Client::ParseWsdl or ::WS::Client::GetAndParseWsdl
#       headers     - Extra headers to add to the HTTP request. This
#                       is a key value list argument. It must be a list with
#                       an even number of elements that alternate between
#                       keys and values. The keys become header field names.
#                       Newlines are stripped from the values so the header
#                       cannot be corrupted.
#                       This is an optional argument and defaults to {}.
#       serviceAlias - Alias (unique) name for service.
#                       This is an optional argument and defaults to the name of the
#                       service in serviceInfo.
#
# Returns :     The name of the service loaded
#
# Side-Effects :        None
#
# Exception Conditions :        None
#
# Pre-requisite Conditions :    None
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::LoadParsedWsdl {serviceInfo {headers {}} {serviceAlias {}}} {
    variable serviceArr

    if {[string length $serviceAlias]} {
        set serviceName $serviceAlias
    } else {
        set serviceName [dict get $serviceInfo name]
    }
    if {[llength $headers]} {
        dict set serviceInfo headers $headers
    }
    set serviceArr($serviceName) $serviceInfo

    if {[dict exists $serviceInfo types]} {
        foreach {typeName partList} [dict get $serviceInfo types] {
            set definition [dict get $partList definition]
            set xns [dict get $partList xns]
            if {[string equal [lindex [split $typeName {:}] 1] {}]} {
                ::WS::Utils::ServiceTypeDef Client $serviceName $typeName $definition tns1
            } else {
                #set typeName [lindex [split $typeName {:}] 1]
                ::WS::Utils::ServiceTypeDef Client $serviceName $typeName $definition $xns
            }
        }
    }

    if {[dict exists $serviceInfo simpletypes]} {
        foreach partList [dict get $serviceInfo simpletypes] {
            lassign $partList typeName definition
            if {[string equal [lindex [split $typeName {:}] 1] {}]} {
                ::WS::Utils::ServiceSimpleTypeDef Client $serviceName $typeName $definition tns1
            } else {
                set xns [lindex [split $typeName {:}] 0]
                #set typeName [lindex [split $typeName {:}] 1]
                ::WS::Utils::ServiceSimpleTypeDef Client $serviceName $typeName $definition $xns
            }
        }
    }

    return $serviceName
}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::GetAndParseWsdl
#
# Description :
#
# Arguments :
#       url     - The url of the WSDL
#       headers     - Extra headers to add to the HTTP request. This
#                       is a key value list argument. It must be a list with
#                       an even number of elements that alternate between
#                       keys and values. The keys become header field names.
#                       Newlines are stripped from the values so the header
#                       cannot be corrupted.
#                       This is an optional argument and defaults to {}.
#       serviceAlias - Alias (unique) name for service.
#                       This is an optional argument and defaults to the name of the
#                       service in serviceInfo.
#
# Returns : The parsed service definition
#
# Side-Effects : None
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::GetAndParseWsdl {url {headers {}} {serviceAlias {}}} {
    variable currentBaseUrl

    set currentBaseUrl $url
    switch -exact -- [dict get [::uri::split $url] scheme] {
        file {
            upvar #0 [::uri::geturl $url] token
            set wsdlInfo [ParseWsdl $token(data) -headers $headers -serviceAlias $serviceAlias]
            unset token
        }
        http -
        https {
            if {[llength $headers]} {
                set token [::http::geturl $url -headers $headers]
            } else {
                set token [::http::geturl $url]
            }
            ::http::wait $token
            set wsdlInfo [ParseWsdl [::http::data $token] -headers $headers -serviceAlias $serviceAlias]
            ::http::cleanup $token
        }
        default {
            return \
                -code error \
                -errorcode [list WS CLIENT UNKURLTYP $url] \
                "Unknown URL type '$url'"
        }
    }
    set currentBaseUrl {}

    return $wsdlInfo
}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::ParseWsdl
#
# Description : Parse a WSDL
#
# Arguments :
#       wsdlXML - XML of the WSDL
#
# Optional Arguments:
#       -createStubs 0|1 - create stub routines for the service
#                               NOTE -- Webservice arguments are position
#                                       independent, thus the proc arguments
#                                       will be defined in alphabetical order.
#       -headers         - Extra headers to add to the HTTP request. This
#                          is a key value list argument. It must be a list with
#                          an even number of elements that alternate between
#                          keys and values. The keys become header field names.
#                          Newlines are stripped from the values so the header
#                          cannot be corrupted.
#                          This is an optional argument and defaults to {}.
#       -serviceAlias - Alias (unique) name for service.
#                       This is an optional argument and defaults to the name of the
#                       service in serviceInfo.
#
# Returns : The parsed service definition
#
# Side-Effects : None
#
# Exception Conditions :None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::ParseWsdl {wsdlXML args} {
    variable serviceArr

    array set defaults {
        -createStubs    0
        -headers        {}
        -serviceAlias   {}
    }

    array set defaults $args

    dom parse $wsdlXML tmpdoc
    $tmpdoc xslt $::WS::Utils::xsltSchemaDom wsdlDoc
    $tmpdoc delete
    $wsdlDoc documentElement wsdlNode
    set nsCount 1
    set targetNs [$wsdlNode getAttribute targetNamespace]
    dict set nsDict url $targetNs tns$nsCount
    foreach itemList [$wsdlNode attributes xmlns:*] {
        set ns [lindex $itemList 0]
        set url [$wsdlNode getAttribute xmlns:$ns]
        if {[dict exists $nsDict url $url]} {
            set tns [dict get $nsDict url $url]
        } else {
            ##
            ## Check for hardcoded namespaces
            ##
            switch -exact -- $url {
                http://schemas.xmlsoap.org/wsdl/ {
                    set tns w
                }
                http://schemas.xmlsoap.org/wsdl/soap/ {
                    set tns d
                }
                http://www.w3.org/2001/XMLSchema {
                    set tns xs
                }
                default {
                    set tns tns[incr nsCount]
                }
            }
            dict set nsDict url $url $tns
        }
        dict set nsDict tns $ns $tns
    }
    $wsdlDoc selectNodesNamespaces {
        w http://schemas.xmlsoap.org/wsdl/
        d http://schemas.xmlsoap.org/wsdl/soap/
        xs http://www.w3.org/2001/XMLSchema
    }
    if {[string length $defaults(-serviceAlias)]} {
        set serviceAlias $defaults(-serviceAlias)
    } else {
        set serviceAlias {}
    }

    set serviceInfo {}

    foreach serviceInfo [buildServiceInfo $wsdlNode $nsDict $serviceInfo $serviceAlias] {
        set serviceName [dict get $serviceInfo name]

        if {[llength $defaults(-headers)]} {
            dict set serviceInfo headers $defaults(-headers)
        }
        dict set serviceInfo types [::WS::Utils::GetServiceTypeDef Client $serviceName]
        dict set serviceInfo simpletypes [::WS::Utils::GetServiceSimpleTypeDef Client $serviceName]

        set serviceArr($serviceName) $serviceInfo

        if {$defaults(-createStubs)} {
            catch {namespace delete $serviceName}
            namespace eval $serviceName {}
            CreateStubs $serviceName
        }
    }

    $wsdlDoc delete

    return $serviceInfo

}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::CreateStubs
#
# Description : Create stubs routines to make calls to Webservice Operations.
#               All routines will be create in a namespace that is the same
#               as the service name.  The procedure name will be the same
#               as the operation name.
#
#               NOTE -- Webservice arguments are position independent, thus
#                       the proc arguments will be defined in alphabetical order.
#
# Arguments :
#       serviceName     - The service to create stubs for
#
# Returns : A string describing the created procedures.
#
# Side-Effects : Existing namespace is deleted.
#
# Exception Conditions : None
#
# Pre-requisite Conditions : Service must have been defined.
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::CreateStubs {serviceName} {
    variable serviceArr

    namespace eval [format {::%s::} $serviceName] {}

    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }

    set serviceInfo $serviceArr($serviceName)

    set procList {}

    foreach operationName [dict get $serviceInfo operList] {
        set procName [format {::%s::%s} $serviceName $operationName]
        set argList {}
        foreach inputHeaderTypeItem [dict get $serviceInfo operation $operationName soapRequestHeader] {
            set  inputHeaderType [lindex $inputHeaderTypeItem 0]
            if {[string equal $inputHeaderType {}]} {
                continue
            }
            set headerTypeInfo [::WS::Utils::GetServiceTypeDef Client $serviceName $inputHeaderType]
            set headerFields [dict keys [dict get $headerTypeInfo definition]]
            if {![string equal $headerFields {}]} {
                lappend argList [lsort -dictionary $headerFields]
            }
        }
        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::log debug "no definition found for inputMsgType $inputMsgType"
          set inputFields {}
        }
        if {![string equal $inputFields {}]} {
            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::log debug [list ::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"
}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::DoRawCall
#
# Description : Call an operation of a web service
#
# Arguments :
#       serviceName     - The name of the Webservice
#       operationName   - The name of the Operation to call
#       argList         - The arguements to the operation as a dictionary object.
#                         This is for both the Soap Header and Body messages.
#       headers         - Extra headers to add to the HTTP request. This
#                         is a key value list argument. It must be a list with
#                         an even number of elements that alternate between
#                         keys and values. The keys become header field names.
#                         Newlines are stripped from the values so the header
#                         cannot be corrupted.
#                         This is an optional argument and defaults to {}.
#
# Returns :
#       The XML of the operation.
#
# Side-Effects :        None
#
# Exception Conditions :
#       WSCLIENT HTTPERROR      - if an HTTP error occured
#
# Pre-requisite Conditions :    Service must have been defined.
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::DoRawCall {serviceName operationName argList {headers {}}} {
    variable serviceArr

    ::log::log debug "Entering ::WS::Client::DoRawCall {$serviceName $operationName $argList}"
    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }
    set serviceInfo $serviceArr($serviceName)
    if {![dict exists $serviceInfo operation $operationName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $operationName]] \
            "Unknown operation '$operationName' for service '$serviceName'"
    }
    set url [dict get $serviceInfo location]
    set query [buildCallquery $serviceName $operationName $url $argList]
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[dict exists $serviceInfo operation $operationName action]} {
        lappend headers  SOAPAction [dict get $serviceInfo operation $operationName action]
    }
    if {[llength $headers]} {
        set token [::http::geturl $url -query $query -type text/xml -headers $headers]
    } else {
        set token [::http::geturl $url -query $query -type text/xml]
    }
    ::http::wait $token

    ##
    ## Check for errors
    ##
    if {![string equal [::http::status $token] ok] || [::http::ncode $token] != 200} {
        set errorCode [list WSCLIENT HTTPERROR [::http::code $token]]
        set errorInfo {}
        set results [::http::error $token]
        set hadError 1
    } else {
        set hadError 0
        set results [::http::data $token]
    }
    ::http::cleanup $token
    if {$hadError} {
        ::log::log debug "Leaving (error) ::WS::Client::DoRawCall"
        return \
            -code error \
            -errorcode $errorCode \
            -errorinfo $errorInfo \
            $results
    } else {
        ::log::log debug "Leaving ::WS::Client::DoRawCall with {$results}"
        return $results
    }

}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::DoCall
#
# Description : Call an operation of a web service
#
# Arguments :
#       serviceName     - The name of the Webservice
#       operationName   - The name of the Operation to call
#       argList         - The arguements to the operation as a dictionary object
#                         This is for both the Soap Header and Body messages.
#       headers         - Extra headers to add to the HTTP request. This
#                         is a key value list argument. It must be a list with
#                         an even number of elements that alternate between
#                         keys and values. The keys become header field names.
#                         Newlines are stripped from the values so the header
#                         cannot be corrupted.
#                         This is an optional argument and defaults to {}.
#
# Returns :
#       The return value of the operation as a dictionary object.
#
# Side-Effects :        None
#
# Exception Conditions :
#       WSCLIENT HTTPERROR      - if an HTTP error occured
#       others                  - as raised by called Operation
#
# Pre-requisite Conditions :    Service must have been defined.
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::DoCall {serviceName operationName argList {headers {}}} {
    variable serviceArr

    ::log::log debug "Entering ::WS::Client::DoCall {$serviceName $operationName $argList}"
    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }
    set serviceInfo $serviceArr($serviceName)
    if {![dict exists $serviceInfo operation $operationName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $operationName]] \
            "Unknown operation '$operationName' for service '$serviceName'"
    }
    set url [dict get $serviceInfo location]
    set query [buildCallquery $serviceName $operationName $url $argList]
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[dict exists $serviceInfo operation $operationName action]} {
        lappend headers  SOAPAction [dict get $serviceInfo operation $operationName action]
    }
    if {[llength $headers]} {
        ::log::log debug [list ::http::geturl $url -query $query -type text/xml -headers $headers]
        set token [::http::geturl $url -query $query -type text/xml -headers $headers]
    } else {
        ::log::log debug  [list ::http::geturl $url -query $query -type text/xml]
        set token [::http::geturl $url -query $query -type text/xml]
    }
    ::http::wait $token

    ##
    ## Check for errors
    ##
    set httpStatus [::http::status $token]
    if {{![string equal $httpStatus ok] && [::http::ncode $token] == 500} {
        set body [::http::data $token]
        ::log::log debug "\tReceived: $body"
        set outTransform [dict get $serviceInfo outTransform]
        if {![string equal $outTransform {}]} {
            set body [$outTransform $serviceName $operationName REPLY $body]
        }
        set hadError [catch {parseResults $serviceName $operationName $body} results]
        if {$hadError} {
            lassign $::errorCode mainError subError
            if {[string equal $mainError WSCLIENT] && [string equal $subError NOSOAP]} {
                ::log::log debug "\tHTTP error $body"
                set results $body
                set errorCode [list WSCLIENT HTTPERROR $body]
                set errorInfo {}
                set hadError 1
            } else {
                ::log::log debug "Reply was $body"
                set errorCode $::errorCode
                set errorInfo $::errorInfo
            }
        }
    } elseif {![string equal $httpStatus ok] || [::http::ncode $token] != 200} {
        ::log::log debug "\tHTTP error [array get $token]"
        set results [::http::error $token]
        set errorCode [list WSCLIENT HTTPERROR [::http::code $token]]
        set errorInfo {}
        set hadError 1
    } else {
        set body [::http::data $token]
        ::log::log debug "\tReceived: $body"
        set outTransform [dict get $serviceInfo outTransform]
        if {![string equal $outTransform {}]} {
            set body [$outTransform $serviceName $operationName REPLY $body]
        }
        set hadError [catch {parseResults $serviceName $operationName $body} results]
        if {$hadError} {
            ::log::log debug "Reply was $body"
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }
    }
    ::http::cleanup $token
    if {$hadError} {
        ::log::log debug "Leaving (error) ::WS::Client::DoCall"
        return \
            -code error \
            -errorcode $errorCode \
            -errorinfo $errorInfo \
            $results
    } else {
        ::log::log debug "Leaving ::WS::Client::DoCall with {$results}"
        return $results
    }

}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::DoAsyncCall
#
# Description : Call an operation of a web service asynchronously
#
# Arguments :
#       serviceName     - The name of the Webservice
#       operationName   - The name of the Operation to call
#       argList         - The arguements to the operation as a dictionary object
#                         This is for both the Soap Header and Body messages.
#       succesCmd       - A command prefix to be called if the operations
#                         does not raise an error.  The results, as a dictionary
#                         object are concatinated to the prefix.
#       errorCmd        - A command prefix to be called if the operations
#                         raises an error.  The error code and stack trace
#                         are concatinated to the prefix.
#       headers         - Extra headers to add to the HTTP request. This
#                         is a key value list argument. It must be a list with
#                         an even number of elements that alternate between
#                         keys and values. The keys become header field names.
#                         Newlines are stripped from the values so the header
#                         cannot be corrupted.
#                         This is an optional argument and defaults to {}.
#
# Returns :
#       None.
#
# Side-Effects :        None
#
# Exception Conditions :
#       WSCLIENT HTTPERROR      - if an HTTP error occured
#       others                  - as raised by called Operation
#
# Pre-requisite Conditions :    Service must have been defined.
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::DoAsyncCall {serviceName operationName argList succesCmd errorCmd {headers {}}} {
    variable serviceArr

    ::log::log debug "Entering ::WS::Client::DoAsyncCall [list $serviceName $operationName $argList $succesCmd $errorCmd $headers]"
    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }
    set serviceInfo $serviceArr($serviceName)
    if {![dict exists $serviceInfo operation $operationName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $operationName]] \
            "Unknown operation '$operationName' for service '$serviceName'"
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    set url [dict get $serviceInfo location]
    set query [buildCallquery $serviceName $operationName $url $argList]
    if {[llength $headers]} {
        ::http::geturl $url \
            -query $query \
            -type text/xml \
            -headers $headers \
            -command [list ::WS::Client::asyncCallDone $serviceName $operationName $succesCmd $errorCmd]
    } else {
        ::http::geturl $url \
            -query $query \
            -type text/xml \
            -command [list ::WS::Client::asyncCallDone $serviceName $operationName $succesCmd $errorCmd]
    }
    ::log::log debug "Leaving ::WS::Client::DoAsyncCall"
    return;
}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::List
#
# Description : List a Webservice's Operations.
#
#               NOTE -- Webservice arguments are position independent, thus
#                       the proc arguments will be defined in alphabetical order.
#
# Arguments :
#       serviceName     - The service to create stubs for
#
# Returns : A string describing the operations.
#
# Side-Effects : Existing namespace is deleted.
#
# Exception Conditions : None
#
# Pre-requisite Conditions : Service must have been defined.
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  10/11/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::List {serviceName} {
    variable serviceArr

    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }

    set serviceInfo $serviceArr($serviceName)

    set procList {}

    foreach operationName [dict get $serviceInfo operList] {
        set procName $operationName
        set argList {}
        foreach inputHeaderTypeItem [dict get $serviceInfo operation $operationName soapRequestHeader] {
            set inputHeaderType [lindex $inputHeaderTypeItem 0]
            if {[string equal $inputHeaderType {}]} {
                continue
            }
            set headerTypeInfo [::WS::Utils::GetServiceTypeDef Client $serviceName $inputHeaderType]
            set headerFields [dict keys [dict get $headerTypeInfo definition]]
            if {![string equal $headerFields {}]} {
                lappend argList [lsort -dictionary $headerFields]
            }
        }
        set inputMsgType [dict get $serviceInfo operation $operationName inputs]
        set inputFields [dict keys [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $inputMsgType] definition]]
        if {![string equal $inputFields {}]} {
            lappend argList [lsort -dictionary $inputFields]
        }
        set argList [join $argList]

        append procList "\n\t$procName $argList"
    }
    return "$procList\n"
}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::ListRest
#
# Description : List a Webservice's Operations.
#
#               NOTE -- Webservice arguments are position independent, thus
#                       the proc arguments will be defined in alphabetical order.
#
# Arguments :
#       serviceName     - The service to create stubs for
#
# Returns : A string describing the operations.
#
# Side-Effects : Existing namespace is deleted.
#
# Exception Conditions : None
#
# Pre-requisite Conditions : Service must have been defined.
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  10/11/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::ListRest {serviceName} {
    variable serviceArr

    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }

    set serviceInfo $serviceArr($serviceName)

    set procList {}

    foreach object [dict get $serviceInfo objList] {
        foreach operationName [dict keys [dict get $serviceInfo object $object operations]] {
            set procName $operationName
            set argList {}
            foreach inputHeaderTypeItem [dict get $serviceInfo operation $operationName soapRequestHeader] {
                set inputHeaderType [lindex $inputHeaderTypeItem 0]
                if {[string equal $inputHeaderType {}]} {
                    continue
                }
                set headerTypeInfo [::WS::Utils::GetServiceTypeDef Client $serviceName $inputHeaderType]
                set headerFields [dict keys [dict get $headerTypeInfo definition]]
                if {![string equal $headerFields {}]} {
                    lappend argList [lsort -dictionary $headerFields]
                }
            }
            set inputMsgType [dict get $serviceInfo operation $operationName inputs]
            set inputFields [dict keys [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $inputMsgType] definition]]
            if {![string equal $inputFields {}]} {
                lappend argList [lsort -dictionary $inputFields]
            }
            set argList [join $argList]

            append procList "\n\t$object $procName $argList"
        }
    }
    return "$procList\n"
}


###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Client::asyncCallDone
#
# Description : Called when an asynchronous call is complete.  This routine
#               will call either the success or error callback depending on
#               if the operation succeeded or failed -- assuming the callback
#               is defined.
#
# Arguments :
#    serviceName        - the name of the service called
#    operationName      - the name of the operation called
#    succesCmd          - the command prefix to call if no error
#    errorCmd           - the command prefix to call on an error
#    token              - the token from the HTTP request
#
# Returns : Nothing
#
# Side-Effects : None
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::asyncCallDone {serviceName operationName succesCmd errorCmd token} {
    ::log::log debug "Entering ::WS::Client::asyncCallDone {$serviceName $operationName $succesCmd $errorCmd $token}"

    ##
    ## Check for errors
    ##
    if {![string equal [::http::status $token] ok] || [::http::ncode $token] != 200} {
        set errorCode [list WSCLIENT HTTPERROR [::http::code $token]]
        set hadError 1
        set errorInfo [::http::error $token]
    } else {
        set body [::http::data $token]
        set hadError [catch {parseResults $serviceName $operationName $body} results]
        if {$hadError} {
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }
    }

    ##
    ## Call the appropriate callback
    ##
    if {$hadError} {
        set cmd $errorCmd
        lappend cmd $errorCode $errorInfo
    } else {
        set cmd $succesCmd
    }
    lappend cmd $results
    catch $cmd

    ##
    ## All done
    ##
    ::http::cleanup $token
    return;
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Client::parseResults
#
# Description : Convert the returned XML into a dictionary object
#
# Arguments :
#    serviceName        - the name of the service called
#    operationName      - the name of the operation called
#    inXML              - the XML returned by the operation
#
# Returns : A dictionary object representing the results
#
# Side-Effects : None
#
# Exception Conditions :
#       WSCLIENT REMERR         - The remote end raised an exception, the third element of
#                                 the error code is the remote fault code.
#                                 Error info is set to the remote fault details.
#                                 The error message is the remote fault string;
#       WSCLIENT BADREPLY       - Badly formatted reply, the third element is a list of
#                                 what message type was received vs what was expected.
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::parseResults {serviceName operationName inXML} {
    variable serviceArr

    ::log::log debug "In parseResults $serviceName $operationName {$inXML}"

    set serviceInfo $serviceArr($serviceName)

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

    dom parse $inXML doc
    $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 tmp [dict get $serviceInfo targetNamespace] {
        lappend xns [lindex $tmp 0] [lindex $tmp 1]
    }
    ::log::log debug "Using namespaces {$xns}"
    $doc selectNodesNamespaces $xns
    set body [$top selectNodes ENV:Body]
    
    ##
    ## Validated that we have a SOAP mes
    ##
    if {![llength $body]} {
        $doc delete
        return \
            -code error \
            -errorcode [list WSCLIENT NOSOAP $inXML] \
            "Did not receive a SOAP message"
    }
    set rootNode [$body childNodes]
    ::log::log debug "Have [llength $rootNode]"
    if {[llength $rootNode] > 1} {
        foreach tmp $rootNode {
            #puts "\t Got {[$tmp localName]} looking for {$expectedMsgTypeBase}"
            if {[string equal [$tmp localName] $expectedMsgTypeBase] ||
                [string equal [$tmp nodeName] $expectedMsgTypeBase] ||
                [string equal [$tmp localName] Fault] ||
                [string equal [$tmp nodeName] Fault]} {
                set rootNode $tmp
                break
            }
        }
    }
    if {([llength $rootNode] == 1) && ![string equal $rootNode {}]} {
        set rootName [$rootNode localName]
        if {[string equal $rootName {}]} {
            set rootName [$rootNode nodeName]
        }
    } else {
        set rootName {}
    }
    ::log::log debug "root name is {$rootName}"

    ##
    ## See if it is a standard error packet
    ##
    if {[string equal $rootName {Fault}]} {
        set faultcode {}
        set faultstring {}
        set detail {}
        foreach item {faultcode faultstring detail} {
            set tmpNode [$rootNode selectNodes ENV:$item]
            if {[string equal $tmpNode {}]} {
                set tmpNode [$rootNode selectNodes $item]
            }
            if {![string equal $tmpNode {}]} {
                if {[$tmpNode hasAttribute href]} {
                    set tmpNode [GetReferenceNode $top [$tmpNode getAttribute href]]
                }
                set $item [$tmpNode asText]
            }
        }
        $doc delete
        return \
            -code error \
            -errorcode [list WSCLIENT REMERR $faultcode] \
            -errorinfo $detail \
            $faultstring
    }

    ##
    ## Validated that it is the expected packet type
    ##
    if {![string equal $rootName $expectedMsgTypeBase]} {
        $doc delete
        return \
            -code error \
            -errorcode [list WSCLIENT BADREPLY [list $rootName $expectedMsgTypeBase]] \
            "Bad reply type, received '$rootName; but expected '$expectedMsgTypeBase'."
    }

    ##
    ## Convert the packet to a dictionary
    ##
    set results {}
    set headerRootNode [$top selectNodes ENV:Header]
    foreach outHeaderType [dict get $serviceInfo operation $operationName soapReplyHeader] {
        if {[string equal $outHeaderType {}]} {
            continue
        }
        set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $outputHeaderType] xns]
        set node [$headerRootNode selectNodes $xns:outHeaderType]
        if {[llength $outHeaderAttrs]} {
            ::WS::Utils::setAttr $node $outHeaderAttrs
        }
        ::log::log debug "Calling [list ::WS::Utils::convertTypeToDict Client $serviceName $node $outHeaderType $headerRootNode]"
        lappend results [::WS::Utils::convertTypeToDict Client $serviceName $node $outHeaderType $headerRootNode]
    }
    ::log::log debug "Calling [list ::WS::Utils::convertTypeToDict Client $serviceName $rootNode $expectedMsgType $body]"
    if {![string equal $rootName {}]} {
        lappend results [::WS::Utils::convertTypeToDict \
                         Client $serviceName $rootNode $expectedMsgType $body]
    }
    set results [join $results]
    $doc delete
    set ::errorCode {}
    set ::errorInfo {}

    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::Client::buildCallquery
#
# Description : Build the XML request message for the call
#
# Arguments :
#    serviceName        - the name of the service called
#    operationName      - the name of the operation called
#    url                - the URL of the operation
#    argList            - a dictionary object of the calling arguments
#
# Returns : The XML for the call
#
# Side-Effects : None
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::buildCallquery {serviceName operationName url argList} {
    variable serviceArr

    set serviceInfo $serviceArr($serviceName)

    set style [dict get $serviceInfo operation $operationName style]
    set suppressTargetNS [dict get $serviceInfo suppressTargetNS]
    if {$suppressTargetNS} {
        ::WS::Utils::SetOption suppressNS tns1
    } else {
        ::WS::Utils::SetOption suppressNS {}
    }

    switch -exact -- $style {
        document/literal {
            set xml [buildDocLiteralCallquery $serviceName $operationName $url $argList]
        }
        rpc/encoded {
            set xml [buildRpcEncodedCallquery $serviceName $operationName $url $argList]
        }
        default {
            return \
                -code error
                "Unsupported Style '$style'"
        }
    }

    ::WS::Utils::SetOption suppressNS {}
    set inTransform [dict get $serviceInfo inTransform]
    if {![string equal $inTransform {}]} {
        set query [$inTransform $serviceName $operationName REQUEST $xml $url $argList]
    }

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

}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Client::buildDocLiteralCallquery
#
# Description : Build the XML request message for the call
#
# Arguments :
#    serviceName        - the name of the service called
#    operationName      - the name of the operation called
#    url                - the URL of the operation
#    argList            - a dictionary object of the calling arguments
#                         This is for both the Soap Header and Body messages.
#
# Returns : The XML for the call
#
# Side-Effects : None
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::buildDocLiteralCallquery {serviceName operationName url argList} {
    variable serviceArr

    ::log::log 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]

    dom createDocument "SOAP-ENV:Envelope" doc
    $doc documentElement env
    $env setAttribute \
        "xmlns:SOAP-ENV" "http://schemas.xmlsoap.org/soap/envelope/" \
        "xmlns:SOAP-ENC" "http://schemas.xmlsoap.org/soap/encoding/" \
        "xmlns:xsi"      "http://www.w3.org/2001/XMLSchema-instance" \
        "xmlns:xs"      "http://www.w3.org/2001/XMLSchema"
    array set tnsArray {}
    array unset tnsArray *
    foreach xns $xnsList {
        set tns [lindex $xns 0]
        set target [lindex $xns 1]
        set tnsArray($target) $tns
        $env  setAttribute \
            xmlns:$tns $target
    }
    #parray tnsArray

    set firstHeader 1
    foreach inputHeaderTypeItem [dict get $serviceInfo operation $operationName soapRequestHeader] {
        lassign $inputHeaderTypeItem inputHeaderType attrList
        if {[string equal $inputHeaderType {}]} {
            continue
        }
        set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $inputHeaderType] xns]
        if {[info exists tnsArray($xns)]} {
            set xns $tnsArray($xns)
        }
        if {$firstHeader} {
            $env appendChild [$doc createElement "SOAP-ENV:Header" header]
            set firstHeader 0
        }
        $header appendChild [$doc createElement $xns:$inputHeaderType headerData]
        if {[llength $attrList]} {
            ::WS::Utils::setAttr $headerData $attrList
        }
        ::WS::Utils::convertDictToType Client $serviceName $doc $headerData $argList $inputHeaderType
    }

    $env appendChild [$doc createElement "SOAP-ENV:Body" bod]
    set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $msgType] xns]
    if {[info exists tnsArray($xns)]} {
        set xns $tnsArray($xns)
    }
    set typeInfo [split $msgType {:}]
    if {[llength $typeInfo] != 1} {
        set xns [lindex $typeInfo 0]
        set msgType [lindex $typeInfo 1]
    }

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

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

    append xml  \
        {<?xml version="1.0"  encoding="utf-8"?>} \
        "\n" \
        [$doc asXML -indent none -doctypeDeclaration 0]
    #regsub "<!DOCTYPE\[^>\]*>\n" [::dom::DOMImplementation serialize $doc] {} xml
    $doc delete

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

    return $xml

}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Client::buildRpcEncodedCallquery
#
# Description : Build the XML request message for the call
#
# Arguments :
#    serviceName        - the name of the service called
#    operationName      - the name of the operation called
#    url                - the URL of the operation
#    argList            - a dictionary object of the calling arguments
#                         This is for both the Soap Header and Body messages.
#
# Returns : The XML for the call
#
# Side-Effects : None
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::buildRpcEncodedCallquery {serviceName operationName url argList} {
    variable serviceArr

    ::log::log 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]
    #set action [dict get $serviceInfo operation $operationName action]

    dom createDocument "SOAP-ENV:Envelope" doc
    $doc documentElement env
    $env setAttribute \
        xmlns:SOAP-ENV "http://schemas.xmlsoap.org/soap/envelope/" \
        xmlns:xsi      "http://www.w3.org/2001/XMLSchema-instance" \
        xmlns:xs      "http://www.w3.org/2001/XMLSchema"

    foreach xns $xnsList {
        set tns [lindex $xns 0]
        set target [lindex $xns 1]
        puts stdout [list $env setAttribute xmlns:$tns $target]
        $env setAttribute xmlns:$tns $target
    }

    set firstHeader 1
    foreach inputHeaderType [dict get $serviceInfo operation $operationName soapRequestHeader] {
        if {[string equal $inputHeaderType {}]} {
            continue
        }
        set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $inputHeaderType] xns]
        if {$firstHeader} {
            $env appendChild [$doc createElement "SOAP-ENV:Header" header]
            set firstHeader 0
        }
        $header appendChild [$doc createElement $xns:$inputHeaderType headerData]
        ::WS::Utils::convertDictToEncodedType Client $serviceName $doc $headerData $argList $inputHeaderType
    }

    $env appendChild [$doc createElement "SOAP-ENV:Body" bod]

    set callXns [dict get $serviceInfo operation $operationName xns]
    if {![string is space $callXns]} {
        $bod appendChild [$doc createElement $callXns:$operationName reply]
    } else {
        $bod appendChild [$doc createElement $operationName reply]
    }
    $reply  setAttribute \
        SOAP-ENV:encodingStyle "http://schemas.xmlsoap.org/soap/encoding/"

    ::WS::Utils::convertDictToEncodedType Client $serviceName $doc $reply $argList $msgType

    append xml  \
        {<?xml version="1.0"  encoding="utf-8"?>} \
        "\n" \
        [$doc asXML -indent none -doctypeDeclaration 0]
    #regsub "<!DOCTYPE\[^>\]*>\n" [::dom::DOMImplementation serialize $doc] {} xml
    $doc delete
    ::log::log debug "Leaving ::::WS::Client::buildRpcEncodedCallquery with {$xml}"

    return $xml

}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Client::buildServiceInfo
#
# Description : Parse the WSDL into our internal representation
#
# Arguments :
#    wsdlNode   - The top node of the WSDL
#    results    - Inital definition. This is optional and defaults to no definition.
#    serviceAlias - Alias (unique) name for service.
#                       This is an optional argument and defaults to the name of the
#                       service in serviceInfo.
#
# Returns : The parsed WSDL
#
# Side-Effects : Defines Client mode types as specified by the WSDL
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::buildServiceInfo {wsdlNode tnsDict {serviceInfo {}} {serviceAlias {}}} {
    ##
    ## Need to refactor to foreach service parseService
    ##  Service drills down to ports, which drills down to bindings and messages
    ##
    ::log::log debug "Entering ::WS::Client::buildServiceInfo with doc $wsdlNode"

    ##
    ## Parse Service information
    ##
    set serviceNameList [$wsdlNode selectNodes w:service]
    if {[string length $serviceAlias] & ([llength $serviceNameList] > 1)} {
        return \
            -code error \
            -errorcode [list WS CLIENT MULTISVC] \
            "Can not specify alias when WSDL defines multiple services"
    } elseif {[llength $serviceNameList] == 0} {
        return \
            -code error \
            -errorcode [list WS CLIENT NOSVC] \
            "WSDL does not define any services"
    }


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

    return $serviceInfo
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Client::parseService
#
# Description : Parse a service from a WSDL into our internal representation
#
# Arguments :
#    wsdlNode     - The top node of the WSDL
#    serviceNode  - The DOM node for the service.
#    serviceAlias - Alias (unique) name for service.
#                       This is an optional argument and defaults to the name of the
#                       service in serviceInfo.
#    tnsDict       - Dictionary of URI to namespaces used
#
# Returns : The parsed service WSDL
#
# Side-Effects : Defines Client mode types for the service as specified by the WSDL
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>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
# -------  ----------  ----------   -------------------------------------------
#       1  08/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::parseService {wsdlNode serviceNode serviceAlias tnsDict} {
    variable serviceArr
    variable options

    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} {
        set addressNode [lindex $addressNodeList 0]
        set portNode [$addressNode parentNode]
        set location [$addressNode getAttribute location]
    } else {
        foreach addressNode $addressNodeList {
            set portNode [$addressNode parentNode]
            if {[$addressNode hasAttribute location]} {
                set location [$addressNode getAttribute location]
                break
            }
        }
    }
    if {![info exists location]} {
        return \
            -code error \
            -errorcode [list WS CLIENT NOSOAPADDR] \
            "Malformed WSDL -- No SOAP address node found."
    }

    set xns {}
    foreach url [dict keys [dict get $tnsDict url]] {
        lappend xns [list [dict get $tnsDict url $url] $url]
    }
    CreateService $serviceName WSDL $location xns $xns
    set serviceInfo $serviceArr($serviceName)
    dict set serviceInfo tnsList $tnsDict
    set bindingName [lindex [split [$portNode getAttribute binding] {:}] end]

    ##
    ## Parse types
    ##
    parseTypes $wsdlNode $serviceName serviceInfo

    ##
    ## Parse bindings
    ##
    parseBinding $wsdlNode $serviceName $bindingName serviceInfo

    ##
    ## All done, so return results
    ##
    dict unset serviceInfo tnsList
    dict set serviceInfo suppressTargetNS $options(suppressTargetNS)
    set serviceArr($serviceName) $serviceInfo
    return $serviceInfo
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Client::parseTypes
#
# Description : Parse the types for a service from a WSDL into
#               our internal representation
#
# Arguments :
#    wsdlNode       - The top node of the WSDL
#    serviceNode    - The DOM node for the service.
#    serviceInfoVar - The name of the dictionary containing the partially
#                     parsed service.
#
# Returns : Nothing
#
# Side-Effects : Defines Client mode types for the service as specified by the WSDL
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>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
# -------  ----------  ----------   -------------------------------------------
#       1  08/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::parseTypes {wsdlNode serviceName serviceInfoVar} {
    ::log:::log debug "Entering [info level 0]"

    upvar 1 $serviceInfoVar serviceInfo


    set tnsCount [llength [dict keys [dict get $serviceInfo tnsList url]]]
    set baseUrl [dict get $serviceInfo location]
    foreach schemaNode [$wsdlNode selectNodes w:types/xs:schema] {
        ::WS::Utils::parseScheme Client $baseUrl $schemaNode $serviceName serviceInfo tnsCount
    }

    ::log:::log debug "Leaving [lindex [info level 0] 0]"
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Client::parseBinding
#
# Description : Parse the bindings for a service from a WSDL into our
#               internal representation
#
# Arguments :
#    wsdlNode       - The top node of the WSDL
#    serviceName    - The name service.
#    bindingName    - The name binding we are to parse.
#    serviceInfoVar - The name of the dictionary containing the partially
#                     parsed service.
#
# Returns : Nothing
#
# Side-Effects : Defines Client mode types for the service as specified by the WSDL
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>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
# -------  ----------  ----------   -------------------------------------------
#       1  08/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::parseBinding {wsdlNode serviceName bindingName serviceInfoVar} {
    ::log:::log debug "Entering [info level 0]"
    upvar 1 $serviceInfoVar serviceInfo

    set bindQuery [format {w:binding[attribute::name='%s']} $bindingName]
    array set msgToOper {}
    foreach binding [$wsdlNode selectNodes $bindQuery] {
        array unset msgToOper *
        set portName [lindex [split [$binding  getAttribute type] {:}] end]
        ::log:::log debug "\t Processing binding '$bindingName' on port '$portName'"
        set operList [$binding selectNodes w:operation]
        set styleNode [$binding selectNodes d:binding]
        if {![info exists style]} {
            if {[catch {$styleNode getAttribute style} tmpStyle]} {
                set styleNode [$binding selectNodes {w:operation[1]/d:operation}]
                if {[string equal $styleNode {}]} {
                    ##
                    ## This binding is for a SOAP level other than 1.1
                    ##
                    ::log:::log debug "Skiping non-SOAP 1.1 binding [$binding asXML]"
                    continue
                }
                set style [$styleNode getAttribute style]
                #puts "Using style for first operation {$style}"
            } else {
                set style $tmpStyle
                #puts "Using style for first binding {$style}"
            }
            if {!([string equal $style document] || [string equal $style rpc])} {
                ::log:::log debug "Leaving [lindex [info level 0] 0] with error @1"
                return \
                    -code error \
                    -errorcode [list WSCLIENT UNSSTY $style] \
                    "Unsupported calling style: '$style'"
            }

            if {![info exists use]} {
                set use [[$binding selectNodes {w:operation[1]/w:input/d:body}] getAttribute use]
                if {!([string equal $style document] && [string equal $use literal]) &&
                    !([string equal $style rpc] && [string equal $use encoded])} {
                    ::log:::log debug "Leaving [lindex [info level 0] 0] with error @2"
                    return \
                        -code error \
                        -errorcode [list WSCLIENT UNSMODE $use] \
                        "Unsupported mode: $style/$use"
                }
            }
        }

        ##
        ## Process each operation
        ##
        foreach oper $operList {
            set operName [$oper getAttribute name]
            ::log:::log debug "\t Processing operation '$operName'"
            dict lappend serviceInfo operList $operName

            #puts "Processing operation $operName"
            set actionNode [$oper selectNodes d:operation]
            if {[string equal $actionNode {}]} {
                ::log:::log debug "Skiping operation with no action [$oper asXML]"
                continue
            }
            dict set serviceInfo operation $operName style $style/$use
            catch {
                set action [$actionNode getAttribute soapAction]
                dict set serviceInfo operation $operName action $action
            }

            ##
            ## Get the input headers, if any
            ##
            set soapRequestHeaderList {{}}
            foreach inHeader [$oper selectNodes w:input/d:header] {
                ##set part [$inHeader getAttribute part]
                set tmp [$inHeader getAttribute use]
                if {![string equal $tmp $use]} {
                    ::log:::log debug "Leaving [lindex [info level 0] 0] with error @3"
                    return \
                        -code error \
                        -errorcode [list WSCLIENT MIXUSE $use $tmp] \
                        "Mixed usageage not supported!'"
                }
                set msgName [$inHeader getAttribute message]
                ::log:::log debug [list messageToType $wsdlNode $serviceName $operName $msgName serviceInfo]
                set type [messageToType $wsdlNode $serviceName $operName $msgName serviceInfo]
                lappend soapRequestHeaderList $type
            }
            dict set serviceInfo operation $operName soapRequestHeader $soapRequestHeaderList
            if {![dict exists [dict get $serviceInfo operation $operName] action]} {
                dict set serviceInfo operation $operName action $serviceName
            }

            ##
            ## Get the output header, if one
            ##
            set soapReplyHeaderList {{}}
            foreach outHeader [$oper selectNodes w:output/d:header] {
                ##set part [$outHeader getAttribute part]
                set tmp [$outHeader getAttribute use]
                if {![string equal $tmp $use]} {
                    ::log:::log debug "Leaving [lindex [info level 0] 0] with error @4"
                    return \
                        -code error \
                        -errorcode [list WSCLIENT MIXUSE $use $tmp] \
                        "Mixed usageage not supported!'"
                }
                set messagePath [$outHeader getAttribute message]
                set msgName [lindex [split $messagePath {:}] end]
                ::log:::log debug [list messageToType $wsdlNode $serviceName $operName $msgName serviceInfo]
                set type [messageToType $wsdlNode $serviceName $operName $msgName serviceInfo]
                lappend soapReplyHeaderList $type
            }
            dict set serviceInfo operation $operName soapReplyHeader $soapReplyHeaderList

            ##
            ## Validate that the input and output uses
            ##
            set inUse $use
            set outUse $use
            catch {set inUse [[$oper selectNodes w:input/d:body] getAttribute use]}
            catch {set outUse [[$oper selectNodes w:output/d:body] getAttribute use]}
            foreach tmp [list $inUse $outUse] {
                if {![string equal $tmp $use]} {
                    ::log:::log debug "Leaving [lindex [info level 0] 0] with error @5"
                    return \
                        -code error \
                        -errorcode [list WSCLIENT MIXUSE $use $tmp] \
                        "Mixed usageage not supported!'"
                }
            }
            set typeList [getTypesForPort $wsdlNode $serviceName $operName $portName serviceInfo]
           ::log:::log debug "\t Messages are {$typeList}"
            foreach type $typeList mode {inputs outputs} {
                dict set serviceInfo operation $operName $mode $type
            }
            ##
            ## Handle target namespace defined at WSDL level for older RPC/Encoded
            ##
            if {![dict exists $serviceInfo targetNamespace]} {
                catch {
                    #puts "attempting to get tragetNamespace"
                    dict set serviceInfo targetNamespace tns1 [[$oper selectNodes w:input/d:body] getAttribute namespace]
                }
            }
            set xns tns1
            dict set serviceInfo operation $operName xns $xns
        }
    }

    ::log:::log debug "Leaving [lindex [info level 0] 0]"
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Client::getTypesForPort
#
# Description : Get the types for a port.
#
# Arguments :
#    wsdlNode       - The top node of the WSDL
#    serviceNode    - The DOM node for the service.
#    operNode       - The DOM node for the operation.
#    portName       - The name of the port.
#    serviceInfoVar - The name of the dictionary containing the partially
#                     parsed service.
#
# Returns : A list containing the input and output types
#
# Side-Effects : Defines Client mode types for the service as specified by the WSDL
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>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
# -------  ----------  ----------   -------------------------------------------
#       1  08/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::getTypesForPort {wsdlNode serviceName operName portName serviceInfoVar} {
    upvar 1 $serviceInfoVar serviceInfo

    set style [dict get $serviceInfo operation $operName style]
    set inType {}
    set outType {}

    set portQuery [format {w:portType[attribute::name='%s']} $portName]
    set portNode [lindex [$wsdlNode selectNodes $portQuery] 0]
    set operQuery [format {w:operation[attribute::name='%s']} $operName]
    set operNode [lindex [$portNode selectNodes $operQuery] 0]

    set inputMsgNode [$operNode selectNodes {w:input}]
    if {![string equal $inputMsgNode {}]} {
        set inputMsgPath [$inputMsgNode getAttribute message]
        set inputMsg [lindex [split $inputMsgPath {:}] end]
        set inType [messageToType $wsdlNode $serviceName $operName $inputMsg serviceInfo]
    }

    set outputMsgNode [$operNode selectNodes {w:output}]
    if {![string equal $outputMsgNode {}]} {
        set outputMsgPath [$outputMsgNode getAttribute message]
        set outputMsg [lindex [split $outputMsgPath {:}] end]
        set outType [messageToType $wsdlNode $serviceName $operName $outputMsg serviceInfo]
    }

    ##
    ## Return the types
    ##
    return [list $inType $outType]
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Client::messageToType
#
# Description : Get a type name from a message
#
# Arguments :
#    wsdlNode       - The top node of the WSDL
#    serviceName    - The name of the service.
#    operName       - The name of the operation.
#    msgName        - The name of the message.
#    serviceInfoVar - The name of the dictionary containing the partially
#                     parsed service.
#
# Returns : The requested type name
#
# Side-Effects : Defines Client mode types for the service as specified by the WSDL
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>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
# -------  ----------  ----------   -------------------------------------------
#       1  08/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::messageToType {wsdlNode serviceName operName msgName serviceInfoVar} {
    upvar 1 $serviceInfoVar serviceInfo

    #puts "Message to Type $serviceName $operName $msgName"

    set style [dict get $serviceInfo operation $operName style]
    set msgQuery [format {w:message[attribute::name='%s']} $msgName]
    set msg [$wsdlNode selectNodes $msgQuery]
    switch -exact -- $style {
        document/literal {
            set partNode [$msg selectNodes w:part]
            set partNodeCount [llength $partNode]
            if {$partNodeCount == 1} {
                if {[$partNode hasAttribute element]} {
                    set type [::WS::Utils::getQualifiedType $serviceInfo [$partNode getAttribute element] tns1]
                }
            }
            if {($partNodeCount > 1) || ![info exist type]} {
                set tmpType {}
                foreach part [$msg selectNodes w:part] {
                    set partName [$part getAttribute name]
                    if {[$part hasAttribute type]} {
                        set partType [$part getAttribute type]
                    } else {
                        set partType [$part getAttribute element]
                    }
                    lappend tmpType $partName [list type [::WS::Utils::getQualifiedType $serviceInfo $partType tns1] comment {}]
                }
                set type tns1:$msgName
                dict set serviceInfo types $type $tmpType
                ::WS::Utils::ServiceTypeDef Client $serviceName $type $tmpType tns1
            } elseif {!$partNodeCount} {
                return \
                    -code error \
                    -errorcode [list WS CLIENT BADMSGSEC $msgName] \
                    "Invalid format for message '$msgName'"
            }
        }
        rpc/encoded {
            set tmpType {}
            foreach part [$msg selectNodes w:part] {
                set partName [$part getAttribute name]
                if {[$part hasAttribute type]} {
                    set partType [$part getAttribute type]
                } else {
                    set partType [$part getAttribute element]
                }
                lappend tmpType $partName [list type [::WS::Utils::getQualifiedType $serviceInfo $partType tns1] comment {}]
            }
            set type tns1:$msgName
            dict set serviceInfo types $type $tmpType
            ::WS::Utils::ServiceTypeDef Client $serviceName $type $tmpType tns1
        }
        default {
            return \
                -code error \
                -errorcode [list WS CLIENT UNKSTYUSE [list $style $use]] \
                "Unknown style/use combination $style/$use"
        }
    }

    ##
    ## Return the type name
    ##
    return $type
}

#---------------------------------------
#---------------------------------------

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::DoRawRestCall
#
# Description : Call an operation of a web service
#
# Arguments :
#       serviceName     - The name of the Webservice
#       operationName   - The name of the Operation to call
#       argList         - The arguements to the operation as a dictionary object.
#                         This is for both the Soap Header and Body messages.
#       headers         - Extra headers to add to the HTTP request. This
#                         is a key value list argument. It must be a list with
#                         an even number of elements that alternate between
#                         keys and values. The keys become header field names.
#                         Newlines are stripped from the values so the header
#                         cannot be corrupted.
#                         This is an optional argument and defaults to {}.
#
# Returns :
#       The XML of the operation.
#
# Side-Effects :        None
#
# Exception Conditions :
#       WSCLIENT HTTPERROR      - if an HTTP error occured
#
# Pre-requisite Conditions :    Service must have been defined.
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::DoRawRestCall {serviceName objectName operationName argList {headers {}} {location {}}} {
    variable serviceArr

    ::log::log 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 {![dict exists $serviceInfo object $objectName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOBJ [list $serviceName $objectName]] \
            "Unknown object '$objectName' for service '$serviceName'"
    }
    if {![dict exists $serviceInfo object $objectName operation $operationName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $objectName $operationName]] \
            "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'"
    }
    if {![string equal $location {}]} {
        set url $location
    } else {
        set url [dict get $serviceInfo object $objectName location]
    }
    set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[llength $headers]} {
        set token [::http::geturl $url -query $query -type text/xml -headers $headers]
    } else {
        set token [::http::geturl $url -query $query -type text/xml]
    }
    ::http::wait $token

    ##
    ## Check for errors
    ##
    if {![string equal [::http::status $token] ok] || [::http::ncode $token] != 200} {
        set errorCode [list WSCLIENT HTTPERROR [::http::code $token]]
        set errorInfo {}
        set results [::http::error $token]
        set hadError 1
    } else {
        set hadError 0
        set results [::http::data $token]
    }
    ::http::cleanup $token
    if {$hadError} {
        ::log::log debug "Leaving (error) ::WS::Client::DoRawRestCall"
        return \
            -code error \
            -errorcode $errorCode \
            -errorinfo $errorInfo \
            $results
    } else {
        ::log::log debug "Leaving ::WS::Client::DoRawRestCall with {$results}"
        return $results
    }

}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::DoRestCall
#
# Description : Call an operation of a web service
#
# Arguments :
#       serviceName     - The name of the Webservice
#       operationName   - The name of the Operation to call
#       argList         - The arguements to the operation as a dictionary object
#                         This is for both the Soap Header and Body messages.
#       headers         - Extra headers to add to the HTTP request. This
#                         is a key value list argument. It must be a list with
#                         an even number of elements that alternate between
#                         keys and values. The keys become header field names.
#                         Newlines are stripped from the values so the header
#                         cannot be corrupted.
#                         This is an optional argument and defaults to {}.
#
# Returns :
#       The return value of the operation as a dictionary object.
#
# Side-Effects :        None
#
# Exception Conditions :
#       WSCLIENT HTTPERROR      - if an HTTP error occured
#       others                  - as raised by called Operation
#
# Pre-requisite Conditions :    Service must have been defined.
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::DoRestCall {serviceName objectName operationName argList {headers {}} {location {}}} {
    variable serviceArr

    ::log::log 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 {![dict exists $serviceInfo object $objectName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOBJ [list $serviceName $objectName]] \
            "Unknown object '$objectName' for service '$serviceName'"
    }
    if {![dict exists $serviceInfo object $objectName operation $operationName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $objectName $operationName]] \
            "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'"
    }
    if {![string equal $location {}]} {
        set url $location
    } else {
        set url [dict get $serviceInfo object $objectName location]
    }
    set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[llength $headers]} {
        set token [::http::geturl $url -query $query -type text/xml -headers $headers]
    } else {
        set token [::http::geturl $url -query $query -type text/xml]
    }
    ::http::wait $token

    ##
    ## Check for errors
    ##
    set httpStatus [::http::status $token]
    set hadError 0
    set results {}
    if {![string equal $httpStatus ok] || [::http::ncode $token] != 200} {
        ::log::log debug "\tHTTP error [array get $token]"
        set results [::http::error $token]
        set errorCode [list WSCLIENT HTTPERROR [::http::code $token]]
        set errorInfo {}
        set hadError 1
    } else {
        set body [::http::data $token]
        ::log::log debug "\tReceived: $body"
        set hadError [catch {parseRestResults $serviceName $objectName $operationName $body} results]
        if {$hadError} {
            ::log::log debug "Reply was [::http::data $token]"
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }
    }
    ::http::cleanup $token
    if {$hadError} {
        ::log::log debug "Leaving (error) ::WS::Client::DoRestCall"
        return \
            -code error \
            -errorcode $errorCode \
            -errorinfo $errorInfo \
            $results
    } else {
        ::log::log debug "Leaving ::WS::Client::DoRestCall with {$results}"
        return $results
    }

}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Client::DoARestsyncCall
#
# Description : Call an operation of a web service asynchronously
#
# Arguments :
#       serviceName     - The name of the Webservice
#       operationName   - The name of the Operation to call
#       argList         - The arguements to the operation as a dictionary object
#                         This is for both the Soap Header and Body messages.
#       succesCmd       - A command prefix to be called if the operations
#                         does not raise an error.  The results, as a dictionary
#                         object are concatinated to the prefix.
#       errorCmd        - A command prefix to be called if the operations
#                         raises an error.  The error code and stack trace
#                         are concatinated to the prefix.
#       headers         - Extra headers to add to the HTTP request. This
#                         is a key value list argument. It must be a list with
#                         an even number of elements that alternate between
#                         keys and values. The keys become header field names.
#                         Newlines are stripped from the values so the header
#                         cannot be corrupted.
#                         This is an optional argument and defaults to {}.
#
# Returns :
#       None.
#
# Side-Effects :        None
#
# Exception Conditions :
#       WSCLIENT HTTPERROR      - if an HTTP error occured
#       others                  - as raised by called Operation
#
# Pre-requisite Conditions :    Service must have been defined.
#
# Original Author : Gerald W. Lester
#
#>>END PUBLIC<<
#
# 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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::DoRestAsyncCall {serviceName objectName operationName argList succesCmd errorCmd {headers {}}} {
    variable serviceArr

    set svcHeaders [dict get $serviceArr($serviceName) headers]
    if {[llength $svcHeaders]} {
        lappend headers $svcHeaders
    }
    ::log::log debug "Entering ::WS::Client::DoAsyncRestCall [list $serviceName $objectName $operationName $argList $succesCmd $errorCmd $headers]"
    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }
    set serviceInfo $serviceArr($serviceName)
    if {![dict exists $serviceInfo object $objectName operation $operationName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $objectName $operationName]] \
            "Unknown operation '$operationName' for service '$serviceName'"
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    set url [dict get $serviceInfo object $objectName location]
    set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]
    if {[llength $headers]} {
        ::http::geturl $url \
            -query $query \
            -type text/xml \
            -headers $headers \
            -command [list ::WS::Client::asyncRestCallDone $serviceName $operationName $succesCmd $errorCmd]
    } else {
        ::http::geturl $url \
            -query $query \
            -type text/xml \
            -command [list ::WS::Client::asyncRestCallDone $serviceName $operationName $succesCmd $errorCmd]
    }
    ::log::log debug "Leaving ::WS::Client::DoAsyncRestCall"
    return;
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Client::buildRestCallquery
#
# Description : Build the XML request message for the call
#
# Arguments :
#    serviceName        - the name of the service called
#    operationName      - the name of the operation called
#    url                - the URL of the operation
#    argList            - a dictionary object of the calling arguments
#                         This is for both the Soap Header and Body messages.
#
# Returns : The XML for the call
#
# Side-Effects : None
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::buildRestCallquery {serviceName objectName operationName url argList} {
    variable serviceArr

    ::log::log 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 xns $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::log 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::convertDictToType Client $serviceName $doc $body $argList $msgType
    foreach {option value} $options {
        ::WS::Utils::SetOption $option $value
    }

    append xml  \
        {<?xml version="1.0"  encoding="utf-8"?>} \
        "\n" \
        [$doc asXML -indent none -doctypeDeclaration 0]
    #regsub "<!DOCTYPE\[^>\]*>\n" [::dom::DOMImplementation serialize $doc] {} xml
    $doc delete

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

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

    return $xml

}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Client::parseRestResults
#
# Description : Convert the returned XML into a dictionary object
#
# Arguments :
#    serviceName        - the name of the service called
#    operationName      - the name of the operation called
#    inXML              - the XML returned by the operation
#
# Returns : A dictionary object representing the results
#
# Side-Effects : None
#
# Exception Conditions :
#       WSCLIENT REMERR         - The remote end raised an exception, the third element of
#                                 the error code is the remote fault code.
#                                 Error info is set to the remote fault details.
#                                 The error message is the remote fault string;
#       WSCLIENT BADREPLY       - Badly formatted reply, the third element is a list of
#                                 what message type was received vs what was expected.
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::parseRestResults {serviceName objectName operationName inXML} {
    variable serviceArr

    ::log::log debug "In parseResults $serviceName $operationName {$inXML}"
    set serviceInfo $serviceArr($serviceName)
    set outTransform [dict get $serviceInfo outTransform]
    if {![string equal $outTransform {}]} {
        set inXML [$outTransform $serviceName $operationName REPLY $inXML]
    }
    set expectedMsgType [dict get $serviceInfo object $objectName operation $operationName outputs]
    dom parse $inXML doc
    $doc documentElement top
    set xns {}
    foreach tmp [dict get $serviceInfo targetNamespace] {
        lappend xns [lindex $tmp 0] [lindex $tmp 1]
    }
    ::log::log debug "Using namespaces {$xns}"
    set body $top
    set status [$body getAttribute status]

    ##
    ## See if it is a standard error packet
    ##
    if {![string equal $status {ok}]} {
        set faultstring {}
        if {[catch {set faultstring [[$body selectNodes error] asText]}]} {
            catch {set faultstring [[$body selectNodes error] asText]}
        }
        $doc delete
        return \
            -code error \
            -errorcode [list WSCLIENT REMERR $status] \
            -errorinfo {} \
            $faultstring
    }

    ##
    ## Convert the packet to a dictionary
    ##
    set results {}
    set options [::WS::Utils::SetOption]
    ::WS::Utils::SetOption UseNS 0
    ::WS::Utils::SetOption parseInAttr 1
    ::log::log debug "Calling [list ::WS::Utils::convertTypeToDict Client $serviceName $body $expectedMsgType $body]"
    if {![string equal $expectedMsgType {}]} {
        set node [$body childNodes]
        set nodeName [$node nodeName]
        if {![string equal $objectName $nodeName]} {
            return \
                -code error \
                -errorcode [list WSCLIENT BADRESPONSE [list $objectName $nodeName]] \
                -errorinfo {} \
                "Unexpected message type {$nodeName}, expected {$objectName}"
        }
        set results [::WS::Utils::convertTypeToDict \
                         Client $serviceName $node $expectedMsgType $body]
    }
    foreach {option value} $options {
        ::WS::Utils::SetOption $option $value
    }
    $doc delete

    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::Client::asyncRestobCallDone
#
# Description : Called when an asynchronous call is complete.  This routine
#               will call either the success or error callback depending on
#               if the operation succeeded or failed -- assuming the callback
#               is defined.
#
# Arguments :
#    serviceName        - the name of the service called
#    operationName      - the name of the operation called
#    succesCmd          - the command prefix to call if no error
#    errorCmd           - the command prefix to call on an error
#    token              - the token from the HTTP request
#
# Returns : Nothing
#
# Side-Effects : None
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>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
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::asyncRestCallDone {serviceName objectName operationName succesCmd errorCmd token} {
    ::log::log debug "Entering ::WS::Client::asyncCallDone {$serviceName $objectName $operationName $succesCmd $errorCmd $token}"

    ##
    ## Check for errors
    ##
    if {![string equal [::http::status $token] ok] || [::http::ncode $token] != 200} {
        set errorCode [list WSCLIENT HTTPERROR [::http::code $token]]
        set hadError 1
        set errorInfo [::http::error $token]
    } else {
        set body [::http::data $token]
        set hadError [catch {parseRestResults $serviceName $objectName $operationName $body} results]
        if {$hadError} {
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }
    }

    ##
    ## Call the appropriate callback
    ##
    if {$hadError} {
        set cmd $errorCmd
        lappend cmd $errorCode $errorInfo
    } else {
        set cmd $succesCmd
    }
    lappend cmd $results
    catch $cmd

    ##
    ## All done
    ##
    ::http::cleanup $token
    return;
}