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.
AM If you use namespace variables (like ::db::row - not "variable row"), you should be able to avoid even such clashes ...
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>\n
}
append res </$type>
}