Index: openacs-4/packages/xotcl-core/tcl/40-thread-mod-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/40-thread-mod-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/xotcl-core/tcl/40-thread-mod-procs.tcl 14 Jul 2006 01:22:11 -0000 1.3
+++ openacs-4/packages/xotcl-core/tcl/40-thread-mod-procs.tcl 30 Mar 2007 19:29:56 -0000 1.4
@@ -12,7 +12,7 @@
When an instance of THREAD is created (e.g. t1),
an init-command is provided. e.g.:
<pre>
- THREAD create t1 {
+ ::xotcl::THREAD create t1 {
Class Counter -parameter {{value 1}}
Counter instproc ++ {} {my incr value}
Counter c1
@@ -52,7 +52,7 @@
creates a Proxy for an object c1 in thread t1.
After this, c1 can be used like an local object.
<pre>
- THREAD::Proxy c1 -attach t1
+ ::xotcl::THREAD::Proxy c1 -attach t1
set x [c1 ++]
</pre>
The Proxy forwards all commands to the
@@ -117,8 +117,20 @@
}
::xotcl::THREAD instproc init cmd {
- my instvar initcmd
- set initcmd {
+ my instvar initcmd
+ if {![ns_ictl epoch]} {
+ #ns_log notice "--THREAD init [self] no epoch"
+
+ # We are during initialization. For some unknown reasons, XOTcl
+ # is not available in newly created threads, so we have to care for it.
+ # We need only a partial initialization, to allow the exit handler
+ # to be defined.
+ set initcmd {
+ package req XOTcl
+ namespace import -force ::xotcl::*
+ }
+ }
+ append initcmd {
::xotcl::Object setExitHandler {
#my log "EXITHANDLER of slave thread SELF [pid]"
}
@@ -161,7 +173,7 @@
my log "thread terminated"
nsv_unset [self class] [self]
thread::mutex destroy [my set mutex]
- ns_log notice "mutex [my set mutex] destroyed"
+ my log "+++ mutex [my set mutex] destroyed"
}
}
next
@@ -189,11 +201,25 @@
set tid [::thread::create]
nsv_set [self class] [self] $tid
if {[my persistent]} {
- my log "created new persistent [self class] as $tid pid=[pid]"
+ my log "--created new persistent [self class] as $tid pid=[pid]"
} else {
- my log "created new [self class] as $tid pid=[pid]"
+ my log "--created new [self class] as $tid pid=[pid]"
}
- ::thread::send $tid [my set initcmd]
+ #my log "--THREAD DO send [self] epoch = [ns_ictl epoch]"
+ if {![ns_ictl epoch]} {
+ #ns_log notice "--THREAD send [self] no epoch"
+ # We are during initialization. For some unknown reasons, XOTcl
+ # is not available in newly created threads, so we have to care
+ # for full initialization, including xotcl blueprint.
+ set initcmd {
+ package req XOTcl
+ namespace import -force ::xotcl::*
+ }
+ append initcmd [::Serializer all]
+ }
+ append initcmd [my set initcmd]
+
+ ::thread::send $tid $initcmd
} else {
set tid [nsv_get [self class] [self]]
}
@@ -223,7 +249,7 @@
# create a sample persistent thread that can be acessed
# via request threads
-#THREAD create t0 {
+#::xotcl::THREAD create t0 {
# Class Counter -parameter {{value 1}}
# Counter instproc ++ {} {my incr value}
#
Index: openacs-4/packages/xotcl-core/tcl/generic-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/generic-procs.tcl,v
diff -u -r1.47 -r1.48
--- openacs-4/packages/xotcl-core/tcl/generic-procs.tcl 25 Mar 2007 21:53:52 -0000 1.47
+++ openacs-4/packages/xotcl-core/tcl/generic-procs.tcl 30 Mar 2007 19:29:56 -0000 1.48
@@ -852,7 +852,7 @@
#
CrItem ad_instproc privilege=creator {
- {-login true} user_id package_id
+ {-login true} user_id package_id method
} {
Define an object specific privilege to be used in the policies.
Index: openacs-4/packages/xotcl-core/tcl/http-client-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/http-client-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/xotcl-core/tcl/http-client-procs.tcl 15 Feb 2007 09:23:32 -0000 1.1
+++ openacs-4/packages/xotcl-core/tcl/http-client-procs.tcl 30 Mar 2007 19:29:56 -0000 1.2
@@ -15,20 +15,21 @@
{user_agent xohttp/0.1}
}
- HttpRequest instproc url {url} {
- my instvar host url path
+ HttpRequest instproc parse_url {} {
+ my instvar url host port path
if {[regexp {http://([^/]*)(/.*)} $url _ host path]} {
set port 80
regexp {^([^:]+):(.*)$} $host _ host port
} else {
- error "unsupported or invalid url '[my url]'"
+ error "unsupported or invalid url '$url'"
}
}
HttpRequest instproc init {} {
my instvar S post_data host port
my set meta [list]
my set data ""
+ if {[my exists url]} {my parse_url}
if {[catch {set S [socket $host $port]} err]} {
my cancel "error socket $host $port: $err"
Index: openacs-4/packages/xotcl-core/tcl/policy-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/policy-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/xotcl-core/tcl/policy-procs.tcl 9 Mar 2007 20:56:32 -0000 1.4
+++ openacs-4/packages/xotcl-core/tcl/policy-procs.tcl 30 Mar 2007 19:29:56 -0000 1.5
@@ -40,11 +40,11 @@
default {
# try object specific privileges. These have the signature:
#
- # <class> instproc privilege=<name> {{-login true} user_id package_id}
+ # <class> instproc privilege=<name> {{-login true} user_id package_id method}
#
if {[$object info methods privilege=$privilege] ne ""} {
if {![info exists package_id]} {set package_id [::xo::cc package_id]}
- set allowed [$object privilege=$privilege -login $login $user_id $package_id]
+ set allowed [$object privilege=$privilege -login $login $user_id $package_id method]
}
}
}