TclOO Reactive Relational Database


Napier / Dash Automation 2015-12-27

I am not highly versed in the world of databases nor am I claiming this is better or worse than anything else available, but I thought it would be insightful to post this example and possibly get some feedback on it. It is far from complete but it operates as I need it to thus far. The idea is to create a basic database scheme which allows querying of data, event listeners on data changes (subscribe / unsubscribe), and validation to keep the specified structure of the data in-check.

I use Tcl for the purposes of Home Automation so the examples will reflect that. I also was not able to utilize any of the SQL or other database extensions so I decided to build my own solution (and those generally do not have the ability to register for callbacks on reading and writing by default).

I would think it would be fairly easy to write middleware to capture values and automatically write to SQL and/or other databases or could be used to persist the data if required (I generally do not require persistence and when I do I use a cloud database such as firebase).

I would also think it will be extremely easy to extend this even further to become asynchronous for reading & writing utilizing coroutines. That is another goal of mine dependent on the need for it when I really start using it.

Things to Note:

  • I wrote this in a hour or so, still have to polish a lot of things, but of course open to suggestions and ideas!
  • It will not currently handle values other than strings very well. While nested data is nice, this is not meant for that really - a table entry should be a pure data set
  • At this time there is no way to unsubscribe a callback, but I will be adding that soon.
  • At this time there is no way to delete a category (Table) or entry once specified or built, however this will also come when I have time!
  • There is more validation I would like this to be doing, thus the "Validation" method.
  • I am sure there are significantly more efficient ways to do a few of the things i'm doing! I am all ears for suggestions!


  • Not too sure how well this will perform given a benchmark. I haven't really tried nor do I really know how / spent the time to look into benchmarking. If anyone wants to do that it would be cool. I would imagine it would not be that great with larger data structures!

I am sure I did it completely wrong, but initially running the following:

time {
Store specify Item#[incr Counter] with 1 2 3 4 5
Store build Item#$Counter Object#$Counter 1 Data 2 Data 3 Data 4 Data 5 Data
Store set Item#$Counter Object#$Counter 1 Hello 5 Another
} 100
% 97.60494 microseconds per iteration

and 10,000 iterations

% time {
Store specify Item#[incr Counter] with 1 2 3 4 5
Store build Item#$Counter Object#$Counter 1 Data 2 Data 3 Data 4 Data 5 Data
Store set Item#$Counter Object#$Counter 1 Hello 5 Another
} 10000
% 325.8800627 microseconds per iteration


Here is how it ends up working out thus far...

Creating a Data Store

First we create a "Store" for our data, for my purposes I intend to restrict to a single data store, but there is nothing stopping you from creating multiple.

set Store [DB create Store]

Specifying a Category (Table)

Next we create a "Category" (which behaves similar to a Table in a RDB) and define what "Keys" (Columns) will be available. The "with" part is not strictly required and it would work the same without it.

$Store specify Door with IP State

We can not specify a category which already exists, this will produce an error.

% $Store specify Door with IP
DB ERROR: Door Already Specified

If you already have one item that is structured with the specification you require, it should be easy to specify it: (Assuming you didn't already specify the door above)

set Door [dict create IP State Closed]
$Store specify Door with {*}[dict keys $Door]

Building an Entry (Row)

Now we are ready to specify an entry to our Category. The syntax for this isn't as fancy at the moment as the above (allowing for a more semantic code)

$Store build Door Door1 IP State Closed
$Store build Door Door2 IP State Closed
$Store build Door Door3 IP State Open

We now have 3 entries: "Door1, Door2, Door3"

There is validation and error reporting being done here. This will stop you from trying to build into categories you haven't specified as well as requiring you have the specified data filled in to appease the specification.


% $Store build Door Door5 IP
         DB ERROR: Schema Does Not Match Provided Data: 
 Required: IP State 
 Received: IP

Subscribing to Events (Callbacks)

It was important that I was able to know when data updates, so I wanted to be able to register callbacks when data changes (but only if data changes). At the moment there is no unsubscribe but it isn't hard to add (and likely will update this with that capability soon enough.

proc doorUpdates {name args} {
      puts "The Door $name was Updated!"
      puts "New Data: $args"

$Store subscribe Door Door1 doorUpdates

We can also easily capture the data that was changed as a list by using upvar within our procedure, as an example we will create a new procedure and register a second callback:

proc keysChanged {name args} {
    upvar keysChanged keysChanged
    puts "Second Callback!"
    puts "The Following Keys were Changed: $keysChanged"

$Store subscribe Door Door1 keysChanged

Getting an Entries Value(s)

Of course we need to be able to retrieve an entries value(s). This will work similar to dict get of course, except we need to define the table as well.

$Store get Door Door1
% IP State Closed

We can retrieve an entries specific values as well

$Store get Door Door1 State
% Closed

Changing an Entries Value(s)

This allows you to change an entries values (one or multiple).

$Store set Door Door1 State Open

If you are following along, the callbacks should have triggered (remember we triggered two, one that shows capturing the changed keys - there is no reason we couldn't have done that in a single callback procedure of course):

$Store set Door Door1 State Open
% The Door Door1 was Updated!
New Data: IP State Open
Second Callback!
The Following Keys were Changed: State

Changing the value to the same value will not trigger any event callbacks:

$Store set Door Door1 State Open

We can set multiple data points at once if we desire:

$Store set Door Door1 State Closed IP
% The Door Door1 was Updated!
New Data: IP State Closed

Querying a Table for Matching Entries

Now what if we want to know the doors that are currently open? The script will automatically generate a valueMap for you to do this easily. This is where I am sure things could be improved for speed, but I did my best! :-). I am using the matching and for syntax so that this can be extended to provide "includes" and possibly other options.

$Store query Door for State matching Open
% Door3 Door1

Saving a Backup of the Entire Data Store

We can easily capture the entire data store at any time for backups, restorations, or state recalls. I want to allow capture/restore for specific data points as well at some point.

set backup [$Store capture]

Restoring a Backup from a Capture

We can restore the capture from a backup at anytime.

$Store restore $backup

Currently the database is captured at the time of a restore and it is returned. This will likely be slower for larger data stores, but for my needs it was largely beneficial:

set newBackup [$Store restore $backup]
# ... sometime Later
$Store restore $newBackup

Cloning a Data Store

Using the same concepts as above, we can clone the entire Data Store simply by creating a new Database and sending it our backup data:

set NewStore [DB create NewStore $backup]
$NewStore getAll

Printing the Entire Data Store

In case you want to see the values that are stored, you can use getAll

$Store getAll

 Door {Door1 {IP State Open} Door2 {IP State Closed} Door3 {IP State Open}}
 Door {schema {IP State} names {Door1 Door2 Door3} valueMap {IP { Door1 Door2 Door3} 
State {Closed Door2 Open {Door3 Door1}}} listeners {Door1 doorUpdates Door2 {} Door3 {}}}

The Code

package require TclOO
namespace import oo::*

class create DB {
    variable db:State; variable db:Map; variable db:Categories
    constructor { { backup "" } } {
        set db:State {}; set db:Categories {}; set db:Map {}
        if {$backup != ""} { my restore $backup }
     method specify {category "with" args} {
        if {$category in ${db:Categories}} {throw error "DB ERROR: $category Already Specified"}
        if {[string equal $with "with"]} { 
            if {[llength $args] == 1} {set keys [lindex $args 0]} else {set keys $args}
        } else { lappend keys $with {*}$args }
        lappend {db:Categories} $category
        foreach key $args {dict set keyDict $key ""}
        dict set {db:Map} $category [dict create schema $keys names {} valueMap $keyDict listeners {}]
    method build {category name args} {
        my Validate category
        if {[llength $args] == 1} {set args [lindex $args 0]}
        if {$name in [dict get ${db:Map} $category names]} {throw error "DB ERROR: $name already exists in $category"}
        set schema [dict get ${db:Map} $category schema]
        if {[my CheckSchema $schema [dict keys $args]]} {
            dict set {db:Map} $category names [ lappend dict {*}[dict get ${db:Map} $category names] $name ]
            dict set {db:Map} $category listeners $name ""
            dict for {k v} $args { my SetValue $category $name $k $v }
        } else { throw error "\t DB ERROR: Schema Does Not Match Provided Data: \n Required: $schema \n Received: [dict keys $args]" }
    method query {category "for" key "matching" value} {
        my Validate category
        if { $key ni [dict get ${db:Map} $category schema] } {throw error "DB Error: $key is not in $category Schema"}
        if { [dict exists ${db:Map} $category valueMap $key $value] } {
            return [dict get ${db:Map} $category valueMap $key $value]
        } else { return "" }
    method set {category name args} {
        my Validate category
        if {[llength $args] == 1} {set args [lindex $args 0]}
        dict for {k v} $args { 
            if { [my SetValue $category $name $k $v] } { lappend keysChanged $k }
        if {[info exists keysChanged] && [llength $keysChanged] >= 1} {
            foreach listener [dict get ${db:Map} $category listeners $name] {
                if {$listener == ""} {continue}
                {*}::$listener $name {*}[dict get ${db:State} $category $name]
    method get {category name args} {
        my Validate category
        if {[dict exists ${db:State} $category $name {*}$args]} {return [dict get ${db:State} $category $name {*}$args]}
    method capture {} {
        return [dict create {db:State} ${db:State} {db:Categories} ${db:Categories} {db:Map} ${db:Map}]
    method restore backup {
        if {[dict exists $backup {db:State}] && [dict exists $backup {db:Categories}] && [dict exists $backup {db:Map}]} {
            set currentState [my capture]
            set {db:State} [dict get $backup {db:State}]
            set {db:Categories} [dict get $backup {db:Categories}]
            set {db:Map} [dict get $backup {db:Map}]
            return $currentState
        } else { throw error "Backup Must Include db:State, db:Map, and db:Categories" }
    method subscribe {category name callback} {
        my Validate category
        if { $callback in [dict get ${db:Map} $category listeners $name] } { throw error "DB Error: Listener already Registered" }
        dict set {db:Map} $category listeners $name [ lappend dict {*}[dict get ${db:Map} $category listeners $name] $callback ]
    method Validate args {
        if { "category" in $args } {
            upvar 1 category category
            if { $category ni ${db:Categories} } { throw error "DB Error: $category category does not exist" } 
    method SetValue {category name key value} {
        if {![dict exists ${db:Map} $category valueMap $key $value]} { dict set {db:Map} $category valueMap $key $value "" }
        set oldValue [expr {[dict exists ${db:State} $category $name $key] ? [dict get ${db:State} $category $name $key] : "" }]
        if {[string equal $oldValue $value]} {return 0}
        if {$oldValue != ""} {
            dict set {db:Map} $category valueMap $key $oldValue [ lsearch -all -inline -not -exact [dict get ${db:Map} $category valueMap $key $oldValue] $name ]
        dict set {db:Map} $category valueMap $key $value [ lappend dict {*}[dict get ${db:Map} $category valueMap $key $value] $name ]
        dict set {db:State} $category $name $key $value
        return 1
    method CheckSchema {l1 l2} {
        foreach i $l1 { if { [ lsearch -exact $l2 $i ] == -1 } { return 0 } }
        foreach i $l2 { if { [ lsearch -exact $l1 $i ] == -1 } { return 0 } }    
        return 1
    method getAll {} {
        puts "\n---------------------------"
        puts "\t State: \n ${db:State}"
        puts "\t Categories: \n ${db:Categories}"
        puts "\t Map: \n ${db:Map}"
        puts "---------------------------\n"