util/src/TclTk/tcl8.6.12/pkgs/tdbcodbc1.1.3/library/tdbcodbc.tcl

   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 \f
  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 \f
 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 \f
 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 \f
 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 \f
 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 \f
 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 \f
 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 \f
 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 }