Purpose: Defines a Tcl wrapper around the INGRES Terminal Monitor tool for interacting with databases.
This is a first stab at wrapping Tcl around the terminal monitor:
#===============================================================================
#
# File : IngresTM.tcl
# Author : C.A.Usher
# Date : 13-Oct-2006
# Language: Tcl
#
#===============================================================================
# Functions to access Ingres via "sql" command.
#===============================================================================
#
# Function:
# Constructs a layer in Tcl on top of the Ingres sql Terminal Monitor.
# The calling program must specify:
#
# sqlstring SQL to execute.
#
# Optional arguments are:
#
# -nodrop Switch to ignore DROP errors.
#
# -db <dbname> Name of database to initiate connection to.
# This should be omitted if specifying an existing session
# id.
#
# -session <var> Name of variable to either:
# hold session id when a new session is created (when
# -db option is specified),
# attach to an existing session when no -db is
# specified.
#
# -data <var> Name of variable in which to store data returned from
# the query.
#
# -log <logfile> Name of log file to send ALL output from Terminal
# Monitor.
#
#-------------------------------------------------------------------------------
# Notes:
# One function here is used by the calling program - execSQL.
# All other functions handle events and sessions.
#
# SQL string passed to function works on same principles as it does through
# the standard sql command line utility, i.e:
# - AUTOCOMMIT may be switched on or off, multiple queries may be specified
# in the same transaction (so rollback will be used if there is a failure
# in that transaction).
# - Multiple queries may be effected by using the \g (or \go) between
# statements.
# - All queries must end in a \g (or \go). If the last query in a string is
# not followed by a \g (or \go), it will not be executed.
#
#===============================================================================
package require cmdline
namespace eval IngresTM {
variable sessionParm
variable sessionLast 0
namespace export execSQL
}
proc IngresTM::execSQL {args} {
variable sessionParm
# Handle options and args
set options {
{nodrop "Ignore DROP errors (optional)"}
{db.arg "" "Database to connect to (optional)"}
{session.arg "" "Variable to read/set SQL session id (optional)"}
{data.arg "" "Variable to set with data (optional)"}
{log.arg {/dev/null} "Log file for sql session output (optional)"}
}
set usage ": execSQL \[options\] sqlstring\noptions:"
array set params [::cmdline::getoptions args $options $usage]
if {[llength $args] > 1} {
return -code error "Too many arguments"
}
if {[llength $args] == 0} {
return -code error "No sqlstring specified"
}
set sqlStr [lindex $args 0]
# Allocate a session (existing or new)
set sess [allocateSession params]
set chan $sessionParm($sess,chan)
# Give access to the global vwait variable
global $sessionParm($sess,donevar)
# Add all queries to a queue for this session, each is executed in turn by writeIt.
# This always removes the last item in list, because we don't want to execute
# anything that was not appended with a \g
foreach oneQuery [lrange [split [string map [list "\\go" "\x17" "\\g" "\x17"] $sqlStr] "\x17"] 0 end-1] {
if {$oneQuery != {}} {
pushQueue $sess "$oneQuery\\g" $params(nodrop)
}
}
# If this is a new session (i.e. db was specified), read in the junk header
# that Terminal Monitor spits out, otherwise just start writing SQL to the
# process.
if {$params(db) != {}} {
fileevent $chan readable [list [namespace code readIt] $sess]
} else {
fileevent $chan writable [list [namespace code writeIt] $sess]
}
# Wait here for transaction to complete ...
vwait $sessionParm($sess,donevar)
set dataVarExists 0
if {$params(data) != {}} {
set dataVarExists 1
upvar 1 $params(data) data
}
set data $sessionParm($sess,data)
unset sessionParm($sess,data)
# Handle session closure based on presence of errors, session persistence
# and whether a data variable was specified
if {$params(session) != {}} {
if {[info exists sessionParm($sess,error)]} {
# Return the data only if a data var was not specified
if {$dataVarExists} {
return -code error -errorinfo "$sessionParm($sess,error)\n$::errorInfo"
} else {
return -code error -errorinfo "$sessionParm($sess,error)\n$::errorInfo" $data
}
}
upvar 1 $params(session) sessVar
set sessVar $sess
} else {
if {[info exists sessionParm($sess,error)]} {
set errMsg $sessionParm($sess,error)
endSession $sess
# Return the data only if a data var was not specified
if {$dataVarExists} {
return -code error -errorinfo "$errMsg\n$::errorInfo"
} else {
return -code error -errorinfo "$errMsg\n$::errorInfo" $data
}
}
endSession $sess
}
# Return the data only if a data var was not specified
if {$dataVarExists} {
return
} else {
return $data
}
}
proc IngresTM::allocateSession {paramsArr} {
variable sessionParm
upvar 1 $paramsArr params
# Check db and session parameters are compatible
if {$params(db) == {}} {
# If no db specified, check that a session has and that it exists
if {$params(session) == {}} {
return -code error "No db or session specified, must use specific session"
}
upvar 2 $params(session) sessId
if {[catch {assignSession $sessId} sess]} {
return -code error "Specified session does not exist"
}
catch {unset sessionParm($sess,error)}
} else {
# No longer needed as params(session) can be used to specify variable to hold
# session id in when db is specified.
#if {$params(session) != {}} {
#return -code error "Ambiguous request, session and db both specified"
#}
# If db is specified, create new session
set sess [createSession $params(db) $params(log)]
}
return $sess
}
proc IngresTM::createSession {db log} {
variable sessionLast
variable sessionParm
set sess [incr sessionLast]
set sqlCmd "|sql $db 2>@stdout | tee $log"
if {[catch {open $sqlCmd r+} chan]} {
return -code error "Error opening Terminal Mointor: $chan"
}
set pid [lindex [pid $chan] 0]
set sessionParm($sess,log) $log
set sessionParm($sess,chan) $chan
set sessionParm($sess,pid) $pid
set sessionParm($sess,start) {}
set sessionParm($sess,donevar) sqlsession_$chan
fconfigure $chan -buffering line -encoding binary -translation auto
return $sess
}
proc IngresTM::assignSession {sess} {
variable sessionParm
if {[info exists sessionParm($sess,pid)] \
&& [checkProcessExists $sessionParm($sess,pid)]} {
return $sess
}
return -code error "The requested session no longer exists!"
}
proc IngresTM::closeSession {sess} {
variable sessionParm
catch {
set chan $sessionParm($sess,chan)
puts $chan "\\q"
flush $chan
}
}
proc IngresTM::endSession {sess} {
variable sessionParm
closeSession $sess
catch {array unset sessionParm "$sess,*"}
}
proc IngresTM::pushQueue {sess sql nodrop} {
variable sessionParm
lappend sessionParm($sess,queue) [list $sql $nodrop]
}
proc IngresTM::checkProcessExists {pid} {
if {[catch {exec ps -e | grep $pid} str]} {
return -code error "Cannot execute ps or grep"
}
if {$str == {}} {
return 0
}
return 1
}
proc IngresTM::popQueue {sess sqlvar} {
variable sessionParm
upvar $sqlvar sql
foreach {sql nodrop} [lindex $sessionParm($sess,queue) 0] {break}
set sessionParm($sess,nodrop) $nodrop
set sessionParm($sess,queue) [lreplace $sessionParm($sess,queue) 0 0]
}
proc IngresTM::trapSqlErr {sess data} {
variable sessionParm
if {[regexp -line {^E_[A-Z]{1,2}[0-9A-F]{4}} $data matchVar]} {
if {$sessionParm($sess,nodrop) && $matchVar == "E_US0AC1"} {
return
}
errorReturn $sess "Ingres Error: $data"
}
}
proc IngresTM::readIt {sess} {
variable sessionParm
set chan $sessionParm($sess,chan)
set charCount [gets $chan inLine]
set lastStr [string range $inLine end-7 end]
trapSqlErr $sess $inLine
if {[info exists sessionParm($sess,data)]} {
append sessionParm($sess,data) "\n$inLine"
} else {
set sessionParm($sess,data) $inLine
}
if {$lastStr == "continue"} {
fileevent $chan readable {}
if {$sessionParm($sess,queue) == {}} {
set sessionParm($sess,end) [clock clicks -milliseconds]
global $sessionParm($sess,donevar)
set $sessionParm($sess,donevar) 1
} else {
fileevent $chan writable [list [namespace code writeIt] $sess]
}
}
}
proc IngresTM::writeIt {sess} {
variable sessionParm
set chan $sessionParm($sess,chan)
popQueue $sess sql
fileevent $chan writable {}
set sessionParm($sess,start) [clock clicks -milliseconds]
puts $chan $sql
flush $chan
fileevent $chan readable [list [namespace code readIt] $sess]
}
proc IngresTM::errorReturn {sess err} {
variable sessionParm
set sessionParm($sess,error) $err
set $sessionParm($sess,donevar) -1
}
package provide IngresTM 1.0
### End of file ###