- Supports input history, so you can use up/down keys to edit and re-execute your query (just like readline lets),
- You can use left/right and home/end keys to move across a query string and edit it (just like readline lets too),
- It always uses the same SQLite interface version as other scripts on the host, so you'll not get problems when you've created database by another script with one interface version and you're trying to read/modify it by the manager.
#!/usr/bin/env tclsh
# tclline: An attempt at a pure tcl readline.
set VER 1.0
# Use Tclx if available:
catch {
package require Tclx
# Prevent sigint from killing our shell:
signal ignore SIGINT
}
# Initialise our own env variables:
foreach {var val} {
PROMPT "sqlite) "
HISTORY ""
HISTORY_BUFFER 100
COMPLETION_MATCH ""
} {
if {![info exists env($var)]} {
set env($var) $val
}
}
foreach {var val} {
CMDLINE ""
CMDLINE_CURSOR 0
CMDLINE_LINES 0
HISTORY_LEVEL -1
} {
set env($var) $val
}
unset var val
array set ALIASES {}
set forever 0
# Resource & history files:
set HISTFILE $env(HOME)/.sqlite_history
set RCFILE $env(HOME)/.sqliterc
# Database
set ver [package require sqlite]
if {$argc != 1} {
puts stderr "$argv0 <database file>"
exit 1
}
if {[catch {sqlite db $argv} res]} {
puts stderr "Error:\n$res"
exit 1
}
puts "Console Sqlite Manager v$VER (SQLite interface version is $ver)"
puts "Database opened: $argv"
puts "\\h\tfor help.\n"
# Procs
proc pad {cnt char str} {
set lgt [string length $str]
if {$lgt < $cnt} {
set addlgt [expr {$cnt - $lgt}]
append str [string repeat $char $addlgt]
}
return $str
}
proc center {cnt char str} {
set lgt [string length $str]
if {$lgt >= $cnt} {
return [string range $str 0 $cnt]
}
set spcs [expr $cnt-$lgt]
set spcs [expr $spcs.0/2]
if {[string index $spcs 2] == 5} {
set lsp [string index $spcs 0]
set rsp [expr [string index $spcs 0]+1]
} else {
set lsp [string index $spcs 0]
set rsp [string index $spcs 0]
}
return "[string repeat $char $lsp]$str[string repeat $char $rsp]"
}
proc ESC {} {
return "\033"
}
proc shift {ls} {
upvar 1 $ls LIST
set ret [lindex $LIST 0]
set LIST [lrange $LIST 1 end]
return $ret
}
proc readbuf {txt} {
upvar 1 $txt STRING
set ret [string index $STRING 0]
set STRING [string range $STRING 1 end]
return $ret
}
proc goto {row {col 1}} {
switch -- $row {
"home" {set row 1}
}
print "[ESC]\[${row};${col}H" nowait
}
proc gotocol {col} {
print "\r" nowait
if {$col > 0} {
print "[ESC]\[${col}C" nowait
}
}
proc clear {} {
print "[ESC]\[2J" nowait
goto home
}
proc clearline {} {
print "[ESC]\[2K\r" nowait
}
proc getColumns {} {
set cols 0
if {![catch {exec stty -a} err]} {
regexp {rows \d+; columns (\d+)} $err -> cols
}
return $cols
}
proc prompt {{txt ""}} {
global env
set prompt [subst $env(PROMPT)]
set txt "$prompt$txt"
foreach {end mid} $env(CMDLINE_LINES) break
# Calculate how many extra lines we need to display.
# Also calculate cursor position:
set n -1
set totalLen 0
set cursorLen [expr {$env(CMDLINE_CURSOR)+[string length $prompt]}]
set row 0
set col 0
# Render output line-by-line to $out then copy back to $txt:
set found 0
set out [list]
foreach line [split $txt "\n"] {
set len [expr {[string length $line]+1}]
incr totalLen $len
if {$found == 0 && $totalLen >= $cursorLen} {
set cursorLen [expr {$cursorLen - ($totalLen - $len)}]
set col [expr {$cursorLen % $env(COLUMNS)}]
set row [expr {$n + ($cursorLen / $env(COLUMNS)) + 1}]
if {$cursorLen >= $len} {
set col 0
incr row
}
set found 1
}
incr n [expr {int(ceil(double($len)/$env(COLUMNS)))}]
while {$len > 0} {
lappend out [string range $line 0 [expr {$env(COLUMNS)-1}]]
set line [string range $line $env(COLUMNS) end]
set len [expr {$len-$env(COLUMNS)}]
}
}
set txt [join $out "\n"]
set row [expr {$n-$row}]
# Reserve spaces for display:
if {$end} {
if {$mid} {
print "[ESC]\[${mid}B" nowait
}
for {set x 0} {$x < $end} {incr x} {
clearline
print "[ESC]\[1A" nowait
}
}
clearline
set env(CMDLINE_LINES) $n
# Output line(s):
print "\r$txt"
if {$row} {
print "[ESC]\[${row}A" nowait
}
gotocol $col
lappend env(CMDLINE_LINES) $row
}
proc print {txt {wait wait}} {
# Sends output to stdout chunks at a time.
# This is to prevent the terminal from hanging if we output too much:
while {[string length $txt]} {
puts -nonewline [string range $txt 0 2047]
set txt [string range $txt 2048 end]
if {$wait == "wait"} {
after 1
}
}
}
rename unknown _unknown
proc unknown {args} {
global env ALIASES
set name [lindex $args 0]
set cmdline $env(CMDLINE)
set cmd [string trim [regexp -inline {^\s*[^\s]+} $cmdline]]
if {[info exists ALIASES($cmd)]} {
set cmd [regexp -inline {^\s*[^\s]+} $ALIASES($cmd)]
}
set new [auto_execok $name]
if {$new != ""} {
set redir ""
if {$name == $cmd && [info command $cmd] == ""} {
set redir ">&@ stdout <@ stdin"
}
if {[catch {
uplevel 1 exec $redir $new [lrange $args 1 end]} ret]
} {
return
}
return $ret
}
eval _unknown $args
}
proc alias {word command} {
global ALIASES
set ALIASES($word) $command
}
proc unalias {word} {
global ALIASES
array unset ALIASES $word
}
################################
# Key bindings
################################
proc handleEscapes {} {
global env
upvar 1 keybuffer keybuffer
set seq ""
set found 0
while {[set ch [readbuf keybuffer]] != ""} {
append seq $ch
switch -exact -- $seq {
"\[A" { ;# Cursor Up (cuu1,up)
handleHistory 1
set found 1; break
}
"\[B" { ;# Cursor Down
handleHistory -1
set found 1; break
}
"\[C" { ;# Cursor Right (cuf1,nd)
if {$env(CMDLINE_CURSOR) < [string length $env(CMDLINE)]} {
incr env(CMDLINE_CURSOR)
}
set found 1; break
}
"\[D" { ;# Cursor Left
if {$env(CMDLINE_CURSOR) > 0} {
incr env(CMDLINE_CURSOR) -1
}
set found 1; break
}
"\[H" - "\[7~" - "\[1~" { ;# home
set env(CMDLINE_CURSOR) 0
set found 1; break
}
"\[3~" { ;# delete
if {$env(CMDLINE_CURSOR) < [string length $env(CMDLINE)]} {
set env(CMDLINE) [string replace $env(CMDLINE) \
$env(CMDLINE_CURSOR) $env(CMDLINE_CURSOR)]
}
set found 1; break
}
"\[F" - "\[K" - "\[8~" - "\[4~" { ;# end
set env(CMDLINE_CURSOR) [string length $env(CMDLINE)]
set found 1; break
}
"\[5~" { ;# Page Up }
"\[6~" { ;# Page Down }
}
}
return $found
}
proc handleControls {} {
global env
upvar 1 char char keybuffer keybuffer
# Control chars start at a == \u0001 and count up.
switch -exact -- $char {
\u0003 { ;# ^c
doExit
}
\u0008 - \u007f { ;# ^h && backspace ?
if {$env(CMDLINE_CURSOR) > 0} {
incr env(CMDLINE_CURSOR) -1
set env(CMDLINE) [string replace $env(CMDLINE) \
$env(CMDLINE_CURSOR) $env(CMDLINE_CURSOR)]
}
}
\u001b { ;# ESC - handle escape sequences
handleEscapes
}
}
# Rate limiter:
set keybuffer ""
}
proc handleHistory {x} {
global env
set hlen [llength $env(HISTORY)]
incr env(HISTORY_LEVEL) $x
if {$env(HISTORY_LEVEL) > -1} {
set env(CMDLINE) [lindex $env(HISTORY) end-$env(HISTORY_LEVEL)]
set env(CMDLINE_CURSOR) [string length $env(CMDLINE)]
}
if {$env(HISTORY_LEVEL) <= -1} {
set env(HISTORY_LEVEL) -1
set env(CMDLINE) ""
set env(CMDLINE_CURSOR) 0
} elseif {$env(HISTORY_LEVEL) > $hlen} {
set env(HISTORY_LEVEL) $hlen
}
}
################################
# History handling functions
################################
proc getHistory {} {
global env
return $env(HISTORY)
}
proc setHistory {hlist} {
global env
set env(HISTORY) $hlist
}
proc appendHistory {cmdline} {
global env
set old [lsearch -exact $env(HISTORY) $cmdline]
if {$old != -1} {
set env(HISTORY) [lreplace $env(HISTORY) $old $old]
}
lappend env(HISTORY) $cmdline
set env(HISTORY) [lrange $env(HISTORY) end-$env(HISTORY_BUFFER) end]
}
################################
# main()
################################
proc rawInput {} {
fconfigure stdin -buffering none -blocking 0
fconfigure stdout -buffering none -translation crlf
exec stty raw -echo
}
proc lineInput {} {
fconfigure stdin -buffering line -blocking 1
fconfigure stdout -buffering line
exec stty -raw echo
}
proc doExit {{code 0}} {
global env HISTFILE
# Reset terminal:
puts ""
lineInput
catch {db close}
set hlist [getHistory]
if {[llength $hlist] > 0} {
set f [open $HISTFILE w]
foreach x $hlist {
# Escape newlines:
puts $f [string map {
\n "\\n"
"\\" "\\b"
} $x]
}
close $f
}
exit $code
}
proc do_select {cmd} {
if {[catch {
set i 0
set cols [list]
db eval $cmd col {
foreach c $col(*) {
if {[info exists max($c)]} {
if {[string length $col($c)] > $max($c)} {
set max($c) [string length $col($c)]
}
} else {
set max($c) [string length $col($c)]
}
lappend val($i) [list $c $col($c)]
}
incr i
set cols $col(*)
}
set wd 15
foreach c $cols {
if {$max($c) < $wd} {
if {$max($c) > [string length $c]} {
set width($c) $max($c)
} else {
set width($c) [string length $c]
}
} else {
set width($c) $wd
}
}
set buf ""
set f 1
foreach row [lsort -dictionary [array names val]] {
if {$f} {
# Horizontal line
set fcol 1
foreach c $cols {
if {!$fcol} {
append buf "+"
}
append buf "[pad $width($c) {-} {}]"
set fcol 0
}
set f 0
append buf "\n"
# Header
set fcol 1
foreach c $cols {
if {!$fcol} {
append buf "|"
}
append buf "[center $width($c) { } $c]"
set fcol 0
}
append buf "\n"
# Horizontal line
set fcol 1
foreach c $cols {
if {!$fcol} {
append buf "+"
}
append buf "[pad $width($c) {-} {}]"
set fcol 0
}
set f 0
append buf "\n"
}
# Rows
set fcol 1
foreach c $cols {
if {!$fcol} {
append buf "|"
}
foreach v $val($row) {
if {[lindex $v 0] == $c} {
append buf "[pad $width($c) { } [string range [lindex $v 1] 0 [expr {$wd-1}]]]"
break
}
}
set fcol 0
}
append buf "\n"
}
# Horizontal line
set fcol 1
foreach c $cols {
if {!$fcol} {
append buf "+"
}
append buf "[pad $width($c) {-} {}]"
set fcol 0
}
set f 0
append buf "\n"
return $buf
} res]} {
return "$res"
}
}
proc handleExecuteCmd {cmd} {
switch -- [string range $cmd 0 1] {
"\\h" {
append buf "\\h\tfor help\n"
append buf "\\e\tto execute Tcl command (\[db] is a database object)\n"
append buf "\\s\talternative SELECT results display method. Use for long cell values.\n"
append buf "\\l\tlists all tables in database.\n"
append buf "\\t\tshows table structure (columns, types, etc).\n"
append buf "\\q\tto quit\n"
}
"\\q" {
db close
doExit
}
"\\e" {
catch {[eval [string range $cmd 3 end]]} res
return $res
}
"\\l" {
append buf "\nTables:\n"
append buf "-------\n"
db eval {SELECT name FROM sqlite_master WHERE type = 'table'} col {
append buf "$col(name)\n"
}
append buf "\n"
}
"\\t" {
set tb [string range $cmd 3 end]
if {$tb == ""} return
append buf "----------------------+-----------+--------------+----------\n"
append buf " Column name | Data type | Default Val. | Not NULL \n"
append buf "----------------------+-----------+--------------+----------\n"
if {[catch {
db eval "PRAGMA table_info($tb)" {
append buf "[pad 22 { } $name]|[pad 11 { } $type]|[pad 14 { } $dflt_value]|[center 10 { } [expr {$notnull == 1 ? true : {}}]]\n"
}
} res]} {
append buf "$res\n"
}
append buf "----------------------+-----------+--------------+----------\n"
}
"\\s" {
append buf "----- START -----\n"
set f 1
if {[catch {
db eval [string range $cmd 3 end] col {
if {$f} {
set max 0
foreach c $col(*) {
if {[string length $c] > $max} {
set max [string length $c]
}
}
set f 0
} else {
append buf "\n"
}
foreach c $col(*) {
append buf "[pad $max { } $c] = '$col($c)'\n"
}
}
} res]} {
append buf "$res\n"
}
append buf "------ END ------"
return $buf
}
default {
if {[string tolower [lindex [split $cmd] 0]] != "select"} {
catch {db eval $cmd} res
append buf "$res\n"
} else {
append buf [do_select $cmd]
}
}
}
}
if {[file exists $RCFILE]} {
source $RCFILE
}
# Load history if available:
if {[llength $env(HISTORY)] == 0} {
if {[file exists $HISTFILE]} {
set f [open $HISTFILE r]
set hlist [list]
foreach x [split [read $f] "\n"] {
if {$x != ""} {
# Undo newline escapes:
lappend hlist [string map {
"\\n" \n
"\\\\" "\\"
"\\b" "\\"
} $x]
}
}
setHistory $hlist
unset hlist
close $f
}
}
rawInput
# This is to restore the environment on exit:
# Do not unalias this!
alias exit doExit
proc tclline {} {
global env
set char ""
set keybuffer [read stdin]
set env(COLUMNS) [getColumns]
while {$keybuffer != ""} {
if {[eof stdin]} return
set char [readbuf keybuffer]
if {$char == ""} {
# Sleep for a bit to reduce CPU time:
after 40
continue
}
if {[string is print $char]} {
set x $env(CMDLINE_CURSOR)
if {$x < 1 && [string trim $char] == ""} continue
set trailing [string range $env(CMDLINE) $x end]
set env(CMDLINE) [string replace $env(CMDLINE) $x end]
append env(CMDLINE) $char
append env(CMDLINE) $trailing
incr env(CMDLINE_CURSOR)
} elseif {$char == "\n" || $char == "\r"} {
if {[info complete $env(CMDLINE)] &&
[string index $env(CMDLINE) end] != "\\"} {
lineInput
print "\n" nowait
uplevel #0 {
global env ALIASES
# Handle aliases:
set cmdline $env(CMDLINE)
set cmd [string trim [regexp -inline {^\s*[^\s]+} $cmdline]]
if {[info exists ALIASES($cmd)]} {
regsub -- "(?q)$cmd" $cmdline $ALIASES($cmd) cmdline
}
# Run the command:
#catch $cmdline res
set res [handleExecuteCmd $cmdline]
if {$res != ""} {
print "$res\n"
}
# Append HISTORY:
set env(HISTORY_LEVEL) -1
appendHistory $env(CMDLINE)
set env(CMDLINE) ""
set env(CMDLINE_CURSOR) 0
set env(CMDLINE_LINES) {0 0}
}
rawInput
} else {
set x $env(CMDLINE_CURSOR)
if {$x < 1 && [string trim $char] == ""} continue
set trailing [string range $env(CMDLINE) $x end]
set env(CMDLINE) [string replace $env(CMDLINE) $x end]
append env(CMDLINE) $char
append env(CMDLINE) $trailing
incr env(CMDLINE_CURSOR)
}
} else {
handleControls
}
}
prompt $env(CMDLINE)
}
tclline
fileevent stdin readable tclline
vwait forever
doExitDKF: Interesting. I wonder if it is possible to split this into two parts: a generic readline engine and the code to specialize it for working with sqlite...Googie: It would be. There are few problems to solve: 1) Command/file completion is disturbing here, 2) '*' character substitution (glob file matching), 3) external code has to be able to connect to line handling (see procedure handleExecuteCmd above).I see the following ways to solve them: 1) Should be configurable via boolean variable (enable/disable), 2) same as 1st point, 3) let tclline procedure be more flexible, put some list variable into it, that would say which other procedures should be called to handle input line.It would be also nice to be able to connect to single character handling.MJ: readline seems to be providing the points above already, however it is not Tcl only.
