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

    if {$value ne {}} {
        dict set serviceInfo $item $value
        set serviceArr($serviceName) $serviceInfo
    }

    return [dict get $serviceInfo $item]

}

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

    if {$inputArgs ne {}} {
        set inType $objectName.$operationName.Request
        ::WS::Utils::ServiceTypeDef Client $serviceName $inType $inputArgs
    } else {
        set inType {}
    }
    if {$returnType ne {}} {
        set outType $objectName.$operationName.Results
        ::WS::Utils::ServiceTypeDef Client $serviceName $outType $returnType
    } else {
        set outType {}
    }

    dict set serviceArr($serviceName) object $objectName location $location

    set tnsCount [expr {[llength [dict get $serviceArr($serviceName) targetNamespace]]/2}]
    set serviceInfo $serviceArr($serviceName)
    dict lappend serviceInfo imports $url
    ::WS::Utils::ProcessImportXml Client $url $xml $serviceName serviceInfo tnsCount
    set serviceArr($serviceName) $serviceInfo
    set result {}
    foreach {result target} [dict get $serviceArr($serviceName) targetNamespace] {
        if {$target eq $url} {
            break
        }
    }
    return $result
}

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

#       1  01/30/2009  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::GetOperationList {serviceName {object {}}} {
    variable serviceArr

    if {$object eq {}} {
        return [dict get $serviceArr($serviceName) operList]
    } else {
        return [list $object [dict get $serviceArr($serviceName) operation $object inputs] [dict get $serviceArr($serviceName) operation $object outputs]]
    }

}

    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
            }
        }

        https {
            if {[llength $headers]} {
                set token [::WS::Utils::geturl_followRedirects $url -headers $headers]
            } else {
                set token [::WS::Utils::geturl_followRedirects $url]
            }
            ::http::wait $token
            if {[::http::status $token] ne {ok} ||
                [::http::ncode $token] != 200} {
                set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
                set errorInfo [FormatHTTPError $token]
                ::http::cleanup $token
                return \
                    -code error \
                    -errorcode $errorCode \

        if {[dict get $serviceInfo operation $operationName cloned]} {
            continue
        }
        set procName [format {::%s::%s} $serviceName $operationName]
        set argList {}
        foreach inputHeaderTypeItem [dict get $serviceInfo operation $operationName soapRequestHeader] {
            set  inputHeaderType [lindex $inputHeaderTypeItem 0]
            if {$inputHeaderType eq {}} {
                continue
            }
            set headerTypeInfo [::WS::Utils::GetServiceTypeDef Client $serviceName $inputHeaderType]
            set headerFields [dict keys [dict get $headerTypeInfo definition]]
            if {$headerFields ne {}} {
                lappend argList [lsort -dictionary $headerFields]
            }
        }
        set inputMsgType [dict get $serviceInfo operation $operationName inputs]
        ## Petasis, 14 July 2008: If an input message has no elements, just do
        ## not add any arguments...
        set inputMsgTypeDefinition [::WS::Utils::GetServiceTypeDef Client $serviceName $inputMsgType]
        if {[dict exists $inputMsgTypeDefinition definition]} {
          set inputFields [dict keys [dict get $inputMsgTypeDefinition definition]]
         } else {
          ::log::log debug "no definition found for inputMsgType $inputMsgType"
          set inputFields {}
        }
        if {$inputFields ne {}} {
            lappend argList [lsort -dictionary $inputFields]
        }
        set argList [join $argList]

        set body {
            set procName [lindex [info level 0] 0]
            set serviceName [string trim [namespace qualifiers $procName] {:}]

    ::http::wait $token

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

    }
    ::http::wait $token

    ##
    ## Check for errors
    ##
    set httpStatus [::http::status $token]
    if {$httpStatus eq {ok} && [::http::ncode $token] == 500} {
        set body [::http::data $token]
        ::log::log debug "\tReceived: $body"
        set outTransform [dict get $serviceInfo outTransform]
        if {$outTransform ne {}} {
            SaveAndSetOptions $serviceName
            catch {set body [$outTransform $serviceName $operationName REPLY $body]}
            RestoreSavedOptions $serviceName
        }
        set hadError [catch {parseResults $serviceName $operationName $body} results]
        if {$hadError} {
            lassign $::errorCode mainError subError
            if {$mainError eq WSCLIENT && $subError eq NOSOAP} {
                ::log::log debug "\tHTTP error $body"
                set results $body
                set errorCode [list WSCLIENT HTTPERROR $body]
                set errorInfo {}
                set hadError 1
            } else {
                ::log::log debug "Reply was $body"
                set errorCode $::errorCode
                set errorInfo $::errorInfo
            }
        }
    } elseif {$httpStatus ne {ok} || [::http::ncode $token] != 200} {
        ::log::log debug "\tHTTP error [array get $token]"
        set results [FormatHTTPError $token]
        set errorCode [list WSCLIENT HTTPERROR [::http::code $token]]
        set errorInfo {}
        set hadError 1
    } else {
        set body [::http::data $token]
        ::log::log debug "\tReceived: $body"
        set outTransform [dict get $serviceInfo outTransform]
        if {$outTransform ne {}} {
            SaveAndSetOptions $serviceName
            catch {set body [$outTransform $serviceName $operationName REPLY $body]}
            RestoreSavedOptions $serviceName
        }
        SaveAndSetOptions $serviceName
        catch {set hadError [catch {parseResults $serviceName $operationName $body} results]}
        RestoreSavedOptions $serviceName

# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  06/02/2015  H.Oehlmann   Initial version
#
#
###########################################################################
proc ::WS::Client::FormatHTTPError {token} {
    if {[::http::status $token] eq {ok}} {
        if {[::http::size $token] == 0} {
            return "HTTP failure socket closed"
        }
        return "HTTP failure code [::http::ncode $token]"
    } else {
        return "HTTP error: [::http::error $token]"
    }

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

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

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

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

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

            "Bad reply type, no SOAP envelope received in: \n$inXML"
    }
    set rootNode [$body childNodes]
    ::log::log debug "Have [llength $rootNode] node under Body"
    if {[llength $rootNode] > 1} {
        foreach tmp $rootNode {
            #puts "\t Got {[$tmp localName]} looking for {$expectedMsgTypeBase}"
            if {[$tmp localName] eq $expectedMsgTypeBase ||
                [$tmp nodeName] eq $expectedMsgTypeBase ||
                [$tmp localName] eq Fault ||
                [$tmp nodeName] eq Fault} {
                set rootNode $tmp
                break
            }
        }
    }
    if {([llength $rootNode] == 1) && $rootNode ne {}} {
        set rootName [$rootNode localName]
        if {$rootName eq {}} {
            set rootName [$rootNode nodeName]
        }
    } else {
        set rootName {}
    }
    ::log::log debug "root name is {$rootName}"

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

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

    ##
    ## Convert the packet to a dictionary
    ##
    set results {}
    set headerRootNode [$top selectNodes ENV:Header]
    if {[llength $headerRootNode]} {
        foreach outHeaderType [dict get $serviceInfo operation $operationName soapReplyHeader] {
            if {$outHeaderType eq {}} {
                continue
            }
            set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $outHeaderType] xns]
            set node [$headerRootNode selectNodes $outHeaderType]
            if {![llength $node]} {
                set node [$headerRootNode selectNodes $xns:$outHeaderType]
                if {![llength $node]} {
                    continue
                }
            }

            #if {[llength $outHeaderAttrs]} {
            #    ::WS::Utils::setAttr $node $outHeaderAttrs
            #}
            ::log::log debug "Calling [list ::WS::Utils::convertTypeToDict Client $serviceName $node $outHeaderType $headerRootNode]"
            lappend results [::WS::Utils::convertTypeToDict Client $serviceName $node $outHeaderType $headerRootNode]
        }
    }
    ::log::log debug "Calling [list ::WS::Utils::convertTypeToDict Client $serviceName $rootNode $expectedMsgType $body]"
    if {$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]
        }

                -code error
                "Unsupported Style '$style'"
        }
    }

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

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

}

            xmlns:$tns $target
    }
    #parray tnsArray

    set firstHeader 1
    foreach inputHeaderTypeItem [dict get $serviceInfo operation $operationName soapRequestHeader] {
        lassign $inputHeaderTypeItem inputHeaderType attrList
        if {$inputHeaderType eq {}} {
            continue
        }
        set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $inputHeaderType] xns]
        if {[info exists tnsArray($xns)]} {
            set xns $tnsArray($xns)
        }
        if {$firstHeader} {

    foreach {tns target} $xnsList {
        $env setAttribute xmlns:$tns $target
    }

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

        set portName [lindex [split [$binding  getAttribute type] {:}] end]
        ::log:::log debug "\t Processing binding '$bindingName' on port '$portName'"
        set operList [$binding selectNodes w:operation]
        set styleNode [$binding selectNodes d:binding]
        if {![info exists style]} {
            if {[catch {$styleNode getAttribute style} tmpStyle]} {
                set styleNode [$binding selectNodes {w:operation[1]/d:operation}]
                if {$styleNode eq {}} {
                    ##
                    ## This binding is for a SOAP level other than 1.1
                    ##
                    ::log:::log debug "Skiping non-SOAP 1.1 binding [$binding asXML]"
                    continue
                }
                set style [$styleNode getAttribute style]
                #puts "Using style for first operation {$style}"
            } else {
                set style $tmpStyle
                #puts "Using style for first binding {$style}"
            }
            if {!($style eq {document} || $style eq {rpc} )} {
                ::log:::log debug "Leaving [lindex [info level 0] 0] with error @1"
                return \
                    -code error \
                    -errorcode [list WS CLIENT UNSSTY $style] \
                    "Unsupported calling style: '$style'"
            }

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

            } else {
                set typeList [getTypesForPort $wsdlNode $serviceName $baseName $portName $inName serviceInfo $style]
                dict set serviceInfo operation $operName isClone 0
            }

            #puts "Processing operation $operName"
            set actionNode [$oper selectNodes d:operation]
            if {$actionNode eq {}} {
                ::log:::log debug "Skiping operation with no action [$oper asXML]"
                continue
            }
            dict lappend serviceInfo operList $operName
            dict set serviceInfo operation $operName cloneList {}
            dict set serviceInfo operation $operName cloned 0
            dict set serviceInfo operation $operName name $baseName

            ##
            ## Get the input headers, if any
            ##
            set soapRequestHeaderList {{}}
            foreach inHeader [$oper selectNodes w:input/d:header] {
                ##set part [$inHeader getAttribute part]
                set tmp [$inHeader getAttribute use]
                if {$tmp ne $use} {
                    ::log:::log debug "Leaving [lindex [info level 0] 0] with error @3"
                    return \
                        -code error \
                        -errorcode [list WS CLIENT MIXUSE $use $tmp] \
                        "Mixed usageage not supported!'"
                }
                set msgName [$inHeader getAttribute message]

            ##
            ## Get the output header, if one
            ##
            set soapReplyHeaderList {{}}
            foreach outHeader [$oper selectNodes w:output/d:header] {
                ##set part [$outHeader getAttribute part]
                set tmp [$outHeader getAttribute use]
                if {$tmp ne $use} {
                    ::log:::log debug "Leaving [lindex [info level 0] 0] with error @4"
                    return \
                        -code error \
                        -errorcode [list WS CLIENT MIXUSE $use $tmp] \
                        "Mixed usageage not supported!'"
                }
                set messagePath [$outHeader getAttribute message]

            ## Validate that the input and output uses
            ##
            set inUse $use
            set outUse $use
            catch {set inUse [[$oper selectNodes w:input/d:body] getAttribute use]}
            catch {set outUse [[$oper selectNodes w:output/d:body] getAttribute use]}
            foreach tmp [list $inUse $outUse] {
                if {$tmp ne $use} {
                    ::log:::log debug "Leaving [lindex [info level 0] 0] with error @5"
                    return \
                        -code error \
                        -errorcode [list WS CLIENT MIXUSE $use $tmp] \
                        "Mixed usageage not supported!'"
                }
            }
            #set typeList [getTypesForPort $wsdlNode $serviceName $baseName $portName $inName serviceInfo $style]
            ::log:::log debug "\t Messages are {$typeList}"
            foreach type $typeList mode {inputs outputs} {
                dict set serviceInfo operation $operName $mode $type
            }
            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 {

    upvar 1 $serviceInfoVar serviceInfo

    set inType {}
    set outType {}

    #set portQuery [format {w:portType[attribute::name='%s']} $portName]
    #set portNode [lindex [$wsdlNode selectNodes $portQuery] 0]
    if {$inName eq {}} {
        set operQuery [format {w:portType[attribute::name='%s']/w:operation[attribute::name='%s']} \
                        $portName $operName]
    } else {
        set operQuery [format {w:portType[attribute::name='%s']/w:operation[attribute::name='%s']/w:input[attribute::name='%s']/parent::*} \
                        $portName $operName $inName]
    }
    ::log:::log debug "\t operNode query is {$operQuery}"
    set operNode [$wsdlNode selectNodes $operQuery]
    if {$operNode eq {} && $inName ne {}} {
        set operQuery [format {w:portType[attribute::name='%s']/w:operation[attribute::name='%s']} \
                        $portName $operName]
        ::log:::log debug "\t operNode query is {$operQuery}"
        set operNode [$wsdlNode selectNodes $operQuery]
    }

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

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

    ##
    ## Return the types

    upvar 1 $serviceInfoVar serviceInfo
    ::log:::log debug "Enteringing [info level 0]"

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

    set msgQuery [format {w:message[attribute::name='%s']} $msgName]
    set msg [$wsdlNode selectNodes $msgQuery]
    if {$msg eq {} &&
        [llength [set msgNameList [split $msgName {:}]]] > 1} {
        set tmpMsgName [join [lrange $msgNameList 1 end] {:}]
        set msgQuery [format {w:message[attribute::name='%s']} $tmpMsgName]
        set msg [$wsdlNode selectNodes $msgQuery]
    }
    if {$msg eq {}} {
        return \
            -code error \
            -errorcode [list WS CLIENT BADMSGSEC $msgName] \
            "Can not find message '$msgName'"
    }
    switch -exact -- $style {
        document/literal {

    }
    if {![dict exists $serviceInfo object $objectName operation $operationName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $objectName $operationName]] \
            "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'"
    }
    if {$location ne {}} {
        set url $location
    } else {
        set url [dict get $serviceInfo object $objectName location]
    }
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName

    }
    ::http::wait $token

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

    }
    if {![dict exists $serviceInfo object $objectName operation $operationName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $objectName $operationName]] \
            "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'"
    }
    if {$location ne {}} {
        set url $location
    } else {
        set url [dict get $serviceInfo object $objectName location]
    }
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName

    ## Check for errors
    ##
    set body [::http::data $token]
    ::log::log info "\tReceived: $body"
    set httpStatus [::http::status $token]
    set hadError 0
    set results {}
    if {$httpStatus ne {ok} ||
        ( [::http::ncode $token] != 200 && $body eq {} )} {
        ::log::log debug "\tHTTP error [array get $token]"
        set results [FormatHTTPError $token]
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set errorInfo {}
        set hadError 1
    } else {
        SaveAndSetOptions $serviceName

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

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

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

    return $xml

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

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

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

    ::log::log debug "Entering ::WS::Client::asyncCallDone {$serviceName $objectName $operationName $succesCmd $errorCmd $token}"

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

}

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.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 baseName $operation
    set cmdName op$baseName
    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]} {
        ##
        ## Handle errors
        ##
        set localerrorCode $::errorCode
        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" {
            set code "SOAP-ENV:MustUnderstand"
        }
        "Client" {
            set code "SOAP-ENV:Client"
        }
        "Server" {
            set code "SOAP-ENV:Server"
        }
        default {
            ## Do nothing
        }
    }

    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.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : :WS::Server::generateReply
#
# 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 $serviceData(-enforceRequired)
            $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 0 $serviceData(-enforceRequired)
                }
            }
            $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 0 $serviceData(-enforceRequired)

            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.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

#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToType {mode service doc parent dict type {forceNs 0} {enforceRequired 0}} {
    ::log::log debug "Entering ::WS::Utils::convertDictToType $mode $service $doc $parent {$dict} $type"
    # ::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 $enforceRequired]
    }

    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 {$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 {$options(nsOnChangeOnly) && [string equal $itemXns $currentNs]} {
            set itemXns {}
        }
        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} 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]

                    }
                } else {
                    set resultValue [dict get $dict $useName]
                }
                if {![string equal $currentNs $itemXns] && ![string equal $itemXns {}]} {
                    set tmpNs $currentNs
                    set currentNs $itemXns
                    convertDictToType $mode $service $doc $retNode $resultValue $itemType $forceNs $enforceRequired
                } else {
                    convertDictToType $mode $service $doc $retNode $resultValue $itemType $forceNs $enforceRequired
                }
                if {[llength $attrList]} {
                    ::WS::Utils::setAttr $retNode $attrList
                }
            }
            {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 $forceNs $enforceRequired
                    } else {
                        convertDictToType $mode $service $doc $retNode $resultValue $tmpType $forceNs $enforceRequired
                    }
                    if {[llength $attrList]} {
                        ::WS::Utils::setAttr $retNode $attrList
                    }
                }
            }
            default {

        #    }
        #}
    }
    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 {enforceRequired 0}} {
    ::log::log debug "Entering ::WS::Utils::convertDictToJson $mode $service $doc {$dict} $type"
    variable typeInfo
    variable simpleTypes
    variable simpleTypesJson
    variable options
    variable standardAttributes

    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 {$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 $enforceRequired
                $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 $enforceRequired
                    $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<<

#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToTypeNoNs {mode service doc parent dict type {enforceRequired 0}} {
    ::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

        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 {$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)} {

                    }
                } else {
                    set resultValue [dict get $dict $itemName]
                }
                if {[llength $attrList]} {
                    ::WS::Utils::setAttr $retNode $attrList
                }
                convertDictToTypeNoNs $mode $service $doc $retnode $resultValue $itemType $enforceRequired
            }
            {1 1} {
                ##
                ## Non-simple array
                ##
                set dataList [dict get $dict $itemName]
                set tmpType [string trimright $itemType {()}]
                foreach row $dataList {
                    $parent appendChild [$doc createElement $itemName retnode]
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {$isAbstract && [string equal $attr {::type}]} {

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

    ::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.4.0

namespace eval ::WS::Wub {

    array set portInfo {}

    set portList [list]
    set forever {}

# WSWub - Wub interface to WebServices
package require Tcl 8.4
# WS::Utils usable here for dict?
if {![llength [info command dict]]} {
    package require dict
}
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 -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]]