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:
- Application chunks register names of variables to put in the file along with a getter script, which is expected to return the value to write to file and a setter which is called when the variable has a setting in a configuration script.
- A safe interpreter is encapsulated in the StateManager to ensure that settings files don't go wild on you.
- Implementation of the singleton pattern to allow parts of a loosely coupled application to all use a common StateManager object. Snit's delegation mechanism makes it very easy to make the StateManagerSingleton objects a complete stand-in for the underlying StateManager singleton instance.
Work to do:
- Ensure the safe interpreter name chosen is really unique -- any takers there?
##
# @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
