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 ... ---- **Package: serialize 0.1** [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 } } if {[llength $methods]} { dict set result methods $methods } if {[llength [info object filters $o]]} { dict set result filters [info object filters $o] } if {[llength [info object mixins $o]]} { dict set result mixins [info object mixins $o] } if {[llength [info object variables $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] if {[dict exists $dict methods]} { 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 } } } if {[dict exists $dict filters]} { ::oo::objdefine $o filter {*}[dict get $dict filters] } if {[dict exists $dict mixins]} { ::oo::objdefine $o mixin {*}[dict get $dict mixins] } if {[dict exists $dict variables]} { ::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.1 ====== ***Usage*** Declare 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: : '''oo::serialize''' ''theRootObject'' and it will return the serialized form. You can deserialize that string (assuming that the objects have been deleted first) using: : '''oo::deserialize''' ''string'' 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). ***Example*** This script: ====== package require TclOO::serializer 0.1 oo::class create foo { superclass oo::object oo::serializable variable foo constructor {{init }} { set foo $init } method foo {} { puts fooooo!!-$foo } destructor { if {[info object isa object $foo]} { $foo destroy } } } foo create f1 [foo create f2] set ser [oo::serialize f1] puts $ser f1 destroy puts [info object isa object f1],[info object isa object f2] oo::deserialize $ser f1 foo f2 foo ====== produces this output: ====== TclOO::serializer 0.1 {nsvars {{scalar foo ::f2}} name ::f1 class ::foo objects {{nsvars {{scalar foo }} name ::f2 class ::foo objects {}}}} 2840851482 0,0 fooooo!!-::f1 fooooo!!- ====== ---- !!!!!! %| [Category Object orientation] |% !!!!!!