1 # vim: ft=tcl foldmarker=<<<,>>>
3 # item_schema example: <<<
4 # variable item_schema {
6 # "Table" {table combobox \
7 # -choices {sql_features sql_languages sql_packages} \
8 # -initial_choice sql_languages
11 # "Has Indexes" {indexed checkbutton}
12 # "Has Rules" {ruled checkbutton}
13 # "Has Triggers" {hastriggers checkbutton}
17 class tlc
::Datasource {
25 variable criteria_values
""
27 variable id_column
0 ;# column to use as the ID column
28 variable criteria_map
{}
30 variable item_schema
{}
32 method get_item_schema
{}
33 method set_criteria_map
{mapping
}
34 method get_criteria
{}
35 method set_criteria
{arraylist
}
36 method get_criteria_values
{}
37 method set_criteria_values
{arraylist
}
38 method set_field_defs
{arraylist
}
39 method get_field_defs
{}
40 method set_defaults
{rowarray
}
41 method get_defaults
{}
43 method get_list
{criteria
{headersvar
{}}}
44 method get_labelled_list
{criteria
{headersvar
{}}}
45 method get_id_column
{}
46 method add_item
{row
{col_list
""}}
47 method update_item
{oldrow newrow
{old_col_list
""} {new_col_list
""}}
48 method remove_item
{row
{col_list
""}}
49 method extract_id
{row
}
50 method get_full_row
{id
}
51 method can_do
{action args
}
57 variable acriteria_values
58 variable last_headers
{}
60 method replace_criteria
{str
{criteria_arraylist
{}}
62 method resolve_row
{row col_list
}
63 method criteria_changed
{}
68 body tlc
::Datasource::constructor {args
} { #<<<1
75 body tlc
::Datasource::destructor {} { #<<<1
76 invoke_handlers destroyed
80 body tlc
::Datasource::replace_criteria {str
{criteria_arraylist
{}} {recursion_level
0}} { #<<<1
81 # TODO: figure out a "proper" way to allow substitutions, and still allow
82 # 1) %var% strign literals that match to pass through
83 # 2) a barrier against infinite recursion
86 if {$criteria_arraylist=={}} {
87 set driving_force
$criteria_values
89 set driving_force
$criteria_arraylist
92 array set valmappings
$criteria_map
93 foreach {idx val
} $driving_force {
94 if {[info exists valmappings
($idx)]} {
95 array set tmp
$valmappings($idx)
96 if {[info exists tmp
($val)]} {
97 lappend map_directives
"%${idx}%" "$tmp($val)"
99 lappend map_directives
"%${idx}%" "$val"
102 lappend map_directives
"%${idx}%" "$val"
105 set ret
[string map
"$map_directives" "$str"]
106 # now, check for recursive re-inclusion of criteria within criteria only
107 foreach {idx val
} $criteria_values {
108 if {[string first
"%$idx%" $ret]>-1} {
109 if {$recursion_level<5} {
110 set ret
[replace_criteria
$ret $driving_force
111 [incr recursion_level
]]
120 body tlc
::Datasource::get_criteria {} { #<<<1
121 # this basically gives the form defination give from the intersection of
122 # the Criteria value and the names of the field_defs array-var
128 body tlc
::Datasource::get_criteria_values {} { #<<<1
129 return $criteria_values
133 body tlc
::Datasource::set_criteria {arraylist
} { #<<<1
134 # sets the criteria (and acriteria) from an array-style list. the list
135 # element style is: {criteria_label} {criteria_varname {form style}}
137 set criteria
$arraylist
141 body tlc
::Datasource::set_criteria_values {arraylist
} { #<<<1
142 # sets the replacement values for the criteria tokenlist from an
143 # array-style list the list element style is:
144 # {criteria_varname} {variable_value}
146 set criteria_values
$arraylist
150 body tlc
::Datasource::set_field_defs {arraylist
} { #<<<1
151 set field_defs
$arraylist
154 body tlc
::Datasource::get_field_defs {} { #<<<1
158 body tlc
::Datasource::resolve_row {row col_list
} { #<<<1
159 # resolves a list of values (row) and a column name list (col_list) into an
161 # inputs: row (raw data list); col_list: column names for items in row
162 # returns: array-style list of the style: {col_name} {col_value}
164 foreach col
$col_list val
$row {
165 lappend ret
$col $val
172 body tlc
::Datasource::get_labelled_list {criteria
{headersvar
{}}} { #<<<1
173 # does the same as a get_list, but each row contains interleaved
174 # header-names with each field; makes the loading of an array or a treeview
175 # structure a lot easier for the client
177 if {$headersvar != {}} {
178 upvar $headersvar headers
180 set rawlist
[get_list
$criteria headers
]
182 foreach rawrow
$rawlist {
184 foreach rawcol
$rawrow head
$headers {
185 lappend lrow
$head $rawcol
190 # puts "\n\nDatasource::get_labelled_list: returning: ($llist)"
195 body tlc
::Datasource::get_list {criteria
{headersvar
{}}} { #<<<1
199 body tlc
::Datasource::get_id_column {} { #<<<1
200 return [list $id_column [lindex $last_headers $id_column]]
204 body tlc
::Datasource::add_item {row
{col_list
{}}} { #<<<1
208 body tlc
::Datasource::update_item {oldrow newrow
{old_col_list
""} {new_col_list
""}} { #<<<1
212 body tlc
::Datasource::remove_item {row
{col_list
""}} { #<<<1
216 body tlc
::Datasource::extract_id {row
} { #<<<1
217 return [lindex $row $id_column]
221 body tlc
::Datasource::criteria_changed {} { #<<<1
225 body tlc
::Datasource::set_criteria_map {mapping
} { #<<<1
226 set criteria_map
$mapping
230 body tlc
::Datasource::get_item_schema {} { #<<<1
234 body tlc
::Datasource::set_defaults {rowarray
} { #<<<1
235 set defaults
$rowarray
238 body tlc
::Datasource::get_defaults {} { #<<<1
242 body tlc
::Datasource::get_full_row {id
} { #<<<1
243 # purpose: to return all fields defined in the filed definitions for the id specified -- to be used
244 # by a client who will be doing an update later
245 # returns: array-style list of {col} {val} {col} {val} ...
246 # this is to be implemented by the client
249 body tlc
::Datasource::can_do {action args
} { #<<<1
250 if {[llength $args] == 0} {
251 return [expr {[info exists can_do
($action)] && $can_do($action)}]
252 } elseif
{[llength $args] == 1} {
253 set can_do
($action) [expr {[lindex $args 0]}]
255 error "Wrong # of args: must be action ?newvalue?"