xotcl 1.6.7-2 / usr / share / tcltk / xotcl1.6.7-actiweb / WebObject.xotcl

This file is indexed.

/usr/share/tcltk/xotcl1.6.7-actiweb/WebObject.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
# $Id: WebObject.xotcl,v 1.3 2005/09/09 21:09:01 neumann Exp $

package provide xotcl::actiweb::webObject 0.8

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

package require XOTcl

namespace eval ::xotcl::actiweb::webObject {
    namespace import ::xotcl::*

    #
    # 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 {
	#my showCall
	my mixinStrategy ::Send=PlainString
	my registerPlace
	my mixinStrategy ::Persistent=Eager
	my persistenceMgr [my place]::agentPersistenceMgr
	next
    }

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

    WebObject instproc deregisterPlace {} {
	[my place]::agentMgr deregister [my 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 {} {
	[my 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 {
	my instvar exportedProcs
	foreach a $args {
	    if {[lsearch $exportedProcs $a] == -1} {
		lappend exportedProcs $a
	    }
	}
    }

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

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

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

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

    WebObject instproc destroy args {
	my 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
    }

    namespace export WebObject ExportAll
}

namespace import ::xotcl::actiweb::webObject::*

APT Browse - Built by Thomas Orozco.