/usr/share/tcltk/xotcl1.6.7-actiweb/Invoker.xotcl is in xotcl 1.6.7-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 | # $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 "<p> invocation error: $msg"
if {[llength $arguments] > 0} {
append errorText ":\n<p> object: '[lindex $arguments 0]' \n"
} else {
append errorText \n
}
if {[llength $arguments] > 1} {
append errorText "<p> 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 "<p>tcl error: '$msg' \n<code><p><pre>$arguments</pre></code>"
} 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::*
|