123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515 |
- # tdbcodbc.tcl --
- #
- # Class definitions and Tcl-level methods for the tdbc::odbc bridge.
- #
- # Copyright (c) 2008 by Kevin B. Kenny
- # See the file "license.terms" for information on usage and redistribution
- # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- #
- # RCS: @(#) $Id: tdbcodbc.tcl,v 1.47 2008/02/27 02:08:27 kennykb Exp $
- #
- #------------------------------------------------------------------------------
- package require tdbc
- ::namespace eval ::tdbc::odbc {
- namespace export connection datasources drivers
- # Data types that are predefined in ODBC
- variable sqltypes [dict create \
- 1 char \
- 2 numeric \
- 3 decimal \
- 4 integer \
- 5 smallint \
- 6 float \
- 7 real \
- 8 double \
- 9 datetime \
- 12 varchar \
- 91 date \
- 92 time \
- 93 timestamp \
- -1 longvarchar \
- -2 binary \
- -3 varbinary \
- -4 longvarbinary \
- -5 bigint \
- -6 tinyint \
- -7 bit \
- -8 wchar \
- -9 wvarchar \
- -10 wlongvarchar \
- -11 guid]
- }
- #------------------------------------------------------------------------------
- #
- # tdbc::odbc::connection --
- #
- # Class representing a connection to a database through ODBC.
- #
- #-------------------------------------------------------------------------------
- ::oo::class create ::tdbc::odbc::connection {
- superclass ::tdbc::connection
- variable statementSeq typemap
- # The constructor is written in C. It takes the connection string
- # as its argument It sets up a namespace to hold the statements
- # associated with the connection, and then delegates to the 'init'
- # method (written in C) to do the actual work of attaching to the
- # database. When that comes back, it sets up a statement to query
- # the support types, makes a dictionary to enumerate them, and
- # calls back to set a flag if WVARCHAR is seen (If WVARCHAR is
- # seen, the database supports Unicode.)
- # The 'statementCreate' method forwards to the constructor of the
- # statement class
- forward statementCreate ::tdbc::odbc::statement create
- # The 'tables' method returns a dictionary describing the tables
- # in the database
- method tables {{pattern %}} {
- set stmt [::tdbc::odbc::tablesStatement create \
- Stmt::[incr statementSeq] [self] $pattern]
- set status [catch {
- set retval {}
- $stmt foreach -as dicts row {
- if {[dict exists $row TABLE_NAME]} {
- dict set retval [dict get $row TABLE_NAME] $row
- }
- }
- set retval
- } result options]
- catch {rename $stmt {}}
- return -level 0 -options $options $result
- }
- # The 'columns' method returns a dictionary describing the tables
- # in the database
- method columns {table {pattern %}} {
- # Make sure that the type map is initialized
- my typemap
- # Query the columns from the database
- set stmt [::tdbc::odbc::columnsStatement create \
- Stmt::[incr statementSeq] [self] $table $pattern]
- set status [catch {
- set retval {}
- $stmt foreach -as dicts origrow {
- # Map the type, precision, scale and nullable indicators
- # to tdbc's notation
- set row {}
- dict for {key value} $origrow {
- dict set row [string tolower $key] $value
- }
- if {[dict exists $row column_name]} {
- if {[dict exists $typemap \
- [dict get $row data_type]]} {
- dict set row type \
- [dict get $typemap \
- [dict get $row data_type]]
- } else {
- dict set row type [dict get $row type_name]
- }
- if {[dict exists $row column_size]} {
- dict set row precision \
- [dict get $row column_size]
- }
- if {[dict exists $row decimal_digits]} {
- dict set row scale \
- [dict get $row decimal_digits]
- }
- if {![dict exists $row nullable]} {
- dict set row nullable \
- [expr {!![string trim [dict get $row is_nullable]]}]
- }
- dict set retval [dict get $row column_name] $row
- }
- }
- set retval
- } result options]
- catch {rename $stmt {}}
- return -level 0 -options $options $result
- }
- # The 'primarykeys' method returns a dictionary describing the primary
- # keys of a table
- method primarykeys {tableName} {
- set stmt [::tdbc::odbc::primarykeysStatement create \
- Stmt::[incr statementSeq] [self] $tableName]
- set status [catch {
- set retval {}
- $stmt foreach -as dicts row {
- foreach {odbcKey tdbcKey} {
- TABLE_CAT tableCatalog
- TABLE_SCHEM tableSchema
- TABLE_NAME tableName
- COLUMN_NAME columnName
- KEY_SEQ ordinalPosition
- PK_NAME constraintName
- } {
- if {[dict exists $row $odbcKey]} {
- dict set row $tdbcKey [dict get $row $odbcKey]
- dict unset row $odbcKey
- }
- }
- lappend retval $row
- }
- set retval
- } result options]
- catch {rename $stmt {}}
- return -level 0 -options $options $result
- }
- # The 'foreignkeys' method returns a dictionary describing the foreign
- # keys of a table
- method foreignkeys {args} {
- set stmt [::tdbc::odbc::foreignkeysStatement create \
- Stmt::[incr statementSeq] [self] {*}$args]
- set status [catch {
- set fkseq 0
- set retval {}
- $stmt foreach -as dicts row {
- foreach {odbcKey tdbcKey} {
- PKTABLE_CAT primaryCatalog
- PKTABLE_SCHEM primarySchema
- PKTABLE_NAME primaryTable
- PKCOLUMN_NAME primaryColumn
- FKTABLE_CAT foreignCatalog
- FKTABLE_SCHEM foreignSchema
- FKTABLE_NAME foreignTable
- FKCOLUMN_NAME foreignColumn
- UPDATE_RULE updateRule
- DELETE_RULE deleteRule
- DEFERRABILITY deferrable
- KEY_SEQ ordinalPosition
- FK_NAME foreignConstraintName
- } {
- if {[dict exists $row $odbcKey]} {
- dict set row $tdbcKey [dict get $row $odbcKey]
- dict unset row $odbcKey
- }
- }
- # Horrible kludge: If the driver doesn't report FK_NAME,
- # make one up.
- if {![dict exists $row foreignConstraintName]} {
- if {![dict exists $row ordinalPosition]
- || [dict get $row ordinalPosition] == 1} {
- set fkname ?[dict get $row foreignTable]?[incr fkseq]
- }
- dict set row foreignConstraintName $fkname
- }
- lappend retval $row
- }
- set retval
- } result options]
- catch {rename $stmt {}}
- return -level 0 -options $options $result
- }
- # The 'prepareCall' method gives a portable interface to prepare
- # calls to stored procedures. It delegates to 'prepare' to do the
- # actual work.
- method preparecall {call} {
- regexp {^[[:space:]]*(?:([A-Za-z_][A-Za-z_0-9]*)[[:space:]]*=)?(.*)} \
- $call -> varName rest
- if {$varName eq {}} {
- my prepare \\{CALL $rest\\}
- } else {
- my prepare \\{:$varName=CALL $rest\\}
- }
- if 0 {
- # Kevin thinks this is going to be
- if {![regexp -expanded {
- ^\s* # leading whitespace
- (?::([[:alpha:]_][[:alnum:]_]*)\s*=\s*) # possible variable name
- (?:(?:([[:alpha:]_][[:alnum:]_]*)\s*[.]\s*)? # catalog
- ([[:alpha:]_][[:alnum:]_]*)\s*[.]\s*)? # schema
- ([[:alpha:]_][[:alnum:]_]*)\s* # procedure
- (.*)$ # argument list
- } $call -> varName catalog schema procedure arglist]} {
- return -code error \
- -errorCode [list TDBC \
- SYNTAX_ERROR_OR_ACCESS_RULE_VIOLATION \
- 42000 ODBC -1] \
- "Syntax error in stored procedure call"
- } else {
- my PrepareCall $varName $catalog $schema $procedure $arglist
- }
- # at least if making all parameters 'inout' doesn't work.
- }
- }
- # The 'typemap' method returns the type map
- method typemap {} {
- if {![info exists typemap]} {
- set typemap $::tdbc::odbc::sqltypes
- set typesStmt [tdbc::odbc::typesStatement new [self]]
- $typesStmt foreach row {
- set typeNum [dict get $row DATA_TYPE]
- if {![dict exists $typemap $typeNum]} {
- dict set typemap $typeNum [string tolower \
- [dict get $row TYPE_NAME]]
- }
- switch -exact -- $typeNum {
- -9 {
- [self] HasWvarchar 1
- }
- -5 {
- [self] HasBigint 1
- }
- }
- }
- rename $typesStmt {}
- }
- return $typemap
- }
- # The 'begintransaction', 'commit' and 'rollback' methods are
- # implemented in C.
- }
- #-------------------------------------------------------------------------------
- #
- # tdbc::odbc::statement --
- #
- # The class 'tdbc::odbc::statement' models one statement against a
- # database accessed through an ODBC connection
- #
- #-------------------------------------------------------------------------------
- ::oo::class create ::tdbc::odbc::statement {
- superclass ::tdbc::statement
- # The constructor is implemented in C. It accepts the handle to
- # the connection and the SQL code for the statement to prepare.
- # It creates a subordinate namespace to hold the statement's
- # active result sets, and then delegates to the 'init' method,
- # written in C, to do the actual work of preparing the statement.
- # The 'resultSetCreate' method forwards to the result set constructor
- forward resultSetCreate ::tdbc::odbc::resultset create
- # The 'params' method describes the parameters to the statement
- method params {} {
- set typemap [[my connection] typemap]
- set result {}
- foreach {name flags typeNum precision scale nullable} [my ParamList] {
- set lst [dict create \
- name $name \
- direction [lindex {unknown in out inout} \
- [expr {($flags & 0x06) >> 1}]] \
- type [dict get $typemap $typeNum] \
- precision $precision \
- scale $scale]
- if {$nullable in {0 1}} {
- dict set list nullable $nullable
- }
- dict set result $name $lst
- }
- return $result
- }
- # Methods implemented in C:
- # init statement ?dictionary?
- # Does the heavy lifting for the constructor
- # connection
- # Returns the connection handle to which this statement belongs
- # paramtype paramname ?direction? type ?precision ?scale??
- # Declares the type of a parameter in the statement
- }
- #------------------------------------------------------------------------------
- #
- # tdbc::odbc::tablesStatement --
- #
- # The class 'tdbc::odbc::tablesStatement' represents the special
- # statement that queries the tables in a database through an ODBC
- # connection.
- #
- #------------------------------------------------------------------------------
- oo::class create ::tdbc::odbc::tablesStatement {
- superclass ::tdbc::statement
- # The constructor is written in C. It accepts the handle to the
- # connection and a pattern to match table names. It works in all
- # ways like the constructor of the 'statement' class except that
- # its 'init' method sets up to enumerate tables and not run a SQL
- # query.
- # The 'resultSetCreate' method forwards to the result set constructor
- forward resultSetCreate ::tdbc::odbc::resultset create
- }
- #------------------------------------------------------------------------------
- #
- # tdbc::odbc::columnsStatement --
- #
- # The class 'tdbc::odbc::tablesStatement' represents the special
- # statement that queries the columns of a table or view
- # in a database through an ODBC connection.
- #
- #------------------------------------------------------------------------------
- oo::class create ::tdbc::odbc::columnsStatement {
- superclass ::tdbc::statement
- # The constructor is written in C. It accepts the handle to the
- # connection, a table name, and a pattern to match column
- # names. It works in all ways like the constructor of the
- # 'statement' class except that its 'init' method sets up to
- # enumerate tables and not run a SQL query.
- # The 'resultSetCreate' class forwards to the constructor of the
- # result set
- forward resultSetCreate ::tdbc::odbc::resultset create
- }
- #------------------------------------------------------------------------------
- #
- # tdbc::odbc::primarykeysStatement --
- #
- # The class 'tdbc::odbc::primarykeysStatement' represents the special
- # statement that queries the primary keys on a table through an ODBC
- # connection.
- #
- #------------------------------------------------------------------------------
- oo::class create ::tdbc::odbc::primarykeysStatement {
- superclass ::tdbc::statement
- # The constructor is written in C. It accepts the handle to the
- # connection and a table name. It works in all
- # ways like the constructor of the 'statement' class except that
- # its 'init' method sets up to enumerate primary keys and not run a SQL
- # query.
- # The 'resultSetCreate' method forwards to the result set constructor
- forward resultSetCreate ::tdbc::odbc::resultset create
- }
- #------------------------------------------------------------------------------
- #
- # tdbc::odbc::foreignkeysStatement --
- #
- # The class 'tdbc::odbc::foreignkeysStatement' represents the special
- # statement that queries the foreign keys on a table through an ODBC
- # connection.
- #
- #------------------------------------------------------------------------------
- oo::class create ::tdbc::odbc::foreignkeysStatement {
- superclass ::tdbc::statement
- # The constructor is written in C. It accepts the handle to the
- # connection and the -primary and -foreign options. It works in all
- # ways like the constructor of the 'statement' class except that
- # its 'init' method sets up to enumerate foreign keys and not run a SQL
- # query.
- # The 'resultSetCreate' method forwards to the result set constructor
- forward resultSetCreate ::tdbc::odbc::resultset create
- }
- #------------------------------------------------------------------------------
- #
- # tdbc::odbc::typesStatement --
- #
- # The class 'tdbc::odbc::typesStatement' represents the special
- # statement that queries the types available in a database through
- # an ODBC connection.
- #
- #------------------------------------------------------------------------------
- oo::class create ::tdbc::odbc::typesStatement {
- superclass ::tdbc::statement
- # The constructor is written in C. It accepts the handle to the
- # connection, and (optionally) a data type number. It works in all
- # ways like the constructor of the 'statement' class except that
- # its 'init' method sets up to enumerate types and not run a SQL
- # query.
- # The 'resultSetCreate' method forwards to the constructor of result sets
- forward resultSetCreate ::tdbc::odbc::resultset create
- # The C code contains a variant implementation of the 'init' method.
- }
- #------------------------------------------------------------------------------
- #
- # tdbc::odbc::resultset --
- #
- # The class 'tdbc::odbc::resultset' models the result set that is
- # produced by executing a statement against an ODBC database.
- #
- #------------------------------------------------------------------------------
- ::oo::class create ::tdbc::odbc::resultset {
- superclass ::tdbc::resultset
- # Methods implemented in C include:
- # constructor statement ?dictionary?
- # -- Executes the statement against the database, optionally providing
- # a dictionary of substituted parameters (default is to get params
- # from variables in the caller's scope).
- # columns
- # -- Returns a list of the names of the columns in the result.
- # nextdict
- # -- Stores the next row of the result set in the given variable in
- # the caller's scope as a dictionary whose keys are
- # column names and whose values are column values.
- # nextlist
- # -- Stores the next row of the result set in the given variable in
- # the caller's scope as a list of cells.
- # rowcount
- # -- Returns a count of rows affected by the statement, or -1
- # if the count of rows has not been determined.
- }
|