Version 1.0 of the itcl persistence stuff I wrote is here: http://sourceforge.net/projects/libtclpq/ CMcC
Persistent itcl
This source package contains three programs:
Persist.tcl
which persists the instance vars of an incr tcl object to a metakit
PersistRemote.tcl PersistRemoteServer.tcl
which (together) form a client/server to Persist incr tcl objects over a tcp/ip connection mediated by the comm package (via the Comm wrapper).
Background: The page Persistent incr-Tcl objects got me thinking about persistence.
The code presented there requires too much user intervention, I want something which handles more of the details automatically.
I've just put up a package called itclPersist on my little projects page here: http://sourceforge.net/projects/libtclpq/
itclPersist consists of a Persist class and a PersistServer class (and some test code.)
The idea is that you inherit from Persist, and attach to an instance of PersistServer. After that, you forget about it - all instance variables and arrays are persisted in a metakit, are refreshed at attach time, and just basically ... persist.
Next step for me is to inherit from the PersistServer to make a RemotePersist class, which does all the same things, but does them on a different machine - I'll probably use comm. Next step after that is to use Mux multiplexer to distribute updates to a set of client/listeners.
Here's a function which constructs a script which, when evaluated in global scope, will do what I think I want.
# serialize extracts all variables and their current values into a script # such that `eval [serialize obj]' will set obj to those values proc serialize {obj {new ""}} { set result "" if {$new == ""} { set new $obj } foreach var [$obj info variable] { foreach {type name} [$obj info variable $var -type -name] break if {([namespace tail $name] != "this") && ($type != "common")} { set fromname "@itcl $obj $name" set toname "@itcl $new $name" if {[catch { append result "eval set [list \[list ${toname}\]] [list [list [set $fromname]]]\n" } err]} { puts stderr "err: $err" } } } return $result }
Here's a small test:
class test_persist { common com "com val" ;# common vars are unchanged by serialize private variable priv "priv default" public variable pub "pub default" protected variable prot "prot default" public variable single single_value_should_not_be_braced # make all variables' values uppercase method change {} { foreach var {priv pub prot} { set $var [string toupper [set $var]] } } constructor {} { # change values from the default set priv {priv value $ [] # \n \{\}} set pub {pub value $ [] # \n \{\}} set prot {prot value $ [] # \n \{\}} } } class test_p1 { inherit test_persist public variable sub_pub sub_pub private variable sub_priv sub_priv method test {} { foreach var [$this info variable] { foreach {type name val} [$this info variable $var -type -name -value] break puts "$name = $val" } } constructor {} { # needs to be here } } test_p1 t puts "Vars: [t info variable]" set lower [serialize t] puts "DUMP: '$lower'" t change ;# uppercase t puts "Will be uppercase:" t test eval $lower puts "Should be lowercase:" t test ;# check change test_p1 t2 t2 change puts "Will be uppercase:" t2 test set tolower [serialize t \$T] puts "DUMP2: '$tolower'" set T t2 eval $tolower puts "Should be lowercase:" t2 test
Persistence and Distribution
This approach raises some interesting possibilities for persistence:
Note