dbConnect is an Itcl object that allows working with different databases (DKF: by acting as a database interface). it was based on ns_database idea but it has better performance as it does not add a lot of wrapping around the sql. we use it in clearance gateway. It works on unix/windows using different databases.
Currently dbConnect supports mysql (mysqltcl or sql package), oracle(version 3,4), sqlServer with tclodbc,informix (Isql) and postgress (Pgtcl). Adding support for another database should not be a hard task.
dbConnect needs of course the database-specific package.
db supports transactions
The base interface is:
type is db type mysql oracle sqlserver odbc-mysql odbc-oracle
name is database name
host is where db is (localhost)
Simple query:
the result will come as a list of lists.
Database specific function can be used by
insert to seuqence or auto_increment column and getting the new id
where sql is the sql statement and idField is the id field.
On create command dbConnect will format the create statement to database create types.
Supported fields are: varchar, char, tinyint, smallint, int, bigint, date and UNIQUE_ID for auto_increment integer (or oracle sequence). you can also use upgradeTable to check wether a table was changed and get suggestion for the needed changes. We use this object in production code (although it is beta) and it works fine.
package provide dbConnect 1.7
package require Itcl
itcl::class dbConnect {
private variable driver
private variable conn
private variable selectCommand
private variable execCommand
private variable commitCommand
private variable rollbackCommand
private variable getTablesCommand
private variable setAutoCommitCommand
private variable autoCommit 1
private variable connectCommand
private variable disconnectCommand
private variable sequenceCommand
private variable limitCommand
private variable descCommand
private variable versionCommand
private variable formatCreate
private variable insertGetIdCommand
private variable lockCommand
private variable functions
private variable debugIn ""
private variable debugOut ""
private variable tableColumns
private variable currentSql
variable dbType
constructor {{driverName ""} {environment ""}} {
initFunctions
if {$driverName!=""} {
loadDriver $driverName $environment
}
}
destructor {
catch {eval $disconnectCommand} msg
}
private method initFunctions {} {
array set functions [list \
toDate '\$mytimefmt' \
getDate \$column
]
}
public method loadDriver {{driverName ""} {environment ""}} {
if {$environment!=""} {
array set ::env $environment
}
set driver $driverName
set dbType $driverName
switch -glob $driverName {
"oracle" {
set pkg Oratcl
if {[catch { package require Oratcl 4 }]} {
package require Oratcl 3
set pkgVersion 3
} else {
set pkgVersion 4
}
}
"mysql" {
if {[catch {package require mysqltcl}]} {
package require sql
set pkg Sql
} else {
set pkg Mysqltcl
}
}
"informix" {
package require Isql
set pkg Isqltcl
}
"postgres" {
package require Pgtcl
set pkg Pgtcl
}
"odbc*" {
package require tclodbc
set pkg Tclodbc
set dbType [lindex [split $driverName "-"] 1]
set driverName "odbc"
}
default {
error "Unsupported driver $driverName. supported drivers are : oracle,mysql,informix,postgres,odbc,odbc-mysql,odbc-sqlserver,odbc-oracle"
}
}
set connectCommand "${driverName}${pkg}Connect"
set disconnectCommand "${driverName}${pkg}Disconnect"
set selectCommand "${driverName}${pkg}Select"
set getTablesCommand "${driverName}${pkg}GetTables"
set execCommand "${driverName}${pkg}Exec"
set descCommand "${dbType}Desc"
set lockCommand "${dbType}LockTable"
set insertGetIdCommand "${dbType}InsertGetId"
set sequenceCommand "${dbType}Sequence"
set limitCommand "${driverName}Limit"
set formatCreate "${dbType}Format"
set setAutoCommitCommand "${driverName}SetAutoCommitCommand"
set commitCommand "${driverName}CommitCommand"
set rollbackCommand "${driverName}RollbackCommand"
set versionCommand "${driverName}VersionCommand"
switch $dbType {
"mysql" {
set setAutoCommitCommand "mysqlSetAutoCommitCommand"
set commitCommand "mysqlCommitCommand"
set rollbackCommand "mysqlRollbackCommand"
set functions(now) "now()"
set functions(dateTime) "\$column"
set functions(date) "DATE_FORMAT(\$column,'%Y-%m-%d')"
set functions(userDate) "DATE_FORMAT(\$column,'%d-%m-%Y')"
set functions(userMonth) "DATE_FORMAT(\$column,'%m-%Y')"
set functions(time) "DATE_FORMAT(\$column,'%T')"
set functions(day) "DATE_FORMAT(\$column,'%d')"
set functions(month) "DATE_FORMAT(\$column,'%m')"
set functions(year) "DATE_FORMAT(\$column,'%Y')"
set functions(mod) "\$column%\$arg1"
set functions(substr) "substring(\$column,\$arg1,\$arg2)"
}
"" -
"sqlserver" {
set functions(now) "convert(varchar(19),getdate(),20)"
set functions(getDate) "convert(varchar(19),\$column,20)"
set functions(dateTime) "convert(varchar(19),\$column,20)"
set functions(date) "convert(varchar(10),\$column,20)"
set functions(userDate) "convert(varchar(10),\$column,105)"
set functions(time) "convert(varchar(8),\$column,114)"
set functions(day) "DATEPART(dd,\$column)"
set functions(month) "DATEPART(mm,\$column)"
set functions(year) "DATEPART(yyyy,\$column)"
set functions(mod) "\$column%\$arg1"
set functions(substr) "substring(\$column,\$arg1,\$arg2)"
}
"oracle" {
if {$driverName=="oracle"} {
set selectCommand "${driverName}${pkg}${pkgVersion}Select"
}
set functions(now) "sysdate"
set functions(toDate) "to_date('\$mytimefmt','YYYY-MM-DD HH24:MI:SS')"
set functions(getDate) "to_char(\$column,'YYYY-MM-DD HH24:MI:SS')"
set functions(dateTime) "to_char(\$column,'YYYY-MM-DD HH24:MI:SS')"
set functions(time) "to_char(\$column,'HH24:MI:SS')"
set functions(date) "to_char(\$column,'YYYY-MM-DD')"
set functions(userDate) "to_char(\$column,'DD-MM-YYYY')"
set functions(userMonth) "to_char(\$column,'MM-YYYY')"
set functions(day) "to_char(\$column,'DD')"
set functions(month) "to_char(\$column,'MM')"
set functions(year) "to_char(\$column,'YYYY')"
set functions(mod) "mod(\$column,\$arg1)"
set functions(substr) "substr(\$column,\$arg1,\$arg2)"
}
"informix" {
set functions(now) "current year to second"
set functions(toDate) "'\$mytimefmt'"
set functions(dateTime) "\$column"
set functions(time) "extend(\$column,hour to second)"
set functions(date) "extend(\$column,year to day)"
set functions(userDate) "extend(\$column,year to day)"
set functions(day) "day(\$column)"
set functions(month) "month(\$column)"
set functions(year) "year(\$column)"
set functions(mod) "mod(\$column,\$arg1)"
}
"postgres" {
set functions(now) "now()"
set functions(toDate) "'\$mytimefmt'"
set functions(getDate) "to_char(\$column,'YYYY-MM-DD HH24:MI:SS')"
set functions(dateTime) "to_char(\$column,'YYYY-MM-DD HH24:MI:SS')"
set functions(time) "to_char(\$column,'HH24:MI:SS')"
set functions(date) "to_char(\$column,'YYYY-MM-DD')"
set functions(userDate) "to_char(\$column,'DD-MM-YYYY')"
set functions(userMonth) "to_char(\$column,'MM-YYYY')"
set functions(day) "date_part('day',\$column)"
set functions(month) "date_part('month',\$column)"
set functions(year) "date_part('year',\$column)"
set functions(mod) "\$column%\$arg1"
set functions(substr) "substr(\$column,\$arg1,\$arg2)"
}
default {
error "Unsupported odbcTclodbc driver. supported drivers are odbc,odbc-mysql,odbc-sqlserver,odbc-oracle"
}
}
return 0
}
public method connect {user password database {host ""} {autoCommit 1} {environment ""}} {
if {$environment!=""} {
array set ::env $environment
}
$connectCommand $user $password $database $host
setAutoCommit $autoCommit
}
public method disconnect {} {
eval $disconnectCommand
}
public method desc {tableName} {
eval $descCommand $tableName
}
public method sql {sql} {
set currentSql $sql
set isError [catch {
set command [string tolower [string range [string trimleft $currentSql " "] 0 5]]
switch -glob -- $command {
"select" {
set result [$selectCommand $currentSql]
}
"create" -
"alter*" {
set currentSql [string trimright [$formatCreate $currentSql] ";"]
set result [$execCommand $currentSql]
}
"insert" -
"delete" -
"update" {
set result [$execCommand $currentSql]
}
"drop*" {
set result [$execCommand $currentSql]
catch {unset tableColumns([lindex $currentSql 2])}
}
default {
error "wrong sql command $command"
}
}
} msg]
if {$isError} {
eval $debugIn
set result "error $msg"
eval $debugOut
error "error: $msg\nsql: $currentSql"
}
eval $debugIn
eval $debugOut
return $result
}
public method select {sql} {
return [eval $selectCommand]
}
public method toDate {seconds} {
set mytimefmt [clock format $seconds -format "%Y-%m-%d %H:%M:%S"]
return [subst $functions(toDate)]
}
public method getDate {column} {
return [subst $functions(getDate)]
}
public method getSequence {sequenceName} {
return [eval $sequenceCommand $sequenceName]
}
public method insertGetId {sql {idField ""} {returnValue 1} {sequenceName ""}} {
return [$insertGetIdCommand $sql $idField $returnValue $sequenceName]
}
public method now {} {
return $functions(now)
}
public method dateTime {column} {
return [subst $functions(dateTime)]
}
public method userDate {column} {
return [subst $functions(userDate)]
}
public method time {column} {
return [subst $functions(time)]
}
public method mod {column arg1} {
return [subst $functions(mod)]
}
public method date {column} {
return [subst $functions(date)]
}
public method year {column} {
return [subst $functions(year)]
}
public method month {column} {
return [subst $functions(month)]
}
public method day {column} {
return [subst $functions(day)]
}
public method substr {column arg1 arg2} {
return [subst $functions(substr)]
}
public method limitSql {sql count} {
return [$limitCommand $sql $count]
}
public method sqlToFile {sql fileName {format ""}} {
set currentSql $sql
eval $debugIn
set ofd [open $fileName a]
if {$format=="csv"} {
set evalFormat "puts $ofd \[join \$row ,]"
} else {
set evalFormat "puts $ofd \$row"
}
set result [$selectCommand $currentSql 2 $evalFormat]
close $ofd
eval $debugOut
return $result
}
public method foreach {sql var script} {
$selectCommand $sql 3 $script $var
}
public method rollback {} {
return [$rollbackCommand]
}
public method commit {} {
return [$commitCommand]
}
public method setAutoCommit {value} {
$setAutoCommitCommand $value
set autoCommit $value
return 0
}
public method getTables {{pattern ""}} {
set tablesList [$getTablesCommand]
if {$pattern==""} {
return $tablesList
} else {
set newTableList ""
::foreach table $tablesList {
set table [lindex $table 0]
if {[regexp $pattern $table]==1} {
lappend newTableList $table
}
}
}
return $newTableList
}
public method resultFromFile {fileName startRow endRow} {
if {$endRow=="end"} {
set endRow 9999999
}
set ofd [open $fileName r]
set count 0
while {$count!=$startRow} {
gets $ofd
incr count
}
while {[set row [gets $ofd]]!="" && $count<$endRow} {
lappend result $row
incr count
}
close $ofd
return $result
}
public method debug {status {debugFile "dbConnectDebug.log"}} {
if {$status} {
set debugIn "set ofd \[open $debugFile a];puts \$ofd \"sql: \$currentSql\";close \$ofd"
set debugOut "set ofd \[open $debugFile a];puts \$ofd \"result: \$result\";close \$ofd"
} else {
set debugIn ""
set debugOut ""
}
}
private method subSelect {sql} {
if {[regexp {\(\s*(select.*)\)} $sql -> subSelect]} {
::foreach id [$selectCommand $subSelect] {
append idList "[lindex $id 0],"
}
if {![info exists idList]} {
set idList "''"
} else {
set idList [string trimright $idList ","]
}
regsub $subSelect $sql $idList sql
}
return $sql
}
public method lockTable {tableName} {
return [eval $lockCommand $tableName]
}
private method mysqlSqlExec {sql} {
::sql exec $conn $sql
}
private method mysqlSqlSelect {sql {type 1} {script ""} {var ""}} {
::sql query $conn $sql
set result ""
if {$type==1} {
while {[set row [::sql fetchrow $conn]]!=""} {
lappend result $row
}
} else {
set count 0
if {$type==2} {
set level 0
} else {
set level 2
upvar 2 $var row
}
while {[set row [::sql fetchrow $conn]]!=""} {
incr count
uplevel $level \[namespace eval \[namespace current] $script]
}
set result $count
}
::sql endquery $conn
return $result
}
private method mysqlSqlDisconnect {} {
::sql disconnect $conn
}
private method mysqlSqlConnect {user password database host} {
set conn [::sql connect $host $user $password]
::sql selectdb $conn $database
}
private method mysqlInsertGetId {sql {idField ""} {returnValue 1} {sequenceName ""}} {
$execCommand $sql
set sql "select last_insert_id()"
if {!$returnValue} {
return ""
}
return [$selectCommand $sql]
}
private method mysqlSequence {sql} {
set sql "UPDATE $sequenceName set id=LAST_INSERT_ID(id+1)"
$execCommand
set sql "select last_insert_id() from $sequenceName"
return [$selectCommand]
}
private method mysqlFormat {sql} {
regsub -nocase -all {UNIQUE_ID} $sql {bigint auto_increment} sql
regsub -nocase -all {\sdate} $sql { datetime} sql
regsub -nocase -all {\svarchar\((2[5-9][0-9]|[1-9][0-9]{3,})\)} $sql { text} sql
return $sql
}
private method mysqlMysqltclConnect {user password database host} {
set conn [mysqlconnect -user $user -password $password -db $database -host $host -encoding iso8859-1]
}
private method mysqlMysqltclDisconnect {} {
mysqlclose $conn
}
private method mysqlMysqltclSelect {sql {type 1} {script ""} {var ""}} {
set sql [subSelect $sql]
mysqlsel $conn $sql
set result ""
if {$type==1} {
while {[set row [mysqlnext $conn]]!=""} {
lappend result $row
}
} else {
set count 0
if {$type==2} {
set level 0
} else {
set level 2
upvar 2 $var row
}
while {[set row [mysqlnext $conn]]!=""} {
incr count
uplevel $level $script
}
set result $count
}
return $result
}
private method mysqlMysqltclExec {sql} {
set sql [subSelect $sql]
mysqlexec $conn $sql
}
private method mysqlDesc {tableName} {
set descList ""
::foreach column [$selectCommand "desc $tableName"] {
if {[lindex $column 5]=="auto_increment"} {
set type "UNIQUE_ID"
} else {
set type [lindex $column 1]
if {[string first "int" $type]!=-1} {
set type [lindex [split $type "("] 0]
} elseif {$type=="datetime"} {
set type "date"
} elseif {$type=="text"} {
set type varchar(text)
}
}
if {[lindex $column 2]==""} {
set isNull no
} else {
set isNull yes
}
lappend descList [list [lindex $column 0] $type [lindex $column 4] $isNull]
}
return $descList
}
private method mysqlLimit {sql count} {
append sql " limit $count"
sql $sql
}
private method mysqlSetAutoCommitCommand {flag} {
set sql "set autocommit=$flag"
set result [$execCommand $sql]
if {$autoCommit==0} {
$execCommand "unlock tables"
}
}
private method mysqlCommitCommand {} {
return [$execCommand " commit"]
}
private method mysqlRollbackCommand {} {
return [$execCommand " rollback"]
}
private method mysqlMysqltclGetTables {} {
return [mysqlinfo $conn tables]
}
private method mysqlSqlGetTables {} {
return [$execCommand "show tables"]
}
public method mysqlLockTable {tableName} {
setAutoCommit 0
set stmt "lock table $tableName write"
return [$execCommand $stmt]
}
private method oracleOratcl3Select {sql {type 1} {script ""} {var ""}} {
set aconn [oraopen $conn]
orasql $aconn $sql
set result ""
if {$type==1} {
while {[set row [orafetch $aconn]]!=""} {
lappend result $row
}
} else {
set count 0
if {$type==2} {
set level 0
} else {
set level 2
upvar 2 $var row
}
while {[set row [orafetch $aconn]]!=""} {
incr count
uplevel $level $script
}
set result $count
}
return $result
}
private method oracleOratcl4Select {sql {type 1} {script ""} {var ""}} {
if {[string match -nocase "* join *" $sql]!=0 && [oracleVersionCommand]<"9"} {
set sql [string tolower $sql]
regexp { (left|right) } $sql => joinType
set joinIndex [string first " join " $sql]
set joinTypeIndex [string first " $joinType " $sql]
set onIndex [string first " on " $sql]
set whereIndex [string first " where " $sql]
set andIndex [string first " and " $sql]
if {$whereIndex==-1} {
if {$andIndex>$whereIndex} {
set andIndex $andIndex
} else {
set andIndex end
}
} else {
if {$andIndex<$whereIndex && $andIndex!=-1} {
set andIndex $andIndex
} else {
set andIndex $whereIndex
}
}
set orderIndex [string first " order by " $sql]
set groupIndex [string first " group by " $sql]
if {$orderIndex!=-1} {
set orderSql [string range $sql $orderIndex end]
set sql [string range $sql 0 [expr {$orderIndex -1}]]
} else {
set orderSql ""
}
if {$groupIndex!=-1} {
set groupSql [string range $sql $groupIndex end]
set sql [string range $sql 0 [expr {$groupIndex -1}]]
} else {
set groupSql ""
}
set onTables [string range $sql [expr {$onIndex+3}] $andIndex]
set newSql [string range $sql 0 $joinTypeIndex],[string range $sql [expr {$joinIndex +5}] $onIndex]
switch $joinType {
"left" {
append onTables "(+)"
}
"right" {
set onTablesList [split $onTables "="]
set onTables "[lindex $onTablesList 0](+)=[lindex $onTablesList 1]"
}
}
if {$whereIndex==-1} {
append newSql " where $onTables"
} else {
append newSql "[string range $sql $whereIndex end] and $onTables"
}
append newSql $groupSql
append newSql $orderSql
set currentSql $newSql
} else {
set currentSql $sql
}
set aconn [oraopen $conn]
if {[catch {
orasql $aconn $currentSql
set result ""
if {$type==1} {
while {![orafetch $aconn -datavariable row]} {
lappend result $row
}
} else {
set count 0
if {$type==2} {
set level 0
} else {
set level 2
upvar 2 $var row
}
while {![orafetch $aconn -datavariable row]} {
incr count
uplevel $level $script
}
set result $count
}
} msg]} {
oraclose $aconn
error $msg
}
oraclose $aconn
return $result
}
private method oracleOratclExec {sql} {
set aconn [oraopen $conn]
if {[catch {
set result [orasql $aconn $sql ]
} msg]} {
oraclose $aconn
error $msg
}
oraclose $aconn
return $result
}
private method oracleOratclConnect {user password database host} {
global tcl_platform
if {[info exists tcl_platform(threaded)]==1} {
package require Thread
thread::eval {set conn [oralogon $user/$password@$database]}
} else {
set conn [oralogon $user/$password@$database]
}
}
private method oracleOratclDisconnect {} {
oralogoff $conn
}
private method oracleFormat {sql} {
array set Entity {
tiny 2
TINY 2
small 4
SMALL 4
"" 9
big 13
BIG 13
}
regsub -all -nocase {varchar} $sql {varchar2} sql
if {[regsub -all -nocase {UNIQUE_ID} $sql { number(13) } sql]} {
set tableName [lindex $sql 2]
catch {sql "create sequence seq_$tableName start with 1"}
}
regsub -all -nocase {\s([a-z]{0,5})int([\s|,|)])} $sql { number($Entity(\1))\2} sql
set sql [subst -nocommand -nobackslash $sql]
set tableName [lindex $sql 2]
regsub -all -nocase {primary key} $sql "constraint pk_$tableName primary key" sql
return $sql
}
private method oracleSequence {sequenceName} {
set sql "select ${sequenceName}.nextval from dual"
return [sql $sql]
}
private method oracleInsertGetId {sql idField returnValue sequenceName} {
set firstOpenBrace [string first "(" $sql]
set tableName [lindex [string range $sql 0 $firstOpenBrace] 2]
if {$sequenceName==""} {
set sequenceName "seq_$tableName"
}
set sqlSeq "select ${sequenceName}.nextval from dual"
set sequenceValue [sql $sqlSeq]
set valuesIndex [string first "values" $sql]
if {$valuesIndex==-1} {
set valuesIndex [string first "VALUES" $sql]
}
set firstCloseBrace [string last ")" [string range $sql 0 $valuesIndex]]
set lastOpenBrace [string first "(" [string range $sql $valuesIndex end]]
set lastCloseBrace [string last ")" $sql]
set sqlInsert "insert into $tableName ($idField,[string range $sql [expr {$firstOpenBrace +1}] $firstCloseBrace] values ($sequenceValue,[string range $sql [expr {$lastOpenBrace +$valuesIndex +1}] [expr {$lastCloseBrace +$valuesIndex}]]"
sql $sqlInsert
return $sequenceValue
}
private method oracleLimit {sql count} {
incr count
set orderBy [string first " by " $sql]
if {$orderBy!=-1} {
set limitSql [string range $sql 0 [incr orderBy -6]]
} else {
set limitSql $sql
}
if {[string first "where" $limitSql]==-1 && [string first "WHERE" $limitSql]==-1} {
append limitSql " where "
} else {
append limitSql " and "
}
append limitSql "rownum<$count"
if {$orderBy!=-1} {
append limitSql " [string range $sql $orderBy end]"
}
sql $limitSql
}
private method oracleSetAutoCommitCommand {flag} {
return [oraautocom $conn $flag]
}
private method oracleCommitCommand {} {
return [oracommit $conn]
}
private method oracleRollbackCommand {} {
return [oraroll $conn]
}
private method oracleOratclGetTables {} {
return [sql "select table_name from user_tables"]
}
private method oracleDesc {tableName} {
set tableName [string toupper $tableName]
set isSequence [$selectCommand "SELECT count(*) from user_sequences WHERE sequence_name='SEQ_$tableName'"]
set uniqueId 0
set result ""
::foreach column [$selectCommand "SELECT column_name,data_type,data_length,data_precision,data_default,nullable,data_scale
FROM user_tab_columns WHERE table_name='$tableName'"] {
set type [lindex $column 1]
if {[lindex $column 1]=="NUMBER"} {
set precision [lindex $column 3]
if {[lindex $column 6]!=0} {
set type decimal($precision,[lindex $column 6])
} else {
switch $precision {
"13" {
if {$isSequence && !$uniqueId} {
set uniqueId 1
set type "UNIQUE_ID"
} else {
set type "bigint"
}
}
"9" {
set type "int"
}
"4" {
set type "smallint"
}
"2" {
set type "tinyint"
}
}
}
} elseif {$type=="DATE"} {
set type "date"
} else {
set type "varchar([lindex $column 2])"
}
if {[lindex $column 5]=="N"} {
set isNull "no"
} else {
set isNull "yes"
}
lappend result [list [string tolower [lindex $column 0]] $type [string trim [string map [list ' ""] [lindex $column 4]]] $isNull]
}
if {$result==""} {
error "table $tableName does not exist"
}
return $result
}
public method oracleLockTable {tableName} {
setAutoCommit 0
set stmt "lock table $tableName in EXCLUSIVE mode"
return [$execCommand $stmt]
}
private method oracleVersionCommand {} {
set data [orainfo server $conn]
set startIndex [expr {[string first "Release" $data] +8}]
set version [string range $data $startIndex [expr {$startIndex +8}]]
return $version
}
private method sqlserverSequence {sql} {
set sql ""
sql $sql
set sql ""
set sequenceNum [sql $sql]
}
private method sqlserverInsertGetId {sql {idField ""} {returnValue 1} {sequenceName ""}} {
sql $sql
if {!$returnValue} {
return ""
}
set getIdSql "select @@identity"
set id [sql $getIdSql]
}
private method sqlserverLimit {sql count} {
$conn set maxrows $count
set rows [sql $sql]
$conn set maxrows 0
return $rows
}
private method sqlserverFormat {sql} {
regsub -nocase {UNIQUE_ID} $sql {bigint identity(1,1)} sql
regsub -nocase -all {\sdate} $sql { datetime} sql
set tableName [lindex $sql 2]
regsub -all -nocase {primary key} $sql "constraint pk_$tableName primary key" sql
regsub -all -nocase { modify } $sql " alter column " sql
return $sql
}
private method sqlserverTclodbcGetTables {} {
return [sql "select distinct table_name from information_schema.columns"]
}
private method sqlserverSetAutoCommitCommand {flag} {
return [$conn set autocommit $flag]
}
private method sqlserverCommitCommand {} {
return [$execCommand "commit"]
}
private method sqlserverRollbackCommand {} {
return [$execCommand "rollback"]
}
private method sqlserverDesc {tableName} {
set descList ""
set primaryColumn ""
::foreach column [$conn columns $tableName] {
set type [lindex $column 5]
if {$type=="bigint identity"} {
set type UNIQUE_ID
} elseif {[string first "int" $type]==-1} {
set type "varchar([lindex $column 6])"
} else {
set type [lindex $column 5]
}
lappend descList [list [lindex $column 3] $type [lindex $column 12] [lindex [lindex $column 17] 0]]
}
return $descList
}
public method sqlserverLockTable {tableName} {
setAutoCommit 0
set stmt "select top 1 'a' from $tableName with (tablockx)"
return [$execCommand $stmt]
}
private method odbcTclodbcConnect {user password database host} {
set conn [database conn[clock clicks] $database $user $password]
}
private method odbcTclodbcDisconnect {} {
$conn disconnect
}
private method odbcTclodbcSelect {sql {type 1} {script ""} {var ""}} {
if {$type==1} {
return [$conn $sql]
} else {
set count 0
if {$type==2} {
set level 0
} else {
set level 2
upvar 2 $var row
}
$conn statement stmHandle $sql
stmHandle execute
while {[set row [stmHandle fetch]]!=""} {
incr count
uplevel $level $script
}
stmHandle drop
return $count
}
}
private method odbcTclodbcExec {sql} {
return [$conn $sql]
}
private method odbcSetAutoCommitCommand {flag} {
return [$conn set autocommit $flag]
}
private method odbcCommitCommand {} {
return [$execCommand "commit"]
}
private method odbcRollbackCommand {} {
return [$execCommand "rollback"]
}
private method odbcTclodbcGetTables {} {
set tableList ""
::foreach tbl [$conn tables] {
lappend tableList [lindex $tbl 2]
}
return $tableList
}
private method odbcLimit {sql count} {
$conn set maxrows $count
set rows [sql $sql]
$conn set maxrows 0
return $rows
}
private method informixIsqltclSelect {sql {type 1} {script ""} {var ""}} {
if {[set fd [::sql open "$sql"]]<0} {
catch {::sql close $fd}
error [::sql geterror]
}
set result ""
if {$type==1} {
while {[set row [::sql fetch $fd 1]]!=""} {
lappend result $row
}
} else {
set count 0
if {$type==2} {
set level 0
} else {
set level 2
upvar 2 $var row
}
while {[set row [::sql fetch $fd 1]]!=""} {
incr count
uplevel $level $script
}
set result $count
}
::sql close $fd
return $result
}
private method informixIsqltclExec {sql} {
if {$autoCommit==0} {
catch {::sql begin}
}
set command [string tolower [string range [string trimleft $sql " "] 0 5]]
set cmd "::sql run "
if {$command=="insert"} {
set bindVals {}
set matching [regexp -all -inline '(.*?)' $sql]
::foreach {match val} $matching {
if {[string length $val]>257} {
set startIndex [string first $match $sql]
set endIndex [expr {$startIndex -1 + [string length $match]}]
set sql [string replace $sql $startIndex $endIndex "?"]
set bindVals [concat $bindVals $val]
}
}
lappend cmd $sql
if {$bindVals!=""} {
lappend cmd $bindVals
}
} else {
lappend cmd $sql
}
if {[set result [eval $cmd]]!=0} {
error [::sql geterror]
}
return $result
}
private method informixIsqltclConnect {user password database host} {
if {[::sql database $database with_concurrent_transaction user $user using password $password]!=0} {
error [::sql geterror]
}
}
private method informixIsqltclDisconnect {} {
::sql finish
}
private method informixFormat {sql} {
regsub -nocase -all {UNIQUE_ID} $sql {serial(100) } sql
regsub -nocase -all {\sdate} $sql { datetime year to second} sql
regsub -nocase -all {\snot null} $sql { tmpnull} sql
regsub -nocase -all {\sdefault null} $sql {} sql
regsub -nocase -all {\snull} $sql {} sql
regsub -nocase -all {\stmpnull} $sql { not null} sql
regsub -nocase -all {\stinyint} $sql { int} sql
regsub -nocase -all {\sbigint} $sql { int} sql
regsub -nocase -all {\svarchar\((2[6-9][0-9]|[1-9][0-9]{3,})\)} $sql { char(\1) } sql
regsub -all -nocase {constraint(.*?)foreign} $sql "foreign" sql
return $sql
}
private method informixSequence {sql} {
}
private method informixInsertGetId {sql idField returnValue sequenceName} {
set firstOpenBrace [string first "(" $sql]
set tableName [lindex [string range $sql 0 $firstOpenBrace] 2]
set valuesIndex [string first "values" $sql]
if {$valuesIndex==-1} {
set valuesIndex [string first "VALUES" $sql]
}
set firstCloseBrace [string last ")" [string range $sql 0 $valuesIndex]]
set lastOpenBrace [string first "(" [string range $sql $valuesIndex end]]
set lastCloseBrace [string last ")" $sql]
set sqlInsert "insert into $tableName ($idField,[string range $sql [expr {$firstOpenBrace +1}] $firstCloseBrace] values (0,[string range $sql [expr {$lastOpenBrace +$valuesIndex +1}] [expr {$lastCloseBrace +$valuesIndex}]]"
sql $sqlInsert
return [lindex [lindex [::sql sqlca] 3] 1]
}
private method informixLimit {sql count} {
return [lrange [sql $sql] 0 [incr count -1]]
}
private method informixSetAutoCommitCommand {flag} {
}
private method informixCommitCommand {} {
return [catch {::sql commit}]
}
private method informixRollbackCommand {} {
return [catch {::sql rollback}]
}
private method informixIsqltclGetTables {} {
return [sql "SELECT tabname FROM systables "]
}
private method postgresPgtclSelect {sql {type 1} {script ""} {var ""}} {
set result ""
if {$type==1} {
pg_select $conn $sql rowArray {
set row ""
::foreach header $rowArray(.headers) {
lappend row $rowArray($header)
}
lappend result $row
}
} else {
set count 0
if {$type==2} {
set level 0
} else {
set level 2
upvar 2 $var row
}
pg_select $conn $sql row {
incr count
set row ""
::foreach header $row(.headers) {
lappend row $rowArray($header)
}
uplevel $level $script
}
ps_result
set result $count
}
return $result
}
private method postgresPgtclExec {sql} {
if {$autoCommit==0} {
pg_exec $conn "begin"
}
set handle [pg_exec $conn $sql]
set result [pg_result $handle -status]
if {$result=="PGRES_FATAL_ERROR"} {
set result [pg_result $handle -error]
pg_result $handle -clear
error $result
}
pg_result $handle -clear
return
}
private method postgresPgtclConnect {user password database host} {
set conn [pg_connect $database -host $host ]
}
private method postgresPgtclDisconnect {} {
pg_disconnect $conn
}
private method postgresFormat {sql} {
regsub -all -nocase {UNIQUE_ID} $sql { serial } sql
regsub -all -nocase {\stinyint\s} $sql { smallint } sql
regsub -nocase -all {\svarchar\((2[5-9][0-9]|[1-9][0-9]{3,})\)} $sql { text} sql
return $sql
}
private method postgresInsertGetId {sql idField returnValue sequenceName} {
set firstOpenBrace [string first "(" $sql]
set tableName [lindex [string range $sql 0 $firstOpenBrace] 2]
if {$sequenceName==""} {
set sequenceName "${tableName}_${idField}_seq"
}
set sqlSeq "select nextval('$sequenceName')"
set sequenceValue [sql $sqlSeq]
set valuesIndex [string first "values" $sql]
if {$valuesIndex==-1} {
set valuesIndex [string first "VALUES" $sql]
}
set firstCloseBrace [string last ")" [string range $sql 0 $valuesIndex]]
set lastOpenBrace [string first "(" [string range $sql $valuesIndex end]]
set lastCloseBrace [string last ")" $sql]
set sqlInsert "insert into $tableName ($idField,[string range $sql [expr {$firstOpenBrace +1}] $firstCloseBrace] values ($sequenceValue,[string range $sql [expr {$lastOpenBrace +$valuesIndex +1}] [expr {$lastCloseBrace +$valuesIndex}]]"
sql $sqlInsert
return $sequenceValue
}
private method postgresLimit {sql count} {
append sql " limit $count"
sql $sql
}
private method postgresSetAutoCommitCommand {flag} {
}
private method postgresCommitCommand {} {
pg_exec $conn "end"
return [pg_exec $conn "commit work"]
}
private method postgresRollbackCommand {} {
return [pg_exec $conn "rollback work"]
}
private method postgresPgtclGetTables {} {
return [sql "select relname from pg_class where relname not like ('pg_%') and relkind='r'"]
}
public method insertUpdateRow {tableName tableRecord} {
if {[catch {
set whereText "WHERE "
set keyExists "false"
buildDescArray $tableName
::foreach {columnKey columnValue} $tableRecord {
if {[string first KEY: $columnKey]!=-1} {
set keyExists 1
set columnKey [lindex [split $columnKey ":"] 1]
switch -glob $tableColumns($tableName,$columnKey,type) {
"varchar*" -
"char*" {
set columnValue [string map [list ' \\\' \" \"] $columnValue]
set columnValue "'$columnValue'"
}
"date" {
set columnValue [toDate [clock scan $columnValue]]
}
}
append whereText "($columnKey = $columnValue) AND"
}
}
set whereText [string trimright $whereText "AND"]
set recordExists 0
if {$keyExists} {
set recordExists [lindex [isExists $tableName $whereText] 0]
}
if { $recordExists } {
set returnValue [update $tableName $tableRecord $whereText]
} else {
set returnValue [insert $tableName $tableRecord ]
}
} err]} {
error "Error: $err"
}
}
public method isExists { tableName whereText } {
set queryText "SELECT count(*) FROM $tableName "
append queryText $whereText
set returnValue [sql $queryText];
if {$returnValue!= 0} {
set returnValue 1
}
return $returnValue;
}
private method buildDescArray {tableName {extend 0}} {
if {[info exists tableColumns($tableName)]} {return}
set tableColumns($tableName) 1
::foreach column [$descCommand $tableName] {
::foreach {name type default null} $column {break}
set tableColumns($tableName,$name,type) $type
if {$extend} {
set tableColumns($tableName,$name,default) $default
set tableColumns($tableName,$name,null) $null
}
}
}
public method insert {tableName tableRecord} {
if {[catch {
buildDescArray $tableName
set queryText "INSERT INTO $tableName "
set recordValue " VALUES ("
set recordKey " ("
::foreach {columnKey columnValue} $tableRecord {
if {[string first KEY: $columnKey]!=-1} {
set columnKey [lindex [split $columnKey ":"] 1]
}
switch -- $columnValue {
"now" {
append recordValue "[now],"
append recordKey "$columnKey,"
}
"seq" {
set seqColumnId "$columnKey";
}
default {
if {![info exists tableColumns($tableName,$columnKey,type)]} {
error "Error: column $columnKey does not exists in table $tableName"
}
switch -glob -- $tableColumns($tableName,$columnKey,type) {
"varchar*" -
"char*" {
set columnValue [string map [list ' \\\' \" \"] $columnValue]
append recordValue '$columnValue',
}
"date" {
append recordValue [toDate [clock scan $columnValue]],
}
default {
append recordValue $columnValue,
}
}
append recordKey "$columnKey,"
}
}
}
set recordValue "[string trimright $recordValue ","])"
set recordKey "[string trimright $recordKey ","])"
append queryText "$recordKey $recordValue";
} err]} {
error $err
}
if {![info exists seqColumnId]} {
set returnValue [sql $queryText];
} else {
set returnValue [insertGetId $queryText $seqColumnId];
}
return $returnValue;
}
public method update {tableName tableRecord whereText } {
if {[catch {
buildDescArray $tableName
set queryText "UPDATE $tableName SET "
set recordValue ""
::foreach {columnKey columnValue} $tableRecord {
if {[string first KEY: $columnKey]!=-1} {
set columnKey [lindex [split $columnKey ":"] 1]
}
switch -- $columnValue {
"seq" {
}
"now" {
append recordValue "$columnKey = [now],"
}
default {
switch -glob $tableColumns($tableName,$columnKey,type) {
"varchar*" -
"char*" {
set columnValue [string map [list ' \\\' \" \"] $columnValue]
append recordValue "$columnKey ='$columnValue',"
}
"date" {
append recordValue "$columnKey=[toDate [clock scan $columnValue]],"
}
default {
append recordValue $columnKey=$columnValue,
}
}
}
}
}
set recordValue [string trimright $recordValue ","]
append queryText "$recordValue $whereText";
} err]} {
error "wrong input format $tableRecord error: $err"
}
return [sql $queryText];
}
public method upgradeTable {sql {upgradeCheck 0}} {
variable dbType
set tableName [lindex $sql 2]
buildDescArray $tableName 1
if {![info exists tableColumns($tableName)]} {
error "$tableName does not exists"
}
regsub -nocase {\([a-z_ ]*,[a-z_ ]*(,[a-z_ ]*)*(,[a-z_ ]*)*\)} $sql "XXX" sql
regsub -nocase {[(]([0-9])[,]([0-9]?)[)]} $sql {(\1-X-\2)} sql
set startColumns [string first "(" $sql]
set endColumns [string last ")" $sql]
set columns [split [string range $sql [incr startColumns] [incr endColumns -1]] ","]
set alterList ""
::foreach column $columns {
regsub -nocase -- {-X-} $column "," column
set alterSql ""
set columnName [string tolower [lindex $column 0]]
set column [string tolower $column]
set columnCheck [lindex $column 0]
if {$columnCheck=="primary" || $columnCheck=="foreign" || $columnCheck=="constraint"} {continue}
set columnType [lindex $column 1]
if {[set findIndex [lsearch -start 2 $column "default"]]!=-1} {
set default [string map [list ' ""] [lindex $column [incr findIndex]]]
} else {
set default ""
}
if {[info exists tableColumns($tableName,$columnName,type)]} {
if {$dbType=="mysql"} {
if {$tableColumns($tableName,$columnName,type)=="varchar(text)"} {
set tableColumns($tableName,$columnName,type) $columnType
}
if {$default=="null" || $columnType=="unique_id"} {
set default ""
} elseif {$tableColumns($tableName,$columnName,default)==0 && $default==""} {
set default 0
}
}
if {[string first "char" $tableColumns($tableName,$columnName,type)]!=-1 && ([string first $tableColumns($tableName,$columnName,type) $columnType]!=-1 || [string first $columnType $tableColumns($tableName,$columnName,type)])} {
set columnType $tableColumns($tableName,$columnName,type)
}
}
if {[set findIndex [lsearch -start 2 $column "not"]]==-1 && $columnType!="unique_id"} {
set null "yes"
} else {
set null "no"
}
if {[info exists tableColumns($tableName,$columnName,type)]==0} {
set alterSql "alter table $tableName add $columnName $columnType"
} elseif {[string match -nocase $tableColumns($tableName,$columnName,type) $columnType]==0 || ![string match -nocase $tableColumns($tableName,$columnName,default) $default] || $tableColumns($tableName,$columnName,null)!=$null} {
set alterSql "alter table $tableName [$formatCreate modify] $columnName $columnType"
}
if {$alterSql!=""} {
if {$default!=""} {
append alterSql " DEFAULT $default"
}
if {$null=="no"} {
append alterSql " not null"
} else {
append alterSql " null"
}
lappend alterList $alterSql
}
}
if {$upgradeCheck} {
return $alterList
}
if {[catch {
::foreach alterSql $alterList {
$execCommand $alterSql
}
} msg]} {
error "$msg. sql: $alterSql"
}
}
public method getNumerator {table column {where ""}} {
if {$where!=""} {
set where "where $where"
}
lockTable $table
set stmt "select max($column),count($column) from $table $where"
::foreach {max count} [lindex [sql $stmt] 0] {break}
if {$count==0} {
setAutoCommit 1
error "no record was found"
}
set updateStmt "update $table set $column=[incr max] $where"
if {[catch {
sql $updateStmt
} msg]} {
setAutoCommit 1
error $msg
}
setAutoCommit 1
return $max
}
public method getDatabaseVersion {} {
return [$versionCommand]
}
}updated version to version 1.7