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 ###