if 0 {Richard Suchenwirth 2004-03-22 - In A simple database, I showed how databases may be implemented with Tcl arrays. This take here is closer to traditional relational databases, with tables of pre-defined columns (modeled here as a list of lists, the first being the column heading, the rest the "records"), and mimicks the SQL SELECT statement a bit. Tables are "pure values", and the result of select is a valid table again:}
proc select {fields "from" tbl "where" condition} { set infields [lindex $tbl 0] if {$fields eq "*"} {set fields $infields} set res [list $fields] foreach inrow [lrange $tbl 1 end] { foreach $infields $inrow break if $condition { set row {} foreach field $fields {lappend row [set $field]} lappend res $row } } set res }
#-- Test data, assuming a little inventory control system:
set table { {number description pieces} {1234 Foo 100} {2345 Bar 50} {3456 Grill 2} }
if 0 {#-- Testing:
% select * from $table where {$pieces < 100} {number description pieces} {2345 Bar 50} {3456 Grill 2} % select {pieces description} from $table where {$number != 1234} {pieces description} {50 Bar} {2 Grill}
Cute, ain't it? There is a danger though, if you happen to name a "database" column condition, row, fields, res or so... because the column names are used as variables, and would overwrite the working variables, possibly causing syntax errors.
Adding a "record" to this database is trivial:
lappend table {1234 "another Item" 1}
Editing a value in place goes well with lset, where you for now need to specify the record number, but can address a column by its name: }
proc col {table field} {lsearch [lindex $table 0] $field}
if 0 {
lset table 4 [col $table description] "Item, another"
Another frequent operation is sorting a table on a column, with options like -increasing or -integer. We only have to make sure that the header list stays always in front:}
proc sort {table field args} { set res [list [lindex $table 0]] eval lappend res [eval lsort -index [col $table $field] $args \ [list [lrange $table 1 end]]] }
if 0 {
% sort $table pieces -integer {number description pieces} {3456 Grill 2} {2345 Bar 50} {1234 Foo 100} % sort $table description -decreasing {number description pieces} {3456 Grill 2} {1234 Foo 100} {2345 Bar 50}
And as fashionable these days, here's a simple sketch how to export a table as XML (with entity escaping of cell):}
proc toXML {table {type table}} { set fields [lindex $table 0] set res <$type>\n foreach row [lrange $table 1 end] { append res <row> foreach field $fields cell $row { set cell [string map {< "<" & "&" > ">"} $cell] append res <$field>$cell</$field> } append res </row> } append res </$type> }