Mercurial > repos > rliterman > csp2

comparison CSP2/CSP2_env/env-d9b9114564458d9d-741b3de822f2aaca6c6caa4325c4afce/lib/tdbcodbc1.1.5/tdbcodbc.tcl @ 68:5028fdace37b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload commit 2e9511a184a1ca667c7be0c6321a36dc4e3d116d
author jpayne
date Tue, 18 Mar 2025 16:23:26 -0400
parents
children
comparison
equal deleted inserted replaced
67:0e9998148a16 68:5028fdace37b
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 'evaldirect' evaluates driver-native SQL code without preparing it,
225 # and returns a list of dicts (similar to '$connection allrows -as dicts').
226
227 method evaldirect {sqlStatement} {
228 set stmt [::tdbc::odbc::evaldirectStatement create \
229 Stmt::[incr statementSeq] [self] $sqlStatement]
230 set status [catch {
231 $stmt allrows -as dicts
232 } result options]
233 catch {rename $stmt {}}
234 return -level 0 -options $options $result
235 }
236
237 # The 'prepareCall' method gives a portable interface to prepare
238 # calls to stored procedures. It delegates to 'prepare' to do the
239 # actual work.
240
241 method preparecall {call} {
242
243 regexp {^[[:space:]]*(?:([A-Za-z_][A-Za-z_0-9]*)[[:space:]]*=)?(.*)} \
244 $call -> varName rest
245 if {$varName eq {}} {
246 my prepare \\{CALL $rest\\}
247 } else {
248 my prepare \\{:$varName=CALL $rest\\}
249 }
250
251 if 0 {
252 # Kevin thinks this is going to be
253
254 if {![regexp -expanded {
255 ^\s* # leading whitespace
256 (?::([[:alpha:]_][[:alnum:]_]*)\s*=\s*) # possible variable name
257 (?:(?:([[:alpha:]_][[:alnum:]_]*)\s*[.]\s*)? # catalog
258 ([[:alpha:]_][[:alnum:]_]*)\s*[.]\s*)? # schema
259 ([[:alpha:]_][[:alnum:]_]*)\s* # procedure
260 (.*)$ # argument list
261 } $call -> varName catalog schema procedure arglist]} {
262 return -code error \
263 -errorCode [list TDBC \
264 SYNTAX_ERROR_OR_ACCESS_RULE_VIOLATION \
265 42000 ODBC -1] \
266 "Syntax error in stored procedure call"
267 } else {
268 my PrepareCall $varName $catalog $schema $procedure $arglist
269 }
270
271 # at least if making all parameters 'inout' doesn't work.
272
273 }
274
275 }
276
277 # The 'typemap' method returns the type map
278
279 method typemap {} {
280 if {![info exists typemap]} {
281 set typemap $::tdbc::odbc::sqltypes
282 set typesStmt [tdbc::odbc::typesStatement new [self]]
283 $typesStmt foreach row {
284 set typeNum [dict get $row DATA_TYPE]
285 if {![dict exists $typemap $typeNum]} {
286 dict set typemap $typeNum [string tolower \
287 [dict get $row TYPE_NAME]]
288 }
289 switch -exact -- $typeNum {
290 -9 {
291 [self] HasWvarchar 1
292 }
293 -5 {
294 [self] HasBigint 1
295 }
296 }
297 }
298 rename $typesStmt {}
299 }
300 return $typemap
301 }
302
303 # The 'begintransaction', 'commit' and 'rollback' methods are
304 # implemented in C.
305
306 }
307
308 #-------------------------------------------------------------------------------
309 #
310 # tdbc::odbc::statement --
311 #
312 # The class 'tdbc::odbc::statement' models one statement against a
313 # database accessed through an ODBC connection
314 #
315 #-------------------------------------------------------------------------------
316
317 ::oo::class create ::tdbc::odbc::statement {
318
319 superclass ::tdbc::statement
320
321 # The constructor is implemented in C. It accepts the handle to
322 # the connection and the SQL code for the statement to prepare.
323 # It creates a subordinate namespace to hold the statement's
324 # active result sets, and then delegates to the 'init' method,
325 # written in C, to do the actual work of preparing the statement.
326
327 # The 'resultSetCreate' method forwards to the result set constructor
328
329 forward resultSetCreate ::tdbc::odbc::resultset create
330
331 # The 'params' method describes the parameters to the statement
332
333 method params {} {
334 set typemap [[my connection] typemap]
335 set result {}
336 foreach {name flags typeNum precision scale nullable} [my ParamList] {
337 set lst [dict create \
338 name $name \
339 direction [lindex {unknown in out inout} \
340 [expr {($flags & 0x06) >> 1}]] \
341 type [dict get $typemap $typeNum] \
342 precision $precision \
343 scale $scale]
344 if {$nullable in {0 1}} {
345 dict set list nullable $nullable
346 }
347 dict set result $name $lst
348 }
349 return $result
350 }
351
352 # Methods implemented in C:
353 # init statement ?dictionary?
354 # Does the heavy lifting for the constructor
355 # connection
356 # Returns the connection handle to which this statement belongs
357 # paramtype paramname ?direction? type ?precision ?scale??
358 # Declares the type of a parameter in the statement
359
360 }
361
362 #------------------------------------------------------------------------------
363 #
364 # tdbc::odbc::tablesStatement --
365 #
366 # The class 'tdbc::odbc::tablesStatement' represents the special
367 # statement that queries the tables in a database through an ODBC
368 # connection.
369 #
370 #------------------------------------------------------------------------------
371
372 oo::class create ::tdbc::odbc::tablesStatement {
373
374 superclass ::tdbc::statement
375
376 # The constructor is written in C. It accepts the handle to the
377 # connection and a pattern to match table names. It works in all
378 # ways like the constructor of the 'statement' class except that
379 # its 'init' method sets up to enumerate tables and not run a SQL
380 # query.
381
382 # The 'resultSetCreate' method forwards to the result set constructor
383
384 forward resultSetCreate ::tdbc::odbc::resultset create
385
386 }
387
388 #------------------------------------------------------------------------------
389 #
390 # tdbc::odbc::columnsStatement --
391 #
392 # The class 'tdbc::odbc::tablesStatement' represents the special
393 # statement that queries the columns of a table or view
394 # in a database through an ODBC connection.
395 #
396 #------------------------------------------------------------------------------
397
398 oo::class create ::tdbc::odbc::columnsStatement {
399
400 superclass ::tdbc::statement
401
402 # The constructor is written in C. It accepts the handle to the
403 # connection, a table name, and a pattern to match column
404 # names. It works in all ways like the constructor of the
405 # 'statement' class except that its 'init' method sets up to
406 # enumerate tables and not run a SQL query.
407
408 # The 'resultSetCreate' class forwards to the constructor of the
409 # result set
410
411 forward resultSetCreate ::tdbc::odbc::resultset create
412
413 }
414
415 #------------------------------------------------------------------------------
416 #
417 # tdbc::odbc::primarykeysStatement --
418 #
419 # The class 'tdbc::odbc::primarykeysStatement' represents the special
420 # statement that queries the primary keys on a table through an ODBC
421 # connection.
422 #
423 #------------------------------------------------------------------------------
424
425 oo::class create ::tdbc::odbc::primarykeysStatement {
426
427 superclass ::tdbc::statement
428
429 # The constructor is written in C. It accepts the handle to the
430 # connection and a table name. It works in all
431 # ways like the constructor of the 'statement' class except that
432 # its 'init' method sets up to enumerate primary keys and not run a SQL
433 # query.
434
435 # The 'resultSetCreate' method forwards to the result set constructor
436
437 forward resultSetCreate ::tdbc::odbc::resultset create
438
439 }
440
441 #------------------------------------------------------------------------------
442 #
443 # tdbc::odbc::foreignkeysStatement --
444 #
445 # The class 'tdbc::odbc::foreignkeysStatement' represents the special
446 # statement that queries the foreign keys on a table through an ODBC
447 # connection.
448 #
449 #------------------------------------------------------------------------------
450
451 oo::class create ::tdbc::odbc::foreignkeysStatement {
452
453 superclass ::tdbc::statement
454
455 # The constructor is written in C. It accepts the handle to the
456 # connection and the -primary and -foreign options. It works in all
457 # ways like the constructor of the 'statement' class except that
458 # its 'init' method sets up to enumerate foreign keys and not run a SQL
459 # query.
460
461 # The 'resultSetCreate' method forwards to the result set constructor
462
463 forward resultSetCreate ::tdbc::odbc::resultset create
464
465 }
466
467 #------------------------------------------------------------------------------
468 #
469 # tdbc::odbc::evaldirectStatement --
470 #
471 # The class 'tdbc::odbc::evaldirectStatement' provides a mechanism to
472 # execute driver-name SQL code through an ODBC connection. The SQL code
473 # is not prepared and no tokenization or variable substitution is done.
474 #
475 #------------------------------------------------------------------------------
476
477 oo::class create ::tdbc::odbc::evaldirectStatement {
478
479 superclass ::tdbc::statement
480
481 # The constructor is written in C. It accepts the handle to the
482 # connection and a SQL statement. It works in all
483 # ways like the constructor of the 'statement' class except that
484 # its 'init' method does not tokenize or prepare the SQL statement, and
485 # sets up to run the SQL query without performing variable substitution.
486
487 # The 'resultSetCreate' method forwards to the result set constructor
488
489 forward resultSetCreate ::tdbc::odbc::resultset create
490
491 }
492
493 #------------------------------------------------------------------------------
494 #
495 # tdbc::odbc::typesStatement --
496 #
497 # The class 'tdbc::odbc::typesStatement' represents the special
498 # statement that queries the types available in a database through
499 # an ODBC connection.
500 #
501 #------------------------------------------------------------------------------
502
503
504 oo::class create ::tdbc::odbc::typesStatement {
505
506 superclass ::tdbc::statement
507
508 # The constructor is written in C. It accepts the handle to the
509 # connection, and (optionally) a data type number. It works in all
510 # ways like the constructor of the 'statement' class except that
511 # its 'init' method sets up to enumerate types and not run a SQL
512 # query.
513
514 # The 'resultSetCreate' method forwards to the constructor of result sets
515
516 forward resultSetCreate ::tdbc::odbc::resultset create
517
518 # The C code contains a variant implementation of the 'init' method.
519
520 }
521
522 #------------------------------------------------------------------------------
523 #
524 # tdbc::odbc::resultset --
525 #
526 # The class 'tdbc::odbc::resultset' models the result set that is
527 # produced by executing a statement against an ODBC database.
528 #
529 #------------------------------------------------------------------------------
530
531 ::oo::class create ::tdbc::odbc::resultset {
532
533 superclass ::tdbc::resultset
534
535 # Methods implemented in C include:
536
537 # constructor statement ?dictionary?
538 # -- Executes the statement against the database, optionally providing
539 # a dictionary of substituted parameters (default is to get params
540 # from variables in the caller's scope).
541 # columns
542 # -- Returns a list of the names of the columns in the result.
543 # nextdict
544 # -- Stores the next row of the result set in the given variable in
545 # the caller's scope as a dictionary whose keys are
546 # column names and whose values are column values.
547 # nextlist
548 # -- Stores the next row of the result set in the given variable in
549 # the caller's scope as a list of cells.
550 # rowcount
551 # -- Returns a count of rows affected by the statement, or -1
552 # if the count of rows has not been determined.
553
554 }