RealWorld U/SQL TCL Script by Bruce Baumann

© August 2001 Bruce Baumann

I have an TCL Package to access the U/SQL command line interface on a SCO OpenServer System. It is far from a professional job but has proved invaluable to us and is used at QC every day via a CGI script to pull data from our RealWorld system and make fancy HTML reports. The only other way is to use ODBC and Windoze.... Yuck ! (Unless you want to buy the code library's from Transoft for about $2000 and write your own TCL extension... and that will only make it work faster... :-)

Once again there is no help file (yet) but anyone who can read a bit of TCL could figure it out (Actually we use the expect extension to TCL).

look under the ...

usql --
... function description to figure it out ... :-)

If you want to get a TCL list answer, replace the select statement in the SQL code with selectlist. EG...

selectlist customer_id. customer_name from ar_customers; quit
 

... and use the list or listheader option of the usql command.

If one or the other is not right the program will fail with errors. (I should fix this but I already know how to use it ... :-)

The users must have TCL 8.0 (From skunkware)

All it does is let you run an SQL query and get back the answer in TCL list format or in the default U/SQL text report format.

############################################################
#                                                          #
# usql.tcl --                                              #
#                                                          #
#     Provide access to the Transoft U/SQL database engine #
#     WARNING: Depends on the "path" package being loaded  #
#              or assumes default locations.               #
#                                                          #
############################################################
#
package provide usql 1.0
global USQL PATH
#
# USQL Default Directories (Adjust these for your system)
#
# Directory where the "usqli" binary program is located
set USQL(HOME) "/u/usql"
# A temporary working directory
set USQL(TEMP) "/u2/temp"
#
# USQL Directories
#
catch {set USQL(HOME) "$PATH(U)/usql"}
catch {set USQL(TEMP) "$PATH(TEMP2)"}
set USQL(BIN)  "$USQL(HOME)/bin"
#
# USQL Files
#
set USQL(USQLI)        "usqli"
set USQL(IN)           "$USQL(TEMP)/usql.$env(USER).sql"
set USQL(OUT)          "$USQL(TEMP)/usql.$env(USER).dat"
set USQL(ERROR)        "$USQL(TEMP)/usql.$env(USER).err"
catch {set USQL(IN)    "$USQL(TEMP)/usql.$env(REMOTE_HOST).sql"}
catch {set USQL(OUT)   "$USQL(TEMP)/usql.$env(REMOTE_HOST).dat"}
catch {set USQL(ERROR) "$USQL(TEMP)/usql.$env(REMOTE_HOST).err"}
#
# Procedures to send SQL statements to
# the U/SQL engine and return results in
# various formats.
#
# usqlWriteFile --
#
#     Write data to a file
#
proc usqlWriteFile {FILE DATA} {
    global USQL
    set x [open $FILE w]
    puts $x $DATA
    flush $x
    close $x
}
#
# usqlReadFile --
#
#     Read all data from a file and return
#
proc usqlReadFile {FILE} {
    global USQL
    set ret ""
    set x [open $FILE r]
    set ret [read $x]
    close $x
    return $ret
}
#
# usqlList --
#
#     Pre-Process U/SQL statements and return in tcl lists
#     Use the selectlist statement in sql to get the lists
#
proc usqlList {SQL_CODE} {
    global USQL
    regsub -all "\n" $SQL_CODE { } sql
    regexp -nocase "selectlist .* from" $sql result(1)
    regsub -all "," $result(1) ",'\} \{'," result(2)
    regsub -all "selectlist" $result(2) "select '\{\{'," result(1)
    regsub -all "from" $result(1) ",'\}\}' from" result(2)
    regsub -nocase -all "selectlist .* from" $sql $result(2) result(1)
    regsub -all ";" $result(1) ";\n" SQL_CODE
    return $SQL_CODE
}
#
# usqlListHeader --
#
#     Pre-Process U/SQL statements and return in tcl lists with fieldnames
#     Use the selectlist statement in sql to get the lists
#
proc usqlListHeader {SQL_CODE} {
    global USQL
    regsub -all "\n" $SQL_CODE { } sql
    regexp -nocase "selectlist .* from" $sql result(1)
    regsub -all "," $result(1) ",'\} \{' as '\} \{'," result(2)
    regsub -all "selectlist" $result(2) "select '\{\{' as '\{\{'," result(1)
    regsub -all "from" $result(1) ",'\}\}' as '\}\}' from" result(2)
    regsub -nocase -all "selectlist .* from" $sql $result(2) result(1)
    regsub -all ";" $result(1) ";\n" SQL_CODE
    return $SQL_CODE
}
#
# usqlRaw --
#
#     Pre-Process U/SQL statements and add line feeds at every ; at end of line
#
proc usqlRaw {SQL_CODE} {
    global USQL
    regsub -all "\n" $SQL_CODE { } sql
    regsub -all "; " $sql ";\n" SQL_CODE
    return $SQL_CODE
}
#
# usqlExecuteRawDirect --
#
#     Get data from U/SQL
#     Return data unprocessed
#
proc usqlExecuteRawDirect {UDD} {
    global USQL
    cd $USQL(BIN)
    set ret ""
    set ret [exec ./$USQL(USQLI) -x -i $USQL(IN) -e $USQL(ERROR) -M qldcom:qldcom $UDD]
    return $ret
}
#
# usqlExecuteRawDump --
#
#     Get data from U/SQL
#     Output to temp file
#     Read back data and return unprocessed
#
proc usqlExecuteRawDump {UDD} {
    global USQL
    cd $USQL(BIN)
    set ret ""
    set x [exec ./$USQL(USQLI) -x -i $USQL(IN) -o $USQL(OUT) -e $USQL(ERROR) -M qldcom:qldcom $UDD]
    set in_file [open $USQL(OUT) r]
    set ret [read $in_file]
    close $in_file
    return $ret
}
#
# usqlExecuteListDirect --
#
#     Get data from U/SQL
#     Select lines that look like lists
#     Return data as tcl list
#
proc usqlExecuteListDirect {UDD} {
    global USQL
    cd $USQL(BIN)
    set ret ""
    set in_file [open "|./$USQL(USQLI) -x -i $USQL(IN) -e $USQL(ERROR) -M qldcom:qldcom $UDD" r]
    foreach line [split [read $in_file] \n] {
        if [regexp "^\{" $line] {
            set line_list [lindex $line 0]
            foreach item  $line_list {
                lappend temp "[string trim $item]"
            }
            lappend ret $temp
            set temp ""
        }
    }
    close $in_file
    return $ret
}
#
# usqlExecuteListDump --
#
#     Get data from U/SQL
#     Output to temp file
#     Read back from temp file and select lines that look like lists
#     Return data as tcl list
#
proc usqlExecuteListDump {UDD} {
    global USQL
    cd $USQL(BIN)
    set ret ""
    set x [exec ./$USQL(USQLI) -x -i $USQL(IN) -o $USQL(OUT) -e $USQL(ERROR) -M qldcom:qldcom $UDD]
    set in_file [open $USQL(OUT) r]
    foreach line [split [read $in_file] \n] {
        if [regexp "^\{" $line] {
            set line_list [lindex $line 0]
            foreach item  $line_list {
                lappend temp "[string trim $item]"
            }
            lappend ret $temp
            set temp ""
        }
    }
    close $in_file
    return $ret
}
#
##############################################################################################
#                                                                                            #
# usql --                                                                                    #
#                                                                                            #
#     ** THIS IS THE MAIN COMMAND **                                                         #
#                                                                                            #
#     Extract data form a Transoft U/SQl database engine.                                    #
#                                                                                            #
#     Command format...                                                                      #
#     usql [udd name]-[input method]-[display method]-[output method] [variable or filename] #
#                                                                                            #
#     [udd name]                                                                             #
#      A UDD name that appears in the usqlsd.ini file                                        #
#                                                                                            #
#     [input method]                                                                         #
#      command (take SQL commands from a variable)                                           #
#      file    (take SQL commands from a file)                                               #
#                                                                                            #
#     [display method]                                                                       #
#      list       (return result in list format)                                             #
#                  use with selectlist sql statement                                         #
#                  E.G. {{data} {data}} ...                                                  #
#      listheader (return result in list format with fieldnames in first list)               #
#                  use with selectlist sql statement                                         #
#                  E.G. {{field} {field}} {{data} {data}} ...                                #
#      raw        (return result without changes)                                            #
#                                                                                            #
#     [output method]                                                                        #
#      direct (send result directly to program)                                              #
#      dump   (send result to file first then send to program)                               #
#                                                                                            #
##############################################################################################
#
proc usql {UDD TYPE SQL_CODE} {
    global USQL
    #
    # Split procedure command options
    #
    set x [split $TYPE {-}]
    set type_a "[lindex $x 0]"
    set type_b "[lindex $x 1]"
    set type_c "[lindex $x 2]"
    #
    # The easy switching bit
    #
    switch $type_a {
        "command" {
            # Check if SQL statement is empty
            if {[string length $SQL_CODE] == 0} {
                puts "<PRE>ERROR: usql - SQL Statement is empty ($SQL_CODE)</PRE>"
                exit
            }
        }
        "file" {
            # Check if file is readable
            if {[file readable $SQL_CODE]} {
                set SQL_CODE [usqlReadFile $SQL_CODE]
                # Check if SQL statement is empty
                if {[string length $SQL_CODE] == 0} {
                    puts "<PRE>ERROR: usql - SQL Statement is empty ($SQL_CODE)</PRE>"
                    exit
                }
            } else {
                puts "<PRE>ERROR: usql - SQL File does not exist ($SQL_CODE)</PRE>"
                exit
            }
        }
        default {
            puts "<PRE>ERROR: usql - Incorrect agrument ($type_a) in ($TYPE)"
            exit
        }
    }
    #
    # The not so easy switching bit
    #
    switch -exact "$type_b" {
        "list" {
            set SQL_CODE [usqlList $SQL_CODE] ; usqlWriteFile $USQL(IN) $SQL_CODE
            switch $type_c {
                "direct" {return [usqlExecuteListDirect $UDD]}
                "dump"   {return [usqlExecuteListDump $UDD]}
                 default {
                     puts "<PRE>ERROR: usql - Incorrect agrument ($type_c) in ($TYPE)"
                     exit
                 }
            }
        }
        "listheader" {
            set SQL_CODE [usqlListHeader $SQL_CODE] ; usqlWriteFile $USQL(IN) $SQL_CODE
            switch $type_c {
                "direct" {return [usqlExecuteListDirect $UDD]}
                "dump"   {return [usqlExecuteListDump $UDD]}
                 default {
                     puts "<PRE>ERROR: usql - Incorrect agrument ($type_c) in ($TYPE)"
                     exit
                 }
            }
        }
        "raw" {
            set SQL_CODE [usqlRaw $SQL_CODE] ; usqlWriteFile $USQL(IN) $SQL_CODE
            switch $type_c {
                "direct" {return [usqlExecuteRawDirect $UDD]}
                "dump"   {return [usqlExecuteRawDump $UDD]}
                 default {
                     puts "<PRE>ERROR: usql - Incorrect agrument ($type_c) in ($TYPE)"
                     exit
                }
            }
        }
        default {
            puts "<PRE>ERROR: usql - Incorrect agrument ($type_b) in ($TYPE)"
            exit
        }
    }
}
 

Any questions to... https://www.qldcom.com ...and choose the email... computer@qldcom.com

Publish your articles, comments, book reviews or opinions here!

© August 2001 Bruce Baumann. All rights reserved

Got something to add? Send me email.

---

Have you tried Searching this site?

This is a Unix/Linux resource website. It contains technical articles about Unix, Linux and general computing related subjects, opinion, news, help files, how-to's, tutorials and more.

Contact us