I worked with TclOO for a little bit and made some libraries to get it
working. Here's some of my old code. Ultimately I found TclOO wasn't a
good fit for Naviserver. Someone please chime in if things have changed
and the garbage collection is no longer needed. Also note that class
creation needs to be in the ns_ictl trace create because it doesn't copy
over to other interpreters.
ns_ictl trace create {
# ModelClass - Base class. Adds garbage collection for [ClassName new]
# Use with:
# superclass BaseClass
::oo::class create BaseClass {
construct {} {
# Add to garbage collection.
lappend ::garbage::objects [self namespace]
set className [info object class [self]]
# Don't allow [ModelClass new]
if {![lindex [self call] 1]} {
return -code error "Class '$className' is abstract.
Use with 'superclass $className' inside '::oo::class create DerievedClass'."
}
}
}
}
#
# garbage
#
# TclOO does not clear temporary objects when the interpreter is deallocated.
# This namespace keeps track of temporary objects and destroys them when
# the connection closes.
#
# If you are taking up a lot of space with temporary objects then you may need
to manually
# when they're no longer needed. The garbage collector only destroys objects
on connection
# end and doesn't cleanup objects you lost references to. For instance
# the following loop replaces the objet reference 1000 times. Those objects
will persist
# through the duration of the connection unless manually destroyed.
#
# set value ""
# for {set i 0} {$i < 1000} {incr i} {
# set obj [MyClass new]
# append value [$obj myMethod]
# $obj destroy
# }
#
# To see the memory leak without garbage collection on. Comment out
# The deallocate garbage::collect and uncomment the ns_log in allocate.
#
# Note: Your constructor should have the line "lappend ::garbage::objects [self
namespace]"
# If the object is to be garbage collected. You should use "set obj [Classname
new]" when
# instantiating the object instead of [Classname create obj]. Then use it with
# "$obj method" etc.
#
namespace eval garbage {
variable objects [list]
proc collect {} {
set total 0
set withError 0
foreach {obj} $::garbage::objects {
if {[namespace exists $obj] && [catch {$obj destroy}
err]} {
# NOTE: on error the object is still destroyed.
ns_log Error "destroy $obj.\n$err."
incr withError
}
incr total
}
if {$withError > 0} {
ns_log Notice "Cleared '$total' objects. With error =
'$withError'."
ns_log Notice ":oo::Obj count is [llength [namespace
children ::oo Obj*]]"
}
set ::garbage::objects [list]
}
}
ns_ictl trace deallocate {
# Collect garbage when we leave.
::garbage::collect
}
ns_ictl trace allocate {
# Test for object destruction.
#ns_log Notice ":oo::Obj count is [llength [namespace children ::oo
Obj*]]"
}
- Tony
On 12/15/17 3:25 AM, Pavel Jurečka wrote:
Hi!
How can i use TclOO in Naviserver?
I have tcllib file: init.tcl, and this code:
namespace eval ::test {
oo::class create greeter {
method say {} {
ns_return 200 text/html "Hello"
}
}
}
ns_register_proc -noinherit GET /ootest {
set g [::test::greeter new]
$g say
}
Then, when i visit: 127.0.0.1/ootest <http://127.0.0.1/ootest>, i get
error:
Error: GET /ootest, PeerAddress: 127.0.0.1
invalid command name "::test::greeter"
while executing
"::test::greeter new"
invoked from within
"set g [::test::greeter new]"
while executing callback
ns:tclrequest {
set g [::test::greeter new]
$g say
}
So, where should i place classes?
Thanks for help!
Pj.
------------------------------------------------------------------------------
Check out the vibrant tech community on one of the world's most
engaging tech sites, Slashdot.org! http://sdm.link/slashdot
_______________________________________________
naviserver-devel mailing list
naviserver-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/naviserver-devel
------------------------------------------------------------------------------
Check out the vibrant tech community on one of the world's most
engaging tech sites, Slashdot.org! http://sdm.link/slashdot
_______________________________________________
naviserver-devel mailing list
naviserver-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/naviserver-devel
