In Playing with TclOO, Richard Suchenwirth provided a method to dump the class and variables of an object:
define oo::object method dump {{pat *}} {
set res [list class [info object class [self]]]
foreach i [info object vars [self] $pat] {
my variable $i
lappend res $i [set $i]
}
set res
}This page should explore ways to serialize/unserialize TclOO objects.
My first thought would be to check if the self's variables themselves are objects:
define oo::object method serialize {{pat *}} {
set res [list class [info object class [self]]]
foreach i [info object vars [self] $pat] {
my variable $i
if {[info object isa object [set $i]]} {
set value [[set $i] serialize]
} else {
set value [set $i]
}
lappend res $i $value
}
set res
}RS 2009-05-08: This is however dangerous when cycles are in the object graph: say, a genealogy application, where a has father:b and b has children:a ...
DKF: I've written a small package to perform serialization of objects. Note that it assumes that it does not need to serialize any classes (and can't deserialize them) that's a project for someone to write in the future.
package require Tcl 8.6
::oo::class create ::oo::serializable {
method Serialize {{objectsToSerialize {}}} {
set o [self]
upvar #1 pendingObjs($o) pendingObjs
lappend pendingObjs {*}$objectsToSerialize
set result {}
set methods {}
set publics [info object methods $o]
foreach m [info object methods $o -private] {
if {![catch {info object definition $o $m} def]} {
lappend methods method $m [expr {$m in $publics}] $def
} elseif {![catch {info object forward $o $m} def]} {
lappend methods forward $m [expr {$m in $publics}] $def
}
}
dict set result methods $methods
dict set result filters [info object filters $o]
dict set result mixins [info object mixins $o]
dict set result variables [info object variables $o]
dict set result nsvars {}
foreach v [info vars [self namespace]::*] {
if {[array exists $v]} {
set val [array get $v]
foreach {eName eVal} $val {
if {[info object isa object $eVal]} {
lappend pendingObjs $val
}
}
dict lappend result nsvars [list \
array [namespace tail $v] $val]
} else {
set val [set $v]
if {[info object isa object $val]} {
lappend pendingObjs $val
}
dict lappend result nsvars [list \
scalar [namespace tail $v] $val]
}
}
return $result
}
method Deserialize {dict} {
set o [self]
foreach m [dict get $dict methods] {
lassign $m t n p d
::oo::objdefine $o $t $n {*}$d
if {$p} {
::oo::objdefine $o export $n
} else {
::oo::objdefine $o unexport $n
}
}
::oo::objdefine $o filter {*}[dict get $dict filters]
::oo::objdefine $o mixin {*}[dict get $dict mixins]
::oo::objdefine $o variable {*}[dict get $dict variables]
foreach v [dict get $dict nsvars] {
lassign $v t n val
switch $t {
"array" {
array set [my varname $n] $val
}
"scalar" {
set [my varname $n] $val
}
}
}
}
# ----------------------------------------------------------------------
method Serialize:object {} {
set o [self]
upvar #1 objects objects pendingObjs($o) pendingObjs
set pendingObjs {}
set objects($o) working
set result [my Serialize]
dict set result name $o
dict set result class [info object class $o]
dict set result objects {}
foreach otherObj $pendingObjs {
if {![info object isa typeof $otherObj ::oo::serializable]} {
# non-serializable object; skip
continue
}
if {![info exists objects($otherObj)]} {
dict lappend result objects \
[[info object namespace $otherObj]::my Serialize:object]
}
}
set objects($o) done
return $result
}
method Deserialize:object {data} {
try {
dict size $data
} on error {} {
rename [self] {}
throw "OO SERIAL FORMAT" \
"data does not describe serialized objects"
}
try {
set name [dict get $data name]
if {[info object isa object $name]} {
error "object already exists"
}
rename [self] $name
::oo::objdefine [self] class [dict get $data class]
set objs [dict get $data objects]
my Deserialize [dict remove $data name class objects]
foreach otherData [dict get $data objects] {
[info object namespace [::oo::serializable new]]::my \
Deserialize:object $otherData
}
} on error {msg opts} {
rename [self] {}
dict set opts -message $msg
return -level 0 -code error -options $opts \
-errorcode "OO SERIAL FAILURE" \
"failed to deserialize object \"$name\": $msg"
}
return [self]
}
}
# ----------------------------------------------------------------------
proc ::oo::serialize {object} {
if {![info object isa object $object]} {
throw "OO SERIAL USAGE" "\"$object\" is not an object"
}
if {![info object isa typeof $object ::oo::serializable]} {
throw "OO SERIAL USAGE" "\"$object\" is not serializable"
}
# Use a coroutine to make some "local global" storage
coroutine ::oo::SerializerCoroutine apply {{object} {
array set objects {}
array set pendingObjs {}
set data [list TclOO::serializer 0.1 \
[[info object namespace $object]::my Serialize:object]]
lappend data [zlib crc32 $data]
}} $object
}
proc ::oo::deserialize {data} {
if {![string is list $data] || [llength $data] < 4} {
throw "OO SERIAL FORMAT" "data does not describe serialized objects"
}
lassign $data tag version content crc
if {
$tag ne "TclOO::serializer"
|| ![package vsatisfies 0.1 $version]
|| [llength $data] > 4
|| [zlib crc32 [lrange $data 0 2]] != $crc
} then {
throw "OO SERIAL FORMAT" \
"data does not describe serialized objects or version wrong"
}
return [[info object namespace [::oo::serializable new]]::my \
Deserialize:object $content]
}
package provide TclOO::serializer 0.1Declare the classes of objects to be serialized to be subclasses of oo::serializable or at least mix that class into the objects to serialize; multiple inheritance can help here.
Then, just call:
and it will return the serialized form. You can deserialize that string (assuming that the objects have been deleted first) using:
and it will return the recreated root object.
If your objects need more control over the serialization/deserialization, override the Serialize and Deserialize methods; don't forget to call the superclass implementations at some point! Here's a simple example of serializing control:
oo::class create listOfObjs {
superclass oo::serializable
variable objlist ;# Holds a list of objects, but serializer package can't figure that out by default
# ...
method Serialize {{objectsToSerialize {}}} {
# Override so that the list of objects is understood to be part of the object graph
next [concat $objectsToSerialize $objlist]
}
}The Serialize method takes an optional list of objects to serialize (allows traversing the object graph) and returns a dictionary describing the object. The Deserialize method takes a dictionary describing the object and rebuilds the object from it; it's result is unimportant (unless it is an error, in which case it aborts the deserialization of all objects that have not yet successfully deserialized).