"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tltcl/lib/tdbcodbc1.1.1/tdbcodbc.tcl" (17 Mar 2020, 15620 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 # tdbcodbc.tcl --
    2 #
    3 #   Class definitions and Tcl-level methods for the tdbc::odbc bridge.
    4 #
    5 # Copyright (c) 2008 by Kevin B. Kenny
    6 # See the file "license.terms" for information on usage and redistribution
    7 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    8 #
    9 # RCS: @(#) $Id: tdbcodbc.tcl,v 1.47 2008/02/27 02:08:27 kennykb Exp $
   10 #
   11 #------------------------------------------------------------------------------
   12 
   13 package require tdbc
   14 
   15 ::namespace eval ::tdbc::odbc {
   16 
   17     namespace export connection datasources drivers
   18 
   19     # Data types that are predefined in ODBC
   20 
   21     variable sqltypes [dict create \
   22                1 char \
   23                2 numeric \
   24                3 decimal \
   25                4 integer \
   26                5 smallint \
   27                6 float \
   28                7 real \
   29                8 double \
   30                9 datetime \
   31                12 varchar \
   32                91 date \
   33                92 time \
   34                93 timestamp \
   35                -1 longvarchar \
   36                -2 binary \
   37                -3 varbinary \
   38                -4 longvarbinary \
   39                -5 bigint \
   40                -6 tinyint \
   41                -7 bit \
   42                -8 wchar \
   43                -9 wvarchar \
   44                -10 wlongvarchar \
   45                -11 guid]
   46 }
   47 
   48 #------------------------------------------------------------------------------
   49 #
   50 # tdbc::odbc::connection --
   51 #
   52 #   Class representing a connection to a database through ODBC.
   53 #
   54 #-------------------------------------------------------------------------------
   55 
   56 ::oo::class create ::tdbc::odbc::connection {
   57 
   58     superclass ::tdbc::connection
   59 
   60     variable statementSeq typemap
   61 
   62     # The constructor is written in C. It takes the connection string
   63     # as its argument It sets up a namespace to hold the statements
   64     # associated with the connection, and then delegates to the 'init'
   65     # method (written in C) to do the actual work of attaching to the
   66     # database. When that comes back, it sets up a statement to query
   67     # the support types, makes a dictionary to enumerate them, and
   68     # calls back to set a flag if WVARCHAR is seen (If WVARCHAR is
   69     # seen, the database supports Unicode.)
   70 
   71     # The 'statementCreate' method forwards to the constructor of the
   72     # statement class
   73 
   74     forward statementCreate ::tdbc::odbc::statement create
   75 
   76     # The 'tables' method returns a dictionary describing the tables
   77     # in the database
   78 
   79     method tables {{pattern %}} {
   80     set stmt [::tdbc::odbc::tablesStatement create \
   81               Stmt::[incr statementSeq] [self] $pattern]
   82         set status [catch {
   83         set retval {}
   84         $stmt foreach -as dicts row {
   85         if {[dict exists $row TABLE_NAME]} {
   86             dict set retval [dict get $row TABLE_NAME] $row
   87         }
   88         }
   89         set retval
   90     } result options]
   91     catch {rename $stmt {}}
   92     return -level 0 -options $options $result
   93     }
   94 
   95     # The 'columns' method returns a dictionary describing the tables
   96     # in the database
   97 
   98     method columns {table {pattern %}} {
   99     # Make sure that the type map is initialized
  100     my typemap
  101 
  102     # Query the columns from the database
  103 
  104     set stmt [::tdbc::odbc::columnsStatement create \
  105               Stmt::[incr statementSeq] [self] $table $pattern]
  106     set status [catch {
  107         set retval {}
  108         $stmt foreach -as dicts origrow {
  109 
  110         # Map the type, precision, scale and nullable indicators
  111         # to tdbc's notation
  112 
  113         set row {}
  114         dict for {key value} $origrow {
  115             dict set row [string tolower $key] $value
  116         }
  117         if {[dict exists $row column_name]} {
  118             if {[dict exists $typemap \
  119                  [dict get $row data_type]]} {
  120             dict set row type \
  121                 [dict get $typemap \
  122                  [dict get $row data_type]]
  123             } else {
  124             dict set row type [dict get $row type_name]
  125             }
  126             if {[dict exists $row column_size]} {
  127             dict set row precision \
  128                 [dict get $row column_size]
  129             }
  130             if {[dict exists $row decimal_digits]} {
  131             dict set row scale \
  132                 [dict get $row decimal_digits]
  133             }
  134             if {![dict exists $row nullable]} {
  135             dict set row nullable \
  136                 [expr {!![string trim [dict get $row is_nullable]]}]
  137             }
  138             dict set retval [dict get $row column_name] $row
  139         }
  140         }
  141         set retval
  142     } result options]
  143     catch {rename $stmt {}}
  144     return -level 0 -options $options $result
  145     }
  146 
  147     # The 'primarykeys' method returns a dictionary describing the primary
  148     # keys of a table
  149 
  150     method primarykeys {tableName} {
  151     set stmt [::tdbc::odbc::primarykeysStatement create \
  152               Stmt::[incr statementSeq] [self] $tableName]
  153         set status [catch {
  154         set retval {}
  155         $stmt foreach -as dicts row {
  156         foreach {odbcKey tdbcKey} {
  157             TABLE_CAT       tableCatalog
  158             TABLE_SCHEM     tableSchema
  159             TABLE_NAME      tableName
  160             COLUMN_NAME     columnName
  161             KEY_SEQ     ordinalPosition
  162             PK_NAME     constraintName
  163         } {
  164             if {[dict exists $row $odbcKey]} {
  165             dict set row $tdbcKey [dict get $row $odbcKey]
  166             dict unset row $odbcKey
  167             }
  168         }
  169         lappend retval $row
  170         }
  171         set retval
  172     } result options]
  173     catch {rename $stmt {}}
  174     return -level 0 -options $options $result
  175     }
  176 
  177     # The 'foreignkeys' method returns a dictionary describing the foreign
  178     # keys of a table
  179 
  180     method foreignkeys {args} {
  181     set stmt [::tdbc::odbc::foreignkeysStatement create \
  182               Stmt::[incr statementSeq] [self] {*}$args]
  183         set status [catch {
  184         set fkseq 0
  185         set retval {}
  186         $stmt foreach -as dicts row {
  187         foreach {odbcKey tdbcKey} {
  188             PKTABLE_CAT     primaryCatalog
  189             PKTABLE_SCHEM   primarySchema
  190             PKTABLE_NAME    primaryTable
  191             PKCOLUMN_NAME   primaryColumn
  192             FKTABLE_CAT     foreignCatalog
  193             FKTABLE_SCHEM   foreignSchema
  194             FKTABLE_NAME    foreignTable
  195             FKCOLUMN_NAME   foreignColumn
  196             UPDATE_RULE     updateRule
  197             DELETE_RULE     deleteRule
  198             DEFERRABILITY   deferrable
  199             KEY_SEQ     ordinalPosition
  200             FK_NAME     foreignConstraintName
  201         } {
  202             if {[dict exists $row $odbcKey]} {
  203             dict set row $tdbcKey [dict get $row $odbcKey]
  204             dict unset row $odbcKey
  205             }
  206         }
  207         # Horrible kludge: If the driver doesn't report FK_NAME,
  208         # make one up.
  209         if {![dict exists $row foreignConstraintName]} {
  210             if {![dict exists $row ordinalPosition]
  211             || [dict get $row ordinalPosition] == 1} {
  212             set fkname ?[dict get $row foreignTable]?[incr fkseq]
  213             }
  214             dict set row foreignConstraintName $fkname
  215         }
  216         lappend retval $row
  217         }
  218         set retval
  219     } result options]
  220     catch {rename $stmt {}}
  221     return -level 0 -options $options $result
  222     }
  223 
  224     # The 'prepareCall' method gives a portable interface to prepare
  225     # calls to stored procedures.  It delegates to 'prepare' to do the
  226     # actual work.
  227 
  228     method preparecall {call} {
  229 
  230     regexp {^[[:space:]]*(?:([A-Za-z_][A-Za-z_0-9]*)[[:space:]]*=)?(.*)} \
  231         $call -> varName rest
  232     if {$varName eq {}} {
  233         my prepare \\{CALL $rest\\}
  234     } else {
  235         my prepare \\{:$varName=CALL $rest\\}
  236     }
  237 
  238     if 0 {
  239     # Kevin thinks this is going to be
  240 
  241     if {![regexp -expanded {
  242         ^\s*                   # leading whitespace
  243         (?::([[:alpha:]_][[:alnum:]_]*)\s*=\s*) # possible variable name
  244         (?:(?:([[:alpha:]_][[:alnum:]_]*)\s*[.]\s*)?   # catalog
  245            ([[:alpha:]_][[:alnum:]_]*)\s*[.]\s*)?      # schema
  246         ([[:alpha:]_][[:alnum:]_]*)\s*         # procedure
  247         (.*)$                      # argument list
  248     } $call -> varName catalog schema procedure arglist]} {
  249         return -code error \
  250         -errorCode [list TDBC \
  251                 SYNTAX_ERROR_OR_ACCESS_RULE_VIOLATION \
  252                 42000 ODBC -1] \
  253         "Syntax error in stored procedure call"
  254     } else {
  255         my PrepareCall $varName $catalog $schema $procedure $arglist
  256     }
  257 
  258     # at least if making all parameters 'inout' doesn't work.
  259 
  260         }
  261 
  262     }
  263 
  264     # The 'typemap' method returns the type map
  265 
  266     method typemap {} {
  267     if {![info exists typemap]} {
  268         set typemap $::tdbc::odbc::sqltypes
  269         set typesStmt [tdbc::odbc::typesStatement new [self]]
  270         $typesStmt foreach row {
  271         set typeNum [dict get $row DATA_TYPE]
  272         if {![dict exists $typemap $typeNum]} {
  273             dict set typemap $typeNum [string tolower \
  274                            [dict get $row TYPE_NAME]]
  275         }
  276         switch -exact -- $typeNum {
  277             -9 {
  278             [self] HasWvarchar 1
  279             }
  280             -5 {
  281             [self] HasBigint 1
  282             }
  283         }
  284         }
  285         rename $typesStmt {}
  286     }
  287     return $typemap
  288     }
  289 
  290     # The 'begintransaction', 'commit' and 'rollback' methods are
  291     # implemented in C.
  292 
  293 }
  294 
  295 #-------------------------------------------------------------------------------
  296 #
  297 # tdbc::odbc::statement --
  298 #
  299 #   The class 'tdbc::odbc::statement' models one statement against a
  300 #       database accessed through an ODBC connection
  301 #
  302 #-------------------------------------------------------------------------------
  303 
  304 ::oo::class create ::tdbc::odbc::statement {
  305 
  306     superclass ::tdbc::statement
  307 
  308     # The constructor is implemented in C. It accepts the handle to
  309     # the connection and the SQL code for the statement to prepare.
  310     # It creates a subordinate namespace to hold the statement's
  311     # active result sets, and then delegates to the 'init' method,
  312     # written in C, to do the actual work of preparing the statement.
  313 
  314     # The 'resultSetCreate' method forwards to the result set constructor
  315 
  316     forward resultSetCreate ::tdbc::odbc::resultset create
  317 
  318     # The 'params' method describes the parameters to the statement
  319 
  320     method params {} {
  321     set typemap [[my connection] typemap]
  322     set result {}
  323     foreach {name flags typeNum precision scale nullable} [my ParamList] {
  324         set lst [dict create \
  325              name $name \
  326              direction [lindex {unknown in out inout} \
  327                     [expr {($flags & 0x06) >> 1}]] \
  328              type [dict get $typemap $typeNum] \
  329              precision $precision \
  330              scale $scale]
  331         if {$nullable in {0 1}} {
  332         dict set list nullable $nullable
  333         }
  334         dict set result $name $lst
  335     }
  336     return $result
  337     }
  338 
  339     # Methods implemented in C:
  340     # init statement ?dictionary?
  341     #     Does the heavy lifting for the constructor
  342     # connection
  343     #   Returns the connection handle to which this statement belongs
  344     # paramtype paramname ?direction? type ?precision ?scale??
  345     #     Declares the type of a parameter in the statement
  346 
  347 }
  348 
  349 #------------------------------------------------------------------------------
  350 #
  351 # tdbc::odbc::tablesStatement --
  352 #
  353 #   The class 'tdbc::odbc::tablesStatement' represents the special
  354 #   statement that queries the tables in a database through an ODBC
  355 #   connection.
  356 #
  357 #------------------------------------------------------------------------------
  358 
  359 oo::class create ::tdbc::odbc::tablesStatement {
  360 
  361     superclass ::tdbc::statement
  362 
  363     # The constructor is written in C. It accepts the handle to the
  364     # connection and a pattern to match table names.  It works in all
  365     # ways like the constructor of the 'statement' class except that
  366     # its 'init' method sets up to enumerate tables and not run a SQL
  367     # query.
  368 
  369     # The 'resultSetCreate' method forwards to the result set constructor
  370 
  371     forward resultSetCreate ::tdbc::odbc::resultset create
  372 
  373 }
  374 
  375 #------------------------------------------------------------------------------
  376 #
  377 # tdbc::odbc::columnsStatement --
  378 #
  379 #   The class 'tdbc::odbc::tablesStatement' represents the special
  380 #   statement that queries the columns of a table or view
  381 #   in a database through an ODBC connection.
  382 #
  383 #------------------------------------------------------------------------------
  384 
  385 oo::class create ::tdbc::odbc::columnsStatement {
  386 
  387     superclass ::tdbc::statement
  388 
  389     # The constructor is written in C. It accepts the handle to the
  390     # connection, a table name, and a pattern to match column
  391     # names. It works in all ways like the constructor of the
  392     # 'statement' class except that its 'init' method sets up to
  393     # enumerate tables and not run a SQL query.
  394 
  395     # The 'resultSetCreate' class forwards to the constructor of the
  396     # result set
  397 
  398     forward resultSetCreate ::tdbc::odbc::resultset create
  399 
  400 }
  401 
  402 #------------------------------------------------------------------------------
  403 #
  404 # tdbc::odbc::primarykeysStatement --
  405 #
  406 #   The class 'tdbc::odbc::primarykeysStatement' represents the special
  407 #   statement that queries the primary keys on a table through an ODBC
  408 #   connection.
  409 #
  410 #------------------------------------------------------------------------------
  411 
  412 oo::class create ::tdbc::odbc::primarykeysStatement {
  413 
  414     superclass ::tdbc::statement
  415 
  416     # The constructor is written in C. It accepts the handle to the
  417     # connection and a table name.  It works in all
  418     # ways like the constructor of the 'statement' class except that
  419     # its 'init' method sets up to enumerate primary keys and not run a SQL
  420     # query.
  421 
  422     # The 'resultSetCreate' method forwards to the result set constructor
  423 
  424     forward resultSetCreate ::tdbc::odbc::resultset create
  425 
  426 }
  427 
  428 #------------------------------------------------------------------------------
  429 #
  430 # tdbc::odbc::foreignkeysStatement --
  431 #
  432 #   The class 'tdbc::odbc::foreignkeysStatement' represents the special
  433 #   statement that queries the foreign keys on a table through an ODBC
  434 #   connection.
  435 #
  436 #------------------------------------------------------------------------------
  437 
  438 oo::class create ::tdbc::odbc::foreignkeysStatement {
  439 
  440     superclass ::tdbc::statement
  441 
  442     # The constructor is written in C. It accepts the handle to the
  443     # connection and the -primary and -foreign options.  It works in all
  444     # ways like the constructor of the 'statement' class except that
  445     # its 'init' method sets up to enumerate foreign keys and not run a SQL
  446     # query.
  447 
  448     # The 'resultSetCreate' method forwards to the result set constructor
  449 
  450     forward resultSetCreate ::tdbc::odbc::resultset create
  451 
  452 }
  453 
  454 #------------------------------------------------------------------------------
  455 #
  456 # tdbc::odbc::typesStatement --
  457 #
  458 #   The class 'tdbc::odbc::typesStatement' represents the special
  459 #   statement that queries the types available in a database through
  460 #   an ODBC connection.
  461 #
  462 #------------------------------------------------------------------------------
  463 
  464 
  465 oo::class create ::tdbc::odbc::typesStatement {
  466 
  467     superclass ::tdbc::statement
  468 
  469     # The constructor is written in C. It accepts the handle to the
  470     # connection, and (optionally) a data type number. It works in all
  471     # ways like the constructor of the 'statement' class except that
  472     # its 'init' method sets up to enumerate types and not run a SQL
  473     # query.
  474 
  475     # The 'resultSetCreate' method forwards to the constructor of result sets
  476 
  477     forward resultSetCreate ::tdbc::odbc::resultset create
  478 
  479     # The C code contains a variant implementation of the 'init' method.
  480 
  481 }
  482 
  483 #------------------------------------------------------------------------------
  484 #
  485 # tdbc::odbc::resultset --
  486 #
  487 #   The class 'tdbc::odbc::resultset' models the result set that is
  488 #   produced by executing a statement against an ODBC database.
  489 #
  490 #------------------------------------------------------------------------------
  491 
  492 ::oo::class create ::tdbc::odbc::resultset {
  493 
  494     superclass ::tdbc::resultset
  495 
  496     # Methods implemented in C include:
  497 
  498     # constructor statement ?dictionary?
  499     #     -- Executes the statement against the database, optionally providing
  500     #        a dictionary of substituted parameters (default is to get params
  501     #        from variables in the caller's scope).
  502     # columns
  503     #     -- Returns a list of the names of the columns in the result.
  504     # nextdict
  505     #     -- Stores the next row of the result set in the given variable in
  506     #        the caller's scope as a dictionary whose keys are
  507     #        column names and whose values are column values.
  508     # nextlist
  509     #     -- Stores the next row of the result set in the given variable in
  510     #        the caller's scope as a list of cells.
  511     # rowcount
  512     #     -- Returns a count of rows affected by the statement, or -1
  513     #        if the count of rows has not been determined.
  514 
  515 }