Here is a small implementation of an XOTcl based query
language that i posted a few years ago to the XOTcl mailing
list. It is slightly adapted to XOTcl 1.6.* and more
general than Stefan's example, since one can use
arbitrary expressions over arbitrary classes.
Note that instead of iterating over all instances of the
classes (see info instances below), it is possible to build
one or multiple indices that can reduce the number of
objects to be tested significantly.
The output of the script below is:
C select {$x > 10} --> {::c2 ::d1}
C select {$x >= 10} --> {::c1 ::c2 ::d1 ::d2}
C select {$x < 1} --> {}
C select {[string match *00* $x]} --> {::d1}
all the best
-gustaf neumann
##############################################################
#
# Small query language for XOTcl Objects (part 1)
#
# Gustaf Neumann fecit, Sept 2005
#
# In this example, we define a method select, which
# can be used to select arbitrary objects from the
# database based on a "select" expression.
#
##############################################################
# 1) Define method expr for all Objects, the operands are taken
# from the instance variables
Object instforward expr -objscope
# 2) Define method select with some arbitrary Tcl expression. All objects,
# for which the expression returns 1 are returned
Class instproc select {expr} {
set result_list [list]
foreach o [my info instances -closure] {
if {![catch [list $o expr $expr] result]} {
if {$result} {
lappend result_list $o
}
} else {
puts "error in expr $expr for object $o -> $result"
}
}
return $result_list
}
# Ok, we are done.
# We define a few sample classes and objects with some instance variables
Class C -parameter {{x 10}}
Class D -superclass C
C c1
C c2 -x 11
D d1 -x 100
D d2
# Finally, we try it out with some demo queries.
#
# A query of the form
# <classname> select <expression>
# returns
# ... all instances of the specified class
# (or one of its subclasses) for which expression
# is true.
#
# Examples:
foreach q {
{$x > 10}
{$x >= 10}
{$x < 1}
{[string match *00* $x]}
} {
puts "C select [list $q] --> {[lsort [C select $q]]}\n"
}
