Index: openacs-4/packages/xotcl-core/xotcl-core.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/xotcl-core.info,v
diff -u -r1.67 -r1.68
--- openacs-4/packages/xotcl-core/xotcl-core.info 6 Jan 2009 01:27:40 -0000 1.67
+++ openacs-4/packages/xotcl-core/xotcl-core.info 23 Apr 2009 10:14:51 -0000 1.68
@@ -10,10 +10,10 @@
t
xotcl
-
+
Gustaf Neumann
XOTcl library functionality (e.g. thread handling, online documentation, Generic Form and List Classes)
- 2009-01-06
+ 2009-04-23
Gustaf Neumann, WU Wien
This component contains some core functionality for OpenACS
applications using XOTcl. It includes
@@ -43,11 +43,11 @@
BSD-Style
0
-
+
-
+
Index: openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl,v
diff -u -r1.36 -r1.37
--- openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl 9 Apr 2009 06:35:09 -0000 1.36
+++ openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl 23 Apr 2009 10:14:51 -0000 1.37
@@ -215,15 +215,15 @@
if {[ns_conn isconnected]} {
append msg "flags=[ad_conn flags] status=[ad_conn status] req=[ad_conn request]"
}
- my log $msg
+ ::xotcl::Object log $msg
set max [info level]
if {$m<$max} {set max $m}
- my log "### Call Stack (level: command)"
+ ::xotcl::Object log "### Call Stack (level: command)"
for {set i 0} {$i < $max} {incr i} {
if {[catch {set s [uplevel $i self]} msg]} {
set s ""
}
- my log "### [format %5d -$i]:\t$s [info level [expr {-$i}]]"
+ ::xotcl::Object log "### [format %5d -$i]:\t$s [info level [expr {-$i}]]"
}
}
@@ -437,7 +437,22 @@
set t1 [clock clicks -milliseconds]
ns_log notice "ON DELETE done ([expr {$t1-$t0}]ms)"
}
-
+
+ #
+ # ::xo::Module is very similar to a plain tcl namespace: When it is
+ # created/recreated, it does not perform a cleanup of its
+ # contents. This means that preexisting procs, objects classes,
+ # variables etc. will survive a recreation. As a consequence,
+ # ::xo::Modules can easily span multiple files an they can be used
+ # like a namespace. However, the modules have the advantage that it
+ # is possible to define procs, instprocs with non-positional
+ # arguments directly in it. It is as well possible to use mixins
+ # etc.
+ #
+ Class create Module
+ Module instproc cleanup args {
+ ns_log notice "create/recreate [self] without cleanup"
+ }
}
#ns_log notice "*** FREECONN? [ns_ictl gettraces freeconn]"
Index: openacs-4/packages/xotcl-core/tcl/04-library-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/04-library-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/xotcl-core/tcl/04-library-procs.tcl 11 Oct 2007 07:58:17 -0000 1.1
+++ openacs-4/packages/xotcl-core/tcl/04-library-procs.tcl 23 Apr 2009 10:14:51 -0000 1.2
@@ -61,6 +61,7 @@
set dirname [file dirname [info script]]
set otherfile $dirname/$filename.tcl
set vn [self]
+ #my log "--exists otherfile $otherfile => [nsv_exists $vn $otherfile]"
if {[nsv_exists $vn $otherfile]} {
nsv_set $vn $otherfile [lsort -unique [concat [nsv_get $vn $otherfile] $myfile]]
#my log "--setting nsv_set $vn $otherfile [lsort -unique [concat [nsv_get $vn $otherfile] $myfile]]"
@@ -69,6 +70,8 @@
#my log "--setting nsv_set $vn $otherfile $myfile"
}
#my log "--source when not loaded [self]-loaded $otherfile: [nsv_exists [self]-loaded $otherfile]"
+ #my log "--loaded = [lsort [nsv_array names [self]-loaded]]"
+
if {![nsv_exists [self]-loaded $otherfile]} {
my log "--sourcing $otherfile"
apm_source $otherfile
@@ -90,7 +93,7 @@
set myfile [file tail [info script]]
set dirname [file dirname [info script]]
set vn [self]
- #my log "--check nsv_exists $vn $dirname/$myfile"
+ #my log "--check nsv_exists $vn $dirname/$myfile [nsv_exists $vn $dirname/$myfile]"
if {[nsv_exists $vn $dirname/$myfile]} {
foreach file [nsv_get $vn $dirname/$myfile] {
my log "--sourcing dependent $dirname/$file"
Index: openacs-4/packages/xotcl-core/tcl/cr-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/cr-procs.tcl,v
diff -u -r1.29 -r1.30
--- openacs-4/packages/xotcl-core/tcl/cr-procs.tcl 19 Mar 2009 21:49:14 -0000 1.29
+++ openacs-4/packages/xotcl-core/tcl/cr-procs.tcl 23 Apr 2009 10:14:51 -0000 1.30
@@ -1311,17 +1311,35 @@
CrCache::Item instproc flush_from_cache_and_refresh {} {
# cache only names with IDs
set obj [self]
- if {[regexp [[self class] set name_pattern] $obj]} {
+ set canonical_name ::[$obj item_id]
+ ::xo::clusterwide ns_cache flush xotcl_object_cache $obj
+ if {$obj eq $canonical_name} {
#my log "--CACHE saving $obj in cache"
- ::xo::clusterwide ns_cache flush xotcl_object_cache $obj
- # We do not want to cache per object mixins for the time being
- # (some classes might be volatile). So save mixin-list, cache
- # and resore them later for the current session.
+ #
+ # The object name is eq to the item_id; we assume, this is a
+ # fully loaded object, containing all relevant instance
+ # variables. We can restore it. after the flash
+ #
+ # We do not want to cache per object mixins for the
+ # time being (some classes might be volatile). So save
+ # mixin-list, cache and resore them later for the current
+ # session.
set mixins [$obj info mixin]
$obj mixin [list]
ns_cache set xotcl_object_cache $obj [$obj serialize]
$obj mixin $mixins
+ } else {
+ # in any case, flush the canonical name
+ ::xo::clusterwide ns_cache flush xotcl_object_cache $canonical_name
}
+ # To be on he safe side, delete the revison as well from the
+ # cache, if possible.
+ if {[$obj exists revision_id]} {
+ set revision_name ::[$obj revision_id]
+ if {$obj ne $revision_name} {
+ ::xo::clusterwide ns_cache flush xotcl_object_cache $revision_name
+ }
+ }
}
CrCache::Item instproc update_attribute_from_slot args {
set r [next]