default {
		ns_return 200 text/plain "prefix = $prefix service = $service requestType = $requestType"
	    }
	}
    }
}

package provide WS::AOLserver 2.0.0

	    default {
		ns_return 200 text/plain "prefix = $prefix service = $service requestType = $requestType"
	    }
	}
    }
}

package provide WS::AOLserver 2.4.0

    }
}

package require uri
package require base64
package require html

package provide WS::Channel 2.0.0

namespace eval ::WS::Channel {

    array set portInfo {}
    array set dataArray {}
}

    }
}

package require uri
package require base64
package require html

package provide WS::Channel 2.4.0

namespace eval ::WS::Channel {

    array set portInfo {}
    array set dataArray {}
}

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

package provide WS::Client 2.3.9

namespace eval ::WS::Client {
    # register https only if not jet registered
    if {[catch { http::unregister https } lPortCmd]} {
        # not registered -> register on my own
        if {[catch {
            package require tls
            http::register https 443 [list ::tls::socket -ssl2 no -ssl3 no -tls1 yes]
        } err]} {
            log::log warning "No https support: $err"
................................................................................
    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]
            set isAbstarct [dict get $partList abstract]
            if {[string equal [lindex [split $typeName {:}] 1] {}]} {
                ::WS::Utils::ServiceTypeDef Client $serviceName $typeName $definition tns1 $isAbstarct
            } else {
                #set typeName [lindex [split $typeName {:}] 1]
                ::WS::Utils::ServiceTypeDef Client $serviceName $typeName $definition $xns $isAbstarct
            }
        }
    }

    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
            }
        }
................................................................................
            #    ::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 {}]} {
        set bodyData [::WS::Utils::convertTypeToDict \
                         Client $serviceName $rootNode $expectedMsgType $body]
        if {![llength $bodyData] && ([dict get $serviceInfo skipLevelWhenActionPresent] || [dict get $serviceInfo skipLevelOnReply])} {
            ::log::log debug "Calling [list ::WS::Utils::convertTypeToDict Client $serviceName $rootNode $expectedMsgType $body] -- skipLevelWhenActionPresent was set"
            set bodyData [::WS::Utils::convertTypeToDict \
                         Client $serviceName $body $expectedMsgType $body]
        }
................................................................................
            }
            set inMessage [dict get $serviceInfo operation $operName inputs]
            if {[dict exists $serviceInfo inputMessages $inMessage] } {
                set operList [dict get $serviceInfo inputMessages $inMessage]
            } else {
                set operList {}
            }
	    lappend operList $operName
            dict set serviceInfo inputMessages $inMessage $operList

            ##
            ## Handle target namespace defined at WSDL level for older RPC/Encoded
            ##
            if {![dict exists $serviceInfo targetNamespace]} {
                catch {

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

package provide WS::Client 2.4.0

namespace eval ::WS::Client {
    # register https only if not yet registered
    if {[catch { http::unregister https } lPortCmd]} {
        # not registered -> register on my own
        if {[catch {
            package require tls
            http::register https 443 [list ::tls::socket -ssl2 no -ssl3 no -tls1 yes]
        } err]} {
            log::log warning "No https support: $err"
................................................................................
    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]
            set isAbstarct [dict get $partList abstract]
            if {[lindex [split $typeName {:}] 1] eq {}} {
                ::WS::Utils::ServiceTypeDef Client $serviceName $typeName $definition tns1 $isAbstarct
            } else {
                #set typeName [lindex [split $typeName {:}] 1]
                ::WS::Utils::ServiceTypeDef Client $serviceName $typeName $definition $xns $isAbstarct
            }
        }
    }

    if {[dict exists $serviceInfo simpletypes]} {
        foreach partList [dict get $serviceInfo simpletypes] {
            lassign $partList typeName definition
            if {[lindex [split $typeName {:}] 1] eq {}} {
                ::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
            }
        }
................................................................................
            #    ::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 {$rootName ne {}} {
        set bodyData [::WS::Utils::convertTypeToDict \
                         Client $serviceName $rootNode $expectedMsgType $body]
        if {![llength $bodyData] && ([dict get $serviceInfo skipLevelWhenActionPresent] || [dict get $serviceInfo skipLevelOnReply])} {
            ::log::log debug "Calling [list ::WS::Utils::convertTypeToDict Client $serviceName $rootNode $expectedMsgType $body] -- skipLevelWhenActionPresent was set"
            set bodyData [::WS::Utils::convertTypeToDict \
                         Client $serviceName $body $expectedMsgType $body]
        }
................................................................................
            }
            set inMessage [dict get $serviceInfo operation $operName inputs]
            if {[dict exists $serviceInfo inputMessages $inMessage] } {
                set operList [dict get $serviceInfo inputMessages $inMessage]
            } else {
                set operList {}
            }
            lappend operList $operName
            dict set serviceInfo inputMessages $inMessage $operList

            ##
            ## Handle target namespace defined at WSDL level for older RPC/Encoded
            ##
            if {![dict exists $serviceInfo targetNamespace]} {
                catch {

}

package require uri
package require base64
package require html
package require log

package provide WS::Embeded 2.3.0

namespace eval ::WS::Embeded {

    array set portInfo {}

    set portList [list]
    set forever {}

}

package require uri
package require base64
package require html
package require log

package provide WS::Embeded 2.4.0

namespace eval ::WS::Embeded {

    array set portInfo {}

    set portList [list]
    set forever {}

##  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 Tcl 8.4
package require WS::Utils 2.3.7 ; # provides dict
package require html
package require log
package require tdom

package provide WS::Server 2.3.7

namespace eval ::WS::Server {
    array set ::WS::Server::serviceArr {}
    set ::WS::Server::procInfo {}
    set ::WS::Server::mode {}
}

................................................................................
#               -prefix         - Path prefix used for the namespace and endpoint
#                                 Defaults to "/service/" plus the service name
#               -traceEnabled   - Boolean to enable/disable trace being passed back in exception
#                                 Defaults to "Y"
#               -docFormat      - Format of the documentation for operations ("text" or "html").
#                                 Defaults to "text"
#               -stylesheet     - The CSS stylesheet URL used in the HTML documentation






#
#
# Returns :     Nothing
#
# Side-Effects :        None
#
# Exception Conditions :
................................................................................
        -author         {}
        -description    {}
        -mode           {tclhttpd}
        -ports          {80}
        -traceEnabled   {Y}
        -docFormat      {text}
        -stylesheet     {}




    }
    array set defaults $args
    if {[string equal $defaults(-mode) channel]} {
        set defaults(-ports) {stdin stdout}
        array set defaults $args
    }
    set requiredList {-service}
................................................................................
    }
    set service $defaults(-service)
    if {![info exists defaults(-prefix)]} {
        set defaults(-prefix) /service/$service
    }
    # find default host
    if {![info exists defaults(-host)]} {
	switch -exact -- $defaults(-mode) {
	    embedded {
		set me [socket -server garbage_word -myaddr [info hostname] 0]
    		set defaults(-host) [lindex [fconfigure $me -sockname] 0]
	    	close $me
	    	if {0 !=[llength $defaults(-ports)] && 80 != [lindex $defaults(-ports) 0]} {
        	    append defaults(-host) ":[lindex $defaults(-ports) 0]"
	    	}
            }
	    default {
	    	set defaults(-host) localhost
            }
	}
    }

    set defaults(-uri) $service
    namespace eval ::$service {}
    set serviceArr($service) [array get defaults]
    if {![dict exists $procInfo $service operationList]} {
        dict set procInfo $service operationList {}
................................................................................
            ::Url_PrefixInstall $defaults(-prefix) ::WS::Server::generateInfo_${service}  \
                -thread 0
        }
        wub {
            package require WS::Wub
        }
        aolserver {
	    package require WS::AOLserver
        }
        rivet {
            package require Rivet
        }
        wibble {
            ##
            ## Define zone handler - get code from andy
................................................................................
                ::WS::Channel::ReturnData \
                    $sock \
                    "text/xml; charset=UTF-8" \
                    "<html><head><title>Webservice Error</title></head><body><h2>$msg</h2></body></html>" \
                    404
            }
            rivet {
                headers type text/html
                headers numeric 404
                puts "<html><head><title>Webservice Error</title></head><body><h2>$msg</h2></body></html>"
            }
	    aolserver {
                ::WS::AOLserver::ReturnData \
                    $sock \
                    text/html \
                    "<html><head><title>Webservice Error</title></head><body><h2>$msg</h2></body></html>" \
                    404
            }
            wibble  {
................................................................................
        }
        embedded {
            set xml [GetWsdl $serviceName]
            ::WS::Embeded::ReturnData $sock "text/xml; charset=UTF-8" $xml 200
        }
        rivet {
            set xml [GetWsdl $serviceName]
            headers type text/xml
            headers numeric 200
            puts $xml
        }
        aolserver {
            set xml [GetWsdl $serviceName]
            ::WS::AOLserver::ReturnData $sock text/xml $xml 200
        }
................................................................................
    variable serviceArr

    array set serviceData $serviceArr($serviceName)
    set targetNamespace "http://$serviceData(-host)$serviceData(-prefix)"
    return [::WS::Utils::GenerateScheme $mode $serviceName $doc $parent $targetNamespace]

}


















































































































































###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
................................................................................
            ::WS::Embeded::ReturnData $sock "text/html; charset=UTF-8" $msg 200
        }
        channel {
            ::WS::Channel::ReturnData $sock "text/html; charset=UTF-8" $msg 200
        }
        rivet {
            headers numeric 200
            headers type text/html
            puts $msg
        }
        aolserver {
            ::WS::AOLserver::ReturnData $sock text/html $msg 200
        }
        wibble  {
                upvar 1 [lindex $args 0] responseDict
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Server::displayType {serviceName type} {
    set testType [string trimright $type {()}]
    if {([lindex [::WS::Utils::TypeInfo Server $serviceName $testType] 0] == 0) &&
        ([info exists ::WS::Utils::simpleTypes($testType)])} {
        set result $type
    } else {
        set result [format {<a href="#type_%1$s">%2$s</a>} $testType $type]
    }
    return $result
................................................................................
            set inXML [dict get $requestDict post xml ""]
        }
        default {
            upvar #0 Httpd$sock data
            set inXML $data(query)
        }
    }







    ::log::log debug "In ::WS::Server::callOperation {$service $sock $args}"
    array set serviceInfo $serviceArr($service)
    ::log::log debug "\tDocument is {$inXML}"

    set ::errorInfo {}
    set ::errorCode {}
    set ns $service

    set inTransform $serviceInfo(-intransform)
    set outTransform $serviceInfo(-outtransform)
    set first [string first {<} $inXML]
    if {$first > 0} {
        set inXML [string range $inXML $first end]
    }

    if {![string equal $inTransform  {}]} {
        set inXML [$inTransform REQUEST $inXML]
    }


























    dom parse $inXML doc
    $doc documentElement top
    ::log::log debug [list $doc selectNodesNamespaces \
        [list ENV http://schemas.xmlsoap.org/soap/envelope/ \
              $service http://$serviceInfo(-host)$serviceInfo(-prefix)]]
    $doc selectNodesNamespaces \
        [list ENV http://schemas.xmlsoap.org/soap/envelope/ \
              $service http://$serviceInfo(-host)$serviceInfo(-prefix)]
    $doc documentElement rootNode


    ##
    ## Determine the name of the method being invoked.
    ##
    set top [$rootNode selectNodes /ENV:Envelope/ENV:Body/*]
    catch {$top localName} requestMessage
    set legacyRpcMode 0
    if {$requestMessage == ""} {
        # older RPC/Encoded clients need to try nodeName instead.
        # Python pySoap needs this.
        catch {$top nodeName} requestMessage
        set legacyRpcMode 1
    }
    ::log::log debug "requestMessage = {$requestMessage}"
    if {[string match {*Request} $requestMessage]} {
        set operation [string range $requestMessage 0 end-7]
    } else {
        # broken clients might not have sent the correct Document Wrapped name.
        # Python pySoap and Perl SOAP::Lite need this.
        set operation $requestMessage
        set legacyRpcMode 1
    }








    ##
    ## Check that the method exists.
    ##
    if {![dict exists $procInfo $service op$operation argList]} {
        set msg "Method $operation not found"
        ::log::log error $msg
        set ::errorInfo {}
        set ::errorCode [list Server UNKNOWN_METHOD $operation]
        set xml [generateError \
                    $serviceInfo(-traceEnabled) \
                    CLIENT \
                    $msg \
                    [list "errorCode" $::errorCode "stackTrace" $::errorInfo]]

        catch {$doc delete}


        ::log::log debug "Leaving @ error 1::WS::Server::callOperation $xml"






        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            embedded {
                ::WS::Embeded::ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            rivet {
                headers type text/xml
                headers numeric 500
                puts $xml
            }
            aolserver {
                ::WS::AOLserver::ReturnData $sock text/xml $xml 500
            }
            wibble  {
                ::WS::Wibble::ReturnData responseDict text/xml $xml 500
            }
            default {
                ## Do nothing
            }
        }
        return;
    }
................................................................................
    set methodName "${ns}::$baseName"

    ##
    ## Parse the arguments for the method.
    ##
    set argInfo [dict get $procInfo $ns $cmdName argList]
    if {[catch {






















































        foreach pass [list 1 2 3] {
            set tclArgList {}
            set gotAnyArgs 0
            set argIndex 0
            foreach argName [dict get $procInfo $ns $cmdName argOrder] {
                set argType [string trim [dict get $argInfo $argName type]]
                set typeInfoList [::WS::Utils::TypeInfo Server $service $argType]
                if {$pass == 1} {
                    # access arguments by name using full namespace
                    set path $service:$argName
                    set node [$top selectNodes $path]
                } elseif {$pass == 2} {
                    # legacyRpcMode only, access arguments by unqualified name
                    set path $argName
                    set node [$top selectNodes $path]
                } else {
                    # legacyRpcMode only, access arguments by index
                    set path "legacy argument index $argIndex"
                    set node [lindex [$top childNodes] $argIndex]
                    incr argIndex
                }
                if {[string equal $node {}]} {
                    ::log::log debug "did not find argument for $argName using $path, leaving blank"
                    lappend tclArgList {}
                    continue
                }
                ::log::log debug "found argument $argName using $path, processing $node"
                set gotAnyArgs 1
                switch -exact -- $typeInfoList {
                    {0 0} {
                        ##
                        ## Simple non-array
                        ##
                        lappend tclArgList [$node asText]
                    }
                    {0 1} {
                        ##
                        ## Simple array
                        ##
                        set tmp {}
                        foreach row $node {
                            lappend tmp [$row asText]
                        }
                        lappend tclArgList $tmp
                    }
                    {1 0} {
                        ##
                        ## Non-simple non-array
                        ##

                        lappend tclArgList [::WS::Utils::convertTypeToDict Server $service $node $argType $top]
                    }
                    {1 1} {
                        ##
                        ## Non-simple array
                        ##
                        set tmp {}
                        set argType [string trimright $argType {()}]
                        foreach row $node {
                            lappend tmp [::WS::Utils::convertTypeToDict Server $service $row $argType $top]
                        }
                        lappend tclArgList $tmp
                    }
                    default {
                        ## Do nothing
                    }
                }
            }
            ::log::log debug "gotAnyArgs $gotAnyArgs, legacyRpcMode $legacyRpcMode"
            if {$gotAnyArgs || !$legacyRpcMode} break






        }
        ::log::log debug "finalargs $tclArgList"
    } errMsg]} {
        ::log::log error $errMsg
        set localerrorCode $::errorCode
        set localerrorInfo $::errorInfo
        set xml [generateError \
                    $serviceInfo(-traceEnabled) \
                    CLIENT \
                    "Error Parsing Arguments -- $errMsg" \
                    [list "errorCode" $localerrorCode "stackTrace" $localerrorInfo]]

        catch {$doc delete}


        ::log::log debug "Leaving @ error 3::WS::Server::callOperation $xml"






        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            embedded {
                ::WS::Embeded::ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            channel {
                ::WS::Channel::ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            rivet {
                headers type text/xml
                headers numeric 500
                puts $xml
            }
            aolserver {
                ::WS::AOLserver::ReturnData $sock text/xml $xml 500
            }
            wibble  {
                ::WS::Wibble::ReturnData responseDict text/xml $xml 500
            }
            default {
                ## Do nothing
            }
        }
        return;
    }
................................................................................
            default {
                lappend cmd $ns $baseName $data(ipaddr) $data(headerlist) $headerList
            }
        }
        eval $cmd
        set results [eval \$methodName $tclArgList]
        # generate a reply packet
        set xml [generateReply $ns $baseName $results]








        # regsub "<!DOCTYPE\[^>\]+>\n" $xml {} xml



        catch {$doc delete}
        set xml [string map {{<?xml version="1.0"?>} {<?xml version="1.0"  encoding="utf-8"?>}} $xml]
        if {![string equal $outTransform  {}]} {
            set xml [$outTransform REPLY $xml $operation $results]
        }
        if {[info exists serviceInfo(-postmonitor)] &&
            [string length $serviceInfo(-postmonitor)]} {
            set precmd $serviceInfo(-postmonitor)
            lappend precmd POST $service $operation OK $results
            catch $precmd
        }
        ::log::log debug "Leaving ::WS::Server::callOperation $xml"
        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "text/xml; charset=UTF-8" $xml 200
            }
            embedded {
                ::WS::Embeded::ReturnData $sock "text/xml; charset=UTF-8" $xml 200
            }
            channel {
                ::WS::Channel::ReturnData $sock "text/xml; charset=UTF-8" $xml 200
            }
            rivet {
                headers type text/xml
                headers numeric 200
                puts $xml
            }
            aolserver {
                ::WS::AOLserver::ReturnData $sock text/xml $xml 200
            }
            wibble  {
                ::WS::Wibble::ReturnData responseDict text/xml $xml 200
            }
            default {
                ## Do nothing
            }
        }
    } msg]} {
        ##
................................................................................
        set localerrorInfo $::errorInfo
        if {[info exists serviceInfo(-postmonitor)] &&
            [string length $serviceInfo(-postmonitor)]} {
            set precmd $serviceInfo(-postmonitor)
            lappend precmd POST $service $operation ERROR $msg
            catch $precmd
        }
        set xml [generateError \
                    $serviceInfo(-traceEnabled) \
                    CLIENT \
                    $msg \
                    [list "errorCode" $localerrorCode "stackTrace" $localerrorInfo]]

        catch {$doc delete}


        ::log::log debug "Leaving @ error 2::WS::Server::callOperation $xml"






        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            embedded {
                ::WS::Embeded::ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            channel {
                ::WS::Channel::ReturnData $sock "text/xml; charset=UTF-8" $xml 500
            }
            rivet {




                headers type text/xml
                headers numeric 500
                puts $xml
            }
            aolserver {
                ::WS::AOLserver::ReturnData $sock text/xml $xml 500
            }
            wibble  {
                ::WS::Wibble::ReturnData responseDict text/xml $xml 500
            }
            default {
                ## Do nothing
            }
        }
        return;
    }
................................................................................
# Description : Generate a standard error packet
#
# Arguments :
#    includeTrace       - Boolean indicate if the trace is to be included.
#    faultcode          - The code describing the error
#    faultstring        - The string describing the error.
#    detail             - Optional details of error.

#
# Returns : XML formatted standard error packet
#
# Side-Effects : None
#
# Exception Conditions : None
#
................................................................................
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Server::generateError {includeTrace faultcode faultstring detail} {
    ::log::log debug "Entering ::WS::Server::generateError $faultcode $faultstring {$detail}"
    set code [lindex $detail 1]
    switch -exact -- $code {
        "VersionMismatch" {
            set code "SOAP-ENV:VersionMismatch"
        }
        "MustUnderstand" {
................................................................................
        "Server" {
            set code "SOAP-ENV:Server"
        }
        default {
            ## Do nothing
        }
    }




















    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/1999/XMLSchema-instance" \
        "xmlns:xsd"      "http://www.w3.org/1999/XMLSchema" \
        "xmlns:SOAP-ENC" "http://schemas.xmlsoap.org/soap/encoding/"
    $env appendChild [$doc createElement "SOAP-ENV:Body" bod]
    $bod appendChild [$doc createElement "SOAP-ENV:Fault" flt]
    $flt appendChild [$doc createElement "faultcode" fcd]
    $fcd appendChild [$doc createTextNode $faultcode]
    $flt appendChild [$doc createElement "faultstring" fst]
    $fst appendChild [$doc createTextNode $faultstring]

    if { $detail != {} } {
        $flt appendChild [$doc createElement "SOAP-ENV:detail" dtl0]
        $dtl0 appendChild [$doc createElement "e:errorInfo" dtl]
        $dtl setAttribute "xmlns:e" "urn:TclErrorInfo"

        foreach {detailName detailInfo} $detail {
            if {!$includeTrace && $detailName == "stackTrace"} {
                continue
            }
            $dtl appendChild [$doc createElement $detailName err]
            $err appendChild [$doc createTextNode $detailInfo]
        }
    }

    # serialize the DOM document and return the XML text
    append xml  \
        {<?xml version="1.0"  encoding="utf-8"?>} \
        "\n" \
        [$doc asXML -indent none -doctypeDeclaration 0]
    $doc delete





    ::log::log debug "Leaving (error) ::WS::Server::generateError $xml"
    return $xml
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
................................................................................
#
# Description : Generate the reply packet for an operation
#
# Arguments :
#    serviceName         - The name of the service
#    operation           - The name of the operation
#    results             - The results as a dictionary object

#
#
# Returns : The results as an XML formatted packet.
#
# Side-Effects : None
#
# Exception Conditions : None
................................................................................
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Server::generateReply {serviceName operation results} {
    ::log::log debug "Entering ::WS::Server::generateReply $serviceName $operation {$results}"

    variable serviceArr

    array set serviceData $serviceArr($serviceName)














    if {[info exists ::Config(docRoot)] && [file exists [file join $::Config(docRoot) $serviceName $operation.css]]} {
        set replaceText [format {<?xml-stylesheet type="text/xsl" href="http://%s/css/%s/%s.css"?>}\
                                $serviceData(-host) \
                                $serviceName \
                                $operation]
        append replaceText "\n"
    } else {
        set replaceText {}
    }

    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/1999/XMLSchema-instance" \
        "xmlns:xsd"      "http://www.w3.org/1999/XMLSchema" \
        "xmlns:SOAP-ENC" "http://schemas.xmlsoap.org/soap/encoding/" \
         xmlns:$serviceName "http://$serviceData(-host)$serviceData(-prefix)"
    if {[llength $serviceData(-outheaders)]} {
        $env appendChild [$doc createElement "SOAP-ENV:Header" header]
        foreach headerType $serviceData(-outheaders) {
            #$header appendChild [$doc createElement ${serviceName}:${headerType} part]
            #::WS::Utils::convertDictToType Server $serviceName $doc $part $results $headerType
            ::WS::Utils::convertDictToType Server $serviceName $doc $header $results $headerType
        }
    }
    $env appendChild [$doc createElement "SOAP-ENV:Body" body]
    $body appendChild [$doc createElement ${serviceName}:${operation}Results reply]

    ::WS::Utils::convertDictToType Server $serviceName $doc $reply $results ${serviceName}:${operation}Results

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






    ::log::log debug "Leaving ::WS::Server::generateReply $xml"
    return $xml

}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
................................................................................
        append msg [::html::closeTag]

        append msg "\n"

        append msg [::html::h4 {Inputs}] "\n"

        append msg [::html::openTag div {style="margin-left: 40px;"}]


        append msg [::html::openTag {table} {border="2"}]
        append msg [::html::hdrRow Name Type Description]
        foreach arg [dict get $procInfo $service op$oper argOrder] {
            ::log::log debug "\t\t\tDisplaying '$arg'"
            if {[dict exists $procInfo $service op$oper argList $arg comment]} {
                set comment [dict get $procInfo $service op$oper argList $arg comment]
            } else {
                set comment {}
            }
            append msg [::html::row \
                            $arg \
                            [displayType $service [dict get $procInfo $service op$oper argList $arg type]] \
                            $comment \
                       ]
        }
        append msg [::html::closeTag]



        append msg [::html::closeTag]

        ::log::log debug "\t\tReturns"
        append msg [::html::h4 {Returns}] "\n"

        append msg [::html::openTag div {style="margin-left: 40px;"}]
        append msg [::html::openTag {table} {border="2"}]
................................................................................
    ::log::log debug "\tDisplay custom types"
    set service [dict get $serviceInfo -service]
    append msg [::html::h2 {<a id='CustomTypeDetails'>Custom Types</a>}]

    set localTypeInfo [::WS::Utils::GetServiceTypeDef Server $service]
    foreach type [lsort -dictionary [dict keys $localTypeInfo]] {
        ::log::log debug "\t\tDisplaying '$type'"

        set typeOverloadArray($type) 1
        append msg [::html::h3 "<a id='type_$type'>$type</a>"]
        set typeDetails [dict get $localTypeInfo $type definition]
        append msg [::html::openTag {table} {border="2"}]
        append msg [::html::hdrRow Field Type]
        foreach part [lsort -dictionary [dict keys $typeDetails]] {
            ::log::log debug "\t\t\tDisplaying '$part'"





            append msg [::html::row \
                            $part \
                            [displayType $service [dict get $typeDetails $part type]]

                       ]
        }
        append msg [::html::closeTag]
    }

    append msg "\n<br/>\n<center>" [::html::minorMenu $menuList] "</center>"
    append msg "\n<hr/>\n"

##  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 Tcl 8.4
package require WS::Utils 2.4 ; # provides dict
package require html
package require log
package require tdom

package provide WS::Server 2.4.0

namespace eval ::WS::Server {
    array set ::WS::Server::serviceArr {}
    set ::WS::Server::procInfo {}
    set ::WS::Server::mode {}
}

................................................................................
#               -prefix         - Path prefix used for the namespace and endpoint
#                                 Defaults to "/service/" plus the service name
#               -traceEnabled   - Boolean to enable/disable trace being passed back in exception
#                                 Defaults to "Y"
#               -docFormat      - Format of the documentation for operations ("text" or "html").
#                                 Defaults to "text"
#               -stylesheet     - The CSS stylesheet URL used in the HTML documentation
#               -errorCallback  - Callback to be invoked in the event of an error being produced
#               -verifyUserArgs - Boolean to enable/disable validating user supplied arguments
#                                 Defaults to "N"
#               -enforceRequired - Throw an error if a required field is not included in the
#                                  response.
#                                  Defaults to "N"
#
#
# Returns :     Nothing
#
# Side-Effects :        None
#
# Exception Conditions :
................................................................................
        -author         {}
        -description    {}
        -mode           {tclhttpd}
        -ports          {80}
        -traceEnabled   {Y}
        -docFormat      {text}
        -stylesheet     {}
        -beautifyJson   {N}
        -errorCallback  {}
        -verifyUserArgs {N}
        -enforceRequired {N}
    }
    array set defaults $args
    if {[string equal $defaults(-mode) channel]} {
        set defaults(-ports) {stdin stdout}
        array set defaults $args
    }
    set requiredList {-service}
................................................................................
    }
    set service $defaults(-service)
    if {![info exists defaults(-prefix)]} {
        set defaults(-prefix) /service/$service
    }
    # find default host
    if {![info exists defaults(-host)]} {
        switch -exact -- $defaults(-mode) {
            embedded {
                set me [socket -server garbage_word -myaddr [info hostname] 0]
                set defaults(-host) [lindex [fconfigure $me -sockname] 0]
                close $me
                if {0 !=[llength $defaults(-ports)] && 80 != [lindex $defaults(-ports) 0]} {
                    append defaults(-host) ":[lindex $defaults(-ports) 0]"
                }
            }
            default {
                set defaults(-host) localhost
            }
        }
    }

    set defaults(-uri) $service
    namespace eval ::$service {}
    set serviceArr($service) [array get defaults]
    if {![dict exists $procInfo $service operationList]} {
        dict set procInfo $service operationList {}
................................................................................
            ::Url_PrefixInstall $defaults(-prefix) ::WS::Server::generateInfo_${service}  \
                -thread 0
        }
        wub {
            package require WS::Wub
        }
        aolserver {
            package require WS::AOLserver
        }
        rivet {
            package require Rivet
        }
        wibble {
            ##
            ## Define zone handler - get code from andy
................................................................................
                ::WS::Channel::ReturnData \
                    $sock \
                    "text/xml; charset=UTF-8" \
                    "<html><head><title>Webservice Error</title></head><body><h2>$msg</h2></body></html>" \
                    404
            }
            rivet {
                headers type "text/html; charset=UTF-8"
                headers numeric 404
                puts "<html><head><title>Webservice Error</title></head><body><h2>$msg</h2></body></html>"
            }
            aolserver {
                ::WS::AOLserver::ReturnData \
                    $sock \
                    text/html \
                    "<html><head><title>Webservice Error</title></head><body><h2>$msg</h2></body></html>" \
                    404
            }
            wibble  {
................................................................................
        }
        embedded {
            set xml [GetWsdl $serviceName]
            ::WS::Embeded::ReturnData $sock "text/xml; charset=UTF-8" $xml 200
        }
        rivet {
            set xml [GetWsdl $serviceName]
            headers type "text/xml; charset=UTF-8"
            headers numeric 200
            puts $xml
        }
        aolserver {
            set xml [GetWsdl $serviceName]
            ::WS::AOLserver::ReturnData $sock text/xml $xml 200
        }
................................................................................
    variable serviceArr

    array set serviceData $serviceArr($serviceName)
    set targetNamespace "http://$serviceData(-host)$serviceData(-prefix)"
    return [::WS::Utils::GenerateScheme $mode $serviceName $doc $parent $targetNamespace]

}


###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Server::generateJsonInfo
#
# Description : Generate an json description of the service, the operations
#               and all applicable type definitions.
#
# Arguments :
#       serviceName     - The name of the service
#       sock            - The socket to return the WSDL on
#       args            - not used
#
# Returns :
#       1 - On error
#       0 - On success
#
# Side-Effects : None
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : James Sulak
#
#>>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  05/16/2012  J.Sulak      Initial version
#
#
###########################################################################
# NOTE: This proc only works with Rivet
# TODO: Update to handle jsonp?
proc ::WS::Server::generateJsonInfo { service sock args } {
    variable serviceArr
    variable procInfo

    ::log::log debug "Generating JSON Documentation for $service on $sock with {$args}"
    set serviceInfo $serviceArr($service)
    array set serviceData $serviceInfo
    set doc [yajl create #auto -beautify $serviceData(-beautifyJson)]

    $doc map_open

    $doc string operations array_open
    ::log::log debug "\tDisplay Operations (json)"
        
    foreach oper [lsort -dictionary [dict get $procInfo $service operationList]] {
        $doc map_open

        # operation name
        $doc string name string $oper

        # description
        set description [dict get $procInfo $service op$oper docs]
        $doc string description string $description

        # parameters
        if {[llength [dict get $procInfo $service op$oper argOrder]]} {
            $doc string inputs array_open
            
            foreach arg [dict get $procInfo $service op$oper argOrder] {
                ::log::log debug "\t\t\tDisplaying '$arg'"
                if {[dict exists $procInfo $service op$oper argList $arg comment]} {
                    set comment [dict get $procInfo $service op$oper argList $arg comment]
                } else {
                    set comment {}
                }

                set type [dict get $procInfo $service op$oper argList $arg type]
                                
                $doc map_open string name string $arg string type string $type string comment string $comment map_close
            }

            $doc array_close
        } else {
            $doc string inputs array_open array_close
        }
        
        $doc string returns map_open

        if {[dict exists $procInfo $service op$oper returnInfo comment]} {
            set comment [dict get $procInfo $service op$oper returnInfo comment]
        } else {
            set comment {}
        }

        set type [dict get $procInfo $service op$oper returnInfo type]
                
        $doc string comment string $comment string type string $type
        $doc map_close
        
        $doc map_close
    }

    $doc array_close

    ::log::log debug "\tDisplay custom types"
    $doc string types array_open
    set localTypeInfo [::WS::Utils::GetServiceTypeDef Server $service]
    foreach type [lsort -dictionary [dict keys $localTypeInfo]] {
        ::log::log debug "\t\tDisplaying '$type'"

        $doc map_open
        $doc string name string $type
        $doc string fields array_open
        
        set typeDetails [dict get $localTypeInfo $type definition]
        foreach part [lsort -dictionary [dict keys $typeDetails]] {
            ::log::log debug "\t\t\tDisplaying '$part'"
            set subType [dict get $typeDetails $part type]
            set comment {}
            if {[dict exists $typeDetails $part comment]} {
                set comment [dict get $typeDetails $part comment]
            }
            $doc map_open string field string $part string type string $subType string comment string $comment map_close
        }

        $doc array_close
        $doc map_close
    }

    $doc array_close
        
    $doc map_close

    set contentType "application/json; charset=UTF-8"
    headers type $contentType
    headers numeric 200
    puts [$doc get]
    $doc delete
}


###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
................................................................................
            ::WS::Embeded::ReturnData $sock "text/html; charset=UTF-8" $msg 200
        }
        channel {
            ::WS::Channel::ReturnData $sock "text/html; charset=UTF-8" $msg 200
        }
        rivet {
            headers numeric 200
            headers type "text/html; charset=UTF-8"
            puts $msg
        }
        aolserver {
            ::WS::AOLserver::ReturnData $sock text/html $msg 200
        }
        wibble  {
                upvar 1 [lindex $args 0] responseDict
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Server::displayType {serviceName type} {
    set testType [string trimright $type {()?}]
    if {([lindex [::WS::Utils::TypeInfo Server $serviceName $testType] 0] == 0) &&
        ([info exists ::WS::Utils::simpleTypes($testType)])} {
        set result $type
    } else {
        set result [format {<a href="#type_%1$s">%2$s</a>} $testType $type]
    }
    return $result
................................................................................
            set inXML [dict get $requestDict post xml ""]
        }
        default {
            upvar #0 Httpd$sock data
            set inXML $data(query)
        }
    }

    # decide if SOAP or REST mode should be used.
    set flavor "soap"
    if {[lsearch -exact $args "-rest"] != -1} {
        set flavor "rest"
    }

    ::log::log debug "In ::WS::Server::callOperation {$service $sock $args}"
    array set serviceInfo $serviceArr($service)
    ::log::log debug "\tDocument is {$inXML}"

    set ::errorInfo {}
    set ::errorCode {}
    set ns $service

    set inTransform $serviceInfo(-intransform)
    set outTransform $serviceInfo(-outtransform)
    # set first [string first {<} $inXML]
    # if {$first > 0} {
    #     set inXML [string range $inXML $first end]

    # }
    if {![string equal $inTransform  {}]} {
        set inXML [$inTransform REQUEST $inXML]
    }

    # Get a reference to the error callback
    set errorCallback $serviceInfo(-errorCallback)

    ##
    ## Parse the input and determine the name of the method being invoked.
    ##
    switch -exact -- $flavor {
        rest {
            package require yajltcl ;   # only needed for rest, not soap.

            set operation [lindex $inXML 0]
            set contentType "application/json"
            set doc ""

            array set rawargs [lindex $inXML 1]
            if {[info exists rawargs(jsonp_callback)]} {
                if {![regexp {^[a-zA-Z_0-9]+$} $rawargs(jsonp_callback)]} {
                    # sanitize the JSONP callback function name for security.
                    set rawargs(jsonp_callback) FlightXmlCallback
                }
                set contentType "text/javascript"
            }
        }
        soap {
            # parse the XML request
            dom parse $inXML doc
            $doc documentElement top
            ::log::log debug [list $doc selectNodesNamespaces \
                                  [list ENV http://schemas.xmlsoap.org/soap/envelope/ \
                                       $service http://$serviceInfo(-host)$serviceInfo(-prefix)]]
            $doc selectNodesNamespaces \
                [list ENV http://schemas.xmlsoap.org/soap/envelope/ \
                     $service http://$serviceInfo(-host)$serviceInfo(-prefix)]
            $doc documentElement rootNode
            


            # extract the name of the method

            set top [$rootNode selectNodes /ENV:Envelope/ENV:Body/*]
            catch {$top localName} requestMessage
            set legacyRpcMode 0
            if {$requestMessage == ""} {
                # older RPC/Encoded clients need to try nodeName instead.
                # Python pySoap needs this.
                catch {$top nodeName} requestMessage
                set legacyRpcMode 1
            }
            ::log::log debug "requestMessage = {$requestMessage}"
            if {[string match {*Request} $requestMessage]} {
                set operation [string range $requestMessage 0 end-7]
            } else {
                # broken clients might not have sent the correct Document Wrapped name.
                # Python pySoap and Perl SOAP::Lite need this.
                set operation $requestMessage
                set legacyRpcMode 1
            }
            set contentType "text/xml"
        }
        default {
            if {$errorCallback ne {}} { $errorCallback "BAD_FLAVOR No supported protocol" {} "UnknownMethod" $flavor }
            error "bad flavor"
        }
    }

    ##
    ## Check that the method exists.
    ##
    if {![dict exists $procInfo $service op$operation argList]} {
        set msg "Method $operation not found"
        ::log::log error $msg
        set ::errorInfo {}
        set ::errorCode [list Server UNKNOWN_METHOD $operation]
        set response [generateError \
                    $serviceInfo(-traceEnabled) \
                    CLIENT \
                    $msg \
                    [list "errorCode" $::errorCode "stackTrace" $::errorInfo] \
                    $flavor]
        catch {$doc delete}
        set httpStatus 404
        if {$errorCallback ne {}} { $errorCallback "UNKNOWN_METHOD $msg" httpStatus $operation $flavor }
        ::log::log debug "Leaving @ error 1::WS::Server::callOperation $response"

        # wrap in JSONP
        if {$flavor == "rest" && [info exists rawargs(jsonp_callback)]} {
            set response "$rawargs(jsonp_callback)($response)"
        }

        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "$contentType; charset=UTF-8" $response $httpStatus
            }
            embedded {
                ::WS::Embeded::ReturnData $sock "$contentType; charset=UTF-8" $response $httpStatus
            }
            rivet {
                headers type "$contentType; charset=UTF-8"
                headers numeric $httpStatus
                puts $response
            }
            aolserver {
                ::WS::AOLserver::ReturnData $sock "$contentType; charset=UTF-8" $response $httpStatus
            }
            wibble  {
                ::WS::Wibble::ReturnData responseDict "$contentType; charset=UTF-8" $response $httpStatus
            }
            default {
                ## Do nothing
            }
        }
        return;
    }
................................................................................
    set methodName "${ns}::$baseName"

    ##
    ## Parse the arguments for the method.
    ##
    set argInfo [dict get $procInfo $ns $cmdName argList]
    if {[catch {
        # Check that all supplied arguments are valid
        set methodArgs [dict get $procInfo $ns $cmdName argOrder]
        if {$serviceInfo(-verifyUserArgs)} {
            foreach {key value} [array get rawargs] {
                if {[lsearch -exact $methodArgs $key] == -1} {
                    error "Invalid argument '$key' supplied"
                }
            }
        }
        switch -exact -- $flavor {
            rest {
                set tclArgList {}
                foreach argName $methodArgs {
                    set argType [string trim [dict get $argInfo $argName type]]
                    set typeInfoList [::WS::Utils::TypeInfo Server $service $argType]

                    if {![info exists rawargs($argName)]} {
                        ::log::log debug "did not find argument for $argName, leaving blank"
                        lappend tclArgList {}
                        continue
                    }

                    switch -exact -- $typeInfoList {
                        {0 0} {
                            ## Simple non-array
                            lappend tclArgList $rawargs($argName)
                        }
                        {0 1} {
                            ## Simple array
                            lappend tclArgList $rawargs($argName)
                        }
                        {1 0} {
                            ## Non-simple non-array
                            error "TODO JSON"
                            #lappend tclArgList [::WS::Utils::convertTypeToDict Server $service $node $argType $top]
                        }
                        {1 1} {
                            ## Non-simple array
                            error "TODO JSON"
                            #set tmp {}
                            #set argType [string trimright $argType {()?}]
                            #foreach row $node {
                            #    lappend tmp [::WS::Utils::convertTypeToDict Server $service $row $argType $top]
                            #}
                            #lappend tclArgList $tmp
                        }
                        default {
                            ## Do nothing
                        }
                    }

                }
            }
            soap {
                foreach pass [list 1 2 3] {
                    set tclArgList {}
                    set gotAnyArgs 0
                    set argIndex 0
                    foreach argName $methodArgs {
                        set argType [string trim [dict get $argInfo $argName type]]
                        set typeInfoList [::WS::Utils::TypeInfo Server $service $argType]
                        if {$pass == 1} {
                            # access arguments by name using full namespace
                            set path $service:$argName
                            set node [$top selectNodes $path]
                        } elseif {$pass == 2} {
                            # legacyRpcMode only, access arguments by unqualified name
                            set path $argName
                            set node [$top selectNodes $path]
                        } else {
                            # legacyRpcMode only, access arguments by index
                            set path "legacy argument index $argIndex"
                            set node [lindex [$top childNodes] $argIndex]
                            incr argIndex
                        }
                        if {[string equal $node {}]} {
                            ::log::log debug "did not find argument for $argName using $path, leaving blank"
                            lappend tclArgList {}
                            continue
                        }
                        ::log::log debug "found argument $argName using $path, processing $node"
                        set gotAnyArgs 1
                        switch -exact -- $typeInfoList {
                            {0 0} {

                                ## Simple non-array

                                lappend tclArgList [$node asText]
                            }
                            {0 1} {

                                ## Simple array

                                set tmp {}
                                foreach row $node {
                                    lappend tmp [$row asText]
                                }
                                lappend tclArgList $tmp
                            }
                            {1 0} {

                                ## Non-simple non-array

                                set argType [string trimright $argType {?}]
                                lappend tclArgList [::WS::Utils::convertTypeToDict Server $service $node $argType $top]
                            }
                            {1 1} {

                                ## Non-simple array

                                set tmp {}
                                set argType [string trimright $argType {()?}]
                                foreach row $node {
                                    lappend tmp [::WS::Utils::convertTypeToDict Server $service $row $argType $top]
                                }
                                lappend tclArgList $tmp
                            }
                            default {
                                ## Do nothing
                            }
                        }
                    }
                    ::log::log debug "gotAnyArgs $gotAnyArgs, legacyRpcMode $legacyRpcMode"
                    if {$gotAnyArgs || !$legacyRpcMode} break
                }
            }
            default {
                if {$errorCallback ne {}} { $errorCallback "BAD_FLAVOR No supported protocol" {} $operation $flavor }
                error "invalid flavor"
            }
        }
        ::log::log debug "finalargs $tclArgList"
    } errMsg]} {
        ::log::log error $errMsg
        set localerrorCode $::errorCode
        set localerrorInfo $::errorInfo
        set response [generateError \
                    $serviceInfo(-traceEnabled) \
                    CLIENT \
                    "Error Parsing Arguments -- $errMsg" \
                    [list "errorCode" $localerrorCode "stackTrace" $localerrorInfo] \
                    $flavor]
        catch {$doc delete}
        set httpStatus 400
        if {$errorCallback ne {}} { $errorCallback "INVALID_ARGUMENT $errMsg" httpStatus $operation $flavor }
        ::log::log debug "Leaving @ error 3::WS::Server::callOperation $response"

        # wrap in JSONP
        if {$flavor == "rest" && [info exists rawargs(jsonp_callback)]} {
            set response "$rawargs(jsonp_callback)($response)"
        }

        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "$contentType; charset=UTF-8" $response $httpStatus
            }
            embedded {
                ::WS::Embeded::ReturnData $sock "$contentType; charset=UTF-8" $response $httpStatus
            }
            channel {
                ::WS::Channel::ReturnData $sock "$contentType; charset=UTF-8" $response $httpStatus
            }
            rivet {
                headers type "$contentType; charset=UTF-8"
                headers numeric $httpStatus
                puts $response
            }
            aolserver {
                ::WS::AOLserver::ReturnData $sock "$contentType; charset=UTF-8" $response $httpStatus
            }
            wibble  {
                ::WS::Wibble::ReturnData responseDict "$contentType; charset=UTF-8" $response $httpStatus
            }
            default {
                ## Do nothing
            }
        }
        return;
    }
................................................................................
            default {
                lappend cmd $ns $baseName $data(ipaddr) $data(headerlist) $headerList
            }
        }
        eval $cmd
        set results [eval \$methodName $tclArgList]
        # generate a reply packet
        set response [generateReply $ns $baseName $results $flavor]

        # wrap in JSONP
        if {$flavor == "rest" && [info exists rawargs(jsonp_callback)]} {
            set response "$rawargs(jsonp_callback)($response)"
        }

        # mangle the XML declaration
        if {$flavor == "soap"} {
            # regsub "<!DOCTYPE\[^>\]+>\n" $response {} response
            set response [string map {{<?xml version="1.0"?>} {<?xml version="1.0"  encoding="utf-8"?>}} $response]
        }

        catch {$doc delete}

        if {![string equal $outTransform  {}]} {
            set response [$outTransform REPLY $response $operation $results]
        }
        if {[info exists serviceInfo(-postmonitor)] &&
            [string length $serviceInfo(-postmonitor)]} {
            set precmd $serviceInfo(-postmonitor)
            lappend precmd POST $service $operation OK $results
            catch $precmd
        }
        ::log::log debug "Leaving ::WS::Server::callOperation $response"
        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "$contentType; charset=UTF-8" $response 200
            }
            embedded {
                ::WS::Embeded::ReturnData $sock "$contentType; charset=UTF-8" $response 200
            }
            channel {
                ::WS::Channel::ReturnData $sock "$contentType; charset=UTF-8" $response 200
            }
            rivet {
                headers type "$contentType; charset=UTF-8"
                headers numeric 200
                puts $response
            }
            aolserver {
                ::WS::AOLserver::ReturnData $sock "$contentType; charset=UTF-8" $response 200
            }
            wibble  {
                ::WS::Wibble::ReturnData responseDict "$contentType; charset=UTF-8" $response 200
            }
            default {
                ## Do nothing
            }
        }
    } msg]} {
        ##
................................................................................
        set localerrorInfo $::errorInfo
        if {[info exists serviceInfo(-postmonitor)] &&
            [string length $serviceInfo(-postmonitor)]} {
            set precmd $serviceInfo(-postmonitor)
            lappend precmd POST $service $operation ERROR $msg
            catch $precmd
        }
        set response [generateError \
                    $serviceInfo(-traceEnabled) \
                    CLIENT \
                    $msg \
                    [list "errorCode" $localerrorCode "stackTrace" $localerrorInfo] \
                    $flavor]
        catch {$doc delete}
        set httpStatus 500
        if {$errorCallback ne {}} { $errorCallback $msg httpStatus $operation $flavor }
        ::log::log debug "Leaving @ error 2::WS::Server::callOperation $response"

        # wrap in JSONP
        if {$flavor == "rest" && [info exists rawargs(jsonp_callback)]} {
            set response "$rawargs(jsonp_callback)($response)"
        }

        switch -exact -- $mode {
            tclhttpd {
                ::Httpd_ReturnData $sock "$contentType; charset=UTF-8" $response $httpStatus
            }
            embedded {
                ::WS::Embeded::ReturnData $sock "$contentType; charset=UTF-8" $response $httpStatus
            }
            channel {
                ::WS::Channel::ReturnData $sock "$contentType; charset=UTF-8" $response $httpStatus
            }
            rivet {
                if {[lindex $localerrorCode 0] == "RIVET" && [lindex $localerrorCode 1] == "ABORTPAGE"} {
                    # if we caught an abort_page, then re-trigger it.
                    abort_page
                }
                headers type "$contentType; charset=UTF-8"
                headers numeric $httpStatus
                puts $response
            }
            aolserver {
                ::WS::AOLserver::ReturnData $sock $contentType $response $httpStatus
            }
            wibble  {
                ::WS::Wibble::ReturnData responseDict "$contentType; charset=UTF-8" $response $httpStatus
            }
            default {
                ## Do nothing
            }
        }
        return;
    }
................................................................................
# Description : Generate a standard error packet
#
# Arguments :
#    includeTrace       - Boolean indicate if the trace is to be included.
#    faultcode          - The code describing the error
#    faultstring        - The string describing the error.
#    detail             - Optional details of error.
#    flavor             - Output mode: "soap" or "rest"
#
# Returns : XML formatted standard error packet
#
# Side-Effects : None
#
# Exception Conditions : None
#
................................................................................
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Server::generateError {includeTrace faultcode faultstring detail flavor} {
    ::log::log debug "Entering ::WS::Server::generateError $faultcode $faultstring {$detail}"
    set code [lindex $detail 1]
    switch -exact -- $code {
        "VersionMismatch" {
            set code "SOAP-ENV:VersionMismatch"
        }
        "MustUnderstand" {
................................................................................
        "Server" {
            set code "SOAP-ENV:Server"
        }
        default {
            ## Do nothing
        }
    }


    # FlightAware-specific error logging
    if {$flavor == "rest"} {
        if {[string match "QUIET*" $faultstring]} {
            set faultstring [regsub {^QUIET\s*} $faultstring {}]
        } else {
            flightaware_error_sql "::WebServices::Server::generateError caught an error '$faultstring' code '$faultcode': $detail" warning
        }
    }

    
    switch -exact -- $flavor {
        rest {
            set doc [yajl create #auto]
            $doc map_open string "error" string $faultstring map_close
            set response [$doc get]
            $doc delete
        }
        soap {
            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/1999/XMLSchema-instance" \
                "xmlns:xsd"      "http://www.w3.org/1999/XMLSchema" \
                "xmlns:SOAP-ENC" "http://schemas.xmlsoap.org/soap/encoding/"
            $env appendChild [$doc createElement "SOAP-ENV:Body" bod]
            $bod appendChild [$doc createElement "SOAP-ENV:Fault" flt]
            $flt appendChild [$doc createElement "faultcode" fcd]
            $fcd appendChild [$doc createTextNode $faultcode]
            $flt appendChild [$doc createElement "faultstring" fst]
            $fst appendChild [$doc createTextNode $faultstring]
            
            if { $detail != {} } {
                $flt appendChild [$doc createElement "SOAP-ENV:detail" dtl0]
                $dtl0 appendChild [$doc createElement "e:errorInfo" dtl]
                $dtl setAttribute "xmlns:e" "urn:TclErrorInfo"
                
                foreach {detailName detailInfo} $detail {
                    if {!$includeTrace && $detailName == "stackTrace"} {
                        continue
                    }
                    $dtl appendChild [$doc createElement $detailName err]
                    $err appendChild [$doc createTextNode $detailInfo]
                }
            }
            
            # serialize the DOM document and return the XML text
            append response  \
                {<?xml version="1.0"  encoding="utf-8"?>} \
                "\n" \
                [$doc asXML -indent none -doctypeDeclaration 0]
            $doc delete
        }
        default {
            error "unsupported flavor"
        }
    }
    ::log::log debug "Leaving (error) ::WS::Server::generateError $response"
    return $response
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
................................................................................
#
# Description : Generate the reply packet for an operation
#
# Arguments :
#    serviceName         - The name of the service
#    operation           - The name of the operation
#    results             - The results as a dictionary object
#    flavor              - Output mode: "soap" or "rest"
#
#
# Returns : The results as an XML formatted packet.
#
# Side-Effects : None
#
# Exception Conditions : None
................................................................................
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Server::generateReply {serviceName operation results flavor} {
    ::log::log debug "Entering ::WS::Server::generateReply $serviceName $operation {$results}"

    variable serviceArr

    array set serviceData $serviceArr($serviceName)


    switch -exact -- $flavor {
        rest {
            set doc [yajl create #auto -beautify $serviceData(-beautifyJson)]

            $doc map_open
            ::WS::Utils::convertDictToJson Server $serviceName $doc $results ${serviceName}:${operation}Results
            $doc map_close

            set output [$doc get]
            $doc delete
        }
        soap {
            if {[info exists ::Config(docRoot)] && [file exists [file join $::Config(docRoot) $serviceName $operation.css]]} {
                set replaceText [format {<?xml-stylesheet type="text/xsl" href="http://%s/css/%s/%s.css"?>}\
                                     $serviceData(-host) \
                                     $serviceName \
                                     $operation]
                append replaceText "\n"
            } else {
                set replaceText {}
            }
            
            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/1999/XMLSchema-instance" \
                "xmlns:xsd"      "http://www.w3.org/1999/XMLSchema" \
                "xmlns:SOAP-ENC" "http://schemas.xmlsoap.org/soap/encoding/" \
                xmlns:$serviceName "http://$serviceData(-host)$serviceData(-prefix)"
            if {[llength $serviceData(-outheaders)]} {
                $env appendChild [$doc createElement "SOAP-ENV:Header" header]
                foreach headerType $serviceData(-outheaders) {
                    #$header appendChild [$doc createElement ${serviceName}:${headerType} part]
                    #::WS::Utils::convertDictToType Server $serviceName $doc $part $results $headerType
                    ::WS::Utils::convertDictToType Server $serviceName $doc $header $results $headerType
                }
            }
            $env appendChild [$doc createElement "SOAP-ENV:Body" body]
            $body appendChild [$doc createElement ${serviceName}:${operation}Results reply]

            ::WS::Utils::convertDictToType Server $serviceName $doc $reply $results ${serviceName}:${operation}Results

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

    ::log::log debug "Leaving ::WS::Server::generateReply $output"
    return $output

}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
................................................................................
        append msg [::html::closeTag]

        append msg "\n"

        append msg [::html::h4 {Inputs}] "\n"

        append msg [::html::openTag div {style="margin-left: 40px;"}]

        if {[llength [dict get $procInfo $service op$oper argOrder]]} {
            append msg [::html::openTag {table} {border="2"}]
            append msg [::html::hdrRow Name Type Description]
            foreach arg [dict get $procInfo $service op$oper argOrder] {
                ::log::log debug "\t\t\tDisplaying '$arg'"
                if {[dict exists $procInfo $service op$oper argList $arg comment]} {
                    set comment [dict get $procInfo $service op$oper argList $arg comment]
                } else {
                    set comment {}
                }
                append msg [::html::row \
                                $arg \
                                [displayType $service [dict get $procInfo $service op$oper argList $arg type]] \
                                $comment \
                               ]
            }
            append msg [::html::closeTag]
        } else {
            append msg "No inputs."
        }
        append msg [::html::closeTag]

        ::log::log debug "\t\tReturns"
        append msg [::html::h4 {Returns}] "\n"

        append msg [::html::openTag div {style="margin-left: 40px;"}]
        append msg [::html::openTag {table} {border="2"}]
................................................................................
    ::log::log debug "\tDisplay custom types"
    set service [dict get $serviceInfo -service]
    append msg [::html::h2 {<a id='CustomTypeDetails'>Custom Types</a>}]

    set localTypeInfo [::WS::Utils::GetServiceTypeDef Server $service]
    foreach type [lsort -dictionary [dict keys $localTypeInfo]] {
        ::log::log debug "\t\tDisplaying '$type'"
        set href_type [lindex [split $type :] end]
        set typeOverloadArray($type) 1
        append msg [::html::h3 "<a id='type_${href_type}'>$type</a>"]
        set typeDetails [dict get $localTypeInfo $type definition]
        append msg [::html::openTag {table} {border="2"}]
        append msg [::html::hdrRow Field Type Comment]
        foreach part [lsort -dictionary [dict keys $typeDetails]] {
            ::log::log debug "\t\t\tDisplaying '$part'"
            if {[dict exists $typeDetails $part comment]} {
                set comment [dict get $typeDetails $part comment]
            } else {
                set comment {}
            }
            append msg [::html::row \
                            $part \
                            [displayType $service [dict get $typeDetails $part type]] \
                            $comment
                       ]
        }
        append msg [::html::closeTag]
    }

    append msg "\n<br/>\n<center>" [::html::minorMenu $menuList] "</center>"
    append msg "\n<hr/>\n"

    }
}

package require log
package require tdom 0.8
package require struct::set

package provide WS::Utils 2.3.10

namespace eval ::WS {}

namespace eval ::WS::Utils {
    set ::WS::Utils::typeInfo {}
    set ::WS::Utils::currentSchema {}
    array set ::WS::Utils::importedXref {}
    set nsList {
        w http://schemas.xmlsoap.org/wsdl/
        d http://schemas.xmlsoap.org/wsdl/soap/
        xs http://www.w3.org/2001/XMLSchema
    }






















    array set ::WS::Utils::simpleTypes {
        anyType 1
        string 1
        boolean 1
        decimal 1
        float 1
        double 1
................................................................................
        parseInAttr 0
        genOutAttr 0
        valueAttrCompatiblityMode 1
        includeDirectory {}
        suppressNS {}
        useTypeNs 0
        nsOnChangeOnly 0
	anyType string
    }

    set ::WS::Utils::standardAttributes {
        baseType
        comment
        pattern
        length
................................................................................
proc ::WS::Utils::GetCrossreference {mode service} {
    variable typeInfo

    array set crossreference {}

    dict for {type typeDict} [dict get $typeInfo $mode $service] {
        foreach {field fieldDict} [dict get $typeDict definition] {
            set fieldType [string trimright [dict get $fieldDict type] {()}]
            incr crossreference($fieldType,count)
            lappend crossreference($fieldType,usedBy) $type.$field
        }
        if {![info exists crossreference($type,count) ]} {
            set crossreference($type,count) 0
            set crossreference($type,usedBy) {}
        }
................................................................................
#
#
###########################################################################
proc ::WS::Utils::GetServiceTypeDef {mode service {type {}}} {
    variable typeInfo
    variable simpleTypes

    set type [string trimright $type {()}]
    set results {}
    if {[string equal $type {}]} {
        ::log::log debug "@1"
        set results [dict get $typeInfo $mode $service]
    } else {
        set typeInfoList [TypeInfo $mode $service $type]
        if {[string equal -nocase -length 3 $type {xs:}]} {
................................................................................
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::GetServiceSimpleTypeDef {mode service {type {}}} {
    variable simpleTypes

    set type [string trimright $type {()}]
    if {[string equal -nocase -length 3 $type {xs:}]} {
        return [::WS::Utils::GetServiceTypeDef $mode $service $type]
    }
    if {[string equal $type {}]} {
        set results {}
        foreach {key value} [array get simpleTypes $mode,$service,*] {
            lappend results [list [lindex [split $key {,}] end] $simpleTypes($key)]
................................................................................
#                            that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Utils::TypeInfo
#
# Description : Return a list indicating if the type is simple or complex
#               and if it is a scalar or an array.
#
# Arguments :
#    type       - the type name, possibly with a () to specify it is an array
#
# Returns : A list of two elements, as follows:
#               0|1 - 0 means a simple type, 1 means a complex type
#               0|1 - 0 means a scalar, 1 means an array
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#  2.3.0   10/16/2012  G. Lester    Corrected detection of service specific simple type.
#  2.3.0   10/31/2012  G. Lester    Corrected missing newline.
#
###########################################################################
proc ::WS::Utils::TypeInfo {mode service type} {
    variable simpleTypes
    variable typeInfo

    set type [string trim $type]





    if {[string equal [string range $type end-1 end] {()}]} {
        set isArray 1
        set type [string range $type 0 end-2]
    } elseif {[string equal $type {array}]} {
        set isArray 1
    } else {
        set isArray 0
    }
    #set isNotSimple [dict exists $typeInfo $mode $service $type]
    #set isNotSimple [expr {$isNotSimple || [dict exists $typeInfo $mode $service $service:$type]}]
    lassign [split $type {:}] tns baseType
    set isNotSimple [expr {!([info exist simpleTypes($type)] || [info exist simpleTypes($baseType)] || [info exist simpleTypes($mode,$service,$type)] || [info exist simpleTypes($mode,$service,$baseType)] )}]



    return [list $isNotSimple $isArray]
}


###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
................................................................................
#       1  07/06/2006  G.Lester     Initial version
#       2  02/03/2008  G.Lester     Moved  into WS::Utils namespace
#
###########################################################################
proc ::WS::Utils::getTypeWSDLInfo {mode serviceName field type} {
    set typeInfo {maxOccurs 1 minOccurs 1 name * type *}
    dict set typeInfo name $field
    set typeList [TypeInfo $mode $serviceName $type]
    if {[lindex $typeList 0] == 0} {
        dict set typeInfo type xs:[string trimright $type {()}]
    } else {
        dict set typeInfo type $serviceName:[string trimright $type {()}]
    }
    if {[lindex $typeList 1]} {
        dict set typeInfo maxOccurs unbounded
    }




    return $typeInfo
}



###########################################################################
................................................................................
    #    }
    #}
    set partsList [dict keys [dict get $typeDefInfo definition]]
    ::log::log debug "\t partsList is {$partsList}"
    set arrayOverride [expr {$isArray && ([llength $partsList] == 1)}]
    foreach partName $partsList {
        set partType [dict get $typeDefInfo definition $partName type]

        if {[dict exists $typeDefInfo definition $partName allowAny] && [dict get $typeDefInfo definition $partName allowAny]} {
            set allowAny 1
        } else {
            set allowAny 0
        }
        if {[string equal $partName *] && [string equal $partType *]} {
            ##
................................................................................
            set isAbstract [dict get $typeInfo $mode $serviceName $partType abstract]
        }
        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
		if {[dict exists $tmpTypeInfo base]} {
		    set baseType [dict get $tmpTypeInfo base]
		} else {
		    set baseType string
		}
                if {$options(parseInAttr)} {
                    foreach attrList [$item attributes] {
                        catch {
                            lassign $attrList attr nsAlias nsUrl
                            if {[string equal $nsUrl $xsiNsUrl]} {
                                set attrValue [$item getAttribute ${nsAlias}:$attr]
                                dict set results $partName ::$attr $attrValue
................................................................................
                    }
                }
            }
            {0 1} {
                ##
                ## Simple array
                ##
		if {[dict exists $tmpTypeInfo base]} {
		    set baseType [dict get $tmpTypeInfo base]
		} else {
		    set baseType string
		}
                set tmp {}
                foreach row $item {
                    if {$options(parseInAttr)} {
                        set rowList {}
                        foreach attrList [$row attributes] {
                            catch {
                                lassign $attrList attr nsAlias nsUrl
................................................................................
    # ::log::log debug "  Parent xml: [$parent asXML]"
    variable typeInfo
    variable simpleTypes
    variable options
    variable standardAttributes
    variable currentNs


    if {!$options(UseNS)} {
        return [::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent $dict $type]
    }

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

    ::log::log debug "\t typeInfoList = {$typeInfoList}"
    if {[dict exists $typeInfo $mode $service $service:$type]} {
        set typeName $service:$type
    } else {
        set typeName $type
    }
    set itemList {}
................................................................................
    }
    set fieldList {}
    foreach {itemName itemDef} $itemList {
        set baseName [lindex [split $itemName {:}] end]
        lappend fieldList $itemName
        set itemType [dict get $itemDef type]
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} itemType ={$itemType}"
        set typeInfoList [TypeInfo $mode $service $itemType]
        ::log::log debug "Expr [list ![dict exists $dict $itemName] && ![dict exists $dict $baseName]]"
        if {![dict exists $dict $itemName] && ![dict exists $dict $baseName]} {
            ::log::log debug "Neither {$itemName} nor {$baseName} are in dictionary {$dict}, skipping"




            continue
        } elseif {[dict exists $dict $baseName]} {
            set useName $baseName
        } else {
            set useName $itemName
        }
        set itemXns $xns
        set tmpInfo [GetServiceTypeDef $mode $service [string trimright $itemType {()}]]
        if {$options(useTypeNs) && [dict exists $tmpInfo xns]} {
            set itemXns [dict get $tmpInfo xns]
        }
        set attrList {}
        if {$options(useTypeNs) && [string equal $itemXns xs]} {
            set itemXns $xns
        }
................................................................................
            if {[lsearch -exact $standardAttributes $key] == -1 && $key ne "isList" && $key ne "xns"} {
                lappend attrList $key [dict get $itemDef $key]
                ::log::log debug "key = {$key} standardAttributes = {$standardAttributes}"
            }
        }
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList} itemXns = {$itemXns} tmpInfo = {$tmpInfo} attrList = {$attrList}"
        set isAbstract false
        set baseType [string trimright $itemType ()]
        if {$options(genOutAttr) && [dict exists $typeInfo $mode $service $baseType abstract]} {
            set isAbstract [dict get $typeInfo $mode $service $baseType abstract]
        }
        ::log::log notice "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList} isAbstract = {$isAbstract}"


        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                if {[string equal $itemXns $options(suppressNS)] || [string equal $itemXns {}]} {
                    $parent appendChild [$doc createElement $itemName retNode]
................................................................................
                }
            }
            {1 1} {
                ##
                ## Non-simple array
                ##
                set dataList [dict get $dict $useName]
                set tmpType [string trimright $itemType ()]
                #::log::log debug "\t\t [llength $dataList] rows {$dataList}"
                foreach row $dataList {
                    if {[string equal $itemXns $options(suppressNS)] || [string equal $itemXns {}]} {
                        $parent appendChild [$doc createElement $itemName retNode]
                    } else {
                        $parent appendChild [$doc createElement $itemXns:$itemName retNode]
                    }
................................................................................
                            } else {
                                lappend attrList $attr [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
                    }





                    if {![string equal $currentNs $itemXns] && ![string equal $itemXns {}]} {
                        set tmpNs $currentNs
                        set currentNs $itemXns
                        convertDictToType $mode $service $doc $retNode $resultValue $tmpType
                    } else {
                        convertDictToType $mode $service $doc $retNode $resultValue $tmpType
                    }
................................................................................
        #    }
        #}
    }
    set currentNs $entryNs
    ::log::log debug "Leaving ::WS::Utils::convertDictToType with xml: [$parent asXML]"
    return;
}



















































































































































###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
................................................................................
    ::log::log debug "Entering ::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent {$dict} $type"
    # ::log::log debug "  Parent xml: [$parent asXML]"
    variable typeInfo
    variable simpleTypes
    variable options
    variable standardAttributes


    if {$options(valueAttrCompatiblityMode)} {
        set valueAttr {}
    } else {
        set valueAttr {::value}
    }
    set typeInfoList [TypeInfo $mode $service $type]
    if {[lindex $typeInfoList 0]} {
................................................................................
        set itemList [list $type {type string}]
    }
    ::log::log debug "\titemList is {$itemList}"
    foreach {itemName itemDef} $itemList {
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef}"
        set itemType [dict get $itemDef type]
        set isAbstract false
        set baseType [string trimright $itemType ()]
        if {$options(genOutAttr) && [dict exists $typeInfo $mode $service $baseType abstract]} {
            set isAbstract [dict get $typeInfo $mode $service $baseType abstract]
        }
        set typeInfoList [TypeInfo $mode $service $itemType]
        if {![dict exists $dict $itemName]} {



            continue
        }
        set attrList {}
        foreach key [dict keys $itemDef] {
            if {[lsearch -exact $standardAttributes $key] == -1 && $key ne "isList" && $key ne "xns"} {
                lappend attrList $key [dict get $itemDef $key]
                ::log::log debug "key = {$key} standardAttributes = {$standardAttributes}"
            }
        }
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList}"

        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                $parent appendChild [$doc createElement $itemName retNode]
                if {$options(genOutAttr)} {
................................................................................
                convertDictToTypeNoNs $mode $service $doc $retnode $resultValue $itemType
            }
            {1 1} {
                ##
                ## Non-simple array
                ##
                set dataList [dict get $dict $itemName]
                set tmpType [string trimright $itemType ()]
                foreach row $dataList {
                    $parent appendChild [$doc createElement $itemName retnode]
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {$isAbstract && [string equal $attr {::type}]} {
................................................................................
    ::log::log debug "Entering ::WS::Utils::convertDictToEncodedType $mode $service $doc $parent {$dict} $type"
    variable typeInfo
    variable options


    set typeInfoList [TypeInfo $mode $service $type]
    ::log::log debug "\t typeInfoList = {$typeInfoList}"

    if {[lindex $typeInfoList 0]} {
        set itemList [dict get $typeInfo $mode $service $type definition]
        set xns [dict get $typeInfo $mode $service $type xns]
    } else {
        if {[info exists simpleTypes($mode,$service,$type)]} {
          set xns [dict get $simpleTypes($mode,$service,$type) xns]
        } else {
................................................................................
              error "Simple type cannot be found: $type"
            }
            set itemList [list $type {type string}]
        }
    }
    ::log::log debug "\titemList is {$itemList} in $xns"
    foreach {itemName itemDef} $itemList {
        set itemType [dict get $itemList $itemName type]
        set typeInfoList [TypeInfo $mode $service $itemType]
        ::log::log debug "\t\t Looking for {$itemName} in {$dict}"
        if {![dict exists $dict $itemName]} {
            ::log::log debug "\t\t Not found, skipping"
            continue
        }
        ::log::log debug "\t\t Type info is {$typeInfoList}"
................................................................................
                set dataList [dict get $dict $itemName]
                set tmpType [string trimright $itemType {()}]
                if {![string match {*:*} $itemType]} {
                    set attrType $xns:$itemType
                } else {
                    set attrType $itemType
                }
                set attrType [string trim $attrType {()}]
                $parent setAttribute xmlns:soapenc {http://schemas.xmlsoap.org/soap/encoding/}
                $parent setAttribute soapenc:arrayType [format {%s[%d]} $attrType [llength $dataList]]
                $parent setAttribute xsi:type soapenc:Array
                #set itemName [$parent nodeName]
                foreach item $dataList {
                    if {[string equal $xns $options(suppressNS)]} {
                        $parent appendChild [$doc createElement $itemName retNode]
................................................................................
            warning {
                set ::WS::Utils::targetNs $tmpTargetNs
                ::log::log $options(StrictMode) "Found $lastUnknownRefCount forward type references: [join [array names unkownRef] {,}]"
            }
            error -
            default {
                set ::WS::Utils::targetNs $tmpTargetNs
                set ofd [open full.xsd w];puts $ofd [$schemaNode asXML];close $ofd
                return \
                    -code error \
                    -errorcode [list WS $mode UNKREFS [list $lastUnknownRefCount]] \
                    "Found $lastUnknownRefCount forward type references: [join [array names unkownRef] {,}]"
            }
        }
    }
................................................................................
                -code error \
                -errorcode [list WS CLIENT MISSCHLOC $baseUrl] \
                "Missing Schema Location in '$baseUrl'"
        }
    }
    set urlTail [$importNode getAttribute $attrName]
    set url [::uri::resolve $baseUrl  $urlTail]
    ::log::log info "Including $url"

    set lastPos [string last / $url]
    set testUrl [string range $url 0 [expr {$lastPos - 1}]]
    if { [info exists ::WS::Utils::redirectArray($testUrl)] } {
        set newUrl $::WS::Utils::redirectArray($testUrl)
        append newUrl [string range $url $lastPos end]
        ::log::log debug "newUrl = $newUrl"
................................................................................
                        return \
                            -code error \
                            -errorcode [list WS $mode UNKREF [list $typeName $partType]] \
                            "Unknown forward type reference {$partType} in {$typeName}"
                    }
                } else {
                    set partName [$middleNode getAttribute name]
                    set partType [getQualifiedType $results [$middleNode getAttribute type string:string] $tns]
                    set partMax [$middleNode getAttribute maxOccurs 1]
                    if {$partMax <= 1} {
                        lappend partList $partName [list type $partType comment $comment]
                    } else {
                        lappend partList $partName [list type [string trimright ${partType} {()}]() comment $comment]
                    }
                }
................................................................................
                                    set ref $attr
                                }
                                catch {set attrArr($name) [$element getAttribute $ref]}
                            }
                            set partName item
                            set partType [getQualifiedType $results $attrArr(arrayType) $tns]
                            set partType [string map {{[]} {()}} $partType]
                            lappend partList $partName [list type [string trimright ${partType} {()}]() comment $comment allowAny 1]
                            set nodeFound 1
                        }
                        extension {
                            ::log::log debug "Calling partList for $contentType of $typeName"
                            if {[catch {set tmp [partList $mode $child $serviceName results $tns]} msg]} {
                                ::log::log debug "Error in partList {$msg}, errorInfo: $errorInfo"
                            }
................................................................................
            ##
            ## Do Nothing
            ##
        }
        element {
            catch {
                set partName [$node getAttribute name]
                set partType [getQualifiedType $results [$node getAttribute type string] $tns]
                set partMax [$node getAttribute maxOccurs 1]
                if {$partMax <= 1} {
                    set partList [list $partName [list type $partType comment {}]]
                } else {
                    set partList [list $partName [list type [string trimright ${partType} {()}]() comment {}]]
                }
            }
................................................................................
                        set attrName ref
                        set isRef 1
                    }
                    set partName [$element getAttribute $attrName]
                    if {$isRef} {
                        set partType {}
                        set partTypeInfo {}
                        set partType [getQualifiedType $results $partName $tns]
                        set partTypeInfo [::WS::Utils::GetServiceTypeDef $mode $serviceName $partType]
                        set partName [lindex [split $partName {:}] end]
                        ::log::log debug "\t\t\t part name is {$partName} type is {$partTypeInfo}"
                        if {[dict exists $partTypeInfo definition $partName]} {
                            set partType [dict get $partTypeInfo definition $partName type]
                        }
                        ::log::log debug "\t\t\t part name is {$partName} type is {$partType}"
................................................................................
                        }
                    } else {
                        set partMax [$element getAttribute maxOccurs 1]
                    }
                    if {$partMax <= 1} {
                        lappend partList $partName [concat [list type $partType comment $comment] $additional_defininition_elements]
                    } else {
                        lappend partList $partName [concat [list type [string trimright ${partType} {()}]() comment $comment] $additional_defininition_elements]
                    }
                } msg]} {
                    ::log::log error "\tError processing {$msg} for [$element asXML]"
                    if {$isRef} {
                        ::log::log error "\t\t Was a reference.  Additionally information is:"
                        ::log::log error "\t\t\t part name is {$partName} type is {$partType} with {$partTypeInfo}"
                    }
................................................................................
                            set ref $attr
                        }
                        catch {set attrArr($name) [$element getAttribute $ref]}
                    }
                    set partName item
                    set partType [getQualifiedType $results $attrArr(arrayType) $tns]
                    set partType [string map {{[]} {()}} $partType]
                    set partList [list $partName [list type [string trimright ${partType} {()}]() comment {} allowAny 1]]
                }
                extension {
                    set extension [$node selectNodes -namespaces $nsList xs:extension]
                    set partList [partList $mode $extension $serviceName results $tns]
                }
                default {
                    ##
................................................................................

        if {[string equal $partMax -1]} {
            set partMax [[$element parent] getAttribute maxOccurs -1]
        }
        if {$partMax <= 1} {
            lappend partList $partName [list type $partType comment {}]
        } else {
            lappend partList $partName [list type [string trimright ${partType} {()}]() comment {}]
        }
    }
    if {[llength $elements] == 0} {
        #
        # Validate this is not really a complex or simple type
        #
        set childList [$node childNodes]
................................................................................
            if {([lindex [TypeInfo $mode $serviceName $partType] 0] == 0) &&
                [string equal $tns:$typeName $partType]} {
                return
            } else {
                lappend partList $typeName [list type $partType comment {}]
            }
        } else {
            lappend partList $typeName [list type [string trimright ${partType} {()}]() comment {}]
        }
    }
    if {[llength $partList]} {
        ::WS::Utils::ServiceTypeDef $mode $serviceName $tns:$typeName $partList $tns $isAbstractType
    } else {
        if {![dict exists $results types $tns:$typeName]} {
            set partList [list base string comment {} xns $tns]
................................................................................
    ##
    set result 1

    ##
    ## Get the type information
    ##
    set typeInfoList [TypeInfo $mode $serviceName $typeName]
    set baseTypeName [string trimright $typeName {()}]

    set typeInfo [GetServiceTypeDef $mode $serviceName $baseTypeName]
    set isComplex [lindex $typeInfoList 0]
    set isArray [lindex $typeInfoList 1]

    if {$isComplex} {
        ##
        ## Is complex
................................................................................
###########################################################################
proc ::WS::Utils::buildTags {mode serviceName typeName valueInfos doc currentNode} {
    upvar 1 $valueInfos values

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

    set xns [dict get $typeInfo $mode $service $type xns]

    foreach {field fieldDef} [dict get $typeInfo definition] {
        ##
        ## Get info about this field and its type
        ##
        array unset fieldInfoArr
        set fieldInfoArr(minOccurs) 0
        array set fieldInfoArr $fieldDef
        set typeInfoList [TypeInfo $mode $serviceName $fieldInfoArr(type)]
        set fieldBaseType [string trimright $fieldInfoArr(type) {()}]
        set isComplex [lindex $typeInfoList 0]
        set isArray [lindex $typeInfoList 1]
        if {[dict exists $valueInfos $field]} {
            if {$isArray} {
                set valueList [dict get $valueInfos $field]
            } else {
                set valueList [list [dict get $valueInfos $field]]
................................................................................
        set results {<** Circular Reference **>}
        ::log::log debug "Leaving [info level 0] with {$results}"
        return $results
    } else {
        set generatedTypes([list $mode $serviceName $type]) 1
    }


    # set typeDefInfo [dict get $typeInfo $mode $serviceName $type]
    set typeDefInfo [GetServiceTypeDef $mode $serviceName $type]
    if {![llength $typeDefInfo]} {
      ## We failed to locate the type. try with the last known xns...
      set typeDefInfo [GetServiceTypeDef $mode $serviceName ${xns}:$type]
    }

................................................................................
        }
      }
      set typeDefInfo [dict create definition [dict create $type $typeDefInfo]]
    }
    set partsList [dict keys [dict get $typeDefInfo definition]]
    ::log::log debug "\t partsList is {$partsList}"
    foreach partName $partsList {
        set partType [dict get $typeDefInfo definition $partName type]
        set partXns $xns
        catch {set partXns  [dict get $typeInfo $mode $serviceName $partType xns]}
        set typeInfoList [TypeInfo $mode $serviceName $partType]
        set isArray [lindex $typeInfoList end]

        ::log::log debug "\tpartName $partName partType $partType xns $xns typeInfoList $typeInfoList"
        switch -exact -- $typeInfoList {
................................................................................
                set lastPos [string last / $initialUrl]
                set initialUrlDir [string range $initialUrl 0 [expr {$lastPos - 1}]]
                set lastPos [string last / $finalUrl]
                set finalUrlDir [string range $finalUrl 0 [expr {$lastPos - 1}]]
                ::log::log debug "initialUrlDir = $initialUrlDir, finalUrlDir = $finalUrlDir"
                set ::WS::Utils::redirectArray($initialUrlDir) $finalUrlDir
            }


            return $token
        }
        # http code announces redirect (3xx)
        array set meta [set ${token}(meta)]
        if {![info exist meta(Location)]} {
            ::log::log debug "Redirect http code without Location"
            return $token

    }
}

package require log
package require tdom 0.8
package require struct::set

package provide WS::Utils 2.4.0

namespace eval ::WS {}

namespace eval ::WS::Utils {
    set ::WS::Utils::typeInfo {}
    set ::WS::Utils::currentSchema {}
    array set ::WS::Utils::importedXref {}
    set nsList {
        w http://schemas.xmlsoap.org/wsdl/
        d http://schemas.xmlsoap.org/wsdl/soap/
        xs http://www.w3.org/2001/XMLSchema
    }

    # mapping of how the simple SOAP types should be serialized using YAJL into JSON.
    array set ::WS::Utils::simpleTypesJson {
        boolean "bool"
        float "number"
        double "double"
        integer "integer"
        int "integer"
        long "integer"
        short "integer"
        byte "integer"
        nonPositiveInteger "integer"
        negativeInteger "integer"
        nonNegativeInteger "integer"
        unsignedLong "integer"
        unsignedInt "integer"
        unsignedShort "integer"
        unsignedByte "integer"
        positiveInteger "integer"
        decimal "number"
    }

    array set ::WS::Utils::simpleTypes {
        anyType 1
        string 1
        boolean 1
        decimal 1
        float 1
        double 1
................................................................................
        parseInAttr 0
        genOutAttr 0
        valueAttrCompatiblityMode 1
        includeDirectory {}
        suppressNS {}
        useTypeNs 0
        nsOnChangeOnly 0
        anyType string
    }

    set ::WS::Utils::standardAttributes {
        baseType
        comment
        pattern
        length
................................................................................
proc ::WS::Utils::GetCrossreference {mode service} {
    variable typeInfo

    array set crossreference {}

    dict for {type typeDict} [dict get $typeInfo $mode $service] {
        foreach {field fieldDict} [dict get $typeDict definition] {
            set fieldType [string trimright [dict get $fieldDict type] {()?}]
            incr crossreference($fieldType,count)
            lappend crossreference($fieldType,usedBy) $type.$field
        }
        if {![info exists crossreference($type,count) ]} {
            set crossreference($type,count) 0
            set crossreference($type,usedBy) {}
        }
................................................................................
#
#
###########################################################################
proc ::WS::Utils::GetServiceTypeDef {mode service {type {}}} {
    variable typeInfo
    variable simpleTypes

    set type [string trimright $type {()?}]
    set results {}
    if {[string equal $type {}]} {
        ::log::log debug "@1"
        set results [dict get $typeInfo $mode $service]
    } else {
        set typeInfoList [TypeInfo $mode $service $type]
        if {[string equal -nocase -length 3 $type {xs:}]} {
................................................................................
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::GetServiceSimpleTypeDef {mode service {type {}}} {
    variable simpleTypes

    set type [string trimright $type {()?}]
    if {[string equal -nocase -length 3 $type {xs:}]} {
        return [::WS::Utils::GetServiceTypeDef $mode $service $type]
    }
    if {[string equal $type {}]} {
        set results {}
        foreach {key value} [array get simpleTypes $mode,$service,*] {
            lappend results [list [lindex [split $key {,}] end] $simpleTypes($key)]
................................................................................
#                            that you update this header block. Thanks.
#
#>>BEGIN PUBLIC<<
#
# Procedure Name : ::WS::Utils::TypeInfo
#
# Description : Return a list indicating if the type is simple or complex
#               and if it is a scalar or an array.  Also if it is optional
#
# Arguments :
#    type       - the type name, possibly with a () to specify it is an array
#
# Returns : A list of two elements, as follows:
#               0|1 - 0 means a simple type, 1 means a complex type
#               0|1 - 0 means a scalar, 1 means an array
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#  2.3.0   10/16/2012  G. Lester    Corrected detection of service specific simple type.
#  2.3.0   10/31/2012  G. Lester    Corrected missing newline.
#
###########################################################################
proc ::WS::Utils::TypeInfo {mode service type {findOptional 0}} {
    variable simpleTypes
    variable typeInfo

    set type [string trim $type]
    set isOptional 0
    if {[string equal [string index $type end] {?}]} {
        set isOptional 1
        set type [string trimright $type {?}]
    }
    if {[string equal [string range $type end-1 end] {()}]} {
        set isArray 1
        set type [string range $type 0 end-2]
    } elseif {[string equal $type {array}]} {
        set isArray 1
    } else {
        set isArray 0
    }
    #set isNotSimple [dict exists $typeInfo $mode $service $type]
    #set isNotSimple [expr {$isNotSimple || [dict exists $typeInfo $mode $service $service:$type]}]
    lassign [split $type {:}] tns baseType
    set isNotSimple [expr {!([info exist simpleTypes($type)] || [info exist simpleTypes($baseType)] || [info exist simpleTypes($mode,$service,$type)] || [info exist simpleTypes($mode,$service,$baseType)] )}]
    if {$findOptional} {
        return [list $isNotSimple $isArray $isOptional]
    }
    return [list $isNotSimple $isArray]
}


###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
................................................................................
#       1  07/06/2006  G.Lester     Initial version
#       2  02/03/2008  G.Lester     Moved  into WS::Utils namespace
#
###########################################################################
proc ::WS::Utils::getTypeWSDLInfo {mode serviceName field type} {
    set typeInfo {maxOccurs 1 minOccurs 1 name * type *}
    dict set typeInfo name $field
    set typeList [TypeInfo $mode $serviceName $type 1]
    if {[lindex $typeList 0] == 0} {
        dict set typeInfo type xs:[string trimright $type {()?}]
    } else {
        dict set typeInfo type $serviceName:[string trimright $type {()?}]
    }
    if {[lindex $typeList 1]} {
        dict set typeInfo maxOccurs unbounded
    }
    if {[lindex $typeList 2]} {
        dict set typeInfo minOccurs 0
    }

    return $typeInfo
}



###########################################################################
................................................................................
    #    }
    #}
    set partsList [dict keys [dict get $typeDefInfo definition]]
    ::log::log debug "\t partsList is {$partsList}"
    set arrayOverride [expr {$isArray && ([llength $partsList] == 1)}]
    foreach partName $partsList {
        set partType [dict get $typeDefInfo definition $partName type]
        set partType [string trimright $partType {?}]
        if {[dict exists $typeDefInfo definition $partName allowAny] && [dict get $typeDefInfo definition $partName allowAny]} {
            set allowAny 1
        } else {
            set allowAny 0
        }
        if {[string equal $partName *] && [string equal $partType *]} {
            ##
................................................................................
            set isAbstract [dict get $typeInfo $mode $serviceName $partType abstract]
        }
        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                if {[dict exists $tmpTypeInfo base]} {
                    set baseType [dict get $tmpTypeInfo base]
                } else {
                    set baseType string
                }
                if {$options(parseInAttr)} {
                    foreach attrList [$item attributes] {
                        catch {
                            lassign $attrList attr nsAlias nsUrl
                            if {[string equal $nsUrl $xsiNsUrl]} {
                                set attrValue [$item getAttribute ${nsAlias}:$attr]
                                dict set results $partName ::$attr $attrValue
................................................................................
                    }
                }
            }
            {0 1} {
                ##
                ## Simple array
                ##
                if {[dict exists $tmpTypeInfo base]} {
                    set baseType [dict get $tmpTypeInfo base]
                } else {
                    set baseType string
                }
                set tmp {}
                foreach row $item {
                    if {$options(parseInAttr)} {
                        set rowList {}
                        foreach attrList [$row attributes] {
                            catch {
                                lassign $attrList attr nsAlias nsUrl
................................................................................
    # ::log::log debug "  Parent xml: [$parent asXML]"
    variable typeInfo
    variable simpleTypes
    variable options
    variable standardAttributes
    variable currentNs

    array set serviceData $::WS::Server::serviceArr($service)
    if {!$options(UseNS)} {
        return [::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent $dict $type]
    }

    if {$options(valueAttrCompatiblityMode)} {
        set valueAttr {}
    } else {
        set valueAttr {::value}
    }
    set typeInfoList [TypeInfo $mode $service $type]
    set type [string trimright $type {?}]
    ::log::log debug "\t typeInfoList = {$typeInfoList}"
    if {[dict exists $typeInfo $mode $service $service:$type]} {
        set typeName $service:$type
    } else {
        set typeName $type
    }
    set itemList {}
................................................................................
    }
    set fieldList {}
    foreach {itemName itemDef} $itemList {
        set baseName [lindex [split $itemName {:}] end]
        lappend fieldList $itemName
        set itemType [dict get $itemDef type]
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} itemType ={$itemType}"
        set typeInfoList [TypeInfo $mode $service $itemType 1]
        ::log::log debug "Expr [list ![dict exists $dict $itemName] && ![dict exists $dict $baseName]]"
        if {![dict exists $dict $itemName] && ![dict exists $dict $baseName]} {
            ::log::log debug "Neither {$itemName} nor {$baseName} are in dictionary {$dict}, skipping"
            # If required parameters are being enforced and this field is not optional, throw an error
            if {$serviceData(-enforceRequired) && ![lindex $typeInfoList 2]} {
                error "Required field $itemName is missing from response"
            }
            continue
        } elseif {[dict exists $dict $baseName]} {
            set useName $baseName
        } else {
            set useName $itemName
        }
        set itemXns $xns
        set tmpInfo [GetServiceTypeDef $mode $service [string trimright $itemType {()?}]]
        if {$options(useTypeNs) && [dict exists $tmpInfo xns]} {
            set itemXns [dict get $tmpInfo xns]
        }
        set attrList {}
        if {$options(useTypeNs) && [string equal $itemXns xs]} {
            set itemXns $xns
        }
................................................................................
            if {[lsearch -exact $standardAttributes $key] == -1 && $key ne "isList" && $key ne "xns"} {
                lappend attrList $key [dict get $itemDef $key]
                ::log::log debug "key = {$key} standardAttributes = {$standardAttributes}"
            }
        }
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList} itemXns = {$itemXns} tmpInfo = {$tmpInfo} attrList = {$attrList}"
        set isAbstract false
        set baseType [string trimright $itemType {()?}]
        if {$options(genOutAttr) && [dict exists $typeInfo $mode $service $baseType abstract]} {
            set isAbstract [dict get $typeInfo $mode $service $baseType abstract]
        }
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList} isAbstract = {$isAbstract}"
        # Strip the optional flag off the typeInfoList
        set typeInfoList [lrange $typeInfoList 0 1]
        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                if {[string equal $itemXns $options(suppressNS)] || [string equal $itemXns {}]} {
                    $parent appendChild [$doc createElement $itemName retNode]
................................................................................
                }
            }
            {1 1} {
                ##
                ## Non-simple array
                ##
                set dataList [dict get $dict $useName]

                #::log::log debug "\t\t [llength $dataList] rows {$dataList}"
                foreach row $dataList {
                    if {[string equal $itemXns $options(suppressNS)] || [string equal $itemXns {}]} {
                        $parent appendChild [$doc createElement $itemName retNode]
                    } else {
                        $parent appendChild [$doc createElement $itemXns:$itemName retNode]
                    }
................................................................................
                            } else {
                                lappend attrList $attr [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
                    }
                    if {[string index $itemType end] eq {?}} {
                        set tmpType "[string trimright $itemType {()?}]?"
                    } else {
                        set tmpType [string trimright $itemType {()}]
                    }
                    if {![string equal $currentNs $itemXns] && ![string equal $itemXns {}]} {
                        set tmpNs $currentNs
                        set currentNs $itemXns
                        convertDictToType $mode $service $doc $retNode $resultValue $tmpType
                    } else {
                        convertDictToType $mode $service $doc $retNode $resultValue $tmpType
                    }
................................................................................
        #    }
        #}
    }
    set currentNs $entryNs
    ::log::log debug "Leaving ::WS::Utils::convertDictToType with xml: [$parent asXML]"
    return;
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Utils::convertDictToJson
#
# Description : Convert a dictionary object into a JSON tree.
#
# Arguments :
#    mode        - The mode, Client or Server
#    service     - The service name the type is defined in
#    doc         - The document (yajltcl)
#    dict        - The dictionary to convert
#    type        - The name of the type
#
# Returns : None
#
# Side-Effects : None
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Jeff Lawson
#
#>>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  03/23/2011  J.Lawson     Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToJson {mode service doc dict type} {
    ::log::log debug "Entering ::WS::Utils::convertDictToJson $mode $service $doc {$dict} $type"
    variable typeInfo
    variable simpleTypes
    variable simpleTypesJson
    variable options
    variable standardAttributes

    array set serviceData $::WS::Server::serviceArr($service)
    set typeInfoList [TypeInfo $mode $service $type]
    set type [string trimright $type {?}]
    if {[dict exists $typeInfo $mode $service $service:$type]} {
        set typeName $service:$type
    } else {
        set typeName $type
    }
	set itemList {}
    if {[lindex $typeInfoList 0] && [dict exists $typeInfo $mode $service $typeName definition]} {
        set itemList [dict get $typeInfo $mode $service $typeName definition]
        set xns [dict get $typeInfo $mode $service $typeName xns]
    } else {
        set xns $simpleTypes($mode,$service,$typeName)
        set itemList [list $typeName {type string}]
    }
    if {[info exists mutableTypeInfo([list $mode $service $typeName])]} {
        set typeName [(*)[lindex mutableTypeInfo([list $mode $service $type]) 0] $mode $service $type $xns $dict]
        set typeInfoList [TypeInfo $mode $service $typeName]
        if {[lindex $typeInfoList 0]} {
            set itemList [dict get $typeInfo $mode $service $typeName definition]
        } else {
            set itemList [list $type {type string}]
        }
    }
    ::log::log debug "\titemList is {$itemList}"
    set fieldList {}
    foreach {itemName itemDef} $itemList {
        lappend fieldList $itemName
        set itemType [dict get $itemDef type]
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} itemType = {$itemType}"
        set typeInfoList [TypeInfo $mode $service $itemType 1]
        if {![dict exists $dict $itemName]} {
            if {$serviceData(-enforceRequired) && ![lindex $typeInfoList 2]} {
                error "Required field $itemName is missing from response"
            }
            continue
        }

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

        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList}"
        set typeInfoList [lrange $typeInfoList 0 1]
        switch $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                set resultValue [dict get $dict $itemName]
                $doc string $itemName $yajlType $resultValue
            }
            {0 1} {
                ##
                ## Simple array
                ##
                set dataList [dict get $dict $itemName]
                $doc string $itemName array_open
                foreach row $dataList {
                    $doc $yajlType $row
                }
                $doc array_close
            }
            {1 0} {
                ##
                ## Non-simple non-array
                ##
                $doc string $itemName map_open
                set resultValue [dict get $dict $itemName]
                convertDictToJson $mode $service $doc $resultValue $itemType
                $doc map_close
            }
            {1 1} {
                ##
                ## Non-simple array
                ##
                set dataList [dict get $dict $itemName]
                $doc string $itemName array_open
                if {[string index $itemType end] eq {?}} {
                    set tmpType "[string trimright $itemType {()?}]?"
                } else {
                    set tmpType [string trimright $itemType {()}]
                }
                foreach row $dataList {
                    $doc map_open
                    convertDictToJson $mode $service $doc $row $tmpType
                    $doc map_close
                }
                $doc array_close
            }
        }
    }
    return;
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
................................................................................
    ::log::log debug "Entering ::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent {$dict} $type"
    # ::log::log debug "  Parent xml: [$parent asXML]"
    variable typeInfo
    variable simpleTypes
    variable options
    variable standardAttributes

    array set serviceData $::WS::Server::serviceArr($service)
    if {$options(valueAttrCompatiblityMode)} {
        set valueAttr {}
    } else {
        set valueAttr {::value}
    }
    set typeInfoList [TypeInfo $mode $service $type]
    if {[lindex $typeInfoList 0]} {
................................................................................
        set itemList [list $type {type string}]
    }
    ::log::log debug "\titemList is {$itemList}"
    foreach {itemName itemDef} $itemList {
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef}"
        set itemType [dict get $itemDef type]
        set isAbstract false
        set baseType [string trimright $itemType {()?}]
        if {$options(genOutAttr) && [dict exists $typeInfo $mode $service $baseType abstract]} {
            set isAbstract [dict get $typeInfo $mode $service $baseType abstract]
        }
        set typeInfoList [TypeInfo $mode $service $itemType 1]
        if {![dict exists $dict $itemName]} {
            if {$serviceData(-enforceRequired) && ![lindex $typeInfoList 2]} {
                error "Required field $itemName is missing from response"
            }
            continue
        }
        set attrList {}
        foreach key [dict keys $itemDef] {
            if {[lsearch -exact $standardAttributes $key] == -1 && $key ne "isList" && $key ne "xns"} {
                lappend attrList $key [dict get $itemDef $key]
                ::log::log debug "key = {$key} standardAttributes = {$standardAttributes}"
            }
        }
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList}"
        set typeInfoList [lrange $typeInfoList 0 1]
        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                $parent appendChild [$doc createElement $itemName retNode]
                if {$options(genOutAttr)} {
................................................................................
                convertDictToTypeNoNs $mode $service $doc $retnode $resultValue $itemType
            }
            {1 1} {
                ##
                ## Non-simple array
                ##
                set dataList [dict get $dict $itemName]
                set tmpType [string trimright $itemType {()}]
                foreach row $dataList {
                    $parent appendChild [$doc createElement $itemName retnode]
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {$isAbstract && [string equal $attr {::type}]} {
................................................................................
    ::log::log debug "Entering ::WS::Utils::convertDictToEncodedType $mode $service $doc $parent {$dict} $type"
    variable typeInfo
    variable options


    set typeInfoList [TypeInfo $mode $service $type]
    ::log::log debug "\t typeInfoList = {$typeInfoList}"
    set type [string trimright $type {?}]
    if {[lindex $typeInfoList 0]} {
        set itemList [dict get $typeInfo $mode $service $type definition]
        set xns [dict get $typeInfo $mode $service $type xns]
    } else {
        if {[info exists simpleTypes($mode,$service,$type)]} {
          set xns [dict get $simpleTypes($mode,$service,$type) xns]
        } else {
................................................................................
              error "Simple type cannot be found: $type"
            }
            set itemList [list $type {type string}]
        }
    }
    ::log::log debug "\titemList is {$itemList} in $xns"
    foreach {itemName itemDef} $itemList {
        set itemType [string trimright [dict get $itemList $itemName type] {?}]
        set typeInfoList [TypeInfo $mode $service $itemType]
        ::log::log debug "\t\t Looking for {$itemName} in {$dict}"
        if {![dict exists $dict $itemName]} {
            ::log::log debug "\t\t Not found, skipping"
            continue
        }
        ::log::log debug "\t\t Type info is {$typeInfoList}"
................................................................................
                set dataList [dict get $dict $itemName]
                set tmpType [string trimright $itemType {()}]
                if {![string match {*:*} $itemType]} {
                    set attrType $xns:$itemType
                } else {
                    set attrType $itemType
                }
                set attrType [string trim $attrType {()?}]
                $parent setAttribute xmlns:soapenc {http://schemas.xmlsoap.org/soap/encoding/}
                $parent setAttribute soapenc:arrayType [format {%s[%d]} $attrType [llength $dataList]]
                $parent setAttribute xsi:type soapenc:Array
                #set itemName [$parent nodeName]
                foreach item $dataList {
                    if {[string equal $xns $options(suppressNS)]} {
                        $parent appendChild [$doc createElement $itemName retNode]
................................................................................
            warning {
                set ::WS::Utils::targetNs $tmpTargetNs
                ::log::log $options(StrictMode) "Found $lastUnknownRefCount forward type references: [join [array names unkownRef] {,}]"
            }
            error -
            default {
                set ::WS::Utils::targetNs $tmpTargetNs

                return \
                    -code error \
                    -errorcode [list WS $mode UNKREFS [list $lastUnknownRefCount]] \
                    "Found $lastUnknownRefCount forward type references: [join [array names unkownRef] {,}]"
            }
        }
    }
................................................................................
                -code error \
                -errorcode [list WS CLIENT MISSCHLOC $baseUrl] \
                "Missing Schema Location in '$baseUrl'"
        }
    }
    set urlTail [$importNode getAttribute $attrName]
    set url [::uri::resolve $baseUrl  $urlTail]
    ::log::log debug "Including $url"

    set lastPos [string last / $url]
    set testUrl [string range $url 0 [expr {$lastPos - 1}]]
    if { [info exists ::WS::Utils::redirectArray($testUrl)] } {
        set newUrl $::WS::Utils::redirectArray($testUrl)
        append newUrl [string range $url $lastPos end]
        ::log::log debug "newUrl = $newUrl"
................................................................................
                        return \
                            -code error \
                            -errorcode [list WS $mode UNKREF [list $typeName $partType]] \
                            "Unknown forward type reference {$partType} in {$typeName}"
                    }
                } else {
                    set partName [$middleNode getAttribute name]
                    set partType [string trimright [getQualifiedType $results [$middleNode getAttribute type string:string] $tns] {?}]
                    set partMax [$middleNode getAttribute maxOccurs 1]
                    if {$partMax <= 1} {
                        lappend partList $partName [list type $partType comment $comment]
                    } else {
                        lappend partList $partName [list type [string trimright ${partType} {()}]() comment $comment]
                    }
                }
................................................................................
                                    set ref $attr
                                }
                                catch {set attrArr($name) [$element getAttribute $ref]}
                            }
                            set partName item
                            set partType [getQualifiedType $results $attrArr(arrayType) $tns]
                            set partType [string map {{[]} {()}} $partType]
                            lappend partList $partName [list type [string trimright ${partType} {()?}]() comment $comment allowAny 1]
                            set nodeFound 1
                        }
                        extension {
                            ::log::log debug "Calling partList for $contentType of $typeName"
                            if {[catch {set tmp [partList $mode $child $serviceName results $tns]} msg]} {
                                ::log::log debug "Error in partList {$msg}, errorInfo: $errorInfo"
                            }
................................................................................
            ##
            ## Do Nothing
            ##
        }
        element {
            catch {
                set partName [$node getAttribute name]
                set partType [string trimright [getQualifiedType $results [$node getAttribute type string] $tns] {?}]
                set partMax [$node getAttribute maxOccurs 1]
                if {$partMax <= 1} {
                    set partList [list $partName [list type $partType comment {}]]
                } else {
                    set partList [list $partName [list type [string trimright ${partType} {()}]() comment {}]]
                }
            }
................................................................................
                        set attrName ref
                        set isRef 1
                    }
                    set partName [$element getAttribute $attrName]
                    if {$isRef} {
                        set partType {}
                        set partTypeInfo {}
                        set partType [string trimright [getQualifiedType $results $partName $tns] {?}]
                        set partTypeInfo [::WS::Utils::GetServiceTypeDef $mode $serviceName $partType]
                        set partName [lindex [split $partName {:}] end]
                        ::log::log debug "\t\t\t part name is {$partName} type is {$partTypeInfo}"
                        if {[dict exists $partTypeInfo definition $partName]} {
                            set partType [dict get $partTypeInfo definition $partName type]
                        }
                        ::log::log debug "\t\t\t part name is {$partName} type is {$partType}"
................................................................................
                        }
                    } else {
                        set partMax [$element getAttribute maxOccurs 1]
                    }
                    if {$partMax <= 1} {
                        lappend partList $partName [concat [list type $partType comment $comment] $additional_defininition_elements]
                    } else {
                        lappend partList $partName [concat [list type [string trimright ${partType} {()?}]() comment $comment] $additional_defininition_elements]
                    }
                } msg]} {
                    ::log::log error "\tError processing {$msg} for [$element asXML]"
                    if {$isRef} {
                        ::log::log error "\t\t Was a reference.  Additionally information is:"
                        ::log::log error "\t\t\t part name is {$partName} type is {$partType} with {$partTypeInfo}"
                    }
................................................................................
                            set ref $attr
                        }
                        catch {set attrArr($name) [$element getAttribute $ref]}
                    }
                    set partName item
                    set partType [getQualifiedType $results $attrArr(arrayType) $tns]
                    set partType [string map {{[]} {()}} $partType]
                    set partList [list $partName [list type [string trimright ${partType} {()?}]() comment {} allowAny 1]]
                }
                extension {
                    set extension [$node selectNodes -namespaces $nsList xs:extension]
                    set partList [partList $mode $extension $serviceName results $tns]
                }
                default {
                    ##
................................................................................

        if {[string equal $partMax -1]} {
            set partMax [[$element parent] getAttribute maxOccurs -1]
        }
        if {$partMax <= 1} {
            lappend partList $partName [list type $partType comment {}]
        } else {
            lappend partList $partName [list type [string trimright ${partType} {()?}]() comment {}]
        }
    }
    if {[llength $elements] == 0} {
        #
        # Validate this is not really a complex or simple type
        #
        set childList [$node childNodes]
................................................................................
            if {([lindex [TypeInfo $mode $serviceName $partType] 0] == 0) &&
                [string equal $tns:$typeName $partType]} {
                return
            } else {
                lappend partList $typeName [list type $partType comment {}]
            }
        } else {
            lappend partList $typeName [list type [string trimright ${partType} {()?}]() comment {}]
        }
    }
    if {[llength $partList]} {
        ::WS::Utils::ServiceTypeDef $mode $serviceName $tns:$typeName $partList $tns $isAbstractType
    } else {
        if {![dict exists $results types $tns:$typeName]} {
            set partList [list base string comment {} xns $tns]
................................................................................
    ##
    set result 1

    ##
    ## Get the type information
    ##
    set typeInfoList [TypeInfo $mode $serviceName $typeName]
    set baseTypeName [string trimright $typeName {()?}]
    set typeName [string trimright $typeName {?}]
    set typeInfo [GetServiceTypeDef $mode $serviceName $baseTypeName]
    set isComplex [lindex $typeInfoList 0]
    set isArray [lindex $typeInfoList 1]

    if {$isComplex} {
        ##
        ## Is complex
................................................................................
###########################################################################
proc ::WS::Utils::buildTags {mode serviceName typeName valueInfos doc currentNode} {
    upvar 1 $valueInfos values

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

    foreach {field fieldDef} [dict get $typeInfo definition] {
        ##
        ## Get info about this field and its type
        ##
        array unset fieldInfoArr
        set fieldInfoArr(minOccurs) 0
        array set fieldInfoArr $fieldDef
        set typeInfoList [TypeInfo $mode $serviceName $fieldInfoArr(type)]
        set fieldBaseType [string trimright $fieldInfoArr(type) {()?}]
        set isComplex [lindex $typeInfoList 0]
        set isArray [lindex $typeInfoList 1]
        if {[dict exists $valueInfos $field]} {
            if {$isArray} {
                set valueList [dict get $valueInfos $field]
            } else {
                set valueList [list [dict get $valueInfos $field]]
................................................................................
        set results {<** Circular Reference **>}
        ::log::log debug "Leaving [info level 0] with {$results}"
        return $results
    } else {
        set generatedTypes([list $mode $serviceName $type]) 1
    }

    set type [string trimright $type {?}]
    # set typeDefInfo [dict get $typeInfo $mode $serviceName $type]
    set typeDefInfo [GetServiceTypeDef $mode $serviceName $type]
    if {![llength $typeDefInfo]} {
      ## We failed to locate the type. try with the last known xns...
      set typeDefInfo [GetServiceTypeDef $mode $serviceName ${xns}:$type]
    }

................................................................................
        }
      }
      set typeDefInfo [dict create definition [dict create $type $typeDefInfo]]
    }
    set partsList [dict keys [dict get $typeDefInfo definition]]
    ::log::log debug "\t partsList is {$partsList}"
    foreach partName $partsList {
        set partType [string trimright [dict get $typeDefInfo definition $partName type] {?}]
        set partXns $xns
        catch {set partXns  [dict get $typeInfo $mode $serviceName $partType xns]}
        set typeInfoList [TypeInfo $mode $serviceName $partType]
        set isArray [lindex $typeInfoList end]

        ::log::log debug "\tpartName $partName partType $partType xns $xns typeInfoList $typeInfoList"
        switch -exact -- $typeInfoList {
................................................................................
                set lastPos [string last / $initialUrl]
                set initialUrlDir [string range $initialUrl 0 [expr {$lastPos - 1}]]
                set lastPos [string last / $finalUrl]
                set finalUrlDir [string range $finalUrl 0 [expr {$lastPos - 1}]]
                ::log::log debug "initialUrlDir = $initialUrlDir, finalUrlDir = $finalUrlDir"
                set ::WS::Utils::redirectArray($initialUrlDir) $finalUrlDir
            }
            return $token
        } elseif {![string match {20[1237]} $ncode]} {
            return $token
        }
        # http code announces redirect (3xx)
        array set meta [set ${token}(meta)]
        if {![info exist meta(Location)]} {
            ::log::log debug "Redirect http code without Location"
            return $token

if {![llength [info command dict]]} {
    package require dict
}
package require uri
package require base64
package require html

package provide WS::Wub 2.2.1

namespace eval ::WS::Wub {

    array set portInfo {}

    set portList [list]
    set forever {}

if {![llength [info command dict]]} {
    package require dict
}
package require uri
package require base64
package require html

package provide WS::Wub 2.4.0

namespace eval ::WS::Wub {

    array set portInfo {}

    set portList [list]
    set forever {}

package require WS::Server

package require OO
package require Direct
package require Debug
Debug off wsdl 10

package provide WS::Wub 2.0.0
package provide Wsdl 1.0

class create Wsdl {
    method / {r args} {
	return [Http Ok $r [::WS::Server::generateInfo $service 0] text/html]
    }

    method /op {r args} {

package require WS::Server

package require OO
package require Direct
package require Debug
Debug off wsdl 10

package provide WS::Wub 2.4.0
package provide Wsdl 2.4.0

class create Wsdl {
    method / {r args} {
	return [Http Ok $r [::WS::Server::generateInfo $service 0] text/html]
    }

    method /op {r args} {

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

package ifneeded WS::Client 2.3.9  [list source [file join $dir ClientSide.tcl]]
package ifneeded WS::Server 2.3.7  [list source [file join $dir ServerSide.tcl]]
package ifneeded WS::Utils 2.3.10 [list source [file join $dir Utilities.tcl]]

package ifneeded WS::Embeded 2.3.0 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::AOLserver 2.0.0 [list source [file join $dir AOLserver.tcl]]
package ifneeded WS::Channel 2.0.0 [list source [file join $dir ChannelServer.tcl]]

package ifneeded WS::Wub 2.2.1 [list source [file join $dir WubServer.tcl]]
package ifneeded Wsdl 2.0.0 [list source [file join $dir WubServer.tcl]]

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

package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]]
package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]]
package ifneeded WS::Client 2.4.0 [list source [file join $dir ClientSide.tcl]]

package ifneeded WS::Embeded 2.4.0 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::Server 2.4.0 [list source [file join $dir ServerSide.tcl]]
package ifneeded WS::Utils 2.4.0 [list source [file join $dir Utilities.tcl]]

package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]]
package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]]