# $Id: Invoker.xotcl,v 1.6 2006/09/27 08:12:40 neumann Exp $ package provide xotcl::actiweb::invoker 0.8 package require XOTcl namespace eval ::xotcl::actiweb::invoker { namespace import ::xotcl::* Class AbstractInvoker AbstractInvoker abstract instproc invokeCall {o method arguments} AbstractInvoker abstract instproc eval {obj method arguments} # # error types are: tclError, invocationError # AbstractInvoker abstract instproc callError {type msg obj arguments} Class Invoker -superclass AbstractInvoker -parameter {{place [self]}} Invoker instproc handleException {response} { if {[my isExceptionObject $response]} { set exceptionObj $response switch [$exceptionObj info class] { ::RedirectException { set obj [$exceptionObj obj] set method [$exceptionObj method] set arguments [$exceptionObj arguments] set response [my eval $obj $method $arguments] } ::ErrorException { set response [$exceptionObj set errorText] } } $exceptionObj destroy } return $response } Invoker instproc invokeCall {o s method arguments} { upvar [self callinglevel] $o obj $s status my instvar place set response "" if {[$place isExportedObj $obj]} { # if method is not given -> call default on the object if {$method eq ""} { set method default } if {[$obj isExportedProc $method]} { #puts stderr "ExportedProcs of $obj: [$obj exportedProcs]" #puts stderr "Call: $obj -- $method -- $arguments" set response [my eval $obj $method $arguments] } else { #puts stderr "ExportedProcs of $obj: [$obj exportedProcs]" set response [my callError invocationError [$place startingObj] \ "Method not found or not exported" \ "$obj $method $arguments"] set status 405 } } else { set called $obj set obj [$place startingObj] set response [my callError invocationError $obj \ "Object '$called' unknown" ""] set status 404 } return [my handleException $response] } # # tests whether "name" is an exception object or not # Invoker instproc isExceptionObject name { if {[Object isobject $name] && [$name istype Exception]} { return 1 } return 0 } # # central eval -- all remote call # are invoked through this method # Invoker instproc eval {obj method arguments} { puts stderr "[clock format [clock seconds] \ -format %Y/%m/%d@%H:%M:%S] \ Eval Call: $obj $method $arguments" if {[catch { set r [::eval $obj $method $arguments] } ei]} { set r [my callError tclError $obj $ei "$obj $method $::errorInfo"] } return $r } Invoker instproc callError {type obj msg arguments} { [my set place]::error $type $obj $msg $arguments } Class ErrorMgr ErrorMgr instproc isHtml o { if {[my isobject $o]} { if {[$o exists contentType]} { if {[$o set contentType] eq "text/html"} { return 1 } } } return 0 } ErrorMgr instproc invocationError {obj msg arguments} { my showCall set ee [ErrorException [self]::[my autoname ee]] $ee instvar errorText if {[my isHtml $obj]} { set errorText "

invocation error: $msg" if {[llength $arguments] > 0} { append errorText ":\n

object: '[lindex $arguments 0]' \n" } else { append errorText \n } if {[llength $arguments] > 1} { append errorText "

call: '[lrange $arguments 1 end]' \n" } } else { set errorText "invocation error: $msg $arguments" } return $ee } ErrorMgr instproc tclError {obj msg arguments} { set ee [ErrorException [self]::[my autoname ee]] if {[my isHtml $obj]} { $ee errorText "

tcl error: '$msg' \n

$arguments
" } else { $ee errorText "tcl error: '$msg'\n$::errorInfo" } return $ee } # # exceptions in invocation behavior # Class Exception # # Execpetion that tells the invoker to redirect the call to # parameters # Class RedirectException -superclass Exception -parameter { {obj ""} {method ""} {arguments ""} } Class ErrorException -superclass Exception -parameter { {errorText ""} } namespace export AbstractInvoker \ Invoker ErrorMgr Exception \ RedirectException ErrorException } namespace import ::xotcl::actiweb::invoker::*