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 postgres (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 whether 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 eq "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 ne ""} { 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 eq "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 eq ""} { 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 eq "end"} { set endRow 9999999 } set ofd [open $fileName r] set count 0 while {$count!=$startRow} { gets $ofd incr count } while {[set row [gets $ofd]] ne "" && $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]] ne ""} { 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] eq "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 eq "datetime"} { set type "date" } elseif {$type eq "text"} { set type varchar(text) } } if {[lindex $column 2] eq ""} { 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]] ne ""} { 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 eq ""} { 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 eq "DATE"} { set type "date" } else { set type "varchar([lindex $column 2])" } if {[lindex $column 5] eq "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 eq ""} { 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 eq "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 eq "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 eq "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 eq ""} { 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 eq "primary" || $columnCheck eq "foreign" || $columnCheck eq "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 eq "mysql"} { if {$tableColumns($tableName,$columnName,type) eq "varchar(text)"} { set tableColumns($tableName,$columnName,type) $columnType } if {$default eq "null" || $columnType eq "unique_id"} { set default "" } elseif {$tableColumns($tableName,$columnName,default) == 0 && $default eq ""} { 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 eq "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