tdbcodbc.tcl 17 KB

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