package provide xotcl::soap::server 0.9

package require xotcl::soap
package require xotcl::comm::httpd

soap::Class soap::Worker -superclass Httpd::Wrk

# overload HTML error Reply --> add no HTML to error REPLY
### uwe: wo wird das verwendet???
#soap::Worker instproc htmlErrorReply {code {msg ""}} {}

soap::Worker instproc respond {} {
  [self] instvar resourceName method
  if {$resourceName == [[[self] info parent] set soapTrigger] &&
    $method == "POST" } {
    [self] soapRespond-POST
  } else {
    next
  }
}
soap::Worker instproc soapRespond-POST {} {
  [self class]::soapParser parse [[self] set data]
  set soapRequest [[self class]::soapInterp buildRequest \
		   [self class]::soapParser::topNode0]
  [self class]::soapParser reset
  $soapRequest print

  soap::Response create [self]::soapResponse -responseCode 200 \
      -name [$soapRequest set name]

  if {[catch {set result [$soapRequest eval]} errMsg]} {
    [self]::soapResponse set faultcode TCL_ERROR

    puts ERROR=$errMsg

    [self]::soapResponse set faultstring $errMsg
    [self]::soapResponse set responseCode 500
  } else {
    [self]::soapResponse value $result
    puts ++++++++$result.
    #### type guessing???
    [self]::soapResponse type string
  }

  [self]::soapResponse print
  set c [[self]::soapResponse createXML]

  #kann replyCode nicht verwenden -> produziert HTML seite und schliesst req ab
  # ==> habe htmlReply eingefuegt

  [self] replyCode [[self]::soapResponse set responseCode]
  [self]::c puts "Content-Type: text/xml; charset=utf-8"
  [self]::c puts "Content-Length: [string length $c]\n"
  [self]::c puts-nonewline $c
  #[self] showVars
  #[self]::soapResponse destroy
  $soapRequest destroy
  [self] close
}

Class soap::Httpd -superclass Httpd -parameter soapTrigger
soap::Httpd instproc init {} {
  lappend [self]::workerMixins soap::Worker
  next
}
