Most of my applications use Tcl scripts to save/restore settings. I'm now building an application with a large number of very loosely coupled components and wanted a way for those components to each save and restore settings from a common file. Below is my modest solution to this. A snit::type (class) called StateManager and an associated type that uses the singleton pattern to allow parts of an application to interact with the same StateManager object.
Key features:
Work to do:
## # @file state.tcl # @brief State manager for save/restore arbitrary states. # @author Ron Fox <[email protected]> package provide StateManager 1.0 package require snit ## # @class StateManager # # Provides a mechanism to allow packages in a program to save and restore # internal state. This is done by associating state variables with # getters and setters and providing a changed method to indicate # when to write a new copy of the saved file. # # Save files are simply Tcl scripts that contain a bunch of set commands. # Those commands will be executed in a safe interpreter. # # OPTIONS # -file - Path to the file that will hold the save script. # # METHOD # addStateVariable - Adds a new state variable to state manager # listStateVariables - lists the state variables in the state manager. # removeStateVariable - Removes a state variable from the registered list. # save - Save the state (-file must be defined by now). # restore - restore the state (-file must be defined by now). # snit::type StateManager { option -file # State variables are an ordered list so that # it is possible to define the order in which data are written to file # and restored from the file to internal state. # # Each element of the list is a three element list containing: # * The variable name. # * A command that will provide the correct value for that variable. This # is parameterized by the variable name when called. # * A command that will react to a restored value for this variable. # This command is parameterized by the variable name and new value. # variable registeredVariables [list] ## # constructor # Contstruct the object. Simply process the configuration options. # @param args option/value pairs. # constructor args { $self configurelist $args } ## # addStateVariable # adds a stateVariable to the list # # @param name - Name of the state variable. # @param getter - Command to get the variable value. # @param setter - Command to set the variable value. # method addStateVariable {name getter setter} { if {[lsearch -exact -index 0 $registeredVariables $name] != -1} { error "There is already a registration for the variable '$name'" } lappend registeredVariables [list $name $getter $setter] } ## # listStateVariables # # @return the current list of state variables. This is a list whose # elements are triples of name, getter, setter. # method listStateVariables {} { return $registeredVariables } ## # save # Saves the configuration. # * -file must have been configured. # * The registered variables are itereated over and the getter # for each is called. # * A set command for the registered variable is written to the # specified -file # method save {} { if {$options(-file) eq ""} { error {Cannot save prior to configuring -file} } set fd [open $options(-file) w] # Now iterate over the variables, getting values and writing # set commands. foreach variable $registeredVariables { set varname [lindex $variable 0] set getter [lindex $variable 1] set value [{*}$getter $varname] puts $fd [list set $varname $value] } # Close the file close $fd } ## # restore # Restores the configuratino # * -file must have been configured. # * A safe interpreter is created and [source] exposed # * The -file is sourced into the interpreter. # * For each variable in the registered list, if that variable # exists in the slave interpreter, that variable's setter is called. # method restore {} { if {$options(-file) eq "" } { error {Cannot restore prior to configuring -file} } if {![file readable $options(-file)]} { error "The restore file '$options(-file)' does not exist or is not readable" } interp create -safe StateManagerInterp StateManagerInterp expose source StateManagerInterp eval source $options(-file) foreach variable $registeredVariables { set varname [lindex $variable 0] set setter [lindex $variable 2] if {[StateManagerInterp eval info vars $varname] eq $varname} { set value [StateManagerInterp eval set $varname] {*}$setter $varname $value } } interp delete StateManagerInterp } } ## # @class StateManagerSingleton # # This is provided for applications that need a single state saver. # snit::type StateManagerSingleton { component instance delegate option * to instance delegate method * to instance typevariable theInstance "" ## # constructor # If this is the first construction, create the instance. # Regardless, install the instance as the instance component. # all options and methods are delegated to the instance component # so this will appear exactly like a state manager oject. # # @param args - configuration options. # constructor args { if {$theInstance eq ""} { set theInstance [StateManager %AUTO%] } install instance using set theInstance $self configurelist $args } }
Here's the test suite for the component:
## # @file state.test # @brief Tests for program state save/restore # @author Ron Fox <[email protected]> package require tcltest package require StateManager #----------------------------------------------------------------------------- # Construction tests tcltest::test construct-0 {Construction provides an identifier} \ -cleanup { a destroy } \ -body { StateManager a } -result ::a tcltest::test construct-1 {Can construct with a -file parameter} \ -cleanup { a destroy } \ -body { StateManager a -file config.tcl a cget -file } -result config.tcl #--------------------------------------------------------------------------- # Registration/listing tests. # tcltest::test register-list-1 {Registration is reflected in listings} \ -setup { StateManager a } \ -cleanup { a destroy } \ -body { a addStateVariable test setTest getTest a listStateVariables } -result [list [list test setTest getTest]] tcltest::test register-list-2 {Duplicate registration is an error} \ -setup { StateManager a } \ -cleanup { a destroy } \ -body { a addStateVariable test setTest getTest set status [catch {a addStateVariable test setTest getTest} message] list $status $message } -result [list 1 {There is already a registration for the variable 'test'}] tcltest::test register-list-3 {Registration order is preserved} \ -setup { StateManager a } \ -cleanup { a destroy } \ -body { a addStateVariable test setTest getTest a addStateVariable btest setbTest getbTest } -result [list [list test setTest getTest] [list btest setbTest getbTest]] #------------------------------------------------------------------------------ # Save tests # Save/restore tests use the infrastructure below: set aa {this is one variable} set bb {this is another variable} # # Setter puts stuff in the ::restored:: namespace which must be # created/cleaned up by the test. This prevents the original # aa/bb from being overwritten. proc setter {varname value} { set ::restored::$varname $value } proc getter {varname} { set ::$varname } # # These getter/setters are used in tests to ensure that # multiword getter/setters can be supplied # proc complexgetter {bravo varname} { set ::$varname } proc complexsetter {bravo varname value} { set ::restored::$varname $value } tcltest::test save-1 {Save without -file set is an error} \ -setup { StateManager a } \ -cleanup { a destroy catch {file delete settings.test} } \ -body { set status [catch {a save} message] list $status $message } -result [list 1 {Cannot save prior to configuring -file}] tcltest::test save-2 {Save with nothing monitored is an empty file} \ -setup { StateManager a set fullpath [file join [tcltest::temporaryDirectory] settings.test] } \ -cleanup { a destroy tcltest::removeFile settings.test } \ -body { a configure -file $fullpath a save set fd [open $fullpath r] set contents [read $fd] close $fd set contents } -result {} tcltest::test save-3 {Save with a registered makes a file with set a...} \ -setup { StateManager a set fullpath [file join [tcltest::temporaryDirectory] settings.test] a addStateVariable aa getter setter interp create -safe slave interp expose slave source } \ -cleanup { a destroy tcltest::removeFile settings.test interp delete slave } \ -body { a configure -file $fullpath a save interp eval slave source $fullpath interp eval slave set aa } -result $aa tcltest::test save-4 {Save with a,b, registered makes a file with set a, set b} \ -setup { StateManager a set fullpath [file join [tcltest::temporaryDirectory] settings.test] a addStateVariable aa getter setter a addStateVariable bb getter setter interp create -safe slave interp expose slave source } \ -cleanup { a destroy tcltest::removeFile settings.test interp delete slave } \ -body { a configure -file $fullpath a save interp eval slave source $fullpath set varaa [interp eval slave set aa] set varbb [interp eval slave set bb] list $varaa $varbb } -result [list $aa $bb] tcltest::test save-5 {Save a with complex getter should give correct save file} \ -setup { StateManager a set fullpath [file join [tcltest::temporaryDirectory] settings.test] a addStateVariable aa [list complexgetter junk] setter interp create -safe slave interp expose slave source } \ -cleanup { a destroy tcltest::removeFile settings.test interp delete slave } \ -body { a configure -file $fullpath a save interp eval slave source $fullpath interp eval slave set aa } -result $aa #------------------------------------------------------------------------------ # Restore tests. # tcltest::test restore-0 {Restore without -file configured fails} \ -setup { StateManager a } \ -cleanup { a destroy } \ -body { set status [catch {a restore} text] list $status $text } -result [list 1 {Cannot restore prior to configuring -file}] tcltest::test restore-1 {Restore with no vars saved does nothing} \ -setup { set fullpath [file join [tcltest::temporaryDirectory] settings.test] StateManager a -file $fullpath a save namespace eval ::restored:: {} } \ -cleanup { a destroy namespace delete ::restored } \ -body { a restore info var ::restored::* } -result [list] tcltest::test restore-2 {Restore with aa saved makes aa in ::restored::} \ -setup { set fullpath [file join [tcltest::temporaryDirectory] settings.test] StateManager a -file $fullpath a addStateVariable aa getter setter a save namespace eval ::restored:: {} } \ -cleanup { a destroy namespace delete ::restored } \ -body { a restore list [info var ::restored::*] [set ::restored::aa] } -result [list ::restored::aa $aa] tcltest::test restore-3 {restore with aa,bb saved makes both in ::restored::} \ -setup { set fullpath [file join [tcltest::temporaryDirectory] settings.test] StateManager a -file $fullpath a addStateVariable aa getter setter a addStateVariable bb getter setter a save namespace eval ::restored:: {} } \ -cleanup { a destroy namespace delete ::restored } \ -body { a restore list [lsort [info var ::restored::*]] [set ::restored::aa] [set ::restored::bb] } -result [list [list ::restored::aa ::restored::bb] $aa $bb] tcltest::test restore-4 {Restore from nonexistent file is an error} \ -setup { StateManager a -file /no/such/file/exists.txt } \ -cleanup { a destroy } \ -body { set status [catch {a restore} message] list $status $message } -result [list 1 {The restore file '/no/such/file/exists.txt' does not exist or is not readable}] tcltest::test restore-5 {Restore with complex setter should work fine} \ -setup { set fullpath [file join [tcltest::temporaryDirectory] settings.test] StateManager a -file $fullpath a addStateVariable aa getter [list complexsetter 1234] a save namespace eval ::restored:: {} } \ -cleanup { a destroy namespace delete ::restored } \ -body { a restore list [info var ::restored::*] [set ::restored::aa] } -result [list ::restored::aa $aa] # Report the test results. tcltest::cleanupTests