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.
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]]
set index [lsearch [lindex $res 0] $field]
eval lappend res [eval lsort -index $index $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}