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

----

[Category Database]