152 lines
4.1 KiB
Tcl
152 lines
4.1 KiB
Tcl
package provide tclodbc 2.2
|
|
|
|
# require tcl 8.0 because of namespaces
|
|
if {$tcl_version >= {8.0}} {
|
|
|
|
namespace eval tclodbc {
|
|
|
|
####################################################################
|
|
#
|
|
# Procedure SqlInsert
|
|
#
|
|
# Return command for creating a insert statement for given table
|
|
# and columns. Mode determines the action for the command. Useful
|
|
# modes are e.g. eval, return and puts.
|
|
#
|
|
# Parameters:
|
|
# db : database object
|
|
# stmt : statement name
|
|
# table : table name
|
|
# columns : column names
|
|
# ?mode? : mode, default is eval
|
|
|
|
namespace export SqlInsert
|
|
proc SqlInsert {db stmt table columns {mode eval}} {
|
|
set sql "INSERT INTO $table ([join $columns ,]) VALUES ([SqlParams $columns , no])"
|
|
set coltypes [ColTypes $db $table $columns]
|
|
$mode "$db statement $stmt \{$sql\} \{$coltypes\}"
|
|
}
|
|
# end proc SqlInsert
|
|
|
|
####################################################################
|
|
#
|
|
# Procedure SqlUpdate
|
|
#
|
|
# Return command for creating a update statement for given table
|
|
# and columns. Mode determines the action for the command. Useful
|
|
# modes are e.g. eval, return and puts.
|
|
#
|
|
# Parameters:
|
|
# db : database object
|
|
# stmt : statement name
|
|
# table : table name
|
|
# datacols : data column names
|
|
# keycols : key column names
|
|
# ?mode? : mode, default is eval
|
|
|
|
namespace export SqlUpdate
|
|
proc SqlUpdate {db stmt table datacols keycols {mode eval}} {
|
|
set sql "UPDATE $table SET [SqlParams $datacols ,] WHERE [SqlParams $keycols]"
|
|
set coltypes [ColTypes $db $table [concat $datacols $keycols]]
|
|
$mode "$db statement $stmt \{$sql\} \{$coltypes\}"
|
|
}
|
|
# end proc SqlUpdate
|
|
|
|
####################################################################
|
|
#
|
|
# Procedure SqlSelect
|
|
#
|
|
# Return command for creating a select statement for given table
|
|
# and columns. Mode determines the action for the command. Useful
|
|
# modes are e.g. eval, return and puts.
|
|
#
|
|
# Parameters:
|
|
# db : database object
|
|
# stmt : statement name
|
|
# table : table name
|
|
# datacols : data column names
|
|
# keycols : key column names
|
|
# ?mode? : mode, default is eval
|
|
|
|
namespace export SqlSelect
|
|
proc SqlSelect {db stmt table datacols keycols {mode eval}} {
|
|
set sql "SELECT [join $datacols ,] FROM $table WHERE [SqlParams $keycols]"
|
|
set coltypes [ColTypes $db $table $keycols]
|
|
$mode "$db statement $stmt \{$sql\} \{$coltypes\}"
|
|
}
|
|
# end proc SqlSelect
|
|
|
|
####################################################################
|
|
#
|
|
# Procedure SqlDelete
|
|
#
|
|
# Create command for creating a delete statement for given table
|
|
# and columns.
|
|
#
|
|
# Parameters:
|
|
# db : database object
|
|
# stmt : statement name
|
|
# table : table name
|
|
# keycols : key column names
|
|
# ?mode? : mode, default is eval
|
|
|
|
namespace export SqlDelete
|
|
proc SqlDelete {db stmt table keycols {mode eval}} {
|
|
set sql "DELETE FROM $table WHERE [SqlParams $keycols]"
|
|
set coltypes [ColTypes $db $table $keycols]
|
|
$mode "$db statement $stmt \{$sql\} \{$coltypes\}"
|
|
}
|
|
# end proc SqlDelete
|
|
|
|
####################################################################
|
|
#
|
|
# Procedure ColTypes
|
|
#
|
|
# Return list of column types for given columns. This list can
|
|
# be used as statement argument specification.
|
|
#
|
|
# Parameters:
|
|
# db : database object
|
|
# table : table name
|
|
# columns : column names
|
|
|
|
namespace export ColTypes
|
|
proc ColTypes {db table columns} {
|
|
set coldefs [$db columns $table]
|
|
foreach i $coldefs {
|
|
set colname [string tolower [lindex $i 3]]
|
|
set coltype($colname) [list [lindex $i 4] [lindex $i 6]]
|
|
|
|
# precision may be empty for certain datatypes
|
|
if {[lindex $i 8] != {}} {
|
|
lappend coltype($colname) [lindex $i 8]
|
|
}
|
|
}
|
|
|
|
foreach i $columns {
|
|
lappend coltypes $coltype([string tolower $i])
|
|
}
|
|
|
|
return $coltypes
|
|
}
|
|
# end proc ColTypes
|
|
|
|
####################################################################
|
|
#
|
|
# Private utility procedures
|
|
|
|
proc SqlParams {columns {separator { AND }} {assign yes}} {
|
|
foreach i $columns {
|
|
if {$assign} {
|
|
lappend marks ${i}=?
|
|
} else {
|
|
lappend marks ?
|
|
}
|
|
}
|
|
return [join $marks $separator]
|
|
}
|
|
|
|
}
|
|
# end namespace tclodbc
|
|
|
|
} |