Version 14 of TclOO Reactive Relational Database

Updated 2015-12-27 07:33:25 by Napier

Premise

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).

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!

Examples

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

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 192.168.1.1 State Closed
$Store build Door Door2 IP 192.168.2.1 State Closed
$Store build Door Door3 IP 192.168.3.1 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.

Example:

% $Store build Door Door5 IP 192.168.1.1
         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 192.168.1.1 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 192.168.0.1 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 192.168.10.1
% The Door Door1 was Updated!
New Data: IP 192.168.10.1 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! :-)

$Store query Door for State matching Open
% Door3 Door1

Printing the Entire Data

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

$Store getAll

---------------------------
         State: 
 Door {Door1 {IP 192.168.1.1 State Open} Door2 {IP 192.168.2.1 State Closed} Door3 {IP 192.168.3.1 State Open}}
         Categories: 
 Door
         Map: 
 Door {schema {IP State} names {Door1 Door2 Door3} valueMap {IP {192.168.1.1 Door1 192.168.2.1 Door2 192.168.3.1 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 args {
        set db:State {}
        set db:Categories {}
        set db:Map {}
    }
    
    method specify {category "with" args} {
        if {$category in ${db:Categories}} {throw error "DB ERROR: $category Already Specified"}
        if {[string equal $with "with"]} { 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 {$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
        set changes 0
        set keysChanged {}
        dict for {k v} $args { 
            if {[my SetValue $category $name $k $v]} {
                incr changes
                lappend keysChanged $k
            }
        }
        if {$changes >= 1} {
            puts "Keys Changed in Method"
            puts $keysChanged
            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 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"
    }
}