I am in the process of developing a TCL/TK application and am looking to put the majority of the procs into a Sqlite3 database and have the "unknown" proc source them from there. The idea is that once the application has loaded the proc from the database via the "unknown" proc then any further call for the proc will be from the instance that is loaded into the namespace.
The schema for the table in the Sqlite3 database is:
CREATE TABLE proc (
proc_ref integer
/*
The unique proc identifier
*/
not null
primary key
autoincrement,
proc_called text
/*
The date time stamp of the last instance that this proc was loaded into namespace
by the "unknown" proc. It enables identification of redundant procs
*/
default null,
proc_name text
/*
The name of the proc being loaded into the namespace
It is deliberately not unique as it can then have versioning where the latest version is selected using
SELECT proc_name, proc_argument, proc_script from proc where proc_name = '$proc_name' order by proc_ref desc limit 1
*/
not null
default '',
proc_argument blob
/*
The arguments for the proc
*/
not null
default '',
proc_script blob
/*
The proc script
*/
not null
default ''
);
In the initialisation phase of the application I have the following code:
# We need to change the 'unknown' command to look in the proc table first
# Save the original one so we can chain to it
rename unknown _unknown
# Provide our own implementation
# $cfg(dirdb) is pre-initialised
sqlite3 procdb $cfg(dirdb)/proc.db
proc unknown args {
puts $args
set sql "select * from proc where proc_name = '[lindex $args 0]' order by proc_ref desc limit 1"
if {[procdb exists $sql]} {
procdb eval $sql {
proc $proc_name $proc_argument $proc_script
set _proc_ref $proc_ref
}
set sql "update proc set proc_called = strftime('%Y-%m-%dT%H:%M:%f') where proc_ref = $_proc_ref"
procdb eval $sql
eval {*}$args
} else {
uplevel 1 [list _unknown {*}$args]
}
}Typical of the procs that I am trying to get to load are these, where the first calls the second and that then calls the third:
proc keyboard {receiver tgtframe nospace} {
global debug init licence opt cfg data;
foreach kbdrow {0 1 2 3 4} {
if {$kbdrow == 4 && $nospace != ""} {
break
}
set kbdframe {}
append kbdframe $tgtframe ".kbd" $opt(keyboard) $kbdrow
set kbdkey [expr \$cfg(kbd$opt(keyboard)$kbdrow)]
pack [_keyboard $kbdframe $kbdrow -keys $kbdkey -receiver $receiver]
}
}
proc _keyboard {w row args} {
global debug init licence opt cfg data;
frame $w
array set opts $args ;# no errors checked
set klist {};
set n 0
foreach i [__keyboard $opts(-keys)] {
set c [format %c $i]
set cmd "$opts(-receiver) insert insert [list $c]"
if {$row == 4} {
set padx 200
set c "Space"
} else {
set padx 20
}
button $w.k$i -text $c -command $cmd -padx $padx -pady 10 -bg $cfg(basebg$opt(theme)) -fg $cfg(basefg$opt(theme)) -font $cfg(kbdfont)
lappend klist $w.k$i
}
if [llength $klist] {eval grid $klist -sticky news}
set w ;# return widget pathname, as the others do
}
proc __keyboard {clist} {
global debug init licence opt cfg data;
set res {}
foreach i $clist {
lappend res [expr $i]
}
set res
} These procs work fine as standalone when loaded using the original "source" proc, and when loaded by the modified "unknown" proc into the namespace and run they work fine, but once loaded into namespace and then run subsequently then anything that looks like a string such as "49 50 51 52 53 54 55 56 57 48" even if it is a list surrounded by "{""}" gets an extra "{" and "}" and this causes great grief.
The problem looks to be in the way that the genuine "unknown" handled lists but I am at a loss to know where to search further.
Please ask if I have not been clear in my explanation.
Regs,...
AMG: One thing jumps out at me. You're not properly quoting your SQL expressions. Just like with expr, you should allow SQLite to internally perform variable substitutions. This is accomplished by brace-quoting your expressions, so "$varname" is passed literally to SQLite without being substituted by Tcl itself. When doing this, you mustn't put single quote marks around the variable, or else you'll inhibit SQLite's internal substitution behavior. Again like with expr, there are several advantages to letting SQLite do its own substitution. One, this protects you from SQL injection attacks. Two, this improves performance by allowing Tcl/SQLite to cache the compiled form of the SQL expression.
For example,
set sql "select * from proc where proc_name = '[lindex $args 0]' order by proc_ref desc limit 1"
set sql "update proc set proc_called = strftime('%Y-%m-%dT%H:%M:%f') where proc_ref = $_proc_ref"should instead be:
set arg0 [lindex $args 0]
set sql {select * from proc where proc_name = $arg0 order by proc_ref desc limit 1}
set sql {update proc set proc_called = strftime('%Y-%m-%dT%H:%M:%f') where proc_ref = $_proc_ref}As you can see, one drawback is that you lose the ability to do command substitution, only variable substitution. So create a variable ahead of time that contains the value you would like to substitute into your SQL.
I see you have a similar issue with expr. To be honest, I'm not sure why you're using it at all, because Tcl itself will do the substitutions and concatenations that you desire.
set kbdkey [expr \$cfg(kbd$opt(keyboard)$kbdrow)]
Can instead be:
set kbdkey $cfg(kbd$opt(keyboard)$kbdrow)
Tcl will start by finding $opt(keyboard) and $kbdrow, then concatenating them and prepending "kbd". Next it will take the result and look it up as a key in the cfg array. The resulting value will be the second argument to set, which will be stored into the kbdkey variable. No expr needed.