Updated 2011-05-07 09:38:39 by dkf

Googie I missed console (*nix) manager for SQLite that supports input line history and interactive query editing, so I've wrote one. It's built on top of Unix pure-tcl readline.

It's pretty similar to binary application sqlite3 but has some advantages:

  • 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.

Here's the code:
 #!/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
 doExit

DKF: 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.