tcl8.6-tdbc-odbc 1.0.4-2+deb9u1 / usr / lib / tcltk / tdbcodbc1.0.4 / tdbcodbc.tcl

# 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.

}