281 lines
6.3 KiB
Tcl
281 lines
6.3 KiB
Tcl
package provide tclodbc 2.2
|
|
|
|
# require tcl 8.0 because of namespaces
|
|
if {$tcl_version >= {8.0}} {
|
|
|
|
namespace eval tclodbc {
|
|
####################################################################
|
|
#
|
|
# Procedure DumpTable
|
|
#
|
|
# Dump the contents of a named table to a file.
|
|
# The filename may be given explicitly, but if not,
|
|
# a default name of the form $tablename.d is used.
|
|
#
|
|
# The .d file format is the following:
|
|
# 1st line contains the data column names.
|
|
# from 2rd line forward, the data in tcl list format.
|
|
#
|
|
# Parameters:
|
|
# db : database object name
|
|
# table : database table name
|
|
# ?filename? : filename, optional
|
|
#
|
|
|
|
namespace export DumpTable
|
|
proc DumpTable {db table {filename {}}} {
|
|
|
|
# generate filename, if not specified
|
|
if {$filename == {}} {
|
|
set filename $table.d
|
|
}
|
|
|
|
# create output file
|
|
set out [open $filename w]
|
|
|
|
# statement for table iteration
|
|
$db statement select$table "select * from $table"
|
|
|
|
# dump column names
|
|
puts $out [select$table columns name]
|
|
|
|
# dump the actual data
|
|
select$table execute
|
|
while {[set row [select$table fetch]] != {}} {
|
|
puts $out $row
|
|
}
|
|
select$table drop
|
|
|
|
close $out
|
|
}
|
|
# end proc DumpTable
|
|
|
|
####################################################################
|
|
#
|
|
# Procedure LoadTable
|
|
#
|
|
# Loads the contents of a named table from a file.
|
|
# The filename may be given explicitly, but if not,
|
|
# a default name of the form $tablename.d is used.
|
|
# The file format is assumed to be of the form generated
|
|
# by DumpData procedure, described above.
|
|
#
|
|
# Parameters:
|
|
# db : database object name
|
|
# table : database table name
|
|
# ?filename? : filename, optional
|
|
#
|
|
|
|
namespace export LoadTable
|
|
proc LoadTable {db table {filename {}}} {
|
|
|
|
# generate filename, if not specified
|
|
if {$filename == {}} {
|
|
set filename $table.d
|
|
}
|
|
|
|
# open input file
|
|
set in [open $filename]
|
|
|
|
# read column names and types
|
|
gets $in colnames
|
|
|
|
# generate insert statement
|
|
SqlInsert $db insert$table $table $colnames
|
|
|
|
# read data
|
|
while {[gets $in row] > -1} {
|
|
insert$table run $row
|
|
}
|
|
insert$table drop
|
|
|
|
close $in
|
|
}
|
|
# end proc LoadTable
|
|
|
|
proc quote {s {q `}} {
|
|
foreach i $s {
|
|
lappend ret $q$i$q
|
|
}
|
|
return $ret
|
|
}
|
|
|
|
####################################################################
|
|
#
|
|
# Procedure TableDef
|
|
#
|
|
# Return the definition of a named database table.
|
|
# The definition consist of a list {tablename coldefs indexdefs}
|
|
#
|
|
# Parameters:
|
|
# db : database object name
|
|
# table : database table name
|
|
#
|
|
|
|
namespace export TableDef
|
|
proc TableDef {db table} {
|
|
# output triplet {tablename coldef indexdef}
|
|
return [list $table [$db columns $table] [db indexes $table]]
|
|
}
|
|
# end proc TableDef
|
|
|
|
####################################################################
|
|
#
|
|
# Procedure TableDefToSql
|
|
#
|
|
# Transforms a TableDef as returned by procedure TableDef to a list
|
|
# of driver specific sql data definition statements.
|
|
#
|
|
# Parameters:
|
|
# db : database object name
|
|
# tabledef : database table name
|
|
#
|
|
|
|
namespace export TableDefToSql
|
|
proc TableDefToSql {db tabledef} {
|
|
# table name
|
|
set table [lindex $tabledef 0]
|
|
|
|
# create column definition sql
|
|
foreach i [lindex $tabledef 1] {
|
|
set colname [lindex $i 3]
|
|
set typeid [lindex $i 4]
|
|
set typeinfo [lindex [$db typeinfo $typeid] 0]
|
|
if {$typeinfo == {}} {error "invalid type id $typeid, sql conversion failed"}
|
|
|
|
set coltype [lindex $typeinfo 0]
|
|
set args [split [lindex $typeinfo 5] ,]
|
|
|
|
# use simple heuristic based on the count of type arguments
|
|
# this propably does not work in all cases !!
|
|
switch [llength [split [lindex $typeinfo 5] ,]] {
|
|
0 {# OK, nothing to do}
|
|
1 {append coltype ([lindex $i 6]) ;# precision}
|
|
2 {append coltype ([lindex $i 6],[lindex $i 8]) ;# precision, scale}
|
|
default {error "invalid count of type arguments"}
|
|
}
|
|
|
|
lappend coldef "$colname $coltype"
|
|
}
|
|
|
|
# CREATE TABLE clause
|
|
lappend sql "CREATE TABLE $table ([join $coldef ,]);"
|
|
|
|
# indexes
|
|
foreach i [lindex $tabledef 2] {
|
|
set ixname [lindex $i 5]
|
|
|
|
# Some database (e.g. Access) have a default index without name.
|
|
# Sql cannot be generated for them.
|
|
if {$ixname == {}} continue
|
|
|
|
# uniqueness
|
|
if {![lindex $i 3]} {set unique($ixname) "UNIQUE "} else {set unique($ixname) {}}
|
|
|
|
# cumulate column definitions to an array
|
|
set coldef [lindex $i 8]
|
|
if {![string compare [lindex $i 9] D]} {append coldef " DESCENDING"}
|
|
lappend ixcoldef($ixname) $coldef
|
|
}
|
|
|
|
foreach i [array names ixcoldef] {
|
|
lappend sql "CREATE $unique($i)INDEX $i ON $table ([join $ixcoldef($i) ,]);"
|
|
}
|
|
|
|
return $sql
|
|
}
|
|
# end proc TableDefToSql
|
|
|
|
####################################################################
|
|
#
|
|
# Procedure LoadSql
|
|
#
|
|
# Loads sql from a file to a database.
|
|
# The input file should contain one sql statement per line.
|
|
#
|
|
# Parameters:
|
|
# db : database object name
|
|
# filename : filename
|
|
#
|
|
|
|
namespace export LoadSql
|
|
proc LoadSql {db filename} {
|
|
|
|
# open input file
|
|
set in [open $filename]
|
|
|
|
# execute lines, one by one
|
|
while {[gets $in line] > -1} {
|
|
$db $line
|
|
}
|
|
|
|
close $in
|
|
}
|
|
# end proc LoadSql
|
|
|
|
####################################################################
|
|
#
|
|
# Procedure DumpSchema
|
|
#
|
|
# Dumps whole database schema to a named file.
|
|
#
|
|
# Parameters:
|
|
# db : database object name
|
|
# filename : filename
|
|
#
|
|
|
|
namespace export DumpSchema
|
|
proc DumpSchema {db filename} {
|
|
|
|
# create output file
|
|
set out [open $filename w]
|
|
|
|
# dump all tables, excluding system tables
|
|
set tables [$db tables]
|
|
foreach i $tables {
|
|
if {![string compare [lindex $i 3] TABLE]} {
|
|
set tablename [lindex $i 2]
|
|
puts $out [TableDef $db $tablename]
|
|
}
|
|
}
|
|
|
|
# close file
|
|
close $out
|
|
}
|
|
# end proc DumpSchema
|
|
|
|
####################################################################
|
|
#
|
|
# Procedure LoadSchema
|
|
#
|
|
# Loads whole database schema from a named file.
|
|
#
|
|
# Parameters:
|
|
# db : database object name
|
|
# filename : filename
|
|
# verbose : puts lines before executing, useful when debugging sql
|
|
#
|
|
|
|
namespace export LoadSchema
|
|
proc LoadSchema {db filename {verbose no}} {
|
|
|
|
# open input file
|
|
set in [open $filename]
|
|
|
|
# read in and interpret lines
|
|
while {[gets $in line] > -1} {
|
|
foreach i [TableDefToSql $db $line] {
|
|
if {$verbose} {puts $i}
|
|
$db $i
|
|
}
|
|
}
|
|
|
|
close $in
|
|
}
|
|
# end proc LoadSchema
|
|
|
|
}
|
|
# end namespace tclodbc
|
|
|
|
}
|
|
# end if tcl_version |