might have had are lost.
#
# @argument key: The name of the variable to move (rename).
# @argument keyNew: The new name of the variable.
# Discard stupid nop requests.
if {"$key" == "$keyNew"} {return}
set slot($keyNew) $slot($key)
unset slot($key)
return
}
}
File code/db_manager.cls
# -*- tcl -*-
# dbmsExplorer @mFullVersion@, as of @mDate@
# Generic manager class
#
# CVS: $Id: dbmsExplorer.rtf,v 1.1.1.1 1998/01/29 21:19:22 aku Exp $
#
# @c Here we define the generic parts of all database managers. Even
# @c procedures without implementation are defined here, to make this
# @c file an explanation of the full interface too. Users of a
# @c database manager have to consult this class description as
# @c reference. Concrete database managers must inherit from this
# @c class.
#
# @s Interface of all RDBMS managers
# @i generic db manager
# -----------------------------
object_class dbGenericManager {
#######################################################
# Use event subsystem
# All member variables matching 'w,*' are reserved by the
# event system and must not be used in this class.
object_include dbNotifier
# @member cache: Reference to the object containing cached
# @member cache: database information. Controlling the object
# @member cache: is the responsibility of the concrete classes.
member cache
method init {} {
# @c This method is called by the framework ()
# @c to execute class-specific instance initialization code.
# @c Here we create the cache to be used by the concrete
# @c manager.
set slot(cache) [dbCache ${self}_c]
return
}
method destroy {} {
# @c This method is called by the framework ()
# @c to execute class-specific instance destruction code.
# @c Here we destroy the cache used by the concrete
# @c manager.
object_destroy $slot(cache)
return
}
#######################################################
# Internal interface from this class to its subclasses, the
# concrete managers. Provides methods for setting up generic
# tables containing information about types, commands, special
# commands and managers provided by the subclass and the RDBMS
# it connects to. Using this tables the generic class is able
# to handle some queries by itself, without delegation to
# the subclass.
# @member meta,types: List containing the names of all types
# @member meta,types: supported by the underlying DBMS
# @member meta,specials: List containing the names of all
# @member meta,specials: special commands provided by the
# @member meta,specials: concrete subclass.
# @member meta,managers: List containing the names of all parts
# @member meta,managers: a table supported by the RDBMS the
# @member meta,managers: concrete subclass connects to. The UI
# @member meta,managers: is currently only able to handle
# @member meta,managers: 'columns' and 'indices'.
member meta,types {}
member meta,specials {}
member meta,managers {}
# The following member variables are dynamically used:
#
# meta,type, - Defined for all names listed in 'meta,types'
# Refers to the description of the specified
# type.
#
# meta,cmd, - Defined for all commands set via
# 'setSupportedCommands' and
# 'setSupportedSpecials'.
#
# The value is 'available' for the first and
# the command description for the second.
method setSupportedCommands {cmdList} {
# @c Used by the concrete subclass to set the names of all
# @c standard commands supported by it.
#
# @argument cmdList: The list of supported commands.
# Recode the list into something easier accessible.
# See method 'isCommandAvailable' too.
foreach cmd $cmdList {
set slot(meta,cmd,$cmd) available
}
return
}
method setSupportedTypes {typeList} {
# @c Used by the concrete subclass to set the names of all
# @c types. The list is in 'array set'-format, the type
# @c names are used as keys, the associated description
# @c as values.
#
# @argument typeList: The list of supported types and their
# @argument typeList: descriptions.
set slot(meta,types) {}
# Split the list into type names and descriptions. Collect
# the former in a list and save the latter in the array,
# indexed by name.
foreach {typeName typeSpec} $typeList {
set slot(meta,type,$typeName) $typeSpec
lappend slot(meta,types) $typeName
}
set slot(meta,types) [lsort $slot(meta,types)]
return
}
method setSupportedManagers {mgrList} {
# @c Used by the concrete subclass to set the names of all
# @c parts of a table supported by it.
#
# @argument mgrList: The list of supported parts of a table.
set slot(meta,managers) $mgrList
}
method setSupportedSpecials {cmdList} {
# @c Used by the concrete subclass to set the names of all
# @c provided special commands. The list is in 'array set'
# @c format, the command names are used as keys, the
# @c associated description as values.
#
# @argument cmdList: The list of provided special commands.
# Recode the list into something easier accessible. The
# command names are collected in the list, the description
# put into the array, indexed by their name.
# See method 'cmdSpec' too.
set slot(meta,specials) {}
foreach {cmdName cmdSpec} $cmdList {
set slot(meta,cmd,$cmdName) $cmdSpec
lappend slot(meta,specials) $cmdName
}
set slot(meta,specials) [lsort $slot(meta,specials)]
return
}
#######################################################
# Accessors for meta information. There is no need to override
# them in a concrete subclass.
method isCommandAvailable {cmd} {
# @c Checks wether the standard command (specified by its
# @c symbolic name) is supported by the concrete subclass
# @c or not.
#
# @argument cmd: Symbolic name of the command to check for.
return [info exists slot(meta,cmd,$cmd)]
}
method availableManagers {} {
# @c Retrieves the list of all parts of a table supported
# @c by the concrete subclass.
return $slot(meta,managers)
}
method knownTypes {} {
# @c Retrieves the list containing the names of all types
# @c supported by the RDBMS the concrete subclass connects
# @c to.
return $slot(meta,types)
}
method typeSpec {type} {
# @c Retrieves the description the of the specified .
#
# @argument type: Symbolic name of the type whose is
# @argument type: description is asked for.
return $slot(meta,type,$type)
}
method knownSpecials {} {
# @c Retrieves the list containing the names of all special
# @c commands supported by the concrete subclass.
return $slot(meta,specials)
}
method cmdSpec {cmdName} {
# @c Retrieves the description the of the specified special
# @c command. Calling this method with name of a standard
# @c command will return the value 'available'.
#
# @argument type: Symbolic name of the special command whose
# @argument type: is description is asked for.
return $slot(meta,cmd,$cmdName)
}
#######################################################
# Methods to override in derived classes.
# Not overiding them will a cause the generation an exception.
# They define the interfaces to query the manager about itself
# and the RDBMS it is connected to.
#
# 'NYI' is a short for 'not yet implemented'
method who {which} {
# @c Returns either the symbolic name of the RDBMS
# @c (which = -name) used as prefix for special types and
# @c commands, or a text usable for display by the UI
# @c layer (which = -text). Other values of 'which' are
# @c not supported.
# -W- This method should be a generic one, with a corresponding
# -W- method in the setup section.
error "abstract method not overidden by subclass"
}
method getDatabases {} {
# @c Returns the list of all databases found in the RDBMS
# @c the concrete instance is connected to.
error "abstract method not overidden by subclass"
}
method getTables {db} {
# @c Returns the list of all tables found in the RDBMS
# @c the concrete instance is connected to, for a specific
# @c database.
#
# @argument db: The name of the database to look at.
error "abstract method not overidden by subclass"
}
method getColumns {db_table} {
# @c Returns the list of all columns found in the RDBMS
# @c the concrete instance is connected to, for a specific
# @c combination of database and table.
#
# @argument db_table: A 2-element list containing the names
# @argument db_table: of database and table to look at, in
# @argument db_table: this order.
error "abstract method not overidden by subclass"
}
method getIndices {db_table} {
# @c Returns the list of all indices found in the RDBMS
# @c the concrete instance is connected to, for a specific
# @c combination of database and table.
#
# @argument db_table: A 2-element list containing the names
# @argument db_table: of database and table to look at, in
# @argument db_table: this order.
error "abstract method not overidden by subclass"
}
method getTableDefinition {db_table} {
# @c Returns the definition of the specified table, see the
# @c design section for an explanation about the structure
# @c of the result.
#
# @argument db_table: A 2-element list containing the names
# @argument db_table: of database and table to look at, in
# @argument db_table: this order.
error "abstract method not overidden by subclass"
}
method getColumnDefinition {db_table_col} {
# @c Returns the definition of the specified column, see the
# @c design section for an explanation about the structure
# @c of the result.
#
# @argument db_table_col: A 3-element list containing the
# @argument db_table_col: names of database, table and
# @argument db_table_col: column to look at, in this order.
error "abstract method not overidden by subclass"
}
method getIndexDefinition {db_table_idx} {
# @c Returns the definition of the specified index, see the
# @c design section for an explanation about the structure
# @c of the result.
#
# @argument db_table_idx: A 3-element list containing the
# @argument db_table_idx: names of database, table and
# @argument db_table_idx: index to look at, in this order.
error "abstract method not overidden by subclass"
}
method getIndexColumns {db_table_idx} {
# @c A convenience method, returns a list containing the
# @c names of all columns used by the specified index.
#
# @argument db_table_idx: A 3-element list containing the
# @argument db_table_idx: names of database, table and
# @argument db_table_idx: index to look at, in this order.
error "abstract method not overidden by subclass"
}
method getIndexUniqeness {db_table_idx} {
# @c A convenience method, returns a boolean value
# @c indicating wether the specified index is unique or not.
# @c True signals uniqueness.
#
# @argument db_table_idx: A 3-element list containing the
# @argument db_table_idx: names of database, table and
# @argument db_table_idx: index to look at, in this order.
error "abstract method not overidden by subclass"
}
method isCommandAllowed {operation opArgs} {
# @c Similar to 'isCommandAvailable', but its results
# @c depends not only on the availability of the command,
# @c but on the specified entity as well.
#
# @argument operation: The symbolic name of the operation
# @argument operation: to check.
#
# @argument opArgs: A description of the argument which will
# @argument opArgs: be given to the method implementing the
# @argument opArgs: command. The format is described in the
# @argument opArgs: design section.
#
# @result A boolean value. True signals that the command is
# @result allowed to act upon the specified entity.
error "abstract method not overidden by subclass"
}
#######################################################
# It is allowed to leave a method unimplemented in a subclass,
# but only if the associated standard command *is not* defined
# as supported, see 'setSupportedCommands'.
method dbCreate {db} {
# @c Creates a new database. Associated command and event
# @c are 'cmdDbCreate' and 'evDbCreate'.
#
# @argument db: The name of the new database.
error "abstract method not overidden by subclass"
}
method dbDrop {db} {
# @c Destroys the specified database. Associated command
# @c and event are 'cmdDbDrop' and 'evDbDrop'.
#
# @argument db: The name of the database to destroy.
error "abstract method not overidden by subclass"
}
method dbRename {db newName} {
# @c Changes the name of the specified database. Associated
# @c command and event are 'cmdDbRename' and 'evDbRename'.
#
# @argument db: The name of the database to rename.
# @argument newName: The new name of the database.
error "abstract method not overidden by subclass"
}
method tableCreate {db_table spec} {
# @c Creates a new table. Associated command and event
# @c are 'cmdTableCreate' and 'evTableCreate'.
#
# @argument db_table: A 2-element list containing the name
# @argument db_table: of the database and the name of the
# @argument db_table: new table, in this order.
#
# @argument spec: The specification of the table to create.
error "abstract method not overidden by subclass"
}
method tableDrop {db_table} {
# @c Destroys the specified table. Associated command
# @c and event are 'cmdTableDrop' and 'evTableDrop'.
#
# @argument db_table: A 2-element list containing the name
# @argument db_table: of the database and the name of the
# @argument db_table: table to destroy, in this order.
error "abstract method not overidden by subclass"
}
method tableRename {db_table newName} {
# @c Changes the name of the specified table. Associated
# @c command and event are 'cmdTableRename' and
# @c 'evTableRename'.
#
# @argument db_table: A 2-element list containing the name
# @argument db_table: of the database and the name of the
# @argument db_table: table to rename, in this order.
# @argument newName: The new name of the table.
error "abstract method not overidden by subclass"
}
method tableAlter {db_table newName newSpec} {
# @c Changes the definition of the specified table.
# @c Associated command and event are 'cmdTableAlter'
# @c and 'evTableAlter'.
#
# @argument db_table: A 2-element list containing the name
# @argument db_table: of the database and the name of the
# @argument db_table: table to change, in this order.
#
# @argument newName: The new name of the table.
# @argument newSpec: The new specification of the table.
error "abstract method not overidden by subclass"
}
method columnCreate {db_table_col spec} {
# @c Creates a new column. Associated command and event
# @c are 'cmdColumnCreate' and 'evColumnCreate'.
#
# @argument db_table_col: A 3-element list containing the
# @argument db_table_col: name of the database, the table
# @argument db_table_col: and the name of the new column,
# @argument db_table_col: in this order.
#
# @argument spec: The type specification to associate with
# @argument spec: the column.
error "abstract method not overidden by subclass"
}
method columnDrop {db_table_col} {
# @c Destroys the specified column. Associated command and
# @c event are 'cmdColumnDrop' and 'evColumnDrop'.
#
# @argument db_table_col: A 3-element list containing the
# @argument db_table_col: name of the database, the table
# @argument db_table_col: and the name of the column to
# @argument db_table_col: destroy, in this order.
error "abstract method not overidden by subclass"
}
method columnRename {db_table_col newName} {
# @c Changes the name of the specified column. Associated
# @c command and event are 'cmdColumnRename'
# @c and 'evColumnRename'.
#
# @argument db_table_col: A 3-element list containing the
# @argument db_table_col: name of the database, the table
# @argument db_table_col: and the name of the column to
# @argument db_table_col: rename, in this order.
#
# @argument newName: The new name of the column.
error "abstract method not overidden by subclass"
}
method columnAlter {db_table_col newName newSpec} {
# @c Changes the definition of the specified column.
# @c Associated command and event are 'cmdColumnAlter'
# @c and 'evColumnAlter'.
#
# @argument db_table_col: A 3-element list containing the
# @argument db_table_col: name of the database, the table
# @argument db_table_col: and the name of the column to
# @argument db_table_col: change, in this order.
#
# @argument newName: The new name of the column.
# @argument newSpec: The new specification of the column.
error "abstract method not overidden by subclass"
}
method indexCreate {db_table_idx spec} {
# @c Creates a new index. Associated command and event
# @c are 'cmdIndexCreate' and 'evIndexCreate'.
#
# @argument db_table_idx: A 3-element list containing the
# @argument db_table_idx: name of the database, the table
# @argument db_table_idx: and the name of the new index,
# @argument db_table_idx: in this order.
#
# @argument spec: The specification of the new index.
error "abstract method not overidden by subclass"
}
method indexDrop {db_table_idx} {
# @c Destroys the specified index. Associated command and
# @c event are 'cmdIndexDrop' and 'evIndexDrop'.
#
# @argument db_table_idx: A 3-element list containing the
# @argument db_table_idx: name of the database, the table
# @argument db_table_idx: and the name of the index to
# @argument db_table_idx: destroy, in this order.
error "abstract method not overidden by subclass"
}
method indexRename {db_table_idx newName} {
# @c Changes the name of the specified index. Associated
# @c command and event are 'cmdIndexRename'
# @c and 'evIndexRename'.
#
# @argument db_table_idx: A 3-element list containing the
# @argument db_table_idx: name of the database, the table
# @argument db_table_idx: and the name of the index to
# @argument db_table_idx: rename, in this order.
#
# @argument newName: The new name of the index.
error "abstract method not overidden by subclass"
}
method indexAlter {db_table_idx newName newSpec} {
# @c Changes the definition of the specified index.
# @c Associated command and event are 'cmdIndexAlter'
# @c and 'evIndexAlter'.
#
# @argument db_table_idx: A 3-element list containing the
# @argument db_table_idx: name of the database, the table
# @argument db_table_idx: and the name of the index to
# @argument db_table_idx: change, in this order.
#
# @argument newName: The new name of the index.
# @argument newSpec: The new specification of the index.
error "abstract method not overidden by subclass"
}
#######################################################
# special interfaces
method convertGenericType2Sql {spec} {
# @c This method converts a generic type specification into
# @c the coressponding SQL syntax used by the RDBMS. It is
# @c exported for usage by the table editor
# @c () as its output is more readble
# @c than the generic representation.
error "abstract method not overidden by subclass"
}
method specialType {what parentWin typeName args} {
# @c This method is called by the type editor to manage the
# @c UI of special types.
#
# @argument what: The operation to execute. Must be one
# @argument what: of 'createPane', 'getDef', 'setDef'
# @argument what: and 'setState'.
# @argument parentWin: The widget to place the generated UI into.
# @argument typeName: The name of the special type to handle
# @argument args: Other arguments, special to chosen
# @argument args: subcommand. Described in the design
# @argument args: section.
# -W- specialType -
# -W- I don't like having UI code in the DBI layer. This
# -W- interface might therefore change in future versions.
# -W- See footnote (3) in the design section too.
error "abstract method not overidden by subclass"
}
#######################################################
}
File code/db_mysql.cls
# -*- tcl -*-
# dbmsExplorer @mFullVersion@, as of @mDate@
# Manager class for mySQL database systems
#
# CVS: $Id: dbmsExplorer.rtf,v 1.1.1.1 1998/01/29 21:19:22 aku Exp $
#
# @c This the concrete subclass of for
# @c handling the MySQL database management system. Version
# @c 3.21.15 or higher is required, as it is the first one
# @c implementing 'create/drop database' as SQL commands.
#
# @s Manager for mySQL DBS
# @i mySQL, db manager
# -----------------------------
object_class dbMysqlManager {
# @c This defines the logic of managing a mySQL DBMS.
#######################################################
# generic interface is superclass
# we need its 'init' and 'destroy' functionality inside
# our own, so save it.
object_include dbGenericManager
object_savedef dbGenericManager init
object_savedef dbGenericManager destroy
# The above declaration imported the following member variables:
#
# cache; meta,*; w,*
#
# These names must not be used here.
# @m conn: Stores the connection handle returned
# @m conn: by the DBMS accessor library
member conn
#######################################################
# OO framework hooks
class_initialization {
# global initialization code, executed upon autoload of the
# compiled class. Forces the logger package and the DBMS
# accessor library into the intepreter.
package require Pool_Log
package require Sql
}
method init {} {
# @c This method is called by the framework ()
# @c to execute class-specific instance initialization code.
# @c Here we initialize the superclass structures and open
# @c a new connection to the DBMS.
$self dbGenericManager:init
set slot(conn) [sql connect]
# The commands 'cmdDbRename', 'cmdIndexCreate',
# 'cmdIndexRename' and 'cmdIndexAlter' are not implemented
# here and therefore not declared as supported.
#
# The UI layer should not call their methods, but errors are
# always possible, so I decided to define their methods
# nevertheless, to generate an error message more appropriate
# than 'abstract method not overidden'.
$self setSupportedCommands {
cmdDbCreate cmdDbDrop
cmdColumnCreate cmdColumnDrop cmdColumnRename cmdColumnAlter
cmdTableCreate cmdTableDrop cmdTableRename cmdTableAlter
cmdIndexDrop
}
# No specials, at least not yet.
$self setSupportedSpecials {
}
# All currently known parts of a table are supported.
$self setSupportedManagers {columns indices}
# This lengthy list contains all types known to MySQL,
# and their descriptions. Read the design section if
# you want to know more about their structure.
$self setSupportedTypes {
blob {nullable 1 defaultable 0 autoincr 0 linked 0
par {}}
tinyblob {nullable 1 defaultable 0 autoincr 0 linked 0
par {}}
mediumblob {nullable 1 defaultable 0 autoincr 0 linked 0
par {}}
longblob {nullable 1 defaultable 0 autoincr 0 linked 0
par {}}
date {nullable 1 defaultable 1 autoincr 0 linked 0
par {}}
datetime {nullable 1 defaultable 1 autoincr 0 linked 0
par {}}
time {nullable 1 defaultable 1 autoincr 0 linked 0
par {}}
timestamp {nullable 0 defaultable 1 autoincr 0 linked 0
par {
{type enum name length text Length optional 0
values {12 14}}}}
mysql-enum {nullable 1 defaultable 1 autoincr 0 linked 0
par {}}
mysql-set {nullable 1 defaultable 1 autoincr 0 linked 0
par {}}
char {nullable 1 defaultable 1 autoincr 0 linked 0
par {
{type range name length text Length optional 0
minval 1 maxval 255}
{type option name binary text Binary optional 0}}}
varchar {nullable 1 defaultable 1 autoincr 0 linked 0
par {
{type range name length text Length optional 0
minval 1 maxval 255}
{type option name binary text Binary optional 0}}}
float {nullable 1 defaultable 1 autoincr 0 linked 0
par {
{type enum name prec text Precision optional 1
values {4 8}}}}
decimal {nullable 1 defaultable 1 autoincr 0 linked 0
par {
{type range name length text Length optional 0 minval 1}
{type range name prec text Precision optional 0
minval 1}}}
float2 {nullable 1 defaultable 1 autoincr 0 linked 1
par {
{type range name length text Length optional 1 minval 1}
{type range name prec text Precision optional 1
minval 1}}}
real {nullable 1 defaultable 1 autoincr 0 linked 1
par {
{type range name length text Length optional 1 minval 1}
{type range name prec text Precision optional 1
minval 1}}}
double {nullable 1 defaultable 1 autoincr 0 linked 1
par {
{type range name length text Length optional 1 minval 1}
{type range name prec text Precision optional 1
minval 1}}}
tinyint {nullable 1 defaultable 1 autoincr 1 linked 0
par {
{type range name length text Length optional 1
minval 1 maxval 4}
{type option name unsigned text Unsigned optional 0}
{type option name zerofill text Zerofill optional 0}}}
smallint {nullable 1 defaultable 1 autoincr 1 linked 0
par {
{type range name length text Length optional 1
minval 1 maxval 6}
{type option name unsigned text Unsigned optional 0}
{type option name zerofill text Zerofill optional 0}}}
mediumint {nullable 1 defaultable 1 autoincr 1 linked 0
par {
{type range name length text Length optional 1
minval 1 maxval 9}
{type option name unsigned text Unsigned optional 0}
{type option name zerofill text Zerofill optional 0}}}
int {nullable 1 defaultable 1 autoincr 1 linked 0
par {
{type range name length text Length optional 1
minval 1 maxval 11}
{type option name unsigned text Unsigned optional 0}
{type option name zerofill text Zerofill optional 0}}}
integer {nullable 1 defaultable 1 autoincr 1 linked 0
par {
{type range name length text Length optional 1
minval 1 maxval 11}
{type option name unsigned text Unsigned optional 0}
{type option name zerofill text Zerofill optional 0}}}
bigint {nullable 1 defaultable 1 autoincr 1 linked 0
par {
{type range name length text Length optional 1
minval 1 maxval 21}
{type option name unsigned text Unsigned optional 0}
{type option name zerofill text Zerofill optional 0}}}
}
# The following is internal information about types. It is
# (manually) derived from the above and associates types
# with a list of their parameters, if they have any. Types
# without parameters are not part of this map.
#
# Used by -> _parseCol to handle the parameters enclosed in
# parentheses. *ONLY* range and enum parameters are listed.
# Handling of options is done differently. The order of the
# parameters is important
array set slot {
__pn,timestamp {length}
__pn,char {length}
__pn,varchar {length}
__pn,float {prec}
__pn,float2 {length prec}
__pn,real {length prec}
__pn,double {length prec}
__pn,decimal {length prec}
__pn,tinyint {length}
__pn,smallint {length}
__pn,mediumint {length}
__pn,int {length}
__pn,integer {length}
__pn,bigint {length}
}
return
}
method destroy {} {
# @c This method is called by the framework ()
# @c to execute class-specific instance destruction code.
# @c Here we close the connection to the DBMS created during
# @c object construction.
$self dbGenericManager:destroy
sql disconnect $slot(conn)
return
}
#######################################################
# meta information helping in configuration of the user
# interface.
#######################################################
method who {which} {
# @c Returns either the symbolic name of the RDBMS
# @c (which = -name) used as prefix for special types and
# @c commands, or a text usable for display by the UI
# @c layer (which = -text). Other values of 'which' are
# @c not supported.
# -W- who -
# -W- This method should be a generic one, with a
# -W- corresponding method in the setup section.
switch -- $which {
-name {return mysql}
-text {return MySQL}
default {error "unknown option $which"}
}
}
method isCommandAllowed {operation opArgs} {
# @c Similar to 'isCommandAvailable', but its results
# @c depends not only on the availability of the command,
# @c but on the specified entity as well.
#
# @argument operation: The symbolic name of the operation
# @argument operation: to check.
#
# @argument opArgs: A description of the argument which will
# @argument opArgs: be given to the method implementing the
# @argument opArgs: command. The format is described in the
# @argument opArgs: design section.
#
# @result A boolean value. True signals that the command is
# @result allowed to act upon the specified entity.
# The general rule followed here is that all operations are
# allowed, except for entities in the 'myssql' database (and
# of course this database). The tables in there contain the
# privilege information used by the server to determine
# wether a person is allowed to operate on the database or not.
# -W- isCommandAllowed -
# -W- The privilege information is currently *not* used here,
# -W- but it should.
# Another exception: If a table contains only one column this
# column cannot be dropped. Drop the table instead!
set result 1
switch -- $operation {
cmdDbAlter -
cmdDbRename -
cmdDbDrop {
# opArgs = db
# protect system database
set result [string compare $opArgs "mysql"]
}
cmdTableCreate -
cmdTableDrop -
cmdTableRename -
cmdTableAlter -
cmdColumnCreate -
cmdColumnRename -
cmdColumnAlter -
cmdIndexCreate -
cmdIndexDrop -
cmdIndexRename -
cmdIndexAlter {
# opArgs = {db table}
# or opArgs = {db table column|index}
#
# Protect system tables, columns and indices.
set result [string compare [lindex $opArgs 0] "mysql"]
}
cmdColumnDrop {
# opArgs = {db table column}
#
# Protect system columns. Additionally disallow
# the deletion of columns in single-column tables.
if {![string compare [lindex $opArgs 0] "mysql"]} {
# Protect system column
set result 0
} else {
set db [lindex $opArgs 0]
set table [lindex $opArgs 1]
if {[llength \
[$slot(cache) getColumns $db $table]] == 1} {
# The column is alone in its table =>can't delete it,
# the table must be dropped instead
set result 0
}
}
}
default {
# Ignore all unknown operations, allow them all
}
}
return $result
}
#######################################################
# Handle queries for various items:
# databases, tables, columns and indices
#######################################################
method getDatabases {} {
# @c Returns the list of all databases found in the RDBMS
# @c the concrete instance is connected to.
# Check the cache first. If it is empty delegate the task
# to the DBMS and populate the cache afterward.
if {[$slot(cache) getDatabases] == {}} {
$slot(cache) setDatabases \
[lsort [$self _sqlGetRows "show databases"]]
}
return [$slot(cache) getDatabases]
}
method getTables {db} {
# @c Returns the list of all tables found in the RDBMS
# @c the concrete instance is connected to, for a specific
# @c database.
#
# @argument db: The name of the database to look at.
# Check the cache first. If it is empty delegate the task
# to the DBMS and populate the cache afterward.
if {![$slot(cache) hasTables $db]} {
$slot(cache) setTables \
$db [$self _sqlGetRows "show tables from $db"]
}
return [$slot(cache) getTables $db]
}
method getColumns {db_table} {
# @c Returns the list of all columns found in the RDBMS
# @c the concrete instance is connected to, for a specific
# @c combination of database and table.
#
# @argument db_table: A 2-element list containing the names
# @argument db_table: of database and table to look at, in
# @argument db_table: this order.
set db [lindex $db_table 0]
set table [lindex $db_table 1]
# Check the cache first. If it is empty delegate the task
# to the DBMS and populate the cache afterward.
if {![$slot(cache) hasColumns $db $table]} {
$self _getTableDefinition $db $table
}
return [$slot(cache) getColumns $db $table]
}
method getIndices {db_table} {
# @c Returns the list of all indices found in the RDBMS
# @c the concrete instance is connected to, for a specific
# @c combination of database and table.
#
# @argument db_table: A 2-element list containing the names
# @argument db_table: of database and table to look at, in
# @argument db_table: this order.
set db [lindex $db_table 0]
set table [lindex $db_table 1]
# Check the cache first. If it is empty delegate the task
# to the DBMS and populate the cache afterward.
if {![$slot(cache) hasIndices $db $table]} {
$self _getTableDefinition $db $table
}
return [$slot(cache) getIndices $db $table]
}
method getTableDefinition {db_table} {
# @c Returns the definition of the specified table, see the
# @c design section for an explanation about the structure
# @c of the result.
#
# @argument db_table: A 2-element list containing the names
# @argument db_table: of database and table to look at, in
# @argument db_table: this order.
set db [lindex $db_table 0]
set table [lindex $db_table 1]
# Check the cache first. If it is empty delegate the task
# to the DBMS and populate the cache afterward.
if {![$slot(cache) hasTable $db $table]} {
$self _getTableDefinition $db $table
}
# The information about the table is a bit scattered in the
# cache. Collect the data about its columns first, then
# about its indices. These are then put together into the
# final specification.
set cd {}
foreach c [$slot(cache) getColumns $db $table] {
lappend cd $c [$slot(cache) getColumn $db $table $c]
}
set id {}
foreach i [$slot(cache) getIndices $db $table] {
lappend id $i [$slot(cache) getIndex $db $table $i]
}
return [list columns $cd indices $id]
}
method getColumnDefinition {db_table_col} {
# @c Returns the definition of the specified column, see the
# @c design section for an explanation about the structure
# @c of the result.
#
# @argument db_table_col: A 3-element list containing the
# @argument db_table_col: names of database, table and
# @argument db_table_col: column to look at, in this order.
set db [lindex $db_table_col 0]
set table [lindex $db_table_col 1]
set column [lindex $db_table_col 2]
# Check the cache first. If it is empty delegate the task
# to the DBMS and populate the cache afterward.
if {![$slot(cache) hasColumn $db $table $column]} {
$self _getTableDefinition $db $table
}
return [$slot(cache) getColumn $db $table $column]
}
method getIndexDefinition {db_table_idx} {
# @c Returns the definition of the specified index, see the
# @c design section for an explanation about the structure
# @c of the result.
#
# @argument db_table_idx: A 3-element list containing the
# @argument db_table_idx: names of database, table and
# @argument db_table_idx: index to look at, in this order.
set db [lindex $db_table_idx 0]
set table [lindex $db_table_idx 1]
set index [lindex $db_table_idx 2]
# Check the cache first. If it is empty delegate the task
# to the DBMS and populate the cache afterward.
if {![$slot(cache) hasIndex $db $table $index]} {
$self _getTableDefinition $db $table
}
return [$slot(cache) getIndex $db $table $index]
}
method getIndexColumns {db_table_idx} {
# @c A convenience method, returns a list containing the
# @c names of all columns used by the specified index.
#
# @argument db_table_idx: A 3-element list containing the
# @argument db_table_idx: names of database, table and
# @argument db_table_idx: index to look at, in this order.
# spec = {unique columnlist}
return [lindex [$self getIndexDefinition $db_table_idx] 1]
}
method getIndexUniqueness {db_table_idx} {
# @c A convenience method, returns a boolean value
# @c indicating wether the specified index is unique or not.
# @c True signals uniqueness.
#
# @argument db_table_idx: A 3-element list containing the
# @argument db_table_idx: names of database, table and
# @argument db_table_idx: index to look at, in this order.
# spec = {unique columnlist}
return [lindex [$self getIndexDefinition $db_table_idx] 0]
}
#######################################################
# Manipulation of DBMS entities.
# - Databases
#######################################################
method dbCreate {db} {
# @c Creates a new database. Associated command and event
# @c are 'cmdDbCreate' and 'evDbCreate'.
#
# @argument db: The name of the new database.
if {[$slot(cache) hasDatabase $db]} {
error "database $db already in existence"
}
# The task is delegated to the DBMS, the cache updated
# afterward. At last the associated event is posted.
$self _sqlExec "create database $db"
$slot(cache) addDatabase $db
$self notify [list evDbCreate $db]
return
}
method dbDrop {db} {
# @c Destroys the specified database. Associated command
# @c and event are 'cmdDbDrop' and 'evDbDrop'.
#
# @argument db: The name of the database to destroy.
if {![$slot(cache) hasDatabase $db]} {
error "database $db does not exist"
}
# The task is delegated to the DBMS, the cache updated
# afterward. At last the associated event is posted.
$self _sqlExec "drop database $db"
$slot(cache) clearDatabase $db
$self notify [list evDbDrop $db]
return
}
method dbRename {db newName} {
# @c Changes the name of the specified database. Associated
# @c command and event are 'cmdDbRename' and 'evDbRename'.
#
# @argument db: The name of the database to rename.
# @argument newName: The new name of the database.
error "dbRename: impossible operation"
}
#######################################################
# Manipulation of DBMS entities.
# - Tables
#######################################################
method tableCreate {db_table spec} {
# @c Creates a new table. Associated command and event
# @c are 'cmdTableCreate' and 'evTableCreate'.
#
# @argument db_table: A 2-element list containing the name
# @argument db_table: of the database and the name of the
# @argument db_table: new table, in this order.
#
# @argument spec: The specification of the table to create.
# 'tableAlter' requires this functionality too, for
# restauration of the old definition in case of a failure.
# The difference is that *no* events must be posted then.
# Because of this an internal method having an additional
# parameter controlling the posting of events is used.
$self _tableCreate $db_table $spec 1
return
}
method _tableCreate {db_table spec events} {
# @c Creates a new table. Associated command and event
# @c are 'cmdTableCreate' and 'evTableCreate'.
#
# @argument db_table: A 2-element list containing the name
# @argument db_table: of the database and the name of the
# @argument db_table: new table, in this order.
#
# @argument spec: The specification of the table to create.
#
# @argument events: Boolean value, true allows posting of
# @argument events: the associated event.
set db [lindex $db_table 0]
set table [lindex $db_table 1]
if {[$slot(cache) hasTable $db $table]} {
error "table {$db $table} already in existence"
}
# The generic table description is converted into the
# equivalent SQL code, then given to the creation command
# send to the DBMS. The cache is updated afterward, at last
# the associated event is posted, if allowed that is.
#
# Note: MySQL has the concept of a 'current' database. All
# commands without a database name in them implicitly
# operate on this one. Because of this the database we want
# to operate on is set as the current one before actually
# sending the sql command.
set spec [$self _cvtTableSpec $spec]
$self _selectDb $db
$self _sqlExec "create table ${table} ($spec)"
$slot(cache) addTable $db $table
if {$events} {
$self notify [list evTableCreate $db $table]
}
return
}
method tableDrop {db_table} {
# @c Destroys the specified table. Associated command
# @c and event are 'cmdTableDrop' and 'evTableDrop'.
#
# @argument db_table: A 2-element list containing the name
# @argument db_table: of the database and the name of the
# @argument db_table: table to destroy, in this order.
# 'tableAlter' requires this functionality too.
# The difference is that *no* events must be posted then.
# Because of this an internal method having an additional
# parameter controlling the posting of events is used.
$self _tableDrop $db_table 1
return
}
method _tableDrop {db_table events} {
# @c Destroys the specified table. Associated command
# @c and event are 'cmdTableDrop' and 'evTableDrop'.
#
# @argument db_table: A 2-element list containing the name
# @argument db_table: of the database and the name of the
# @argument db_table: table to destroy, in this order.
#
# @argument events: Boolean value, true allows posting of
# @argument events: the associated event.
set db [lindex $db_table 0]
set table [lindex $db_table 1]
if {![$slot(cache) hasTable $db $table]} {
error "table {$db $table} does not exist"
}
# The task is delegated to the DBMS, the cache updated
# afterward. At last the associated event is posted.
# If allowed, that is.
$self _selectDb $db
$self _sqlExec "drop table ${table}"
$slot(cache) clearTable $db $table
if {$events} {
$self notify [list evTableDrop $db $table]
}
return
}
method tableRename {db_table newName} {
# @c Changes the name of the specified table. Associated
# @c command and event are 'cmdTableRename' and
# @c 'evTableRename'.
#
# @argument db_table: A 2-element list containing the name
# @argument db_table: of the database and the name of the
# @argument db_table: table to rename, in this order.
#
# @argument newName: The new name of the table.
# 'tableAlter' requires this functionality too.
# The difference is that *no* events must be posted then.
# Because of this an internal method having an additional
# parameter controlling the posting of events is used.
$self _tableRename $db_table $newName 1
return
}
method _tableRename {db_table newName events} {
# @c Changes the name of the specified table. Associated
# @c command and event are 'cmdTableRename' and
# @c 'evTableRename'.
#
# @argument db_table: A 2-element list containing the name
# @argument db_table: of the database and the name of the
# @argument db_table: table to rename, in this order.
# @argument newName: The new name of the table.
#
# @argument events: Boolean value, true allows posting of
# @argument events: the associated event.
#puts "db_table=<$db_table> newName=<$newName>"
set db [lindex $db_table 0]
set table [lindex $db_table 1]
if {![$slot(cache) hasTable $db $table]} {
error "table {$db $table} does not exist"
}
# The task is delegated to the DBMS, the cache updated
# afterward. At last the associated event is posted.
# If allowed, that is.
set cmd "alter table ${table} rename as ${newName}"
$self _selectDb $db
$self _sqlExec $cmd
$slot(cache) renameTable $db $table $newName
if {$events} {
$self notify [list evTableRename $db $table $newName]
}
return
}
method tableAlter {db_table newName newSpec} {
# @c Changes the definition of the specified table.
# @c Associated command and event are 'cmdTableAlter'
# @c and 'evTableAlter'.
#
# @argument db_table: A 2-element list containing the name
# @argument db_table: of the database and the name of the
# @argument db_table: table to change, in this order.
#
# @argument newName: The new name of the table.
# @argument newSpec: The new specification of the table.
# drop and recreate, don't send out events
# the latter is done here.
set db [lindex $db_table 0]
set table [lindex $db_table 1]
# Changing the specification of a table is not som simple.
#
# First we remember the old specification, to have it handy
# in case of problems. Then we destroy the old table
# (*including its contents*) and generate a new one its place,
# the latter having the new structure. In case of a changed
# name we do a rename afterward. At last we have to update
# the cache and post the associated event.
#
# In case of problems reported by the DBMS we recreate the
# old definition and refill the cache. Only after that we
# are allowed to report the error upward.
set oldSpec [$self getTableDefinition $db_table]
$self _tableDrop $db_table 0
set fail [catch {$self _tableCreate $db_table $newSpec 0} error]
if {$fail} {
# recreate old definition in case of failure. this destroys
# the table contents, but this is no problem, as a sucessful
# alteration would have done so too.
$self _tableCreate $db_table $oldSpec 0
$self _getTableDefinition $db $table
error $error
}
if {"$table" != "$newName"} {
$self _tableRename $db_table $newName 0
}
$self _getTableDefinition $db $newName
$self notify [list evTableAlter $db $table $newName]
return
}
#######################################################
# Manipulation of DBMS entities.
# - Columns
#######################################################
method columnCreate {db_table_col spec} {
# @c Creates a new column. Associated command and event
# @c are 'cmdColumnCreate' and 'evColumnCreate'.
#
# @argument db_table_col: A 3-element list containing the
# @argument db_table_col: name of the database, the table
# @argument db_table_col: and the name of the new column,
# @argument db_table_col: in this order.
#
# @argument spec: The type specification to associate with
# @argument spec: the column.
set db [lindex $db_table_col 0]
set table [lindex $db_table_col 1]
set column [lindex $db_table_col 2]
if {[$slot(cache) hasColumn $db $table $column]} {
error "column {$db $table $column} already in existence"
}
# The generic type specification is converted into the
# equivalent SQL code, then given to the creation command
# send to the DBMS. The cache is updated afterward, at last
# the associated event is posted.
set colSpec [$self convertGenericType2Sql $spec]
set cmd "alter table $table add column $column $colSpec"
$self _selectDb $db
$self _sqlExec $cmd
$slot(cache) addColumn $db $table $column
$slot(cache) setColumn $db $table $column $spec
$self notify [list evColumnCreate $db $table $column]
return
}
method columnDrop {db_table_col} {
# @c Destroys the specified column. Associated command and
# @c event are 'cmdColumnDrop' and 'evColumnDrop'.
#
# @argument db_table_col: A 3-element list containing the
# @argument db_table_col: name of the database, the table
# @argument db_table_col: and the name of the column to
# @argument db_table_col: destroy, in this order.
set db [lindex $db_table_col 0]
set table [lindex $db_table_col 1]
set column [lindex $db_table_col 2]
if {![$slot(cache) hasColumn $db $table $column]} {
error "column {$db $table $column} does not exist"
}
# The task is delegated to the DBMS, afterward we update
# the cache and post the associated event.
#
# The only special thing is the addtional posting of
# 'evColumnDrop' for all indices which had to be dropped
# too, as they lost their one and only remaining column.
# This destruction happened automatically in the database,
# but is detected here during the cache-update. Without
# the cache we would have no way of detecting this
# condition short of rereading the complete table
# specification.
set cmd "alter table ${table} drop column ${column}"
$self _selectDb $db
$self _sqlExec $cmd
set lostIndices [$slot(cache) clearColumn $db $table $column]
$self notify [list evColumnDrop $db $table $column]
foreach index $lostIndices {
$self notify [list evIndexDrop $db $table $index]
}
return
}
method columnRename {db_table_col newName} {
# @c Changes the name of the specified column. Associated
# @c command and event are 'cmdColumnRename'
# @c and 'evColumnRename'.
#
# @argument db_table_col: A 3-element list containing the
# @argument db_table_col: name of the database, the table
# @argument db_table_col: and the name of the column to
# @argument db_table_col: rename, in this order.
#
# @argument newName: The new name of the column.
set db [lindex $db_table_col 0]
set table [lindex $db_table_col 1]
set column [lindex $db_table_col 2]
# Renaming a column was not considered as separate operation,
# only a complete 'alter' is possible. Using the information
# stored in the cache it is possible to regenerate the type
# specification, thereby restricting the 'alter' to the name.
$self _columnAlter evColumnRename $db_table_col $newName \
[$slot(cache) getColumn $db $table $column]
return
}
method columnAlter {db_table_col newName newSpec} {
# @c Changes the definition of the specified column.
# @c Associated command and event are 'cmdColumnAlter'
# @c and 'evColumnAlter'.
#
# @argument db_table_col: A 3-element list containing the
# @argument db_table_col: name of the database, the table
# @argument db_table_col: and the name of the column to
# @argument db_table_col: change, in this order.
#
# @argument newName: The new name of the column.
# @argument newSpec: The new specification of the column.
# The task at hand is delegated to the internal method
# handling this (and 'rename').
$self _columnAlter evColumnAlter $db_table_col $newName $newSpec
return
}
method _columnAlter {event db_table_col newName newSpec} {
# @c Changes the definition of the specified column.
# @c Associated command and event are 'cmdColumnAlter'
# @c and 'evColumnAlter'. Or 'cmdColumnRename' and
# @c and 'evColumnReaname' as this method handles both
# @c situations.
#
# @argument event: The name of the event to post after
# @argument event: completion of the task. Is an
# @argument event: indication of the caller too.
#
# @argument db_table_col: A 3-element list containing the
# @argument db_table_col: name of the database, the table
# @argument db_table_col: and the name of the column to
# @argument db_table_col: change, in this order.
#
# @argument newName: The new name of the column.
# @argument newSpec: The new specification of the column.
set db [lindex $db_table_col 0]
set table [lindex $db_table_col 1]
set column [lindex $db_table_col 2]
if {![$slot(cache) hasColumn $db $table $column]} {
error "column {$db $table $column} does not exist"
}
# The generic type specification is converted into the
# equivalent SQL code, then given to the change command
# send to the DBMS. The cache is updated afterward, at last
# the specified event is posted.
set colSpec [$self convertGenericType2Sql $newSpec]
set cmd \
"alter table ${table} change column $column $newName $colSpec"
$self _selectDb $db
$self _sqlExec $cmd
if {"$column" != "$newName"} {
$slot(cache) renameColumn $db $table $column $newName
}
$slot(cache) setColumn $db $table $newName $newSpec
$self notify [list $event $db $table $column $newName]
return
}
#######################################################
# Manipulation of DBMS entities.
# - Indices
#######################################################
method indexCreate {db table index spec} {
# @c Creates a new index. Associated command and event
# @c are 'cmdIndexCreate' and 'evIndexCreate'.
#
# @argument db_table_idx: A 3-element list containing the
# @argument db_table_idx: name of the database, the table
# @argument db_table_idx: and the name of the new index,
# @argument db_table_idx: in this order.
#
# @argument spec: The specification of the new index.
error "indexCreate: impossible operation"
# -W- indexCreate -
# -W- The statement above might not be true. Adding the
# -W- 'spec' to the cached table specification and the
# -W- executing a 'tableAlter' using that might do the
# -W- trick. But this destroys the table contents,
# -W- something which should not be necessary as the
# -W- primary goal is the *addition* of more information.
# -W- Hm, if I decide to implement the operation in this
# -W- destructive way then I should expand the generic
# -W- interface too, to allow the markup of such dangerous
# -W- operations in the UI. All commands must a have
# -W- command description then, even the standard ones.
}
method indexDrop {db_table_idx} {
# @c Destroys the specified index. Associated command and
# @c event are 'cmdIndexDrop' and 'evIndexDrop'.
#
# @argument db_table_idx: A 3-element list containing the
# @argument db_table_idx: name of the database, the table
# @argument db_table_idx: and the name of the index to
# @argument db_table_idx: destroy, in this order.
set db [lindex $db_table_idx 0]
set table [lindex $db_table_idx 1]
set index [lindex $db_table_idx 2]
# The task at hand is delegated to the DBMS, the cache
# updated afterward, at last we post the associated event.
# Beware, MySQL distinguishes between the index associated
# to the primary key of the table and all else.
if {"$index" == "PRIMARY"} {
set cmd "alter table ${table} drop primary key"
} else {
set cmd "alter table ${table} drop index ${index}"
}
$self _selectDb $db
$self _sqlExec $cmd
$slot(cache) clearIndex $db $table $index
$self notify [list evIndexDrop $db $table $index]
return
}
method indexRename {db_table_idx newName} {
# @c Changes the name of the specified index. Associated
# @c command and event are 'cmdIndexRename'
# @c and 'evIndexRename'.
#
# @argument db_table_idx: A 3-element list containing the
# @argument db_table_idx: name of the database, the table
# @argument db_table_idx: and the name of the index to
# @argument db_table_idx: rename, in this order.
#
# @argument newName: The new name of the index.
error "indexRename: impossible operation"
# -W- indexRename -
# -W- See '-W-' of 'indexCreate'.
}
method indexAlter {db table index newSpec} {
# @c Changes the definition of the specified index.
# @c Associated command and event are 'cmdIndexAlter'
# @c and 'evIndexAlter'.
#
# @argument db_table_idx: A 3-element list containing the
# @argument db_table_idx: name of the database, the table
# @argument db_table_idx: and the name of the index to
# @argument db_table_idx: change, in this order.
#
# @argument newName: The new name of the index.
# @argument newSpec: The new specification of the index.
error "indexAlter: impossible operation"
# -W- indexAlter -
# -W- See '-W-' of 'indexCreate'.
}
#######################################################
# internal helper procedures
method _getTableDefinition {db table} {
# @c This method is called by various query methods in the
# @c provided interface to get at the specification of the
# @c given table. All results are stored in the cache.
#
# @argument db: The name of the database to look ak.
# @argument table: The name of the table whose specification
# @argument table: is asked for.
# One, ask the database for information about the columns
# the table is made of. This information is then split into
# its pieces and converted into the generic representation.
# The main work of this is done in '_parseCol'. Its results
# are immediately added to the cache. The column names are
# collected in a list which is placed in the cache after the
# loop.
set columns {}
foreach column \
[$self _sqlGetRows "show columns from $table from $db"] {
# MySQL returns six fields per row.
#
# These are: column name, type, nullable, key info,
# default, xtra
#
# The 'key' information is ignored here, we use the
# 'show keys' command later to get a more detailed
# description of this aspect.
set name [lindex $column 0]
set type [lindex $column 1]
set null [lindex $column 2]
# 'key' at position 3 is ignored
set def [lindex $column 4]
set xtra [lindex $column 5]
lappend columns $name
$slot(cache) setColumn $db $table $name \
[$self _parseCol $type $null $def $xtra]
}
$slot(cache) setColumns $db $table $columns
# Two, ask the database for information about the columns
# the table is made of. We will get a row for each column of
# each index associated to the table. Because of this an
# array is used to collect the column list of all indices
# during the loop. A second loop then adds this information
# to the information entered during the first loop.
#
# Note: The order of the rows for one index is important, it
# is the order of usage for the columns in the index.
set indices {}
array_def icol
foreach index \
[$self _sqlGetRows "show keys from $table from $db"] {
# MySQL returns 8 fields per row:
#
# These are: table, not!unique, name, seq, colName,
# collate, card, subpart
set table [lindex $index 0]
set uniq [expr {![lindex $index 1]}]
set name [lindex $index 2]
set seq [lindex $index 3]
set colN [lindex $index 4]
set coll [lindex $index 5]
set card [lindex $index 6]
set subp [lindex $index 7]
# Note: Indices having more than one column are entered
# multiple times! (*) This is no problem for 'setIndex',
# but the list of names must be corrected later.
lappend indices $name
$slot(cache) setIndex $db $table $name [list $uniq {}]
# Here we remember the columns, they are added later.
lappend icol($name) $colN
}
# See (*) above, weed out the duplicates, ...
set indices [luniq [lsort $indices]]
$slot(cache) setIndices $db $table $indices
# ... and add the column lists to the indices in the cache.
foreach index $indices {
set iDef [$slot(cache) getIndex $db $table $index]
lexchange iDef 1 $icol($index)
$slot(cache) setIndex $db $table $index $iDef
}
unset icol
return
}
method _cvtTypeDependentData {type pArray} {
# @c This method converts a type and its specific parameters
# #c into the equivalent SQL representation.
#
# @argument type: The name of the type to convert.
# @argument pArray: The name of an array holding the
# @argument pArray: parameter information of the type
# @argument pArray: specification.
upvar $pArray par
# The conversion process is simple. We just use the typename
# to dispatch the correct set of actions.
switch -- $type {
blob -
tinyblob -
longblob -
mediumblob -
date -
time -
datetime {
# Unparameterized types, just return the name.
return $type
}
timestamp {
# A single required parameter
return "${type}($par(length))"
}
char -
varchar {
# Two parameters: 'length', 'binary'.
# The 2nd is a boolean option.
if {$par(binary)} {
return "${type}($par(length)) binary"
} else {
return "${type}($par(length))"
}
}
float {
# A single optional parameter.
if {$par(prec) == {}} {
return $type
} else {
return "${type}($par(prec))"
}
}
float2 -
real -
double {
if {"$type" == "float2"} {
# 'float2' is essentially 'float', but with a
# different set of parameters! This was handled
# here by splitting the definition into two
# separate types. If such constructions are
# common I might need to think about a type
# description format with the ability to handle
# more than one parameter set.
set type float
}
# The length and precision parameters are optional,
# but linked. That is, either both of them are
# missing or none. The UI knows this too.
set len $par(length)
set prec $par(prec)
if {($len == {}) || ($prec == {})} {
return $type
} else {
return "${type}($len,$prec)"
}
}
decimal {
# The same set of parameters as for 'double' and
# consorts, but here are they required.
set len $par(length)
set prec $par(prec)
return "${type}($len,$prec)"
}
tinyint -
smallint -
mediumint -
int -
integer -
bigint {
# 3 parameters, an optional length and 2 boolean options.
set length $par(length)
set unsigned $par(unsigned)
set zerofill $par(zerofill)
if {$length != {}} {append type "($length)"}
if {$unsigned} {append type " unsigned"}
if {$zerofill} {append type " zerofill"}
return $type
}
mysql-enum -
mysql-set {
# The special types. Stripping the database prefix
# reveals their true names. Their parameter is a
# list of strings, added in parentheses to the
# base type. The loop has no need to handle the last
# element in the list differently than the others,
# the superfluous comma is just trimmed off afterward.
regsub -- {^mysql-} $type {} type
append type "("
foreach v $par(values) {
append type "\"$v\","
}
set type [string trimright $type ,]
append type ")"
return $type
}
}
}
method convertGenericType2Sql {spec} {
# @c This method converts a generic type specification into
# @c the coressponding SQL syntax used by the RDBMS. It is
# @c exported for usage by the table editor
# @c () as its output is more readble
# @c than the generic representation.
# The first element of the 'spec' is the name of the type.
# This is followed by its specification in 'array set'
# format.
set type [lshift spec]
array set par $spec
# From now on 'spec' is used to hold the SQL representation
# of the specified type. The first part comes from the
# conversion of the type-specific parameters.
set spec [$self _cvtTypeDependentData $type par]
# After that we place the information gathered from the
# standard options (null, default and autoincr).
if {!$par(null)} {
append spec " not null"
}
if {$par(default) != {}} {
# Force handling of default value as string for some types.
if {[regexp -- \
{^(mysql-enum|mysql-set|char|varchar)} $type]} {
set par(default) "\"$par(default)\""
}
append spec " default $par(default)"
}
if {$par(autoincr)} {
append spec " auto_increment"
}
return $spec
}
method _cvtTableSpec {tableSpec} {
# @c This method converts a table specification into the
# @c equivalent SQL representation.
#
# @argument tableSpec: The specification of a table
# @argument tableSpec: (without name), in the format as
# @argument tableSpec: described in the design section.
# tableSpec = {columns {..} indices {..}}
# ^^ == columnName columnType
# indexName {unique colName..} == ^^
# First, parse the specification into its parts, place the
# result into an array. Then convert the column
# specifications and add them to the sql string. At last
# loop over the index specifications and convert them too.
# Superfluous commata at the end are removed.
array set tSpec $tableSpec
set sql ""
foreach {col type} $tSpec(columns) {
append sql "$col [$self convertGenericType2Sql $type],"
}
foreach {idx idxDef} $tSpec(indices) {
# idxDef = {unique {column...}}
set unique [lindex $idxDef 0]
set columns [lindex $idxDef 1]
set idxCmd [expr {$unique ? "unique": "index"}]
append sql "$idxCmd $idx ([join $columns ,]),"
}
return [string trimright $sql ,]
}
method _parseCol {type null def xtra} {
# @c The main method to convert the information given by
# @c 'show columns' into the generic type specification.
#
# @argument type: The base type and its parameters.
# @argument null: empty or 'YES'. The latter signals a
# @argument null: nullable column.
# @argument def: empty or the default value
# @argument xtra: empty or 'auto_increment'
# General syntax of 'type':
# [ '(' ,... ')' ] ['unsigned'] ['zerofill']
# [ '(' ,... ')' ] ['binary']
#
# For types 'enum' and 'set' the parenthesised list of
# values does not contain parameters but is a single
# parameter, the list of allowed strings.
# tSpec is the array we are building the specification in.
# 1. Standard configuration options:
# default value, (not) null, auto_increment
array set tSpec {null 0 autoincr 0 default {}}
if {"$null" == "YES"} {set tSpec(null) 1}
if {"$xtra" == "auto_increment"} {set tSpec(autoincr) 1}
if {$def != {}} {set tSpec(default) $def}
# Now we take a look at the boolean options behind base
# name and possible parenthises. We have to differentiate
# between 'int' and 'char' types, 'string match' is used
# to get a that information (we have not extracted the base
# name yet).
set type [split $type]
# Initialize the options associated to the type.
if {[string match *int* [lindex $type 0]]} {
array set tSpec {unsigned 0 zerofill 0}
} elseif {[string match *char* [lindex $type 0]]} {
array set tSpec {binary 0}
}
if {[llength $type] > 1} {
# We have options! Remember the information before
# them, then set their corresponding array entries.
set baseType [lshift type]
foreach option $type {
set tSpec($option) 1
}
set type $baseType
unset baseType
}
# At last we handle the 2nd set of parameters stored as part
# of the type (immediately behind the basename, in the
# parentheses). In the special case of 'enum' and 'set' the
# list is a single parameter. These types must be sent out
# with the database name as prefix too.
if {[regexp -- {^(enum|set)} $type]} {
# The next two commands change the string into a comma
# separated list, with the type name as its first
# element
regsub -- {\(} $type {,} type
regsub -- {\)} $type {} type
set type [split $type ,]
set typeName [lshift type]
# Remember the values found, but without the
# surrounding ' or " ->" fake out tcl mode in emacs
set tSpec(values) {}
foreach v $type {
lappend tSpec(values) [string trim $v {'"}] ;#"
}
set type mysql-$typeName
unset typeName
} elseif {[regexp -- {\(} $type]} {
# The next two commands change the string into a comma
# separated list, with the type name as its first
# element
regsub -- {\(} $type {,} type
regsub -- {\)} $type {} type
set type [split $type ,]
set typeName [lshift type]
# 'float' has two different parameter sets. They are
# realized as 2 separate types. The variant having 2
# parameters is shown as 'float2' in the UI.
if {("$typeName" == "float") && ([llength $type] > 1)} {
set typeName float2
}
# The mapping from types to their list of range/enum-
# parameters (__pn,*, see 'init') is used here to
# associate parameter position and parameter name.
foreach pv $type pn $slot(__pn,$typeName) {
set tSpec($pn) $pv
}
set type $typeName
unset typeName
}
# Finishing touches: Convert the array into a list and place
# the typename before all else.
set result [array get tSpec]
lunshift result $type
return $result
}
#######################################################
# Handling of special types (enum, set)
#
#######################################################
method specialType {what parentWin typeName args} {
# @c This method is called by the type editor to manage the
# @c UI of special types.
#
# @argument what: The operation to execute. Must be one
# @argument what: of 'createPane', 'getDef', 'setDef'
# @argument what: and 'setState'.
# @argument parentWin: The widget to place the generated UI
# @argument parentWin: into.
# @argument typeName: The name of the special type to handle.
# @argument args: Other arguments, special to chosen
# @argument args: subcommand. Described in the design
# @argument args: section.
# Dispatch to an internal method according to the chosen
# subcommand.
return [eval $self _st_$what $parentWin $typeName $args]
}
method _st_createPane {parentWin typeName} {
# @c Internal method to create the parameter specification
# @c panel for special types. These are 'enum' and 'set'.
# @c Both use the same type of panel for their specification.
#
# @argument parentWin: The widget to place the generated UI into.
# @argument typeName: The name of the special type to handle.
set w $parentWin
# The structure created here is very simple:
#
# A listbox (with scrollbar) on the left, an entry field on
# the right, two buttons for shifting values between the two
# in the middle.
#
# The listbox contains all enum/set values already specified.
# The entry field allows entering new values.
# The buttons move values between the 2 areas.
listbox $w.lb -selectmode single -height 10
scrollbar $w.sb
multi_scroll $w.sb y $w.lb
frame $w.bt
button $w.add -text < -command [list $self _st_add $w]
button $w.sub -text > -command [list $self _st_sub $w]
entry $w.string -width 20 -relief sunken -bd 2
pack $w.string -side top -fill both -expand 1
pack $w.sb -side left -fill both -expand 0
pack $w.lb -side left -fill both -expand 1
pack $w.bt -side left -fill both -expand 0 \
-ipadx 1m -ipady 1m
pack $w.add -side top -fill both -expand 0 -in $w.bt
pack $w.sub -side top -fill both -expand 0 -in $w.bt
return
}
method _st_setState {parentWin typeName state} {
# @c Internal method to set the state of the parameter
# @c specification panel for special types.
#
# @argument parentWin: The widget containing the panel.
# @argument typeName: The name of the special type to handle.
# @argument state: The state to set, either 'normal' or
# @argument state: 'disabled'.
set w $parentWin
$w.add configure -state $state
$w.sub configure -state $state
$w.string configure -state $state
# $w.lb, $w.sb were not forgotten. They don't understand
# state. And should not be switched off too.
return
}
method _st_getDef {parentWin typeName} {
# @c Internal method. Returns the specified values for
# @c inclusion into the full type specification.
#
# @argument parentWin: The widget containing the panel.
# @argument typeName: The name of the special type to handle.
return [list values [$parentWin.lb get 0 end]]
}
method _st_setDef {parentWin typeName tSpec} {
# @c Internal method. Extracts the relevant values from the
# @c given type specification and puts them into the panel.
#
# @argument parentWin: The widget containing the panel.
# @argument typeName: The name of the special type to handle.
# @argument tSpec: Name of the array variable containing
# @argument tSpec: the type specification.
# Beware: 'upvar 2' is required to skip over stackframe of
# 'specialType'.
upvar 2 $tSpec t
set w $parentWin
$w.lb delete 0 end
eval $w.lb insert end $t(values)
return
}
method _st_add {w} {
# @c Internal method, not used 'specialType'. The callback
# @c of the '<'-button in the created panels. Transfers the
# @c value in the entry to the listbox.
#
# @argument w: The widget containing the panel.
# Get the entry value and append it to the listbox. But only
# if it is not already part of the list.
set new [$w.string get]
if {[lsearch [$w.lb get 0 end] $new] < 0} {
$w.lb insert end $new
$w.string selection clear
$w.string selection range 0 end
}
return
}
method _st_sub {w} {
# @c Internal method, not used 'specialType'. The callback
# @c of the '<'-button in the created panels. Transfers the
# @c selected value in the listbox to the entry.
#
# @argument w: The widget containing the panel.
# Nothing is done if no selection was made.
set sel [$w.lb curselection]
if {$sel == {}} {
return
}
# The selected value is retrieved, removed from the listbox
# and then inserted into the entry field.
set text [$w.lb get $sel]
$w.lb delete $sel
$w.string delete 0 end
$w.string insert 0 $text
return
}
#######################################################
# Wrappers around code actually executing sql commands,
# to do logs, notifications, and the like.
member lastDatabase ""
method _selectDb {db} {
# @c Internal method. Used by all methods operating on the
# @c RDBMS to announce the database they will be working
# @c with.
#
# @argument db: The name of the database to work with.
# Note: MySQL has the concept of a 'current' database. All
# commands without a database name in them implicitly
# operate on this one. Because of this the database we want
# to operate on is set as the current one before actually
# sending the sql command.
# Nothing is done if the database dis not change.
if {"$db" == "$slot(lastDatabase)"} {
return
}
# The task is delegated to the RDBMS. In case of success the
# new name is recorded for further invocations and the
# associated event posted.
#
# Here we have to use some special commands of the DBMS
# accessor library, not SQL.
syslog info sql selectdb $slot(conn) $db
sql selectdb $slot(conn) $db
set slot(lastDatabase) $db
$self notify [list evSqlSelectedDb $db]
return
}
method _sqlExec {script} {
# @c Internal method. Wrapped around the execution of
# @c arbitrary sql commands, logs them, and posts the
# @c associated event.
#
# @argument script: The sql command to execute.
syslog info sql exec $slot(conn) $script
sql exec $slot(conn) $script
$self notify [list evSqlExecuted $script]
return
}
method _sqlGetRows {query} {
# @c Internal method. Wrapped around all sql command
# @c returning a set of rows. Logs the command, posts the
# @c associated event, and most of all, retrieves the
# @c result set of the command.
#
# @argument query: The sql command to execute, must be
# @argument query: a query.
#
# @result A list containing all rows returned by the quer
