# @(#$Id$ (C) 1994 CDKIT
# INFORMIX-specific CODE for the tcsq module
package provide INFORMIXtcsq 0.1
proc INFORMIXquotequote {in} {
# Informix uses '' to quote ', not \'. This is database-dependant
regsub -all "'" "$in" "''" out
return $out
}
# This is bogus. There is only one connection for informix
# and it is database-relative
proc INFORMIXconnect {{host ""} {user ""} {passwd ""}} {
uplevel #0 "set INFORMIXhost $host"
return "ixhdl"
}
proc INFORMIXuse {hdl database} {
global INFORMIXdatabase
if {$hdl != "ixhdl"} {
return -code error "Bad handle value '$hdl' for INFORMIX connection"
}
if {[info exists INFORMIXdatabase] && $INFORMIXdatabase == $database} {
return
}
# tcsqdebug "INFORMIXuse: hdl $hdl, database $database, calling sql" 2
sql database $database
set INFORMIXdatabase $database
return 0
}
proc INFORMIXopensel {hdl stmt} {
if {$hdl != "ixhdl" && $hdl != ""} {
return -code error "Bad handle value '$hdl' for INFORMIX connection"
}
sql open $stmt
}
proc INFORMIXnext {qry} {
sql fetch $qry
}
proc INFORMIXrew {qry} {
sql reopen $qry
}
proc INFORMIXclosel {qry} {
sql close $qry
}
proc INFORMIXexec {hdl stmt} {
if {$hdl != "ixhdl" && $hdl != ""} {
return -code error "Bad handle value '$hdl' for INFORMIX connection"
}
sql run $stmt
}
proc INFORMIXdiscon {hdl} {
if {$hdl != "ixhdl"} {
return -code error "Bad handle value '$hdl' for INFORMIX connection"
}
sql finish
uplevel #0 {catch "unset INFORMIXhost";catch "unset INFORMIXdatabase"}
}
proc INFORMIXtabinfo {hdl} {
set qry [sql open \
"select tabname,tabid from systables where tabid >= 100"]
set lst {}
for {set r [sql fetch $qry 1]} {$r != ""} {set r [sql fetch $qry 1]} {
lappend lst [lindex $r 0]
}
sql close $qry
return $lst
}
proc INFORMIXinsertid {hdl} {
# sql sqlca returns a list with the sqlca struct's elements:
# long sqlcode
# char sqlerrm[72]
# char sqlerrp[8]
# long sqlerrd[6]
# 0 - estimated number of rows returned
# 1 - serial value after insert or ISAM error code
# 2 - number of rows processed
# 3 - estimated cost
# 4 - offset of the error into the SQL statement
# 5 - rowid after insert
# struct sqlaw_s sqlwarn;
set sqlerrd [lindex [sql sqlca] 3]
return [lindex $sqlerrd 1]
}
proc INFORMIXcolinfo {hdl tbl arnm} {
upvar $arnm ar
global sqlsc_def_maxlen
# tcsqdebug "INFORMIXcolinfo: tbl: $tbl arnm: $arnm"
if {$hdl != "ixhdl"} {
return -code error "Bad handle value '$hdl' for INFORMIX connection"
}
# get tabid
set qry [sql open "select tabid from systables where tabname = '$tbl'"]
set tabid [lindex [sql fetch $qry 1] 0]
sql close $qry
if {$tabid == ""} {
return -code error "No column information for table name '$tbl'"
}
# Column list: if not set, get all
if {![info exists ar(columns)]} {
set q [sql open "select colname from syscolumns where
tabid = $tabid"]
for {set col [sql fetch $q 1]} {$col != ""} \
{set col [sql fetch $q 1]} {
lappend ar(columns) $col
}
sql close $q
if {![info exists ar(columns)]} {
return -code error "No columns found for table $tbl !"
}
set autocols 1
} else {
set autocols 0
}
if {[llength $ar(columns)] == 0} {
return -code error "No columns in column list for $tbl"
}
# Does table have a serial ? That's the only kind of primary
# key (updateindex) we currently support with informix,
# No valid reason for this, just no need for anything else
# There can be at most one serial in an INFORMIX table
set qry [sql open "select colname from syscolumns where
tabid = $tabid and \(coltype = 6 or coltype = 262\)"]
set tabcolserial [lindex [sql fetch $qry 1] 0]
sql close $qry
if {$tabcolserial != ""} {
# tcsqdebug "Table $tbl has serial field $tabcolserial"
set ar(tabcolserial) $tabcolserial
if {$autocols} {
set ar(updateindex) $tabcolserial
}
} else {
# tcsqdebug "Table $tbl has no serial field"
}
foreach col $ar(columns) {
# puts "col: $col"
set scol [_tcsqsimplecolname $tbl $col]
if {$scol == ""} {
continue
}
set q [sql open "select coltype, collength from syscolumns where
tabid = $tabid and colname = ?" $scol]
set typlen [sql fetch $q 1]
sql close $q
if {$typlen == ""} {
# Not an error, this might be a column from another table
continue
}
set typ [lindex $typlen 0]
set typ [expr $typ & 0xf]
# not used
set nonulls [expr $typ & 0x100]
set len [lindex $typlen 1]
# In all cases, remember type and length as from db
set ar(sqlsc_${col}_dbtype) $typ
set ar(sqlsc_${col}_dblen) $len
set typind "sqlsc_${col}_type"
set lenind "sqlsc_${col}_len"
# type 6 is serial but we don't set a special case because
# it's listed in ar(tabcolserial) anyway
# The length stored by informix are storage length, with
# little relation to display lens except for char types. We
# fix them
switch $typ {
"0" -
"13" -
"15" -
"16" {
# puts "$col: char or varchar column"
set ar($typind) "char"
if {$autocols} {
lappend ar(upshiftcols) $col
}
}
"7" {
# puts "$col is date column"
set ar($typind) "date"
set len 10
}
"8" {
# puts "$col is money column"
set ar($typind) "money"
set len 12
}
"10" {
# puts "$col is datetime column"
set ar($typind) "datetime"
set len 20
}
default {
# puts "$col is 'other' column"
# Don't care about other types, no special processing
set ar($typind) "bin"
set len 10
}
}
if {![info exists ar($lenind)]} {
set ar($lenind) $len
# puts "$col: length not preset, set to $ar($lenind)"
if {$ar($lenind) > $sqlsc_def_maxlen} {
# puts "$col: limiting width to $sqlsc_def_maxlen"
set ar($lenind) $sqlsc_def_maxlen
}
}
}
}
proc INFORMIXuniqueid {hdl tbl} {
global INFORMIXdatabase INFORMIXhost
return [cdkuniqueid $INFORMIXhost $INFORMIXdatabase $tbl]
}