# $Id: s.WebObject.xotcl 1.9 01/03/23 21:55:32+01:00 neumann@somewhere.wu-wien.ac.at $
package provide xotcl::mos::webObject 0.8

package require xotcl::mos::sendStrategy
package require xotcl::mixinStrategy
package require xotcl::store::persistence

#
# base interface for all web-entitites
#
Class WebObject -parameter {
  {exportedProcs {echo default}}
  agentInfo
  {contentType ""}
  {place ""}
}

#
# default send strategy == send the response from the place
#
WebObject instproc init args {
  #[self] showCall
  [self] mixinStrategy Send=PlainString
  [self] registerPlace
  [self] mixinStrategy Persistent=Eager
  [self] persistenceMgr [[self] place]::agentPersistenceMgr
  next
}

WebObject instproc registerPlace {} {
  [self] set place [Place getInstance]
  [self] set agentInfo [[[self] place]::agentMgr \
			  register [[self] selfName]]
}

WebObject instproc deregisterPlace {} {
  [[self] place]::agentMgr deregister [[self] selfName]
}

#
# seek for the HTTP worker object that has invoked
# the current call
#
WebObject instproc getWorker {} {
  for {set level 1} {1} {incr level} {
    if {[catch {set worker [uplevel $level self]}]} {
      return ""
    } elseif {[$worker istype Place::HttpdWrk]} {
      return $worker
    }
  }
}
WebObject instproc getFormData {} {
  [[self] getWorker] formData
}

#
# code a call for an action on self;
# action is "proc args"
#
WebObject instproc selfAction {action} {
  return [url encodeItem "[string trimleft [self] :] $action"]
}
WebObject instproc action {o action} {
  return [url encodeItem "[string trimleft $o :] $action"]
}
WebObject instproc echo {} {
  return [self]
}

WebObject instproc error args {
  return "Error on [self]: Invocation '$args' failed."
}

WebObject instproc default {} {
  return "No default behaviour on [self]."
}

WebObject instproc exportProcs args {
  [self] instvar exportedProcs
  foreach a $args {
    if {[lsearch $exportedProcs $a] == -1} {
      lappend exportedProcs $a
    }
  }
}

WebObject instproc isExportedProc p {
  expr {[lsearch [[self] set exportedProcs] $p] != -1}
}

WebObject instproc selfName {} {
  return [string trimleft [self] :]
}

WebObject instproc objName {obj} {
  return [string trimleft $obj :]
}

WebObject instproc buildAdress {} {
  [self] instvar place
  set a http://[$place host]
  if {[set p [$place port]]} {
    append a :$p
  }
}

WebObject instproc destroy args {
  [self] deregisterPlace
  next
}

#
# simple class, to be inherited before WebObject, if
# every remote method should reach the object
#
Class ExportAll
ExportAll instproc isExportedProc p {
   return 1
}