1 /*
2 * tdbcmysql.c --
3 *
4 * Bridge between TDBC (Tcl DataBase Connectivity) and MYSQL.
5 *
6 * Copyright (c) 2008, 2009 by Kevin B. Kenny.
7 *
8 * Please refer to the file, 'license.terms' for the conditions on
9 * redistribution of this file and for a DISCLAIMER OF ALL WARRANTIES.
10 *
11 * $Id: $
12 *
13 *-----------------------------------------------------------------------------
14 */
15
16 #ifdef _MSC_VER
17 # define _CRT_SECURE_NO_WARNINGS
18 #endif
19
20 #include <tcl.h>
21 #include <tclOO.h>
22 #include <tdbc.h>
23
24 #include <stdio.h>
25 #include <string.h>
26
27 #ifdef HAVE_STDINT_H
28 # include <stdint.h>
29 #endif
30
31 #include "int2ptr_ptr2int.h"
32
33 #include "fakemysql.h"
34
35 /* Static data contained in this file */
36
37 TCL_DECLARE_MUTEX(mysqlMutex); /* Mutex protecting the global environment
38 * and its reference count */
39
40 static int mysqlRefCount = 0; /* Reference count on the global environment */
41 Tcl_LoadHandle mysqlLoadHandle = NULL;
42 /* Handle to the MySQL library */
43 unsigned long mysqlClientVersion;
44 /* Version number of MySQL */
45
46 /*
47 * Objects to create within the literal pool
48 */
49
50 const char* LiteralValues[] = {
51 "",
52 "0",
53 "1",
54 "direction",
55 "in",
56 "inout",
57 "name",
58 "nullable",
59 "out",
60 "precision",
61 "scale",
62 "type",
63 NULL
64 };
65 enum LiteralIndex {
66 LIT_EMPTY,
67 LIT_0,
68 LIT_1,
69 LIT_DIRECTION,
70 LIT_IN,
71 LIT_INOUT,
72 LIT_NAME,
73 LIT_NULLABLE,
74 LIT_OUT,
75 LIT_PRECISION,
76 LIT_SCALE,
77 LIT_TYPE,
78 LIT__END
79 };
80
81 /*
82 * Structure that holds per-interpreter data for the MYSQL package.
83 */
84
85 typedef struct PerInterpData {
86 size_t refCount; /* Reference count */
87 Tcl_Obj* literals[LIT__END];
88 /* Literal pool */
89 Tcl_HashTable typeNumHash; /* Lookup table for type numbers */
90 } PerInterpData;
91 #define IncrPerInterpRefCount(x) \
92 do { \
93 ++((x)->refCount); \
94 } while(0)
95 #define DecrPerInterpRefCount(x) \
96 do { \
97 PerInterpData* _pidata = x; \
98 if (((_pidata->refCount))-- <= 1) { \
99 DeletePerInterpData(_pidata); \
100 } \
101 } while(0)
102
103 /*
104 * Structure that carries the data for an MYSQL connection
105 *
106 * The ConnectionData structure is refcounted to simplify the
107 * destruction of statements associated with a connection.
108 * When a connection is destroyed, the subordinate namespace that
109 * contains its statements is taken down, destroying them. It's
110 * not safe to take down the ConnectionData until nothing is
111 * referring to it, which avoids taking down the hDBC until the
112 * other objects that refer to it vanish.
113 */
114
115 typedef struct ConnectionData {
116 size_t refCount; /* Reference count. */
117 PerInterpData* pidata; /* Per-interpreter data */
118 MYSQL* mysqlPtr; /* MySql connection handle */
119 unsigned int nCollations; /* Number of collations defined */
120 int* collationSizes; /* Character lengths indexed by collation ID */
121 int flags;
122 } ConnectionData;
123
124 /*
125 * Flags for the state of an MYSQL connection
126 */
127
128 #define CONN_FLAG_AUTOCOMMIT 0x1 /* Autocommit is set */
129 #define CONN_FLAG_IN_XCN 0x2 /* Transaction is in progress */
130 #define CONN_FLAG_INTERACTIVE 0x4 /* -interactive requested at connect */
131
132 #define IncrConnectionRefCount(x) \
133 do { \
134 ++((x)->refCount); \
135 } while(0)
136 #define DecrConnectionRefCount(x) \
137 do { \
138 ConnectionData* conn = x; \
139 if (((conn->refCount)--) <= 01) { \
140 DeleteConnection(conn); \
141 } \
142 } while(0)
143
144 /*
145 * Structure that carries the data for a MySQL prepared statement.
146 *
147 * Just as with connections, statements need to defer taking down
148 * their client data until other objects (i.e., result sets) that
149 * refer to them have had a chance to clean up. Hence, this
150 * structure is reference counted as well.
151 */
152
153 typedef struct StatementData {
154 size_t refCount; /* Reference count */
155 ConnectionData* cdata; /* Data for the connection to which this
156 * statement pertains. */
157 Tcl_Obj* subVars; /* List of variables to be substituted, in the
158 * order in which they appear in the
159 * statement */
160 struct ParamData *params; /* Data types and attributes of parameters */
161 Tcl_Obj* nativeSql; /* Native SQL statement to pass into
162 * MySQL */
163 MYSQL_STMT* stmtPtr; /* MySQL statement handle */
164 MYSQL_RES* metadataPtr; /* MySQL result set metadata */
165 Tcl_Obj* columnNames; /* Column names in the result set */
166 int flags;
167 } StatementData;
168 #define IncrStatementRefCount(x) \
169 do { \
170 ++((x)->refCount); \
171 } while (0)
172 #define DecrStatementRefCount(x) \
173 do { \
174 StatementData* stmt = (x); \
175 if ((stmt->refCount--) <= 1) { \
176 DeleteStatement(stmt); \
177 } \
178 } while(0)
179
180 /* Flags in the 'StatementData->flags' word */
181
182 #define STMT_FLAG_BUSY 0x1 /* Statement handle is in use */
183
184 /*
185 * Structure describing the data types of substituted parameters in
186 * a SQL statement.
187 */
188
189 typedef struct ParamData {
190 int flags; /* Flags regarding the parameters - see below */
191 int dataType; /* Data type */
192 int precision; /* Size of the expected data */
193 int scale; /* Digits after decimal point of the
194 * expected data */
195 } ParamData;
196
197 #define PARAM_KNOWN 1<<0 /* Something is known about the parameter */
198 #define PARAM_IN 1<<1 /* Parameter is an input parameter */
199 #define PARAM_OUT 1<<2 /* Parameter is an output parameter */
200 /* (Both bits are set if parameter is
201 * an INOUT parameter) */
202 #define PARAM_BINARY 1<<3 /* Parameter is binary */
203
204 /*
205 * Structure describing a MySQL result set. The object that the Tcl
206 * API terms a "result set" actually has to be represented by a MySQL
207 * "statement", since a MySQL statement can have only one set of results
208 * at any given time.
209 */
210
211 typedef struct ResultSetData {
212 size_t refCount; /* Reference count */
213 StatementData* sdata; /* Statement that generated this result set */
214 MYSQL_STMT* stmtPtr; /* Handle to the MySQL statement object */
215 Tcl_Obj* paramValues; /* List of parameter values */
216 MYSQL_BIND* paramBindings; /* Parameter bindings */
217 unsigned long* paramLengths;/* Parameter lengths */
218 my_ulonglong rowCount; /* Number of affected rows */
219 my_bool* resultErrors; /* Failure indicators for retrieving columns */
220 my_bool* resultNulls; /* NULL indicators for retrieving columns */
221 unsigned long* resultLengths;
222 /* Byte lengths of retrieved columns */
223 MYSQL_BIND* resultBindings; /* Bindings controlling column retrieval */
224 } ResultSetData;
225 #define IncrResultSetRefCount(x) \
226 do { \
227 ++((x)->refCount); \
228 } while (0)
229 #define DecrResultSetRefCount(x) \
230 do { \
231 ResultSetData* rs = (x); \
232 if (rs->refCount-- <= 1) { \
233 DeleteResultSet(rs); \
234 } \
235 } while(0)
236
237 /* Table of MySQL type names */
238
239 #define IS_BINARY (1<<16) /* Flag to OR in if a param is binary */
240 typedef struct MysqlDataType {
241 const char* name; /* Type name */
242 int num; /* Type number */
243 } MysqlDataType;
244 static const MysqlDataType dataTypes[] = {
245 { "tinyint", MYSQL_TYPE_TINY },
246 { "smallint", MYSQL_TYPE_SHORT },
247 { "integer", MYSQL_TYPE_LONG },
248 { "float", MYSQL_TYPE_FLOAT },
249 { "real", MYSQL_TYPE_FLOAT },
250 { "double", MYSQL_TYPE_DOUBLE },
251 { "NULL", MYSQL_TYPE_NULL },
252 { "timestamp", MYSQL_TYPE_TIMESTAMP },
253 { "bigint", MYSQL_TYPE_LONGLONG },
254 { "mediumint", MYSQL_TYPE_INT24 },
255 { "date", MYSQL_TYPE_NEWDATE },
256 { "date", MYSQL_TYPE_DATE },
257 { "time", MYSQL_TYPE_TIME },
258 { "datetime", MYSQL_TYPE_DATETIME },
259 { "year", MYSQL_TYPE_YEAR },
260 { "bit", MYSQL_TYPE_BIT | IS_BINARY },
261 { "numeric", MYSQL_TYPE_NEWDECIMAL },
262 { "decimal", MYSQL_TYPE_NEWDECIMAL },
263 { "numeric", MYSQL_TYPE_DECIMAL },
264 { "decimal", MYSQL_TYPE_DECIMAL },
265 { "enum", MYSQL_TYPE_ENUM },
266 { "set", MYSQL_TYPE_SET },
267 { "tinytext", MYSQL_TYPE_TINY_BLOB },
268 { "tinyblob", MYSQL_TYPE_TINY_BLOB | IS_BINARY },
269 { "mediumtext", MYSQL_TYPE_MEDIUM_BLOB },
270 { "mediumblob", MYSQL_TYPE_MEDIUM_BLOB | IS_BINARY },
271 { "longtext", MYSQL_TYPE_LONG_BLOB },
272 { "longblob", MYSQL_TYPE_LONG_BLOB | IS_BINARY },
273 { "text", MYSQL_TYPE_BLOB },
274 { "blob", MYSQL_TYPE_BLOB | IS_BINARY },
275 { "varbinary", MYSQL_TYPE_VAR_STRING | IS_BINARY },
276 { "varchar", MYSQL_TYPE_VAR_STRING },
277 { "varbinary", MYSQL_TYPE_VARCHAR | IS_BINARY },
278 { "varchar", MYSQL_TYPE_VARCHAR },
279 { "binary", MYSQL_TYPE_STRING | IS_BINARY },
280 { "char", MYSQL_TYPE_STRING },
281 { "geometry", MYSQL_TYPE_GEOMETRY },
282 { NULL, 0 }
283 };
284
285 /* Configuration options for MySQL connections */
286
287 /* Data types of configuration options */
288
289 enum OptType {
290 TYPE_STRING, /* Arbitrary character string */
291 TYPE_FLAG, /* Boolean flag */
292 TYPE_ENCODING, /* Encoding name */
293 TYPE_ISOLATION, /* Transaction isolation level */
294 TYPE_PORT, /* Port number */
295 TYPE_READONLY, /* Read-only indicator */
296 TYPE_TIMEOUT /* Timeout value */
297 };
298
299 /* Locations of the string options in the string array */
300
301 enum OptStringIndex {
302 INDX_DB, INDX_HOST, INDX_PASSWD, INDX_SOCKET,
303 INDX_SSLCA, INDX_SSLCAPATH, INDX_SSLCERT, INDX_SSLCIPHER, INDX_SSLKEY,
304 INDX_USER,
305 INDX_MAX
306 };
307
308 /* Flags in the configuration table */
309
310 #define CONN_OPT_FLAG_MOD 0x1 /* Configuration value changable at runtime */
311 #define CONN_OPT_FLAG_SSL 0x2 /* Configuration change requires setting
312 * SSL options */
313 #define CONN_OPT_FLAG_ALIAS 0x4 /* Configuration option is an alias */
314
315 /* Table of configuration options */
316
317 static const struct {
318 const char * name; /* Option name */
319 enum OptType type; /* Option data type */
320 int info; /* Option index or flag value */
321 int flags; /* Flags - modifiable; SSL related; is an alias */
322 const char* query; /* How to determine the option value? */
323 } ConnOptions [] = {
324 { "-compress", TYPE_FLAG, CLIENT_COMPRESS, 0,
325 "SELECT '', @@SLAVE_COMPRESSED_PROTOCOL" },
326 { "-database", TYPE_STRING, INDX_DB, CONN_OPT_FLAG_MOD,
327 "SELECT '', DATABASE();"},
328 { "-db", TYPE_STRING, INDX_DB, CONN_OPT_FLAG_MOD
329 | CONN_OPT_FLAG_ALIAS,
330 "SELECT '', DATABASE()" },
331 { "-encoding", TYPE_ENCODING, 0, 0,
332 "SELECT '', 'utf-8'" },
333 { "-host", TYPE_STRING, INDX_HOST, 0,
334 "SHOW SESSION VARIABLES WHERE VARIABLE_NAME = 'hostname'" },
335 { "-interactive", TYPE_FLAG, CLIENT_INTERACTIVE, 0,
336 "SELECT '', 0" },
337 { "-isolation", TYPE_ISOLATION, 0, CONN_OPT_FLAG_MOD,
338 "SELECT '', LCASE(REPLACE(@@TX_ISOLATION, '-', ''))" },
339 { "-passwd", TYPE_STRING, INDX_PASSWD, CONN_OPT_FLAG_MOD
340 | CONN_OPT_FLAG_ALIAS,
341 "SELECT '', ''" },
342 { "-password", TYPE_STRING, INDX_PASSWD, CONN_OPT_FLAG_MOD,
343 "SELECT '', ''" },
344 { "-port", TYPE_PORT, 0, 0,
345 "SHOW SESSION VARIABLES WHERE VARIABLE_NAME = 'port'" },
346 { "-readonly", TYPE_READONLY, 0, 0,
347 "SELECT '', 0" },
348 { "-socket", TYPE_STRING, INDX_SOCKET, 0,
349 "SHOW SESSION VARIABLES WHERE VARIABLE_NAME = 'socket'" },
350 { "-ssl_ca", TYPE_STRING, INDX_SSLCA, CONN_OPT_FLAG_SSL,
351 "SELECT '', @@SSL_CA"},
352 { "-ssl_capath", TYPE_STRING, INDX_SSLCAPATH, CONN_OPT_FLAG_SSL,
353 "SELECT '', @@SSL_CAPATH" },
354 { "-ssl_cert", TYPE_STRING, INDX_SSLCERT, CONN_OPT_FLAG_SSL,
355 "SELECT '', @@SSL_CERT" },
356 { "-ssl_cipher", TYPE_STRING, INDX_SSLCIPHER, CONN_OPT_FLAG_SSL,
357 "SELECT '', @@SSL_CIPHER" },
358 { "-ssl_cypher", TYPE_STRING, INDX_SSLCIPHER, CONN_OPT_FLAG_SSL
359 | CONN_OPT_FLAG_ALIAS,
360 "SELECT '', @@SSL_CIPHER" },
361 { "-ssl_key", TYPE_STRING, INDX_SSLKEY, CONN_OPT_FLAG_SSL,
362 "SELECT '', @@SSL_KEY" },
363 { "-timeout", TYPE_TIMEOUT, 0, CONN_OPT_FLAG_MOD,
364 "SELECT '', @@WAIT_TIMEOUT" },
365 { "-user", TYPE_STRING, INDX_USER, CONN_OPT_FLAG_MOD,
366 "SELECT '', USER()" },
367 { NULL, TYPE_STRING, 0, 0, NULL }
368 };
369
370 /* Tables of isolation levels: Tcl, SQL, and MySQL 'tx_isolation' */
371
372 static const char *const TclIsolationLevels[] = {
373 "readuncommitted",
374 "readcommitted",
375 "repeatableread",
376 "serializable",
377 NULL
378 };
379 static const char *const SqlIsolationLevels[] = {
380 "SET TRANSACTION ISOLATION LEVEL READ UNCOMMITTED",
381 "SET TRANSACTION ISOLATION LEVEL READ COMMITTED",
382 "SET TRANSACTION ISOLATION LEVEL REPEATABLE READ",
383 "SET TRANSACTION ISOLATION LEVEL SERIALIZABLE",
384 NULL
385 };
386 enum IsolationLevel {
387 ISOL_READ_UNCOMMITTED,
388 ISOL_READ_COMMITTED,
389 ISOL_REPEATABLE_READ,
390 ISOL_SERIALIZABLE,
391 ISOL_NONE = -1
392 };
393
394 /* Declarations of static functions appearing in this file */
395
396 static MYSQL_BIND* MysqlBindAlloc(int nBindings);
397 static MYSQL_BIND* MysqlBindIndex(MYSQL_BIND* b, int i);
398 static void* MysqlBindAllocBuffer(MYSQL_BIND* b, int i, unsigned long len);
399 static void MysqlBindFreeBuffer(MYSQL_BIND* b, int i);
400 static void MysqlBindSetBufferType(MYSQL_BIND* b, int i,
401 enum enum_field_types t);
402 static void* MysqlBindGetBuffer(MYSQL_BIND* b, int i);
403 static unsigned long MysqlBindGetBufferLength(MYSQL_BIND* b, int i);
404 static void MysqlBindSetLength(MYSQL_BIND* b, int i, unsigned long* p);
405 static void MysqlBindSetIsNull(MYSQL_BIND* b, int i, my_bool* p);
406 static void MysqlBindSetError(MYSQL_BIND* b, int i, my_bool* p);
407
408 static MYSQL_FIELD* MysqlFieldIndex(MYSQL_FIELD* fields, int i);
409
410 static void TransferMysqlError(Tcl_Interp* interp, MYSQL* mysqlPtr);
411 static void TransferMysqlStmtError(Tcl_Interp* interp, MYSQL_STMT* mysqlPtr);
412
413 static Tcl_Obj* QueryConnectionOption(ConnectionData* cdata, Tcl_Interp* interp,
414 int optionNum);
415 static int ConfigureConnection(ConnectionData* cdata, Tcl_Interp* interp,
416 int objc, Tcl_Obj *const objv[], int skip);
417 static int ConnectionConstructor(ClientData clientData, Tcl_Interp* interp,
418 Tcl_ObjectContext context,
419 int objc, Tcl_Obj *const objv[]);
420 static int ConnectionBegintransactionMethod(ClientData clientData,
421 Tcl_Interp* interp,
422 Tcl_ObjectContext context,
423 int objc, Tcl_Obj *const objv[]);
424 static int ConnectionColumnsMethod(ClientData clientData, Tcl_Interp* interp,
425 Tcl_ObjectContext context,
426 int objc, Tcl_Obj *const objv[]);
427 static int ConnectionCommitMethod(ClientData clientData, Tcl_Interp* interp,
428 Tcl_ObjectContext context,
429 int objc, Tcl_Obj *const objv[]);
430 static int ConnectionConfigureMethod(ClientData clientData, Tcl_Interp* interp,
431 Tcl_ObjectContext context,
432 int objc, Tcl_Obj *const objv[]);
433 static int ConnectionEvaldirectMethod(ClientData clientData, Tcl_Interp* interp,
434 Tcl_ObjectContext context,
435 int objc, Tcl_Obj *const objv[]);
436 static int ConnectionNeedCollationInfoMethod(ClientData clientData,
437 Tcl_Interp* interp,
438 Tcl_ObjectContext context,
439 int objc, Tcl_Obj *const objv[]);
440 static int ConnectionRollbackMethod(ClientData clientData, Tcl_Interp* interp,
441 Tcl_ObjectContext context,
442 int objc, Tcl_Obj *const objv[]);
443 static int ConnectionSetCollationInfoMethod(ClientData clientData,
444 Tcl_Interp* interp,
445 Tcl_ObjectContext context,
446 int objc, Tcl_Obj *const objv[]);
447 static int ConnectionTablesMethod(ClientData clientData, Tcl_Interp* interp,
448 Tcl_ObjectContext context,
449 int objc, Tcl_Obj *const objv[]);
450
451 static void DeleteConnectionMetadata(ClientData clientData);
452 static void DeleteConnection(ConnectionData* cdata);
453 static int CloneConnection(Tcl_Interp* interp, ClientData oldClientData,
454 ClientData* newClientData);
455
456 static StatementData* NewStatement(ConnectionData* cdata);
457 static MYSQL_STMT* AllocAndPrepareStatement(Tcl_Interp* interp,
458 StatementData* sdata);
459 static Tcl_Obj* ResultDescToTcl(MYSQL_RES* resultDesc, int flags);
460
461 static int StatementConstructor(ClientData clientData, Tcl_Interp* interp,
462 Tcl_ObjectContext context,
463 int objc, Tcl_Obj *const objv[]);
464 static int StatementParamtypeMethod(ClientData clientData, Tcl_Interp* interp,
465 Tcl_ObjectContext context,
466 int objc, Tcl_Obj *const objv[]);
467 static int StatementParamsMethod(ClientData clientData, Tcl_Interp* interp,
468 Tcl_ObjectContext context,
469 int objc, Tcl_Obj *const objv[]);
470
471 static void DeleteStatementMetadata(ClientData clientData);
472 static void DeleteStatement(StatementData* sdata);
473 static int CloneStatement(Tcl_Interp* interp, ClientData oldClientData,
474 ClientData* newClientData);
475
476 static int ResultSetConstructor(ClientData clientData, Tcl_Interp* interp,
477 Tcl_ObjectContext context,
478 int objc, Tcl_Obj *const objv[]);
479 static int ResultSetColumnsMethod(ClientData clientData, Tcl_Interp* interp,
480 Tcl_ObjectContext context,
481 int objc, Tcl_Obj *const objv[]);
482 static int ResultSetNextrowMethod(ClientData clientData, Tcl_Interp* interp,
483 Tcl_ObjectContext context,
484 int objc, Tcl_Obj *const objv[]);
485 static int ResultSetRowcountMethod(ClientData clientData, Tcl_Interp* interp,
486 Tcl_ObjectContext context,
487 int objc, Tcl_Obj *const objv[]);
488
489 static void DeleteResultSetMetadata(ClientData clientData);
490 static void DeleteResultSet(ResultSetData* rdata);
491 static int CloneResultSet(Tcl_Interp* interp, ClientData oldClientData,
492 ClientData* newClientData);
493
494
495 static void DeleteCmd(ClientData clientData);
496 static int CloneCmd(Tcl_Interp* interp,
497 ClientData oldMetadata, ClientData* newMetadata);
498
499 static void DeletePerInterpData(PerInterpData* pidata);
500
501 /* Metadata type that holds connection data */
502
503 const static Tcl_ObjectMetadataType connectionDataType = {
504 TCL_OO_METADATA_VERSION_CURRENT,
505 /* version */
506 "ConnectionData", /* name */
507 DeleteConnectionMetadata, /* deleteProc */
508 CloneConnection /* cloneProc - should cause an error
509 * 'cuz connections aren't clonable */
510 };
511
512 /* Metadata type that holds statement data */
513
514 const static Tcl_ObjectMetadataType statementDataType = {
515 TCL_OO_METADATA_VERSION_CURRENT,
516 /* version */
517 "StatementData", /* name */
518 DeleteStatementMetadata, /* deleteProc */
519 CloneStatement /* cloneProc - should cause an error
520 * 'cuz statements aren't clonable */
521 };
522
523 /* Metadata type for result set data */
524
525 const static Tcl_ObjectMetadataType resultSetDataType = {
526 TCL_OO_METADATA_VERSION_CURRENT,
527 /* version */
528 "ResultSetData", /* name */
529 DeleteResultSetMetadata, /* deleteProc */
530 CloneResultSet /* cloneProc - should cause an error
531 * 'cuz result sets aren't clonable */
532 };
533
534 /* Method types of the connection methods that are implemented in C */
535
536 const static Tcl_MethodType ConnectionConstructorType = {
537 TCL_OO_METHOD_VERSION_CURRENT,
538 /* version */
539 "CONSTRUCTOR", /* name */
540 ConnectionConstructor, /* callProc */
541 DeleteCmd, /* deleteProc */
542 CloneCmd /* cloneProc */
543 };
544
545 const static Tcl_MethodType ConnectionBegintransactionMethodType = {
546 TCL_OO_METHOD_VERSION_CURRENT,
547 /* version */
548 "begintransaction", /* name */
549 ConnectionBegintransactionMethod, /* callProc */
550 NULL, /* deleteProc */
551 NULL /* cloneProc */
552 };
553 const static Tcl_MethodType ConnectionColumnsMethodType = {
554 TCL_OO_METHOD_VERSION_CURRENT,
555 /* version */
556 "Columns", /* name */
557 ConnectionColumnsMethod, /* callProc */
558 NULL, /* deleteProc */
559 NULL /* cloneProc */
560 };
561 const static Tcl_MethodType ConnectionCommitMethodType = {
562 TCL_OO_METHOD_VERSION_CURRENT,
563 /* version */
564 "commit", /* name */
565 ConnectionCommitMethod, /* callProc */
566 NULL, /* deleteProc */
567 NULL /* cloneProc */
568 };
569 const static Tcl_MethodType ConnectionConfigureMethodType = {
570 TCL_OO_METHOD_VERSION_CURRENT,
571 /* version */
572 "configure", /* name */
573 ConnectionConfigureMethod, /* callProc */
574 NULL, /* deleteProc */
575 NULL /* cloneProc */
576 };
577 const static Tcl_MethodType ConnectionEvaldirectMethodType = {
578 TCL_OO_METHOD_VERSION_CURRENT,
579 /* version */
580 "evaldirect", /* name */
581 ConnectionEvaldirectMethod, /* callProc */
582 NULL, /* deleteProc */
583 NULL /* cloneProc */
584 };
585 const static Tcl_MethodType ConnectionNeedCollationInfoMethodType = {
586 TCL_OO_METHOD_VERSION_CURRENT,
587 /* version */
588 "NeedCollationInfo", /* name */
589 ConnectionNeedCollationInfoMethod, /* callProc */
590 NULL, /* deleteProc */
591 NULL /* cloneProc */
592 };
593 const static Tcl_MethodType ConnectionRollbackMethodType = {
594 TCL_OO_METHOD_VERSION_CURRENT,
595 /* version */
596 "rollback", /* name */
597 ConnectionRollbackMethod, /* callProc */
598 NULL, /* deleteProc */
599 NULL /* cloneProc */
600 };
601 const static Tcl_MethodType ConnectionSetCollationInfoMethodType = {
602 TCL_OO_METHOD_VERSION_CURRENT,
603 /* version */
604 "SetCollationInfo", /* name */
605 ConnectionSetCollationInfoMethod, /* callProc */
606 NULL, /* deleteProc */
607 NULL /* cloneProc */
608 };
609 const static Tcl_MethodType ConnectionTablesMethodType = {
610 TCL_OO_METHOD_VERSION_CURRENT,
611 /* version */
612 "tables", /* name */
613 ConnectionTablesMethod, /* callProc */
614 NULL, /* deleteProc */
615 NULL /* cloneProc */
616 };
617
618 const static Tcl_MethodType* ConnectionMethods[] = {
619 &ConnectionBegintransactionMethodType,
620 &ConnectionColumnsMethodType,
621 &ConnectionCommitMethodType,
622 &ConnectionConfigureMethodType,
623 &ConnectionEvaldirectMethodType,
624 &ConnectionNeedCollationInfoMethodType,
625 &ConnectionRollbackMethodType,
626 &ConnectionSetCollationInfoMethodType,
627 &ConnectionTablesMethodType,
628 NULL
629 };
630
631 /* Method types of the statement methods that are implemented in C */
632
633 const static Tcl_MethodType StatementConstructorType = {
634 TCL_OO_METHOD_VERSION_CURRENT,
635 /* version */
636 "CONSTRUCTOR", /* name */
637 StatementConstructor, /* callProc */
638 NULL, /* deleteProc */
639 NULL /* cloneProc */
640 };
641 const static Tcl_MethodType StatementParamsMethodType = {
642 TCL_OO_METHOD_VERSION_CURRENT,
643 /* version */
644 "params", /* name */
645 StatementParamsMethod, /* callProc */
646 NULL, /* deleteProc */
647 NULL /* cloneProc */
648 };
649 const static Tcl_MethodType StatementParamtypeMethodType = {
650 TCL_OO_METHOD_VERSION_CURRENT,
651 /* version */
652 "paramtype", /* name */
653 StatementParamtypeMethod, /* callProc */
654 NULL, /* deleteProc */
655 NULL /* cloneProc */
656 };
657
658 /*
659 * Methods to create on the statement class.
660 */
661
662 const static Tcl_MethodType* StatementMethods[] = {
663 &StatementParamsMethodType,
664 &StatementParamtypeMethodType,
665 NULL
666 };
667
668 /* Method types of the result set methods that are implemented in C */
669
670 const static Tcl_MethodType ResultSetConstructorType = {
671 TCL_OO_METHOD_VERSION_CURRENT,
672 /* version */
673 "CONSTRUCTOR", /* name */
674 ResultSetConstructor, /* callProc */
675 NULL, /* deleteProc */
676 NULL /* cloneProc */
677 };
678 const static Tcl_MethodType ResultSetColumnsMethodType = {
679 TCL_OO_METHOD_VERSION_CURRENT,
680 /* version */ "columns", /* name */
681 ResultSetColumnsMethod, /* callProc */
682 NULL, /* deleteProc */
683 NULL /* cloneProc */
684 };
685 const static Tcl_MethodType ResultSetNextrowMethodType = {
686 TCL_OO_METHOD_VERSION_CURRENT,
687 /* version */
688 "nextrow", /* name */
689 ResultSetNextrowMethod, /* callProc */
690 NULL, /* deleteProc */
691 NULL /* cloneProc */
692 };
693 const static Tcl_MethodType ResultSetRowcountMethodType = {
694 TCL_OO_METHOD_VERSION_CURRENT,
695 /* version */
696 "rowcount", /* name */
697 ResultSetRowcountMethod, /* callProc */
698 NULL, /* deleteProc */
699 NULL /* cloneProc */
700 };
701
702
703 /* Methods to create on the result set class */
704
705 const static Tcl_MethodType* ResultSetMethods[] = {
706 &ResultSetColumnsMethodType,
707 &ResultSetRowcountMethodType,
708 NULL
709 };
710
711 /*
712 *-----------------------------------------------------------------------------
713 *
714 * MysqlBindAlloc --
715 *
716 * Allocate a number of MYSQL_BIND structures.
717 *
718 * Results:
719 * Returns a pointer to the array of structures, which will be zeroed out.
720 *
721 *-----------------------------------------------------------------------------
722 */
723
724 static MYSQL_BIND*
MysqlBindAlloc(int nBindings)725 MysqlBindAlloc(int nBindings)
726 {
727 int size;
728 void* retval = NULL;
729 if (mysqlClientVersion >= 50100) {
730 size = sizeof(struct st_mysql_bind_51);
731 } else {
732 size = sizeof(struct st_mysql_bind_50);
733 }
734 size *= nBindings;
735 if (size != 0) {
736 retval = ckalloc(size);
737 memset(retval, 0, size);
738 }
739 return (MYSQL_BIND*) retval;
740 }
741
742 /*
743 *-----------------------------------------------------------------------------
744 *
745 * MysqlBindIndex --
746 *
747 * Returns a pointer to one of an array of MYSQL_BIND objects
748 *
749 *-----------------------------------------------------------------------------
750 */
751
752 static MYSQL_BIND*
MysqlBindIndex(MYSQL_BIND * b,int i)753 MysqlBindIndex(
754 MYSQL_BIND* b, /* Binding array to alter */
755 int i /* Index in the binding array */
756 ) {
757 if (mysqlClientVersion >= 50100) {
758 return (MYSQL_BIND*)(((struct st_mysql_bind_51*) b) + i);
759 } else {
760 return (MYSQL_BIND*)(((struct st_mysql_bind_50*) b) + i);
761 }
762 }
763
764 /*
765 *-----------------------------------------------------------------------------
766 *
767 * MysqlBindAllocBuffer --
768 *
769 * Allocates the buffer in a MYSQL_BIND object
770 *
771 * Results:
772 * Returns a pointer to the allocated buffer
773 *
774 *-----------------------------------------------------------------------------
775 */
776
777 static void*
MysqlBindAllocBuffer(MYSQL_BIND * b,int i,unsigned long len)778 MysqlBindAllocBuffer(
779 MYSQL_BIND* b, /* Pointer to a binding array */
780 int i, /* Index into the array */
781 unsigned long len /* Length of the buffer to allocate or 0 */
782 ) {
783 void* block = NULL;
784 if (len != 0) {
785 block = ckalloc(len);
786 }
787 if (mysqlClientVersion >= 50100) {
788 ((struct st_mysql_bind_51*) b)[i].buffer = block;
789 ((struct st_mysql_bind_51*) b)[i].buffer_length = len;
790 } else {
791 ((struct st_mysql_bind_50*) b)[i].buffer = block;
792 ((struct st_mysql_bind_50*) b)[i].buffer_length = len;
793 }
794 return block;
795 }
796
797 /*
798 *-----------------------------------------------------------------------------
799 *
800 * MysqlBindFreeBuffer --
801 *
802 * Frees trhe buffer in a MYSQL_BIND object
803 *
804 * Results:
805 * None.
806 *
807 * Side effects:
808 * Buffer is returned to the system.
809 *
810 *-----------------------------------------------------------------------------
811 */
812 static void
MysqlBindFreeBuffer(MYSQL_BIND * b,int i)813 MysqlBindFreeBuffer(
814 MYSQL_BIND* b, /* Pointer to a binding array */
815 int i /* Index into the array */
816 ) {
817 if (mysqlClientVersion >= 50100) {
818 struct st_mysql_bind_51* bindings = (struct st_mysql_bind_51*) b;
819 if (bindings[i].buffer) {
820 ckfree(bindings[i].buffer);
821 bindings[i].buffer = NULL;
822 }
823 bindings[i].buffer_length = 0;
824 } else {
825 struct st_mysql_bind_50* bindings = (struct st_mysql_bind_50*) b;
826 if (bindings[i].buffer) {
827 ckfree(bindings[i].buffer);
828 bindings[i].buffer = NULL;
829 }
830 bindings[i].buffer_length = 0;
831 }
832 }
833
834 /*
835 *-----------------------------------------------------------------------------
836 *
837 * MysqlBindGetBufferLength, MysqlBindSetBufferType, MysqlBindGetBufferType,
838 * MysqlBindSetLength, MysqlBindSetIsNull,
839 * MysqlBindSetError --
840 *
841 * Access the fields of a MYSQL_BIND object
842 *
843 *-----------------------------------------------------------------------------
844 */
845
846 static void*
MysqlBindGetBuffer(MYSQL_BIND * b,int i)847 MysqlBindGetBuffer(
848 MYSQL_BIND* b, /* Binding array to alter */
849 int i /* Index in the binding array */
850 ) {
851 if (mysqlClientVersion >= 50100) {
852 return ((struct st_mysql_bind_51*) b)[i].buffer;
853 } else {
854 return ((struct st_mysql_bind_50*) b)[i].buffer;
855 }
856 }
857
858 static unsigned long
MysqlBindGetBufferLength(MYSQL_BIND * b,int i)859 MysqlBindGetBufferLength(
860 MYSQL_BIND* b, /* Binding array to alter */
861 int i /* Index in the binding array */
862 ) {
863 if (mysqlClientVersion >= 50100) {
864 return ((struct st_mysql_bind_51*) b)[i].buffer_length;
865 } else {
866 return ((struct st_mysql_bind_50*) b)[i].buffer_length;
867 }
868
869 }
870
871 static enum enum_field_types
MysqlBindGetBufferType(MYSQL_BIND * b,int i)872 MysqlBindGetBufferType(
873 MYSQL_BIND* b, /* Binding array to alter */
874 int i /* Index in the binding array */
875 ) {
876 if (mysqlClientVersion >= 50100) {
877 return ((struct st_mysql_bind_51*) b)[i].buffer_type;
878 } else {
879 return ((struct st_mysql_bind_50*) b)[i].buffer_type;
880 }
881 }
882
883 static void
MysqlBindSetBufferType(MYSQL_BIND * b,int i,enum enum_field_types t)884 MysqlBindSetBufferType(
885 MYSQL_BIND* b, /* Binding array to alter */
886 int i, /* Index in the binding array */
887 enum enum_field_types t /* Buffer type to assign */
888 ) {
889 if (mysqlClientVersion >= 50100) {
890 ((struct st_mysql_bind_51*) b)[i].buffer_type = t;
891 } else {
892 ((struct st_mysql_bind_50*) b)[i].buffer_type = t;
893 }
894 }
895
896 static void
MysqlBindSetLength(MYSQL_BIND * b,int i,unsigned long * p)897 MysqlBindSetLength(
898 MYSQL_BIND* b, /* Binding array to alter */
899 int i, /* Index in the binding array */
900 unsigned long* p /* Length pointer to assign */
901 ) {
902 if (mysqlClientVersion >= 50100) {
903 ((struct st_mysql_bind_51*) b)[i].length = p;
904 } else {
905 ((struct st_mysql_bind_50*) b)[i].length = p;
906 }
907 }
908
909 static void
MysqlBindSetIsNull(MYSQL_BIND * b,int i,my_bool * p)910 MysqlBindSetIsNull(
911 MYSQL_BIND* b, /* Binding array to alter */
912 int i, /* Index in the binding array */
913 my_bool* p /* "Is null" indicator pointer to assign */
914 ) {
915 if (mysqlClientVersion >= 50100) {
916 ((struct st_mysql_bind_51*) b)[i].is_null = p;
917 } else {
918 ((struct st_mysql_bind_50*) b)[i].is_null = p;
919 }
920 }
921
922 static void
MysqlBindSetError(MYSQL_BIND * b,int i,my_bool * p)923 MysqlBindSetError(
924 MYSQL_BIND* b, /* Binding array to alter */
925 int i, /* Index in the binding array */
926 my_bool* p /* Error indicator pointer to assign */
927 ) {
928 if (mysqlClientVersion >= 50100) {
929 ((struct st_mysql_bind_51*) b)[i].error = p;
930 } else {
931 ((struct st_mysql_bind_50*) b)[i].error = p;
932 }
933 }
934
935 /*
936 *-----------------------------------------------------------------------------
937 *
938 * MysqlFieldIndex --
939 *
940 * Return a pointer to a given MYSQL_FIELD structure in an array
941 *
942 * The MYSQL_FIELD structure grows by one pointer between 5.0 and 5.1.
943 * Our code never creates a MYSQL_FIELD, nor does it try to access that
944 * pointer, so we handle things simply by casting the types.
945 *
946 *-----------------------------------------------------------------------------
947 */
948
949 static MYSQL_FIELD*
MysqlFieldIndex(MYSQL_FIELD * fields,int i)950 MysqlFieldIndex(MYSQL_FIELD* fields,
951 /* Pointer to the array*/
952 int i) /* Index in the array */
953 {
954 MYSQL_FIELD* retval;
955 if (mysqlClientVersion >= 50100) {
956 retval = (MYSQL_FIELD*)(((struct st_mysql_field_51*) fields)+i);
957 } else {
958 retval = (MYSQL_FIELD*)(((struct st_mysql_field_50*) fields)+i);
959 }
960 return retval;
961 }
962
963 /*
964 *-----------------------------------------------------------------------------
965 *
966 * TransferMysqlError --
967 *
968 * Obtains the error message, SQL state, and error number from the
969 * MySQL client library and transfers them into the Tcl interpreter
970 *
971 * Results:
972 * None.
973 *
974 * Side effects:
975 * Sets the interpreter result and error code to describe the SQL error
976 *
977 *-----------------------------------------------------------------------------
978 */
979
980 static void
TransferMysqlError(Tcl_Interp * interp,MYSQL * mysqlPtr)981 TransferMysqlError(
982 Tcl_Interp* interp, /* Tcl interpreter */
983 MYSQL* mysqlPtr /* MySQL connection handle */
984 ) {
985 const char* sqlstate = mysql_sqlstate(mysqlPtr);
986 Tcl_Obj* errorCode = Tcl_NewObj();
987 Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj("TDBC", -1));
988 Tcl_ListObjAppendElement(NULL, errorCode,
989 Tcl_NewStringObj(Tdbc_MapSqlState(sqlstate), -1));
990 Tcl_ListObjAppendElement(NULL, errorCode,
991 Tcl_NewStringObj(sqlstate, -1));
992 Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj("MYSQL", -1));
993 Tcl_ListObjAppendElement(NULL, errorCode,
994 Tcl_NewWideIntObj(mysql_errno(mysqlPtr)));
995 Tcl_SetObjErrorCode(interp, errorCode);
996 Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_error(mysqlPtr), -1));
997 }
998
999 /*
1000 *-----------------------------------------------------------------------------
1001 *
1002 * TransferMysqlStmtError --
1003 *
1004 * Obtains the error message, SQL state, and error number from the
1005 * MySQL client library and transfers them into the Tcl interpreter
1006 *
1007 * Results:
1008 * None.
1009 *
1010 * Side effects:
1011 * Sets the interpreter result and error code to describe the SQL error
1012 *
1013 *-----------------------------------------------------------------------------
1014 */
1015
1016 static void
TransferMysqlStmtError(Tcl_Interp * interp,MYSQL_STMT * stmtPtr)1017 TransferMysqlStmtError(
1018 Tcl_Interp* interp, /* Tcl interpreter */
1019 MYSQL_STMT* stmtPtr /* MySQL statment handle */
1020 ) {
1021 const char* sqlstate = mysql_stmt_sqlstate(stmtPtr);
1022 Tcl_Obj* errorCode = Tcl_NewObj();
1023 Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj("TDBC", -1));
1024 Tcl_ListObjAppendElement(NULL, errorCode,
1025 Tcl_NewStringObj(Tdbc_MapSqlState(sqlstate), -1));
1026 Tcl_ListObjAppendElement(NULL, errorCode,
1027 Tcl_NewStringObj(sqlstate, -1));
1028 Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj("MYSQL", -1));
1029 Tcl_ListObjAppendElement(NULL, errorCode,
1030 Tcl_NewWideIntObj(mysql_stmt_errno(stmtPtr)));
1031 Tcl_SetObjErrorCode(interp, errorCode);
1032 Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_stmt_error(stmtPtr), -1));
1033 }
1034
1035 /*
1036 *-----------------------------------------------------------------------------
1037 *
1038 * QueryConnectionOption --
1039 *
1040 * Determine the current value of a connection option.
1041 *
1042 * Results:
1043 * Returns a Tcl object containing the value if successful, or NULL
1044 * if unsuccessful. If unsuccessful, stores error information in the
1045 * Tcl interpreter.
1046 *
1047 *-----------------------------------------------------------------------------
1048 */
1049
1050 static Tcl_Obj*
QueryConnectionOption(ConnectionData * cdata,Tcl_Interp * interp,int optionNum)1051 QueryConnectionOption (
1052 ConnectionData* cdata, /* Connection data */
1053 Tcl_Interp* interp, /* Tcl interpreter */
1054 int optionNum /* Position of the option in the table */
1055 ) {
1056 MYSQL_RES* result; /* Result of the MySQL query for the option */
1057 MYSQL_ROW row; /* Row of the result set */
1058 int fieldCount; /* Number of fields in a row */
1059 unsigned long* lengths; /* Character lengths of the fields */
1060 Tcl_Obj* retval; /* Return value */
1061
1062 if (mysql_query(cdata->mysqlPtr, ConnOptions[optionNum].query)) {
1063 TransferMysqlError(interp, cdata->mysqlPtr);
1064 return NULL;
1065 }
1066 result = mysql_store_result(cdata->mysqlPtr);
1067 if (result == NULL) {
1068 TransferMysqlError(interp, cdata->mysqlPtr);
1069 return NULL;
1070 }
1071 fieldCount = mysql_num_fields(result);
1072 if (fieldCount < 2) {
1073 retval = cdata->pidata->literals[LIT_EMPTY];
1074 } else {
1075 if ((row = mysql_fetch_row(result)) == NULL) {
1076 if (mysql_errno(cdata->mysqlPtr)) {
1077 TransferMysqlError(interp, cdata->mysqlPtr);
1078 mysql_free_result(result);
1079 return NULL;
1080 } else {
1081 retval = cdata->pidata->literals[LIT_EMPTY];
1082 }
1083 } else {
1084 lengths = mysql_fetch_lengths(result);
1085 retval = Tcl_NewStringObj(row[1], lengths[1]);
1086 }
1087 }
1088 mysql_free_result(result);
1089 return retval;
1090 }
1091
1092 /*
1093 *-----------------------------------------------------------------------------
1094 *
1095 * ConfigureConnection --
1096 *
1097 * Applies configuration settings to a MySQL connection.
1098 *
1099 * Results:
1100 * Returns a Tcl result. If the result is TCL_ERROR, error information
1101 * is stored in the interpreter.
1102 *
1103 * Side effects:
1104 * Updates configuration in the connection data. Opens a connection
1105 * if none is yet open.
1106 *
1107 *-----------------------------------------------------------------------------
1108 */
1109
1110 static int
ConfigureConnection(ConnectionData * cdata,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[],int skip)1111 ConfigureConnection(
1112 ConnectionData* cdata, /* Connection data */
1113 Tcl_Interp* interp, /* Tcl interpreter */
1114 int objc, /* Parameter count */
1115 Tcl_Obj* const objv[], /* Parameter data */
1116 int skip /* Number of parameters to skip */
1117 ) {
1118
1119 const char* stringOpts[INDX_MAX];
1120 /* String-valued options */
1121 unsigned long mysqlFlags=0; /* Connection flags */
1122 int sslFlag = 0; /* Flag==1 if SSL configuration is needed */
1123 int optionIndex; /* Index of the current option in ConnOptions */
1124 int optionValue; /* Integer value of the current option */
1125 unsigned short port = 0; /* Server port number */
1126 int isolation = ISOL_NONE; /* Isolation level */
1127 int timeout = 0; /* Timeout value */
1128 int i;
1129 Tcl_Obj* retval;
1130 Tcl_Obj* optval;
1131
1132 if (cdata->mysqlPtr != NULL) {
1133
1134 /* Query configuration options on an existing connection */
1135
1136 if (objc == skip) {
1137 retval = Tcl_NewObj();
1138 for (i = 0; ConnOptions[i].name != NULL; ++i) {
1139 if (ConnOptions[i].flags & CONN_OPT_FLAG_ALIAS) continue;
1140 optval = QueryConnectionOption(cdata, interp, i);
1141 if (optval == NULL) {
1142 return TCL_ERROR;
1143 }
1144 Tcl_DictObjPut(NULL, retval,
1145 Tcl_NewStringObj(ConnOptions[i].name, -1),
1146 optval);
1147 }
1148 Tcl_SetObjResult(interp, retval);
1149 return TCL_OK;
1150 } else if (objc == skip+1) {
1151
1152 if (Tcl_GetIndexFromObjStruct(interp, objv[skip],
1153 (void*) ConnOptions,
1154 sizeof(ConnOptions[0]), "option",
1155 0, &optionIndex) != TCL_OK) {
1156 return TCL_ERROR;
1157 }
1158 retval = QueryConnectionOption(cdata, interp, optionIndex);
1159 if (retval == NULL) {
1160 return TCL_ERROR;
1161 } else {
1162 Tcl_SetObjResult(interp, retval);
1163 return TCL_OK;
1164 }
1165 }
1166 }
1167
1168 if ((objc-skip) % 2 != 0) {
1169 Tcl_WrongNumArgs(interp, skip, objv, "?-option value?...");
1170 return TCL_ERROR;
1171 }
1172
1173 /* Extract options from the command line */
1174
1175 for (i = 0; i < INDX_MAX; ++i) {
1176 stringOpts[i] = NULL;
1177 }
1178 for (i = skip; i < objc; i += 2) {
1179
1180 /* Unknown option */
1181
1182 if (Tcl_GetIndexFromObjStruct(interp, objv[i], (void*) ConnOptions,
1183 sizeof(ConnOptions[0]), "option",
1184 0, &optionIndex) != TCL_OK) {
1185 return TCL_ERROR;
1186 }
1187
1188 /* Unmodifiable option */
1189
1190 if (cdata->mysqlPtr != NULL && !(ConnOptions[optionIndex].flags
1191 & CONN_OPT_FLAG_MOD)) {
1192 Tcl_Obj* msg = Tcl_NewStringObj("\"", -1);
1193 Tcl_AppendObjToObj(msg, objv[i]);
1194 Tcl_AppendToObj(msg, "\" option cannot be changed dynamically", -1);
1195 Tcl_SetObjResult(interp, msg);
1196 Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY000",
1197 "MYSQL", "-1", NULL);
1198 return TCL_ERROR;
1199 }
1200
1201 /* Record option value */
1202
1203 switch (ConnOptions[optionIndex].type) {
1204 case TYPE_STRING:
1205 stringOpts[ConnOptions[optionIndex].info] =
1206 Tcl_GetString(objv[i+1]);
1207 break;
1208 case TYPE_FLAG:
1209 if (Tcl_GetBooleanFromObj(interp, objv[i+1], &optionValue)
1210 != TCL_OK) {
1211 return TCL_ERROR;
1212 }
1213 if (optionValue) {
1214 mysqlFlags |= ConnOptions[optionIndex].info;
1215 }
1216 break;
1217 case TYPE_ENCODING:
1218 if (strcmp(Tcl_GetString(objv[i+1]), "utf-8")) {
1219 Tcl_SetObjResult(interp,
1220 Tcl_NewStringObj("Only UTF-8 transfer "
1221 "encoding is supported.\n",
1222 -1));
1223 Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY000",
1224 "MYSQL", "-1", NULL);
1225 return TCL_ERROR;
1226 }
1227 break;
1228 case TYPE_ISOLATION:
1229 if (Tcl_GetIndexFromObjStruct(interp, objv[i+1], TclIsolationLevels,
1230 sizeof(char *), "isolation level", TCL_EXACT, &isolation)
1231 != TCL_OK) {
1232 return TCL_ERROR;
1233 }
1234 break;
1235 case TYPE_PORT:
1236 if (Tcl_GetIntFromObj(interp, objv[i+1], &optionValue) != TCL_OK) {
1237 return TCL_ERROR;
1238 }
1239 if (optionValue < 0 || optionValue > 0xffff) {
1240 Tcl_SetObjResult(interp, Tcl_NewStringObj("port number must "
1241 "be in range "
1242 "[0..65535]", -1));
1243 Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY000",
1244 "MYSQL", "-1", NULL);
1245 return TCL_ERROR;
1246 }
1247 port = optionValue;
1248 break;
1249 case TYPE_READONLY:
1250 if (Tcl_GetBooleanFromObj(interp, objv[i+1], &optionValue)
1251 != TCL_OK) {
1252 return TCL_ERROR;
1253 }
1254 if (optionValue != 0) {
1255 Tcl_SetObjResult(interp,
1256 Tcl_NewStringObj("MySQL does not support "
1257 "readonly connections", -1));
1258 Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY000",
1259 "MYSQL", "-1", NULL);
1260 return TCL_ERROR;
1261 }
1262 break;
1263 case TYPE_TIMEOUT:
1264 if (Tcl_GetIntFromObj(interp, objv[i+1], &timeout) != TCL_OK) {
1265 return TCL_ERROR;
1266 }
1267 break;
1268 }
1269 if (ConnOptions[optionIndex].flags & CONN_OPT_FLAG_SSL) {
1270 sslFlag = 1;
1271 }
1272 }
1273
1274 if (cdata->mysqlPtr == NULL) {
1275
1276 /* Configuring a new connection. Open the database */
1277
1278 cdata->mysqlPtr = mysql_init(NULL);
1279 if (cdata->mysqlPtr == NULL) {
1280 Tcl_SetObjResult(interp,
1281 Tcl_NewStringObj("mysql_init() failed.", -1));
1282 Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY001",
1283 "MYSQL", "NULL", NULL);
1284 return TCL_ERROR;
1285 }
1286
1287 /* Set character set for the connection */
1288
1289 mysql_options(cdata->mysqlPtr, MYSQL_SET_CHARSET_NAME, "utf8");
1290
1291 /* Set SSL options if needed */
1292
1293 if (sslFlag) {
1294 mysql_ssl_set(cdata->mysqlPtr, stringOpts[INDX_SSLKEY],
1295 stringOpts[INDX_SSLCERT], stringOpts[INDX_SSLCA],
1296 stringOpts[INDX_SSLCAPATH],
1297 stringOpts[INDX_SSLCIPHER]);
1298 }
1299
1300 /* Establish the connection */
1301
1302 /*
1303 * TODO - mutex around this unless linked to libmysqlclient_r ?
1304 */
1305
1306 if (mysql_real_connect(cdata->mysqlPtr, stringOpts[INDX_HOST],
1307 stringOpts[INDX_USER], stringOpts[INDX_PASSWD],
1308 stringOpts[INDX_DB], port,
1309 stringOpts[INDX_SOCKET], mysqlFlags) == NULL) {
1310 TransferMysqlError(interp, cdata->mysqlPtr);
1311 return TCL_ERROR;
1312 }
1313
1314 cdata->flags |= CONN_FLAG_AUTOCOMMIT;
1315
1316 } else {
1317
1318 /* Already open connection */
1319
1320 if (stringOpts[INDX_USER] != NULL) {
1321
1322 /* User name changed - log in again */
1323
1324 if (mysql_change_user(cdata->mysqlPtr,
1325 stringOpts[INDX_USER],
1326 stringOpts[INDX_PASSWD],
1327 stringOpts[INDX_DB])) {
1328 TransferMysqlError(interp, cdata->mysqlPtr);
1329 return TCL_ERROR;
1330 }
1331 } else if (stringOpts[INDX_DB] != NULL) {
1332
1333 /* Database name changed - use the new database */
1334
1335 if (mysql_select_db(cdata->mysqlPtr, stringOpts[INDX_DB])) {
1336 TransferMysqlError(interp, cdata->mysqlPtr);
1337 return TCL_ERROR;
1338 }
1339 }
1340 }
1341
1342 /* Transaction isolation level */
1343
1344 if (isolation != ISOL_NONE) {
1345 if (mysql_query(cdata->mysqlPtr, SqlIsolationLevels[isolation])) {
1346 TransferMysqlError(interp, cdata->mysqlPtr);
1347 return TCL_ERROR;
1348 }
1349 }
1350
1351 /* Timeout */
1352
1353 if (timeout != 0) {
1354 int result;
1355 Tcl_Obj* query = Tcl_ObjPrintf("SET SESSION WAIT_TIMEOUT = %d\n",
1356 timeout);
1357 Tcl_IncrRefCount(query);
1358 result = mysql_query(cdata->mysqlPtr, Tcl_GetString(query));
1359 Tcl_DecrRefCount(query);
1360 if (result) {
1361 TransferMysqlError(interp, cdata->mysqlPtr);
1362 return TCL_ERROR;
1363 }
1364 }
1365
1366 return TCL_OK;
1367 }
1368
1369 /*
1370 *-----------------------------------------------------------------------------
1371 *
1372 * ConnectionConstructor --
1373 *
1374 * Constructor for ::tdbc::mysql::connection, which represents a
1375 * database connection.
1376 *
1377 * Results:
1378 * Returns a standard Tcl result.
1379 *
1380 * The ConnectionInitMethod takes alternating keywords and values giving
1381 * the configuration parameters of the connection, and attempts to connect
1382 * to the database.
1383 *
1384 *-----------------------------------------------------------------------------
1385 */
1386
1387 static int
ConnectionConstructor(ClientData clientData,Tcl_Interp * interp,Tcl_ObjectContext context,int objc,Tcl_Obj * const objv[])1388 ConnectionConstructor(
1389 ClientData clientData, /* Environment handle */
1390 Tcl_Interp* interp, /* Tcl interpreter */
1391 Tcl_ObjectContext context, /* Object context */
1392 int objc, /* Parameter count */
1393 Tcl_Obj *const objv[] /* Parameter vector */
1394 ) {
1395 PerInterpData* pidata = (PerInterpData*) clientData;
1396 /* Per-interp data for the MYSQL package */
1397 Tcl_Object thisObject = Tcl_ObjectContextObject(context);
1398 /* The current object */
1399 int skip = Tcl_ObjectContextSkippedArgs(context);
1400 /* The number of leading arguments to skip */
1401 ConnectionData* cdata; /* Per-connection data */
1402
1403 /* Hang client data on this connection */
1404
1405 cdata = (ConnectionData*) ckalloc(sizeof(ConnectionData));
1406 cdata->refCount = 1;
1407 cdata->pidata = pidata;
1408 cdata->mysqlPtr = NULL;
1409 cdata->nCollations = 0;
1410 cdata->collationSizes = NULL;
1411 cdata->flags = 0;
1412 IncrPerInterpRefCount(pidata);
1413 Tcl_ObjectSetMetadata(thisObject, &connectionDataType, (ClientData) cdata);
1414
1415 /* Configure the connection */
1416
1417 if (ConfigureConnection(cdata, interp, objc, objv, skip) != TCL_OK) {
1418 return TCL_ERROR;
1419 }
1420
1421 return TCL_OK;
1422
1423 }
1424
1425 /*
1426 *-----------------------------------------------------------------------------
1427 *
1428 * ConnectionBegintransactionMethod --
1429 *
1430 * Method that requests that following operations on an OBBC connection
1431 * be executed as an atomic transaction.
1432 *
1433 * Usage:
1434 * $connection begintransaction
1435 *
1436 * Parameters:
1437 * None.
1438 *
1439 * Results:
1440 * Returns an empty result if successful, and throws an error otherwise.
1441 *
1442 *-----------------------------------------------------------------------------
1443 */
1444
1445 static int
ConnectionBegintransactionMethod(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext objectContext,int objc,Tcl_Obj * const objv[])1446 ConnectionBegintransactionMethod(
1447 ClientData dummy, /* Unused */
1448 Tcl_Interp* interp, /* Tcl interpreter */
1449 Tcl_ObjectContext objectContext, /* Object context */
1450 int objc, /* Parameter count */
1451 Tcl_Obj *const objv[] /* Parameter vector */
1452 ) {
1453 Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
1454 /* The current connection object */
1455 ConnectionData* cdata = (ConnectionData*)
1456 Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
1457 (void)dummy;
1458
1459 /* Check parameters */
1460
1461 if (objc != 2) {
1462 Tcl_WrongNumArgs(interp, 2, objv, "");
1463 return TCL_ERROR;
1464 }
1465
1466 /* Reject attempts at nested transactions */
1467
1468 if (cdata->flags & CONN_FLAG_IN_XCN) {
1469 Tcl_SetObjResult(interp, Tcl_NewStringObj("MySQL does not support "
1470 "nested transactions", -1));
1471 Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HYC00",
1472 "MYSQL", "-1", NULL);
1473 return TCL_ERROR;
1474 }
1475 cdata->flags |= CONN_FLAG_IN_XCN;
1476
1477 /* Turn off autocommit for the duration of the transaction */
1478
1479 if (cdata->flags & CONN_FLAG_AUTOCOMMIT) {
1480 if (mysql_autocommit(cdata->mysqlPtr, 0)) {
1481 TransferMysqlError(interp, cdata->mysqlPtr);
1482 return TCL_ERROR;
1483 }
1484 cdata->flags &= ~CONN_FLAG_AUTOCOMMIT;
1485 }
1486
1487 return TCL_OK;
1488 }
1489
1490 /*
1491 *-----------------------------------------------------------------------------
1492 *
1493 * ConnectionColumnsMethod --
1494 *
1495 * Method that asks for the names of columns in a table
1496 * in the database (optionally matching a given pattern)
1497 *
1498 * Usage:
1499 * $connection columns table ?pattern?
1500 *
1501 * Parameters:
1502 * None.
1503 *
1504 * Results:
1505 * Returns the list of tables
1506 *
1507 *-----------------------------------------------------------------------------
1508 */
1509
1510 static int
ConnectionColumnsMethod(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext objectContext,int objc,Tcl_Obj * const objv[])1511 ConnectionColumnsMethod(
1512 ClientData dummy, /* Completion type */
1513 Tcl_Interp* interp, /* Tcl interpreter */
1514 Tcl_ObjectContext objectContext, /* Object context */
1515 int objc, /* Parameter count */
1516 Tcl_Obj *const objv[] /* Parameter vector */
1517 ) {
1518 Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
1519 /* The current connection object */
1520 ConnectionData* cdata = (ConnectionData*)
1521 Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
1522 /* Instance data */
1523 PerInterpData* pidata = cdata->pidata;
1524 /* Per-interpreter data */
1525 Tcl_Obj** literals = pidata->literals;
1526 /* Literal pool */
1527 const char* patternStr; /* Pattern to match table names */
1528 MYSQL_RES* results; /* Result set */
1529 Tcl_Obj* retval; /* List of table names */
1530 Tcl_Obj* name; /* Name of a column */
1531 Tcl_Obj* attrs; /* Attributes of the column */
1532 Tcl_HashEntry* entry; /* Hash entry for data type */
1533 (void)dummy;
1534
1535 /* Check parameters */
1536
1537 if (objc == 3) {
1538 patternStr = NULL;
1539 } else if (objc == 4) {
1540 patternStr = Tcl_GetString(objv[3]);
1541 } else {
1542 Tcl_WrongNumArgs(interp, 2, objv, "table ?pattern?");
1543 return TCL_ERROR;
1544 }
1545
1546 results = mysql_list_fields(cdata->mysqlPtr, Tcl_GetString(objv[2]),
1547 patternStr);
1548 if (results == NULL) {
1549 TransferMysqlError(interp, cdata->mysqlPtr);
1550 return TCL_ERROR;
1551 } else {
1552 unsigned int fieldCount = mysql_num_fields(results);
1553 MYSQL_FIELD* fields = mysql_fetch_fields(results);
1554 unsigned int i;
1555 retval = Tcl_NewObj();
1556 Tcl_IncrRefCount(retval);
1557 for (i = 0; i < fieldCount; ++i) {
1558 MYSQL_FIELD* field = MysqlFieldIndex(fields, i);
1559 attrs = Tcl_NewObj();
1560 name = Tcl_NewStringObj(field->name, field->name_length);
1561
1562 Tcl_DictObjPut(NULL, attrs, literals[LIT_NAME], name);
1563 /* TODO - Distinguish CHAR and BINARY */
1564 entry = Tcl_FindHashEntry(&(pidata->typeNumHash),
1565 (char*) field->type);
1566 if (entry != NULL) {
1567 Tcl_DictObjPut(NULL, attrs, literals[LIT_TYPE],
1568 (Tcl_Obj*) Tcl_GetHashValue(entry));
1569 }
1570 if (IS_NUM(field->type)) {
1571 Tcl_DictObjPut(NULL, attrs, literals[LIT_PRECISION],
1572 Tcl_NewWideIntObj(field->length));
1573 } else if (field->charsetnr < cdata->nCollations) {
1574 Tcl_DictObjPut(NULL, attrs, literals[LIT_PRECISION],
1575 Tcl_NewWideIntObj(field->length
1576 / cdata->collationSizes[field->charsetnr]));
1577 }
1578 Tcl_DictObjPut(NULL, attrs, literals[LIT_SCALE],
1579 Tcl_NewWideIntObj(field->decimals));
1580 Tcl_DictObjPut(NULL, attrs, literals[LIT_NULLABLE],
1581 Tcl_NewWideIntObj(!(field->flags
1582 & (NOT_NULL_FLAG))));
1583 Tcl_DictObjPut(NULL, retval, name, attrs);
1584 }
1585 mysql_free_result(results);
1586 Tcl_SetObjResult(interp, retval);
1587 Tcl_DecrRefCount(retval);
1588 return TCL_OK;
1589 }
1590 }
1591
1592 /*
1593 *-----------------------------------------------------------------------------
1594 *
1595 * ConnectionCommitMethod --
1596 *
1597 * Method that requests that a pending transaction against a database
1598 * be committed.
1599 *
1600 * Usage:
1601 * $connection commit
1602 *
1603 * Parameters:
1604 * None.
1605 *
1606 * Results:
1607 * Returns an empty Tcl result if successful, and throws an error
1608 * otherwise.
1609 *
1610 *-----------------------------------------------------------------------------
1611 */
1612
1613 static int
ConnectionCommitMethod(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext objectContext,int objc,Tcl_Obj * const objv[])1614 ConnectionCommitMethod(
1615 ClientData dummy, /* Not used */
1616 Tcl_Interp* interp, /* Tcl interpreter */
1617 Tcl_ObjectContext objectContext, /* Object context */
1618 int objc, /* Parameter count */
1619 Tcl_Obj *const objv[] /* Parameter vector */
1620 ) {
1621 Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
1622 /* The current connection object */
1623 ConnectionData* cdata = (ConnectionData*)
1624 Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
1625 /* Instance data */
1626 my_bool rc; /* MySQL status return */
1627 (void)dummy;
1628
1629 /* Check parameters */
1630
1631 if (objc != 2) {
1632 Tcl_WrongNumArgs(interp, 2, objv, "");
1633 return TCL_ERROR;
1634 }
1635
1636 /* Reject the request if no transaction is in progress */
1637
1638 if (!(cdata->flags & CONN_FLAG_IN_XCN)) {
1639 Tcl_SetObjResult(interp, Tcl_NewStringObj("no transaction is in "
1640 "progress", -1));
1641 Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY010",
1642 "MYSQL", "-1", NULL);
1643 return TCL_ERROR;
1644 }
1645
1646 /* End transaction, turn off "transaction in progress", and report status */
1647
1648 rc = mysql_commit(cdata->mysqlPtr);
1649 cdata->flags &= ~ CONN_FLAG_IN_XCN;
1650 if (rc) {
1651 TransferMysqlError(interp, cdata->mysqlPtr);
1652 return TCL_ERROR;
1653 }
1654 return TCL_OK;
1655 }
1656
1657 /*
1658 *-----------------------------------------------------------------------------
1659 *
1660 * ConnectionConfigureMethod --
1661 *
1662 * Change configuration parameters on an open connection.
1663 *
1664 * Usage:
1665 * $connection configure ?-keyword? ?value? ?-keyword value ...?
1666 *
1667 * Parameters:
1668 * Keyword-value pairs (or a single keyword, or an empty set)
1669 * of configuration options.
1670 *
1671 * Options:
1672 * The following options are supported;
1673 * -database
1674 * Name of the database to use by default in queries
1675 * -encoding
1676 * Character encoding to use with the server. (Must be utf-8)
1677 * -isolation
1678 * Transaction isolation level.
1679 * -readonly
1680 * Read-only flag (must be a false Boolean value)
1681 * -timeout
1682 * Timeout value (both wait_timeout and interactive_timeout)
1683 *
1684 * Other options supported by the constructor are here in read-only
1685 * mode; any attempt to change them will result in an error.
1686 *
1687 *-----------------------------------------------------------------------------
1688 */
1689
ConnectionConfigureMethod(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext objectContext,int objc,Tcl_Obj * const objv[])1690 static int ConnectionConfigureMethod(
1691 ClientData dummy,
1692 Tcl_Interp* interp,
1693 Tcl_ObjectContext objectContext,
1694 int objc,
1695 Tcl_Obj *const objv[]
1696 ) {
1697 Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
1698 /* The current connection object */
1699 int skip = Tcl_ObjectContextSkippedArgs(objectContext);
1700 /* Number of arguments to skip */
1701 ConnectionData* cdata = (ConnectionData*)
1702 Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
1703 (void)dummy;
1704
1705 /* Instance data */
1706 return ConfigureConnection(cdata, interp, objc, objv, skip);
1707 }
1708
1709 /*
1710 *-----------------------------------------------------------------------------
1711 *
1712 * ConnectionEvaldirectMethod --
1713 *
1714 * Evaluates a MySQL statement that is not supported by the prepared
1715 * statement API.
1716 *
1717 * Usage:
1718 * $connection evaldirect sql-statement
1719 *
1720 * Parameters:
1721 * sql-statement -
1722 * SQL statement to evaluate. The statement may not contain
1723 * substitutions.
1724 *
1725 * Results:
1726 * Returns a standard Tcl result. If the operation is successful,
1727 * the result consists of a list of rows (in the same form as
1728 * [$connection allrows -as dicts]). If the operation fails, the
1729 * result is an error message.
1730 *
1731 * Side effects:
1732 * Whatever the SQL statement does.
1733 *
1734 *-----------------------------------------------------------------------------
1735 */
1736
1737 static int
ConnectionEvaldirectMethod(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext objectContext,int objc,Tcl_Obj * const objv[])1738 ConnectionEvaldirectMethod(
1739 ClientData dummy, /* Unused */
1740 Tcl_Interp* interp, /* Tcl interpreter */
1741 Tcl_ObjectContext objectContext, /* Object context */
1742 int objc, /* Parameter count */
1743 Tcl_Obj *const objv[]) /* Parameter vector */
1744 {
1745 Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
1746 /* Current connection object */
1747 ConnectionData* cdata = (ConnectionData*)
1748 Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
1749 /* Instance data */
1750 int nColumns; /* Number of columns in the result set */
1751 MYSQL_RES* resultPtr; /* MySQL result set */
1752 MYSQL_ROW rowPtr; /* One row of the result set */
1753 unsigned long* lengths; /* Lengths of the fields in a row */
1754 Tcl_Obj* retObj; /* Result set as a Tcl list */
1755 Tcl_Obj* rowObj; /* One row of the result set as a Tcl list */
1756 Tcl_Obj* fieldObj; /* One field of the row */
1757 int i;
1758 (void)dummy;
1759
1760 /* Check parameters */
1761
1762 if (objc != 3) {
1763 Tcl_WrongNumArgs(interp, 2, objv, "");
1764 return TCL_ERROR;
1765 }
1766
1767 /* Execute the given statement */
1768
1769 if (mysql_query(cdata->mysqlPtr, Tcl_GetString(objv[2]))) {
1770 TransferMysqlError(interp, cdata->mysqlPtr);
1771 return TCL_ERROR;
1772 }
1773
1774 /* Retrieve the result set */
1775
1776 resultPtr = mysql_store_result(cdata->mysqlPtr);
1777 nColumns = mysql_field_count(cdata->mysqlPtr);
1778 if (resultPtr == NULL) {
1779 /*
1780 * Can't retrieve result set. Distinguish result-less statements
1781 * from MySQL errors.
1782 */
1783 if (nColumns == 0) {
1784 Tcl_SetObjResult
1785 (interp,
1786 Tcl_NewWideIntObj(mysql_affected_rows(cdata->mysqlPtr)));
1787 return TCL_OK;
1788 } else {
1789 TransferMysqlError(interp, cdata->mysqlPtr);
1790 return TCL_ERROR;
1791 }
1792 }
1793
1794 /* Make a list-of-lists of the result */
1795
1796 retObj = Tcl_NewObj();
1797 while ((rowPtr = mysql_fetch_row(resultPtr)) != NULL) {
1798 rowObj = Tcl_NewObj();
1799 lengths = mysql_fetch_lengths(resultPtr);
1800 for (i = 0; i < nColumns; ++i) {
1801 if (rowPtr[i] != NULL) {
1802 fieldObj = Tcl_NewStringObj(rowPtr[i], lengths[i]);
1803 } else {
1804 fieldObj = cdata->pidata->literals[LIT_EMPTY];
1805 }
1806 Tcl_ListObjAppendElement(NULL, rowObj, fieldObj);
1807 }
1808 Tcl_ListObjAppendElement(NULL, retObj, rowObj);
1809 }
1810 Tcl_SetObjResult(interp, retObj);
1811
1812 /*
1813 * Free the result set.
1814 */
1815 mysql_free_result(resultPtr);
1816
1817 return TCL_OK;
1818 }
1819
1820
1821 /*
1822 *-----------------------------------------------------------------------------
1823 *
1824 * ConnectionNeedCollationInfoMethod --
1825 *
1826 * Internal method that determines whether the collation lengths
1827 * are known yet.
1828 *
1829 * Usage:
1830 * $connection NeedCollationInfo
1831 *
1832 * Parameters:
1833 * None.
1834 *
1835 * Results:
1836 * Returns a Boolean value.
1837 *
1838 *-----------------------------------------------------------------------------
1839 */
1840
1841 static int
ConnectionNeedCollationInfoMethod(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext objectContext,int objc,Tcl_Obj * const objv[])1842 ConnectionNeedCollationInfoMethod(
1843 ClientData dummy, /* Not used */
1844 Tcl_Interp* interp, /* Tcl interpreter */
1845 Tcl_ObjectContext objectContext, /* Object context */
1846 int objc, /* Parameter count */
1847 Tcl_Obj *const objv[] /* Parameter vector */
1848 ) {
1849 Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
1850 /* The current connection object */
1851 ConnectionData* cdata = (ConnectionData*)
1852 Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
1853 /* Instance data */
1854 (void)dummy;
1855
1856 if (objc != 2) {
1857 Tcl_WrongNumArgs(interp, 2, objv, "");
1858 return TCL_ERROR;
1859 }
1860
1861 Tcl_SetObjResult(interp, Tcl_NewWideIntObj(cdata->collationSizes == NULL));
1862 return TCL_OK;
1863 }
1864
1865 /*
1866 *-----------------------------------------------------------------------------
1867 *
1868 * ConnectionRollbackMethod --
1869 *
1870 * Method that requests that a pending transaction against a database
1871 * be rolled back.
1872 *
1873 * Usage:
1874 * $connection rollback
1875 *
1876 * Parameters:
1877 * None.
1878 *
1879 * Results:
1880 * Returns an empty Tcl result if successful, and throws an error
1881 * otherwise.
1882 *
1883 *-----------------------------------------------------------------------------
1884 */
1885
1886 static int
ConnectionRollbackMethod(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext objectContext,int objc,Tcl_Obj * const objv[])1887 ConnectionRollbackMethod(
1888 ClientData dummy, /* Not used */
1889 Tcl_Interp* interp, /* Tcl interpreter */
1890 Tcl_ObjectContext objectContext, /* Object context */
1891 int objc, /* Parameter count */
1892 Tcl_Obj *const objv[] /* Parameter vector */
1893 ) {
1894 Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
1895 /* The current connection object */
1896 ConnectionData* cdata = (ConnectionData*)
1897 Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
1898 /* Instance data */
1899 my_bool rc; /* Result code from MySQL operations */
1900 (void)dummy;
1901
1902 /* Check parameters */
1903
1904 if (objc != 2) {
1905 Tcl_WrongNumArgs(interp, 2, objv, "");
1906 return TCL_ERROR;
1907 }
1908
1909 /* Reject the request if no transaction is in progress */
1910
1911 if (!(cdata->flags & CONN_FLAG_IN_XCN)) {
1912 Tcl_SetObjResult(interp, Tcl_NewStringObj("no transaction is in "
1913 "progress", -1));
1914 Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY010",
1915 "MYSQL", "-1", NULL);
1916 return TCL_ERROR;
1917 }
1918
1919 /* End transaction, turn off "transaction in progress", and report status */
1920
1921 rc = mysql_rollback(cdata->mysqlPtr);
1922 cdata->flags &= ~CONN_FLAG_IN_XCN;
1923 if (rc) {
1924 TransferMysqlError(interp, cdata->mysqlPtr);
1925 return TCL_ERROR;
1926 }
1927 return TCL_OK;
1928 }
1929
1930 /*
1931 *-----------------------------------------------------------------------------
1932 *
1933 * ConnectionSetCollationInfoMethod --
1934 *
1935 * Internal method that saves the character lengths of the collations
1936 *
1937 * Usage:
1938 * $connection SetCollationInfo {collationNum size} ...
1939 *
1940 * Parameters:
1941 * One or more pairs of collation number and character length,
1942 * ordered in decreasing sequence by collation number.
1943 *
1944 * Results:
1945 * None.
1946 *
1947 * The [$connection columns $table] method needs to know the sizes
1948 * of characters in a given column's collation and character set.
1949 * This information is available by querying INFORMATION_SCHEMA, which
1950 * is easier to do from Tcl than C. This method passes in the results.
1951 *
1952 *-----------------------------------------------------------------------------
1953 */
1954
1955 static int
ConnectionSetCollationInfoMethod(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext objectContext,int objc,Tcl_Obj * const objv[])1956 ConnectionSetCollationInfoMethod(
1957 ClientData dummy, /* Not used */
1958 Tcl_Interp* interp, /* Tcl interpreter */
1959 Tcl_ObjectContext objectContext, /* Object context */
1960 int objc, /* Parameter count */
1961 Tcl_Obj *const objv[] /* Parameter vector */
1962 ) {
1963 Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
1964 /* The current connection object */
1965 ConnectionData* cdata = (ConnectionData*)
1966 Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
1967 /* Instance data */
1968 int listLen;
1969 Tcl_Obj* objPtr;
1970 unsigned int collationNum;
1971 int i;
1972 int t;
1973 (void)dummy;
1974
1975 if (objc <= 2) {
1976 Tcl_WrongNumArgs(interp, 2, objv, "{collationNum size}...");
1977 return TCL_ERROR;
1978 }
1979 if (Tcl_ListObjIndex(interp, objv[2], 0, &objPtr) != TCL_OK) {
1980 return TCL_ERROR;
1981 }
1982 if (Tcl_GetIntFromObj(interp, objPtr, &t) != TCL_OK) {
1983 return TCL_ERROR;
1984 }
1985 cdata->nCollations = (unsigned int)(t+1);
1986 if (cdata->collationSizes) {
1987 ckfree((char*) cdata->collationSizes);
1988 }
1989 cdata->collationSizes =
1990 (int*) ckalloc(cdata->nCollations * sizeof(int));
1991 memset(cdata->collationSizes, 0, cdata->nCollations * sizeof(int));
1992 for (i = 2; i < objc; ++i) {
1993 if (Tcl_ListObjLength(interp, objv[i], &listLen) != TCL_OK) {
1994 return TCL_ERROR;
1995 }
1996 if (listLen != 2) {
1997 Tcl_SetObjResult(interp, Tcl_NewStringObj("args must be 2-element "
1998 "lists", -1));
1999 return TCL_ERROR;
2000 }
2001 if (Tcl_ListObjIndex(interp, objv[i], 0, &objPtr) != TCL_OK
2002 || Tcl_GetIntFromObj(interp, objPtr, &t) != TCL_OK) {
2003 return TCL_ERROR;
2004 }
2005 collationNum = (unsigned int) t;
2006 if (collationNum > cdata->nCollations) {
2007 Tcl_SetObjResult(interp, Tcl_NewStringObj("collations must be "
2008 "in decreasing sequence",
2009 -1));
2010 return TCL_ERROR;
2011 }
2012 if ((Tcl_ListObjIndex(interp, objv[i], 1, &objPtr) != TCL_OK)
2013 || (Tcl_GetIntFromObj(interp, objPtr,
2014 cdata->collationSizes+collationNum)
2015 != TCL_OK)) {
2016 return TCL_ERROR;
2017 }
2018 }
2019 return TCL_OK;
2020 }
2021
2022 /*
2023 *-----------------------------------------------------------------------------
2024 *
2025 * ConnectionTablesMethod --
2026 *
2027 * Method that asks for the names of tables in the database (optionally
2028 * matching a given pattern
2029 *
2030 * Usage:
2031 * $connection tables ?pattern?
2032 *
2033 * Parameters:
2034 * None.
2035 *
2036 * Results:
2037 * Returns the list of tables
2038 *
2039 *-----------------------------------------------------------------------------
2040 */
2041
2042 static int
ConnectionTablesMethod(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext objectContext,int objc,Tcl_Obj * const objv[])2043 ConnectionTablesMethod(
2044 ClientData dummy, /* Not used */
2045 Tcl_Interp* interp, /* Tcl interpreter */
2046 Tcl_ObjectContext objectContext, /* Object context */
2047 int objc, /* Parameter count */
2048 Tcl_Obj *const objv[] /* Parameter vector */
2049 ) {
2050 Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
2051 /* The current connection object */
2052 ConnectionData* cdata = (ConnectionData*)
2053 Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
2054 /* Instance data */
2055 Tcl_Obj** literals = cdata->pidata->literals;
2056 /* Literal pool */
2057 const char* patternStr = NULL;
2058 /* Pattern to match table names */
2059 MYSQL_RES* results = NULL; /* Result set */
2060 MYSQL_ROW row = NULL; /* Row in the result set */
2061 int status = TCL_OK; /* Return status */
2062 Tcl_Obj* retval = NULL; /* List of table names */
2063 (void)dummy;
2064
2065 /* Check parameters */
2066
2067 if (objc == 2) {
2068 patternStr = NULL;
2069 } else if (objc == 3) {
2070 patternStr = Tcl_GetString(objv[2]);
2071 } else {
2072 Tcl_WrongNumArgs(interp, 2, objv, "");
2073 return TCL_ERROR;
2074 }
2075
2076 results = mysql_list_tables(cdata->mysqlPtr, patternStr);
2077 if (results == NULL) {
2078 TransferMysqlError(interp, cdata->mysqlPtr);
2079 return TCL_ERROR;
2080 } else {
2081 retval = Tcl_NewObj();
2082 Tcl_IncrRefCount(retval);
2083 while ((row = mysql_fetch_row(results)) != NULL) {
2084 unsigned long * lengths = mysql_fetch_lengths(results);
2085 if (row[0]) {
2086 Tcl_ListObjAppendElement(NULL, retval,
2087 Tcl_NewStringObj(row[0],
2088 (int)lengths[0]));
2089 Tcl_ListObjAppendElement(NULL, retval, literals[LIT_EMPTY]);
2090 }
2091 }
2092 if (mysql_errno(cdata->mysqlPtr)) {
2093 TransferMysqlError(interp, cdata->mysqlPtr);
2094 status = TCL_ERROR;
2095 }
2096 if (status == TCL_OK) {
2097 Tcl_SetObjResult(interp, retval);
2098 }
2099 Tcl_DecrRefCount(retval);
2100 mysql_free_result(results);
2101 return status;
2102 }
2103 }
2104
2105 /*
2106 *-----------------------------------------------------------------------------
2107 *
2108 * DeleteCmd --
2109 *
2110 * Callback executed when the initialization method of the connection
2111 * class is deleted.
2112 *
2113 * Side effects:
2114 * Dismisses the environment, which has the effect of shutting
2115 * down MYSQL when it is no longer required.
2116 *
2117 *-----------------------------------------------------------------------------
2118 */
2119
2120 static void
DeleteCmd(ClientData clientData)2121 DeleteCmd (
2122 ClientData clientData /* Environment handle */
2123 ) {
2124 PerInterpData* pidata = (PerInterpData*) clientData;
2125 DecrPerInterpRefCount(pidata);
2126 }
2127
2128 /*
2129 *-----------------------------------------------------------------------------
2130 *
2131 * CloneCmd --
2132 *
2133 * Callback executed when any of the MYSQL client methods is cloned.
2134 *
2135 * Results:
2136 * Returns TCL_OK to allow the method to be copied.
2137 *
2138 * Side effects:
2139 * Obtains a fresh copy of the environment handle, to keep the
2140 * refcounts accurate
2141 *
2142 *-----------------------------------------------------------------------------
2143 */
2144
2145 static int
CloneCmd(Tcl_Interp * dummy,ClientData oldClientData,ClientData * newClientData)2146 CloneCmd(
2147 Tcl_Interp* dummy, /* Tcl interpreter */
2148 ClientData oldClientData, /* Environment handle to be discarded */
2149 ClientData* newClientData /* New environment handle to be used */
2150 ) {
2151 (void)dummy;
2152
2153 *newClientData = oldClientData;
2154 return TCL_OK;
2155 }
2156
2157 /*
2158 *-----------------------------------------------------------------------------
2159 *
2160 * DeleteConnectionMetadata, DeleteConnection --
2161 *
2162 * Cleans up when a database connection is deleted.
2163 *
2164 * Results:
2165 * None.
2166 *
2167 * Side effects:
2168 * Terminates the connection and frees all system resources associated
2169 * with it.
2170 *
2171 *-----------------------------------------------------------------------------
2172 */
2173
2174 static void
DeleteConnectionMetadata(ClientData clientData)2175 DeleteConnectionMetadata(
2176 ClientData clientData /* Instance data for the connection */
2177 ) {
2178 DecrConnectionRefCount((ConnectionData*)clientData);
2179 }
2180
2181 static void
DeleteConnection(ConnectionData * cdata)2182 DeleteConnection(
2183 ConnectionData* cdata /* Instance data for the connection */
2184 ) {
2185 if (cdata->collationSizes != NULL) {
2186 ckfree((char*) cdata->collationSizes);
2187 }
2188 if (cdata->mysqlPtr != NULL) {
2189 mysql_close(cdata->mysqlPtr);
2190 }
2191 DecrPerInterpRefCount(cdata->pidata);
2192 ckfree((char*) cdata);
2193 }
2194
2195 /*
2196 *-----------------------------------------------------------------------------
2197 *
2198 * CloneConnection --
2199 *
2200 * Attempts to clone an MYSQL connection's metadata.
2201 *
2202 * Results:
2203 * Returns the new metadata
2204 *
2205 * At present, we don't attempt to clone connections - it's not obvious
2206 * that such an action would ever even make sense. Instead, we return NULL
2207 * to indicate that the metadata should not be cloned. (Note that this
2208 * action isn't right, either. What *is* right is to indicate that the object
2209 * is not clonable, but the API gives us no way to do that.
2210 *
2211 *-----------------------------------------------------------------------------
2212 */
2213
2214 static int
CloneConnection(Tcl_Interp * interp,ClientData metadata,ClientData * newMetaData)2215 CloneConnection(
2216 Tcl_Interp* interp, /* Tcl interpreter for error reporting */
2217 ClientData metadata, /* Metadata to be cloned */
2218 ClientData* newMetaData /* Where to put the cloned metadata */
2219 ) {
2220 (void)metadata;
2221 (void)newMetaData;
2222
2223 Tcl_SetObjResult(interp,
2224 Tcl_NewStringObj("MYSQL connections are not clonable", -1));
2225 return TCL_ERROR;
2226 }
2227
2228 /*
2229 *-----------------------------------------------------------------------------
2230 *
2231 * NewStatement --
2232 *
2233 * Creates an empty object to hold statement data.
2234 *
2235 * Results:
2236 * Returns a pointer to the newly-created object.
2237 *
2238 *-----------------------------------------------------------------------------
2239 */
2240
2241 static StatementData*
NewStatement(ConnectionData * cdata)2242 NewStatement(
2243 ConnectionData* cdata /* Instance data for the connection */
2244 ) {
2245 StatementData* sdata = (StatementData*) ckalloc(sizeof(StatementData));
2246 sdata->refCount = 1;
2247 sdata->cdata = cdata;
2248 IncrConnectionRefCount(cdata);
2249 sdata->subVars = Tcl_NewObj();
2250 Tcl_IncrRefCount(sdata->subVars);
2251 sdata->params = NULL;
2252 sdata->nativeSql = NULL;
2253 sdata->stmtPtr = NULL;
2254 sdata->metadataPtr = NULL;
2255 sdata->columnNames = NULL;
2256 sdata->flags = 0;
2257 return sdata;
2258 }
2259
2260 /*
2261 *-----------------------------------------------------------------------------
2262 *
2263 * AllocAndPrepareStatement --
2264 *
2265 * Allocate space for a MySQL prepared statement, and prepare the
2266 * statement.
2267 *
2268 * Results:
2269 * Returns the statement handle if successful, and NULL on failure.
2270 *
2271 * Side effects:
2272 * Prepares the statement.
2273 * Stores error message and error code in the interpreter on failure.
2274 *
2275 *-----------------------------------------------------------------------------
2276 */
2277
2278 static MYSQL_STMT*
AllocAndPrepareStatement(Tcl_Interp * interp,StatementData * sdata)2279 AllocAndPrepareStatement(
2280 Tcl_Interp* interp, /* Tcl interpreter for error reporting */
2281 StatementData* sdata /* Statement data */
2282 ) {
2283 ConnectionData* cdata = sdata->cdata;
2284 /* Connection data */
2285 MYSQL_STMT* stmtPtr; /* Statement handle */
2286 const char* nativeSqlStr; /* Native SQL statement to prepare */
2287 int nativeSqlLen; /* Length of the statement */
2288
2289 /* Allocate space for the prepared statement */
2290
2291 stmtPtr = mysql_stmt_init(cdata->mysqlPtr);
2292 /*
2293 * MySQL allows only one writable cursor open at a time, and
2294 * the default cursor type is writable. Make all our cursors
2295 * read-only to avoid 'Commands out of sync' errors.
2296 */
2297
2298 if (stmtPtr == NULL) {
2299 TransferMysqlError(interp, cdata->mysqlPtr);
2300 } else {
2301
2302 /* Prepare the statement */
2303
2304 nativeSqlStr = Tcl_GetStringFromObj(sdata->nativeSql, &nativeSqlLen);
2305 if (mysql_stmt_prepare(stmtPtr, nativeSqlStr, nativeSqlLen)) {
2306 TransferMysqlStmtError(interp, stmtPtr);
2307 mysql_stmt_close(stmtPtr);
2308 stmtPtr = NULL;
2309 }
2310 }
2311 return stmtPtr;
2312 }
2313
2314 /*
2315 *-----------------------------------------------------------------------------
2316 *
2317 * ResultDescToTcl --
2318 *
2319 * Converts a MySQL result description for return as a Tcl list.
2320 *
2321 * Results:
2322 * Returns a Tcl object holding the result description
2323 *
2324 * If any column names are duplicated, they are disambiguated by
2325 * appending '#n' where n increments once for each occurrence of the
2326 * column name.
2327 *
2328 *-----------------------------------------------------------------------------
2329 */
2330
2331 static Tcl_Obj*
ResultDescToTcl(MYSQL_RES * result,int flags)2332 ResultDescToTcl(
2333 MYSQL_RES* result, /* Result set description */
2334 int flags /* Flags governing the conversion */
2335 ) {
2336 Tcl_Obj* retval = Tcl_NewObj();
2337 Tcl_HashTable names; /* Hash table to resolve name collisions */
2338 Tcl_Obj* nameObj; /* Name of a result column */
2339 int isNew; /* Flag == 1 if a result column is unique */
2340 Tcl_HashEntry* entry; /* Hash table entry for a column name */
2341 int count; /* Number used to disambiguate a column name */
2342 (void)flags;
2343
2344 Tcl_InitHashTable(&names, TCL_STRING_KEYS);
2345 if (result != NULL) {
2346 unsigned int fieldCount = mysql_num_fields(result);
2347 MYSQL_FIELD* fields = mysql_fetch_fields(result);
2348 unsigned int i;
2349 char numbuf[16];
2350 for (i = 0; i < fieldCount; ++i) {
2351 MYSQL_FIELD* field = MysqlFieldIndex(fields, i);
2352 nameObj = Tcl_NewStringObj(field->name, field->name_length);
2353 Tcl_IncrRefCount(nameObj);
2354 entry = Tcl_CreateHashEntry(&names, field->name, &isNew);
2355 count = 1;
2356 while (!isNew) {
2357 count = PTR2INT(Tcl_GetHashValue(entry));
2358 ++count;
2359 Tcl_SetHashValue(entry, INT2PTR(count));
2360 sprintf(numbuf, "#%d", count);
2361 Tcl_AppendToObj(nameObj, numbuf, -1);
2362 entry = Tcl_CreateHashEntry(&names, Tcl_GetString(nameObj),
2363 &isNew);
2364 }
2365 Tcl_SetHashValue(entry, INT2PTR(count));
2366 Tcl_ListObjAppendElement(NULL, retval, nameObj);
2367 Tcl_DecrRefCount(nameObj);
2368 }
2369 }
2370 Tcl_DeleteHashTable(&names);
2371 return retval;
2372 }
2373
2374 /*
2375 *-----------------------------------------------------------------------------
2376 *
2377 * StatementConstructor --
2378 *
2379 * C-level initialization for the object representing an MySQL prepared
2380 * statement.
2381 *
2382 * Usage:
2383 * statement new connection statementText
2384 * statement create name connection statementText
2385 *
2386 * Parameters:
2387 * connection -- the MySQL connection object
2388 * statementText -- text of the statement to prepare.
2389 *
2390 * Results:
2391 * Returns a standard Tcl result
2392 *
2393 * Side effects:
2394 * Prepares the statement, and stores it (plus a reference to the
2395 * connection) in instance metadata.
2396 *
2397 *-----------------------------------------------------------------------------
2398 */
2399
2400 static int
StatementConstructor(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext context,int objc,Tcl_Obj * const objv[])2401 StatementConstructor(
2402 ClientData dummy, /* Not used */
2403 Tcl_Interp* interp, /* Tcl interpreter */
2404 Tcl_ObjectContext context, /* Object context */
2405 int objc, /* Parameter count */
2406 Tcl_Obj *const objv[] /* Parameter vector */
2407 ) {
2408 Tcl_Object thisObject = Tcl_ObjectContextObject(context);
2409 /* The current statement object */
2410 int skip = Tcl_ObjectContextSkippedArgs(context);
2411 /* Number of args to skip before the
2412 * payload arguments */
2413 Tcl_Object connectionObject;
2414 /* The database connection as a Tcl_Object */
2415 ConnectionData* cdata; /* The connection object's data */
2416 StatementData* sdata; /* The statement's object data */
2417 Tcl_Obj* tokens; /* The tokens of the statement to be prepared */
2418 int tokenc; /* Length of the 'tokens' list */
2419 Tcl_Obj** tokenv; /* Exploded tokens from the list */
2420 Tcl_Obj* nativeSql; /* SQL statement mapped to native form */
2421 char* tokenStr; /* Token string */
2422 int tokenLen; /* Length of a token */
2423 int nParams; /* Number of parameters of the statement */
2424 int i;
2425 (void)dummy;
2426
2427 /* Find the connection object, and get its data. */
2428
2429 thisObject = Tcl_ObjectContextObject(context);
2430 if (objc != skip+2) {
2431 Tcl_WrongNumArgs(interp, skip, objv, "connection statementText");
2432 return TCL_ERROR;
2433 }
2434
2435 connectionObject = Tcl_GetObjectFromObj(interp, objv[skip]);
2436 if (connectionObject == NULL) {
2437 return TCL_ERROR;
2438 }
2439 cdata = (ConnectionData*) Tcl_ObjectGetMetadata(connectionObject,
2440 &connectionDataType);
2441 if (cdata == NULL) {
2442 Tcl_AppendResult(interp, Tcl_GetString(objv[skip]),
2443 " does not refer to a MySQL connection", NULL);
2444 return TCL_ERROR;
2445 }
2446
2447 /*
2448 * Allocate an object to hold data about this statement
2449 */
2450
2451 sdata = NewStatement(cdata);
2452
2453 /* Tokenize the statement */
2454
2455 tokens = Tdbc_TokenizeSql(interp, Tcl_GetString(objv[skip+1]));
2456 if (tokens == NULL) {
2457 goto freeSData;
2458 }
2459 Tcl_IncrRefCount(tokens);
2460
2461 /*
2462 * Rewrite the tokenized statement to MySQL syntax. Reject the
2463 * statement if it is actually multiple statements.
2464 */
2465
2466 if (Tcl_ListObjGetElements(interp, tokens, &tokenc, &tokenv) != TCL_OK) {
2467 goto freeTokens;
2468 }
2469 nativeSql = Tcl_NewObj();
2470 Tcl_IncrRefCount(nativeSql);
2471 for (i = 0; i < tokenc; ++i) {
2472 tokenStr = Tcl_GetStringFromObj(tokenv[i], &tokenLen);
2473
2474 switch (tokenStr[0]) {
2475 case '$':
2476 case ':':
2477 case '@':
2478 Tcl_AppendToObj(nativeSql, "?", 1);
2479 Tcl_ListObjAppendElement(NULL, sdata->subVars,
2480 Tcl_NewStringObj(tokenStr+1, tokenLen-1));
2481 break;
2482
2483 case ';':
2484 Tcl_SetObjResult(interp,
2485 Tcl_NewStringObj("tdbc::mysql"
2486 " does not support semicolons "
2487 "in statements", -1));
2488 goto freeNativeSql;
2489 break;
2490
2491 default:
2492 Tcl_AppendToObj(nativeSql, tokenStr, tokenLen);
2493 break;
2494
2495 }
2496 }
2497 sdata->nativeSql = nativeSql;
2498 Tcl_DecrRefCount(tokens);
2499
2500 /* Prepare the statement */
2501
2502 sdata->stmtPtr = AllocAndPrepareStatement(interp, sdata);
2503 if (sdata->stmtPtr == NULL) {
2504 goto freeSData;
2505 }
2506
2507 /* Get result set metadata */
2508
2509 sdata->metadataPtr = mysql_stmt_result_metadata(sdata->stmtPtr);
2510 if (mysql_stmt_errno(sdata->stmtPtr)) {
2511 TransferMysqlStmtError(interp, sdata->stmtPtr);
2512 goto freeSData;
2513 }
2514 sdata->columnNames = ResultDescToTcl(sdata->metadataPtr, 0);
2515 Tcl_IncrRefCount(sdata->columnNames);
2516
2517 Tcl_ListObjLength(NULL, sdata->subVars, &nParams);
2518 sdata->params = (ParamData*) ckalloc(nParams * sizeof(ParamData));
2519 for (i = 0; i < nParams; ++i) {
2520 sdata->params[i].flags = PARAM_IN;
2521 sdata->params[i].dataType = MYSQL_TYPE_VARCHAR;
2522 sdata->params[i].precision = 0;
2523 sdata->params[i].scale = 0;
2524 }
2525
2526 /* Attach the current statement data as metadata to the current object */
2527
2528 Tcl_ObjectSetMetadata(thisObject, &statementDataType, (ClientData) sdata);
2529 return TCL_OK;
2530
2531 /* On error, unwind all the resource allocations */
2532
2533 freeNativeSql:
2534 Tcl_DecrRefCount(nativeSql);
2535 freeTokens:
2536 Tcl_DecrRefCount(tokens);
2537 freeSData:
2538 DecrStatementRefCount(sdata);
2539 return TCL_ERROR;
2540 }
2541
2542 /*
2543 *-----------------------------------------------------------------------------
2544 *
2545 * StatementParamsMethod --
2546 *
2547 * Lists the parameters in a MySQL statement.
2548 *
2549 * Usage:
2550 * $statement params
2551 *
2552 * Results:
2553 * Returns a standard Tcl result containing a dictionary. The keys
2554 * of the dictionary are parameter names, and the values are parameter
2555 * types, themselves expressed as dictionaries containing the keys,
2556 * 'name', 'direction', 'type', 'precision', 'scale' and 'nullable'.
2557 *
2558 *
2559 *-----------------------------------------------------------------------------
2560 */
2561
2562 static int
StatementParamsMethod(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext context,int objc,Tcl_Obj * const objv[])2563 StatementParamsMethod(
2564 ClientData dummy, /* Not used */
2565 Tcl_Interp* interp, /* Tcl interpreter */
2566 Tcl_ObjectContext context, /* Object context */
2567 int objc, /* Parameter count */
2568 Tcl_Obj *const objv[] /* Parameter vector */
2569 ) {
2570 Tcl_Object thisObject = Tcl_ObjectContextObject(context);
2571 /* The current statement object */
2572 StatementData* sdata /* The current statement */
2573 = (StatementData*) Tcl_ObjectGetMetadata(thisObject,
2574 &statementDataType);
2575 ConnectionData* cdata = sdata->cdata;
2576 PerInterpData* pidata = cdata->pidata; /* Per-interp data */
2577 Tcl_Obj** literals = pidata->literals; /* Literal pool */
2578 int nParams; /* Number of parameters to the statement */
2579 Tcl_Obj* paramName; /* Name of a parameter */
2580 Tcl_Obj* paramDesc; /* Description of one parameter */
2581 Tcl_Obj* dataTypeName; /* Name of a parameter's data type */
2582 Tcl_Obj* retVal; /* Return value from this command */
2583 Tcl_HashEntry* typeHashEntry;
2584 int i;
2585 (void)dummy;
2586
2587 if (objc != 2) {
2588 Tcl_WrongNumArgs(interp, 2, objv, "");
2589 return TCL_ERROR;
2590 }
2591
2592 retVal = Tcl_NewObj();
2593 Tcl_ListObjLength(NULL, sdata->subVars, &nParams);
2594 for (i = 0; i < nParams; ++i) {
2595 paramDesc = Tcl_NewObj();
2596 Tcl_ListObjIndex(NULL, sdata->subVars, i, ¶mName);
2597 Tcl_DictObjPut(NULL, paramDesc, literals[LIT_NAME], paramName);
2598 switch (sdata->params[i].flags & (PARAM_IN | PARAM_OUT)) {
2599 case PARAM_IN:
2600 Tcl_DictObjPut(NULL, paramDesc, literals[LIT_DIRECTION],
2601 literals[LIT_IN]);
2602 break;
2603 case PARAM_OUT:
2604 Tcl_DictObjPut(NULL, paramDesc, literals[LIT_DIRECTION],
2605 literals[LIT_OUT]);
2606 break;
2607 case PARAM_IN | PARAM_OUT:
2608 Tcl_DictObjPut(NULL, paramDesc, literals[LIT_DIRECTION],
2609 literals[LIT_INOUT]);
2610 break;
2611 default:
2612 break;
2613 }
2614 typeHashEntry =
2615 Tcl_FindHashEntry(&(pidata->typeNumHash),
2616 INT2PTR(sdata->params[i].dataType));
2617 if (typeHashEntry != NULL) {
2618 dataTypeName = (Tcl_Obj*) Tcl_GetHashValue(typeHashEntry);
2619 Tcl_DictObjPut(NULL, paramDesc, literals[LIT_TYPE], dataTypeName);
2620 }
2621 Tcl_DictObjPut(NULL, paramDesc, literals[LIT_PRECISION],
2622 Tcl_NewWideIntObj(sdata->params[i].precision));
2623 Tcl_DictObjPut(NULL, paramDesc, literals[LIT_SCALE],
2624 Tcl_NewWideIntObj(sdata->params[i].scale));
2625 Tcl_DictObjPut(NULL, retVal, paramName, paramDesc);
2626 }
2627
2628 Tcl_SetObjResult(interp, retVal);
2629 return TCL_OK;
2630 }
2631
2632 /*
2633 *-----------------------------------------------------------------------------
2634 *
2635 * StatementParamtypeMethod --
2636 *
2637 * Defines a parameter type in a MySQL statement.
2638 *
2639 * Usage:
2640 * $statement paramtype paramName ?direction? type ?precision ?scale??
2641 *
2642 * Results:
2643 * Returns a standard Tcl result.
2644 *
2645 * Side effects:
2646 * Updates the description of the given parameter.
2647 *
2648 *-----------------------------------------------------------------------------
2649 */
2650
2651 static int
StatementParamtypeMethod(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext context,int objc,Tcl_Obj * const objv[])2652 StatementParamtypeMethod(
2653 ClientData dummy, /* Not used */
2654 Tcl_Interp* interp, /* Tcl interpreter */
2655 Tcl_ObjectContext context, /* Object context */
2656 int objc, /* Parameter count */
2657 Tcl_Obj *const objv[] /* Parameter vector */
2658 ) {
2659 Tcl_Object thisObject = Tcl_ObjectContextObject(context);
2660 /* The current statement object */
2661 StatementData* sdata /* The current statement */
2662 = (StatementData*) Tcl_ObjectGetMetadata(thisObject,
2663 &statementDataType);
2664 static const struct {
2665 const char* name;
2666 int flags;
2667 } directions[] = {
2668 { "in", PARAM_IN },
2669 { "out", PARAM_OUT },
2670 { "inout", PARAM_IN | PARAM_OUT },
2671 { NULL, 0 }
2672 };
2673 int direction;
2674 int typeNum; /* Data type number of a parameter */
2675 int precision; /* Data precision */
2676 int scale; /* Data scale */
2677
2678 int nParams; /* Number of parameters to the statement */
2679 const char* paramName; /* Name of the parameter being set */
2680 Tcl_Obj* targetNameObj; /* Name of the ith parameter in the statement */
2681 const char* targetName; /* Name of a candidate parameter in the
2682 * statement */
2683 int matchCount = 0; /* Number of parameters matching the name */
2684 Tcl_Obj* errorObj; /* Error message */
2685
2686 int i;
2687 (void)dummy;
2688
2689 /* Check parameters */
2690
2691 if (objc < 4) {
2692 goto wrongNumArgs;
2693 }
2694
2695 i = 3;
2696 if (Tcl_GetIndexFromObjStruct(interp, objv[i], directions,
2697 sizeof(directions[0]), "direction",
2698 TCL_EXACT, &direction) != TCL_OK) {
2699 direction = PARAM_IN;
2700 Tcl_ResetResult(interp);
2701 } else {
2702 ++i;
2703 }
2704 if (i >= objc) goto wrongNumArgs;
2705 if (Tcl_GetIndexFromObjStruct(interp, objv[i], dataTypes,
2706 sizeof(dataTypes[0]), "SQL data type",
2707 TCL_EXACT, &typeNum) == TCL_OK) {
2708 ++i;
2709 } else {
2710 return TCL_ERROR;
2711 }
2712 if (i < objc) {
2713 if (Tcl_GetIntFromObj(interp, objv[i], &precision) == TCL_OK) {
2714 ++i;
2715 } else {
2716 return TCL_ERROR;
2717 }
2718 }
2719 if (i < objc) {
2720 if (Tcl_GetIntFromObj(interp, objv[i], &scale) == TCL_OK) {
2721 ++i;
2722 } else {
2723 return TCL_ERROR;
2724 }
2725 }
2726 if (i != objc) {
2727 goto wrongNumArgs;
2728 }
2729
2730 /* Look up parameters by name. */
2731
2732 Tcl_ListObjLength(NULL, sdata->subVars, &nParams);
2733 paramName = Tcl_GetString(objv[2]);
2734 for (i = 0; i < nParams; ++i) {
2735 Tcl_ListObjIndex(NULL, sdata->subVars, i, &targetNameObj);
2736 targetName = Tcl_GetString(targetNameObj);
2737 if (!strcmp(paramName, targetName)) {
2738 ++matchCount;
2739 sdata->params[i].flags = direction;
2740 sdata->params[i].dataType = dataTypes[typeNum].num;
2741 sdata->params[i].precision = precision;
2742 sdata->params[i].scale = scale;
2743 }
2744 }
2745 if (matchCount == 0) {
2746 errorObj = Tcl_NewStringObj("unknown parameter \"", -1);
2747 Tcl_AppendToObj(errorObj, paramName, -1);
2748 Tcl_AppendToObj(errorObj, "\": must be ", -1);
2749 for (i = 0; i < nParams; ++i) {
2750 Tcl_ListObjIndex(NULL, sdata->subVars, i, &targetNameObj);
2751 Tcl_AppendObjToObj(errorObj, targetNameObj);
2752 if (i < nParams-2) {
2753 Tcl_AppendToObj(errorObj, ", ", -1);
2754 } else if (i == nParams-2) {
2755 Tcl_AppendToObj(errorObj, " or ", -1);
2756 }
2757 }
2758 Tcl_SetObjResult(interp, errorObj);
2759 return TCL_ERROR;
2760 }
2761
2762 return TCL_OK;
2763
2764 wrongNumArgs:
2765 Tcl_WrongNumArgs(interp, 2, objv,
2766 "name ?direction? type ?precision ?scale??");
2767 return TCL_ERROR;
2768 }
2769
2770 /*
2771 *-----------------------------------------------------------------------------
2772 *
2773 * DeleteStatementMetadata, DeleteStatement --
2774 *
2775 * Cleans up when a MySQL statement is no longer required.
2776 *
2777 * Side effects:
2778 * Frees all resources associated with the statement.
2779 *
2780 *-----------------------------------------------------------------------------
2781 */
2782
2783 static void
DeleteStatementMetadata(ClientData clientData)2784 DeleteStatementMetadata(
2785 ClientData clientData /* Instance data for the connection */
2786 ) {
2787 DecrStatementRefCount((StatementData*)clientData);
2788 }
2789 static void
DeleteStatement(StatementData * sdata)2790 DeleteStatement(
2791 StatementData* sdata /* Metadata for the statement */
2792 ) {
2793 if (sdata->columnNames != NULL) {
2794 Tcl_DecrRefCount(sdata->columnNames);
2795 }
2796 if (sdata->metadataPtr != NULL) {
2797 mysql_free_result(sdata->metadataPtr);
2798 }
2799 if (sdata->stmtPtr != NULL) {
2800 mysql_stmt_close(sdata->stmtPtr);
2801 }
2802 if (sdata->nativeSql != NULL) {
2803 Tcl_DecrRefCount(sdata->nativeSql);
2804 }
2805 if (sdata->params != NULL) {
2806 ckfree((char*)sdata->params);
2807 }
2808 Tcl_DecrRefCount(sdata->subVars);
2809 DecrConnectionRefCount(sdata->cdata);
2810 ckfree((char*)sdata);
2811 }
2812
2813 /*
2814 *-----------------------------------------------------------------------------
2815 *
2816 * CloneStatement --
2817 *
2818 * Attempts to clone a MySQL statement's metadata.
2819 *
2820 * Results:
2821 * Returns the new metadata
2822 *
2823 * At present, we don't attempt to clone statements - it's not obvious
2824 * that such an action would ever even make sense. Instead, we return NULL
2825 * to indicate that the metadata should not be cloned. (Note that this
2826 * action isn't right, either. What *is* right is to indicate that the object
2827 * is not clonable, but the API gives us no way to do that.
2828 *
2829 *-----------------------------------------------------------------------------
2830 */
2831
2832 static int
CloneStatement(Tcl_Interp * interp,ClientData metadata,ClientData * newMetaData)2833 CloneStatement(
2834 Tcl_Interp* interp, /* Tcl interpreter for error reporting */
2835 ClientData metadata, /* Metadata to be cloned */
2836 ClientData* newMetaData /* Where to put the cloned metadata */
2837 ) {
2838 (void)metadata;
2839 (void)newMetaData;
2840
2841 Tcl_SetObjResult(interp,
2842 Tcl_NewStringObj("MySQL statements are not clonable", -1));
2843 return TCL_ERROR;
2844 }
2845
2846 /*
2847 *-----------------------------------------------------------------------------
2848 *
2849 * ResultSetConstructor --
2850 *
2851 * Constructs a new result set.
2852 *
2853 * Usage:
2854 * $resultSet new statement ?dictionary?
2855 * $resultSet create name statement ?dictionary?
2856 *
2857 * Parameters:
2858 * statement -- Statement handle to which this resultset belongs
2859 * dictionary -- Dictionary containing the substitutions for named
2860 * parameters in the given statement.
2861 *
2862 * Results:
2863 * Returns a standard Tcl result. On error, the interpreter result
2864 * contains an appropriate message.
2865 *
2866 *-----------------------------------------------------------------------------
2867 */
2868
2869 static int
ResultSetConstructor(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext context,int objc,Tcl_Obj * const objv[])2870 ResultSetConstructor(
2871 ClientData dummy, /* Not used */
2872 Tcl_Interp* interp, /* Tcl interpreter */
2873 Tcl_ObjectContext context, /* Object context */
2874 int objc, /* Parameter count */
2875 Tcl_Obj *const objv[] /* Parameter vector */
2876 ) {
2877 Tcl_Object thisObject = Tcl_ObjectContextObject(context);
2878 /* The current result set object */
2879 int skip = Tcl_ObjectContextSkippedArgs(context);
2880 /* Number of args to skip */
2881 Tcl_Object statementObject; /* The current statement object */
2882 ConnectionData* cdata; /* The MySQL connection object's data */
2883 StatementData* sdata; /* The statement object's data */
2884 ResultSetData* rdata; /* THe result set object's data */
2885 int nParams; /* The parameter count on the statement */
2886 int nBound; /* Number of parameters bound so far */
2887 Tcl_Obj* paramNameObj; /* Name of the current parameter */
2888 const char* paramName; /* Name of the current parameter */
2889 Tcl_Obj* paramValObj; /* Value of the current parameter */
2890 const char* paramValStr; /* String value of the current parameter */
2891 char* bufPtr; /* Pointer to the parameter buffer */
2892 int len; /* Length of a bound parameter */
2893 int nColumns; /* Number of columns in the result set */
2894 MYSQL_FIELD* fields = NULL; /* Description of columns of the result set */
2895 MYSQL_BIND* resultBindings; /* Bindings of the columns of the result set */
2896 unsigned long* resultLengths;
2897 /* Lengths of the columns of the result set */
2898 int i;
2899 (void)dummy;
2900
2901 /* Check parameter count */
2902
2903 if (objc != skip+1 && objc != skip+2) {
2904 Tcl_WrongNumArgs(interp, skip, objv, "statement ?dictionary?");
2905 return TCL_ERROR;
2906 }
2907
2908 /* Initialize the base classes */
2909
2910 Tcl_ObjectContextInvokeNext(interp, context, skip, objv, skip);
2911
2912 /* Find the statement object, and get the statement data */
2913
2914 statementObject = Tcl_GetObjectFromObj(interp, objv[skip]);
2915 if (statementObject == NULL) {
2916 return TCL_ERROR;
2917 }
2918 sdata = (StatementData*) Tcl_ObjectGetMetadata(statementObject,
2919 &statementDataType);
2920 if (sdata == NULL) {
2921 Tcl_AppendResult(interp, Tcl_GetString(objv[skip]),
2922 " does not refer to a MySQL statement", NULL);
2923 return TCL_ERROR;
2924 }
2925 Tcl_ListObjLength(NULL, sdata->columnNames, &nColumns);
2926 cdata = sdata->cdata;
2927
2928 /*
2929 * If there is no transaction in progress, turn on auto-commit so that
2930 * this statement will execute directly.
2931 */
2932
2933 if ((cdata->flags & (CONN_FLAG_IN_XCN | CONN_FLAG_AUTOCOMMIT)) == 0) {
2934 if (mysql_autocommit(cdata->mysqlPtr, 1)) {
2935 TransferMysqlError(interp, cdata->mysqlPtr);
2936 return TCL_ERROR;
2937 }
2938 cdata->flags |= CONN_FLAG_AUTOCOMMIT;
2939 }
2940
2941 /* Allocate an object to hold data about this result set */
2942
2943 rdata = (ResultSetData*) ckalloc(sizeof(ResultSetData));
2944 rdata->refCount = 1;
2945 rdata->sdata = sdata;
2946 rdata->stmtPtr = NULL;
2947 rdata->paramValues = NULL;
2948 rdata->paramBindings = NULL;
2949 rdata->paramLengths = NULL;
2950 rdata->rowCount = 0;
2951 rdata->resultErrors = (my_bool*) ckalloc(nColumns * sizeof(my_bool));
2952 rdata->resultNulls = (my_bool*) ckalloc(nColumns * sizeof(my_bool));
2953 resultLengths = rdata->resultLengths = (unsigned long*)
2954 ckalloc(nColumns * sizeof(unsigned long));
2955 rdata->resultBindings = resultBindings = MysqlBindAlloc(nColumns);
2956 IncrStatementRefCount(sdata);
2957 Tcl_ObjectSetMetadata(thisObject, &resultSetDataType, (ClientData) rdata);
2958
2959 /* Make bindings for all the result columns. Defer binding variable
2960 * length fields until first execution. */
2961
2962 if (nColumns > 0) {
2963 fields = mysql_fetch_fields(sdata->metadataPtr);
2964 }
2965 for (i = 0; i < nColumns; ++i) {
2966 MYSQL_FIELD* field = MysqlFieldIndex(fields, i);
2967 switch (field->type) {
2968
2969 case MYSQL_TYPE_FLOAT:
2970 case MYSQL_TYPE_DOUBLE:
2971 MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_DOUBLE);
2972 MysqlBindAllocBuffer(resultBindings, i, sizeof(double));
2973 resultLengths[i] = sizeof(double);
2974 break;
2975
2976 case MYSQL_TYPE_BIT:
2977 MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_BIT);
2978 MysqlBindAllocBuffer(resultBindings, i, field->length);
2979 resultLengths[i] = field->length;
2980 break;
2981
2982 case MYSQL_TYPE_LONGLONG:
2983 MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_LONGLONG);
2984 MysqlBindAllocBuffer(resultBindings, i, sizeof(Tcl_WideInt));
2985 resultLengths[i] = sizeof(Tcl_WideInt);
2986 break;
2987
2988 case MYSQL_TYPE_TINY:
2989 case MYSQL_TYPE_SHORT:
2990 case MYSQL_TYPE_INT24:
2991 case MYSQL_TYPE_LONG:
2992 MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_LONG);
2993 MysqlBindAllocBuffer(resultBindings, i, sizeof(int));
2994 resultLengths[i] = sizeof(int);
2995 break;
2996
2997 default:
2998 MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_STRING);
2999 MysqlBindAllocBuffer(resultBindings, i, 0);
3000 resultLengths[i] = 0;
3001 break;
3002 }
3003 MysqlBindSetLength(resultBindings, i, rdata->resultLengths + i);
3004 rdata->resultNulls[i] = 0;
3005 MysqlBindSetIsNull(resultBindings, i, rdata->resultNulls + i);
3006 rdata->resultErrors[i] = 0;
3007 MysqlBindSetError(resultBindings, i, rdata->resultErrors + i);
3008 }
3009
3010 /*
3011 * Find a statement handle that we can use to execute the SQL code.
3012 * If the main statement handle associated with the statement
3013 * is idle, we can use it. Otherwise, we have to allocate and
3014 * prepare a fresh one.
3015 */
3016
3017 if (sdata->flags & STMT_FLAG_BUSY) {
3018 rdata->stmtPtr = AllocAndPrepareStatement(interp, sdata);
3019 if (rdata->stmtPtr == NULL) {
3020 return TCL_ERROR;
3021 }
3022 } else {
3023 rdata->stmtPtr = sdata->stmtPtr;
3024 sdata->flags |= STMT_FLAG_BUSY;
3025 }
3026
3027 /* Allocate the parameter bindings */
3028
3029 Tcl_ListObjLength(NULL, sdata->subVars, &nParams);
3030 rdata->paramValues = Tcl_NewObj();
3031 Tcl_IncrRefCount(rdata->paramValues);
3032 rdata->paramBindings = MysqlBindAlloc(nParams);
3033 rdata->paramLengths = (unsigned long*) ckalloc(nParams
3034 * sizeof(unsigned long));
3035 for (nBound = 0; nBound < nParams; ++nBound) {
3036 MysqlBindSetBufferType(rdata->paramBindings, nBound, MYSQL_TYPE_NULL);
3037 }
3038
3039 /* Bind the substituted parameters */
3040
3041 for (nBound = 0; nBound < nParams; ++nBound) {
3042 Tcl_ListObjIndex(NULL, sdata->subVars, nBound, ¶mNameObj);
3043 paramName = Tcl_GetString(paramNameObj);
3044 if (objc == skip+2) {
3045
3046 /* Param from a dictionary */
3047
3048 if (Tcl_DictObjGet(interp, objv[skip+1],
3049 paramNameObj, ¶mValObj) != TCL_OK) {
3050 return TCL_ERROR;
3051 }
3052 } else {
3053
3054 /* Param from a variable */
3055
3056 paramValObj = Tcl_GetVar2Ex(interp, paramName, NULL,
3057 TCL_LEAVE_ERR_MSG);
3058 }
3059
3060 /*
3061 * At this point, paramValObj contains the parameter to bind.
3062 * Convert the parameters to the appropriate data types for
3063 * MySQL's prepared statement interface, and bind them.
3064 */
3065
3066 if (paramValObj != NULL) {
3067 switch (sdata->params[nBound].dataType & 0xffff) {
3068
3069 case MYSQL_TYPE_NEWDECIMAL:
3070 case MYSQL_TYPE_DECIMAL:
3071 if (sdata->params[nBound].scale == 0) {
3072 if (sdata->params[nBound].precision < 10) {
3073 goto smallinteger;
3074 } else if (sdata->params[nBound].precision < 19) {
3075 goto biginteger;
3076 } else {
3077 goto charstring;
3078 }
3079 } else if (sdata->params[nBound].precision < 17) {
3080 goto real;
3081 } else {
3082 goto charstring;
3083 }
3084
3085 case MYSQL_TYPE_FLOAT:
3086 case MYSQL_TYPE_DOUBLE:
3087 real:
3088 MysqlBindSetBufferType(rdata->paramBindings, nBound,
3089 MYSQL_TYPE_DOUBLE);
3090 bufPtr = (char *)MysqlBindAllocBuffer(rdata->paramBindings,
3091 nBound, sizeof(double));
3092 rdata->paramLengths[nBound] = sizeof(double);
3093 MysqlBindSetLength(rdata->paramBindings, nBound,
3094 &(rdata->paramLengths[nBound]));
3095 if (Tcl_GetDoubleFromObj(interp, paramValObj,
3096 (double*) bufPtr) != TCL_OK) {
3097 return TCL_ERROR;
3098 }
3099 break;
3100
3101 case MYSQL_TYPE_BIT:
3102 case MYSQL_TYPE_LONGLONG:
3103 biginteger:
3104 MysqlBindSetBufferType(rdata->paramBindings, nBound,
3105 MYSQL_TYPE_LONGLONG);
3106 bufPtr = (char *)MysqlBindAllocBuffer(rdata->paramBindings, nBound,
3107 sizeof(Tcl_WideInt));
3108 rdata->paramLengths[nBound] = sizeof(Tcl_WideInt);
3109 MysqlBindSetLength(rdata->paramBindings, nBound,
3110 &(rdata->paramLengths[nBound]));
3111 if (Tcl_GetWideIntFromObj(interp, paramValObj,
3112 (Tcl_WideInt*) bufPtr) != TCL_OK) {
3113 return TCL_ERROR;
3114 }
3115 break;
3116
3117 case MYSQL_TYPE_TINY:
3118 case MYSQL_TYPE_SHORT:
3119 case MYSQL_TYPE_INT24:
3120 case MYSQL_TYPE_LONG:
3121 smallinteger:
3122 MysqlBindSetBufferType(rdata->paramBindings, nBound,
3123 MYSQL_TYPE_LONG);
3124 bufPtr = (char *)MysqlBindAllocBuffer(rdata->paramBindings, nBound,
3125 sizeof(int));
3126 rdata->paramLengths[nBound] = sizeof(int);
3127 MysqlBindSetLength(rdata->paramBindings, nBound,
3128 &(rdata->paramLengths[nBound]));
3129 if (Tcl_GetIntFromObj(interp, paramValObj,
3130 (int*) bufPtr) != TCL_OK) {
3131 return TCL_ERROR;
3132 }
3133 break;
3134
3135 default:
3136 charstring:
3137 Tcl_ListObjAppendElement(NULL, rdata->paramValues, paramValObj);
3138 if (sdata->params[nBound].dataType & IS_BINARY) {
3139 MysqlBindSetBufferType(rdata->paramBindings, nBound,
3140 MYSQL_TYPE_BLOB);
3141 paramValStr = (char*)
3142 Tcl_GetByteArrayFromObj(paramValObj, &len);
3143 } else {
3144 MysqlBindSetBufferType(rdata->paramBindings, nBound,
3145 MYSQL_TYPE_STRING);
3146 paramValStr = Tcl_GetStringFromObj(paramValObj, &len);
3147 }
3148 bufPtr = (char *)MysqlBindAllocBuffer(rdata->paramBindings, nBound,
3149 len+1);
3150 memcpy(bufPtr, paramValStr, len);
3151 rdata->paramLengths[nBound] = len;
3152 MysqlBindSetLength(rdata->paramBindings, nBound,
3153 &(rdata->paramLengths[nBound]));
3154 break;
3155
3156 }
3157 } else {
3158 MysqlBindSetBufferType(rdata->paramBindings, nBound,
3159 MYSQL_TYPE_NULL);
3160 }
3161 }
3162
3163 /* Execute the statement */
3164
3165 /*
3166 * It is tempting to conserve client memory here by omitting
3167 * the call to 'mysql_stmt_store_result', but doing so causes
3168 * 'calls out of sync' errors when attempting to prepare a
3169 * statement while a result set is open. Certain of these errors
3170 * can, in turn, be avoided by using mysql_stmt_set_attr
3171 * and turning on "CURSOR_MODE_READONLY", but that, in turn
3172 * causes the server summarily to disconnect the client in
3173 * some tests.
3174 */
3175
3176 if (mysql_stmt_bind_param(rdata->stmtPtr, rdata->paramBindings)
3177 || ((nColumns > 0) && mysql_stmt_bind_result(rdata->stmtPtr,
3178 resultBindings))
3179 || mysql_stmt_execute(rdata->stmtPtr)
3180 || mysql_stmt_store_result(rdata->stmtPtr) ) {
3181 TransferMysqlStmtError(interp, sdata->stmtPtr);
3182 return TCL_ERROR;
3183 }
3184
3185 /* Determine and store the row count */
3186
3187 rdata->rowCount = mysql_stmt_affected_rows(sdata->stmtPtr);
3188 return TCL_OK;
3189 }
3190
3191 /*
3192 *----------------------------------------------------------------------
3193 *
3194 * ResultSetColumnsMethod --
3195 *
3196 * Retrieves the list of columns from a result set.
3197 *
3198 * Usage:
3199 * $resultSet columns
3200 *
3201 * Results:
3202 * Returns the count of columns
3203 *
3204 *-----------------------------------------------------------------------------
3205 */
3206
3207 static int
ResultSetColumnsMethod(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext context,int objc,Tcl_Obj * const objv[])3208 ResultSetColumnsMethod(
3209 ClientData dummy, /* Not used */
3210 Tcl_Interp* interp, /* Tcl interpreter */
3211 Tcl_ObjectContext context, /* Object context */
3212 int objc, /* Parameter count */
3213 Tcl_Obj *const objv[] /* Parameter vector */
3214 ) {
3215
3216 Tcl_Object thisObject = Tcl_ObjectContextObject(context);
3217 /* The current result set object */
3218 ResultSetData* rdata = (ResultSetData*)
3219 Tcl_ObjectGetMetadata(thisObject, &resultSetDataType);
3220 StatementData* sdata = (StatementData*) rdata->sdata;
3221 (void)dummy;
3222
3223 if (objc != 2) {
3224 Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
3225 return TCL_ERROR;
3226 }
3227
3228 Tcl_SetObjResult(interp, sdata->columnNames);
3229
3230 return TCL_OK;
3231
3232 }
3233
3234 /*
3235 *-----------------------------------------------------------------------------
3236 *
3237 * ResultSetNextrowMethod --
3238 *
3239 * Retrieves the next row from a result set.
3240 *
3241 * Usage:
3242 * $resultSet nextrow ?-as lists|dicts? ?--? variableName
3243 *
3244 * Options:
3245 * -as Selects the desired form for returning the results.
3246 *
3247 * Parameters:
3248 * variableName -- Variable in which the results are to be returned
3249 *
3250 * Results:
3251 * Returns a standard Tcl result. The interpreter result is 1 if there
3252 * are more rows remaining, and 0 if no more rows remain.
3253 *
3254 * Side effects:
3255 * Stores in the given variable either a list or a dictionary
3256 * containing one row of the result set.
3257 *
3258 *-----------------------------------------------------------------------------
3259 */
3260
3261 static int
ResultSetNextrowMethod(ClientData clientData,Tcl_Interp * interp,Tcl_ObjectContext context,int objc,Tcl_Obj * const objv[])3262 ResultSetNextrowMethod(
3263 ClientData clientData, /* Not used */
3264 Tcl_Interp* interp, /* Tcl interpreter */
3265 Tcl_ObjectContext context, /* Object context */
3266 int objc, /* Parameter count */
3267 Tcl_Obj *const objv[] /* Parameter vector */
3268 ) {
3269
3270 int lists = PTR2INT(clientData);
3271 /* Flag == 1 if lists are to be returned,
3272 * 0 if dicts are to be returned */
3273
3274 Tcl_Object thisObject = Tcl_ObjectContextObject(context);
3275 /* The current result set object */
3276 ResultSetData* rdata = (ResultSetData*)
3277 Tcl_ObjectGetMetadata(thisObject, &resultSetDataType);
3278 /* Data pertaining to the current result set */
3279 StatementData* sdata = (StatementData*) rdata->sdata;
3280 /* Statement that yielded the result set */
3281 ConnectionData* cdata = (ConnectionData*) sdata->cdata;
3282 /* Connection that opened the statement */
3283 PerInterpData* pidata = (PerInterpData*) cdata->pidata;
3284 /* Per interpreter data */
3285 Tcl_Obj** literals = pidata->literals;
3286 /* Literal pool */
3287
3288 int nColumns = 0; /* Number of columns in the result set */
3289 Tcl_Obj* colName; /* Name of the current column */
3290 Tcl_Obj* resultRow; /* Row of the result set under construction */
3291
3292 Tcl_Obj* colObj; /* Column obtained from the row */
3293 int status = TCL_ERROR; /* Status return from this command */
3294 MYSQL_FIELD* fields; /* Fields of the result set */
3295 MYSQL_BIND* resultBindings = rdata->resultBindings;
3296 /* Descriptions of the results */
3297 unsigned long* resultLengths = rdata->resultLengths;
3298 /* String lengths of the results */
3299 my_bool* resultNulls = rdata->resultNulls;
3300 /* Indicators that the results are null */
3301 void* bufPtr; /* Pointer to a result's buffer */
3302 unsigned char byte; /* One byte extracted from a bit field */
3303 Tcl_WideInt bitVal; /* Value of a bit field */
3304 int mysqlStatus; /* Status return from MySQL */
3305 int i;
3306 unsigned int j;
3307
3308 if (objc != 3) {
3309 Tcl_WrongNumArgs(interp, 2, objv, "varName");
3310 return TCL_ERROR;
3311 }
3312
3313
3314 /* Get the column names in the result set. */
3315
3316 Tcl_ListObjLength(NULL, sdata->columnNames, &nColumns);
3317 if (nColumns == 0) {
3318 Tcl_SetObjResult(interp, literals[LIT_0]);
3319 return TCL_OK;
3320 }
3321
3322 resultRow = Tcl_NewObj();
3323 Tcl_IncrRefCount(resultRow);
3324
3325 /*
3326 * Try to rebind the result set before doing the next fetch
3327 */
3328
3329 fields = mysql_fetch_fields(sdata->metadataPtr);
3330 if (mysql_stmt_bind_result(rdata->stmtPtr, resultBindings)) {
3331 goto cleanup;
3332 }
3333
3334 /* Fetch the row to determine sizes. */
3335
3336 mysqlStatus = mysql_stmt_fetch(rdata->stmtPtr);
3337 if (mysqlStatus != 0 && mysqlStatus != MYSQL_DATA_TRUNCATED) {
3338 if (mysqlStatus == MYSQL_NO_DATA) {
3339 Tcl_SetObjResult(interp, literals[LIT_0]);
3340 status = TCL_OK;
3341 }
3342 goto cleanup;
3343 }
3344
3345 /* Retrieve one column at a time. */
3346
3347 for (i = 0; i < nColumns; ++i) {
3348 MYSQL_FIELD* field = MysqlFieldIndex(fields, i);
3349 colObj = NULL;
3350 if (!resultNulls[i]) {
3351 if (resultLengths[i]
3352 > MysqlBindGetBufferLength(resultBindings, i)) {
3353 MysqlBindFreeBuffer(resultBindings, i);
3354 MysqlBindAllocBuffer(resultBindings, i, resultLengths[i] + 1);
3355 if (mysql_stmt_fetch_column(rdata->stmtPtr,
3356 MysqlBindIndex(resultBindings, i),
3357 i, 0)) {
3358 goto cleanup;
3359 }
3360 }
3361 bufPtr = MysqlBindGetBuffer(resultBindings, i);
3362 switch (MysqlBindGetBufferType(resultBindings, i)) {
3363
3364 case MYSQL_TYPE_BIT:
3365 bitVal = 0;
3366 for (j = 0; j < resultLengths[i]; ++j) {
3367 byte = ((unsigned char*) bufPtr)[resultLengths[i]-1-j];
3368 bitVal |= (byte << (8*j));
3369 }
3370 colObj = Tcl_NewWideIntObj(bitVal);
3371 break;
3372
3373 case MYSQL_TYPE_DOUBLE:
3374 colObj = Tcl_NewDoubleObj(*(double*) bufPtr);
3375 break;
3376
3377 case MYSQL_TYPE_LONG:
3378 colObj = Tcl_NewWideIntObj(*(int*) bufPtr);
3379 break;
3380
3381 case MYSQL_TYPE_LONGLONG:
3382 colObj = Tcl_NewWideIntObj(*(Tcl_WideInt*) bufPtr);
3383 break;
3384
3385 default:
3386 if (field->charsetnr == 63) {
3387 colObj = Tcl_NewByteArrayObj((unsigned char*) bufPtr,
3388 resultLengths[i]);
3389 } else {
3390 colObj = Tcl_NewStringObj((char*) bufPtr,
3391 resultLengths[i]);
3392 }
3393 break;
3394 }
3395 }
3396
3397 if (lists) {
3398 if (colObj == NULL) {
3399 colObj = literals[LIT_EMPTY];
3400 }
3401 Tcl_ListObjAppendElement(NULL, resultRow, colObj);
3402 } else {
3403 if (colObj != NULL) {
3404 Tcl_ListObjIndex(NULL, sdata->columnNames, i, &colName);
3405 Tcl_DictObjPut(NULL, resultRow, colName, colObj);
3406 }
3407 }
3408 }
3409
3410 /* Save the row in the given variable */
3411
3412 if (Tcl_SetVar2Ex(interp, Tcl_GetString(objv[2]), NULL,
3413 resultRow, TCL_LEAVE_ERR_MSG) == NULL) {
3414 goto cleanup;
3415 }
3416
3417 Tcl_SetObjResult(interp, literals[LIT_1]);
3418 status = TCL_OK;
3419
3420 cleanup:
3421 if (status != TCL_OK) {
3422 TransferMysqlStmtError(interp, rdata->stmtPtr);
3423 }
3424 Tcl_DecrRefCount(resultRow);
3425 return status;
3426
3427 }
3428
3429 /*
3430 *-----------------------------------------------------------------------------
3431 *
3432 * ResultSetRowcountMethod --
3433 *
3434 * Returns (if known) the number of rows affected by a MySQL statement.
3435 *
3436 * Usage:
3437 * $resultSet rowcount
3438 *
3439 * Results:
3440 * Returns a standard Tcl result giving the number of affected rows.
3441 *
3442 *-----------------------------------------------------------------------------
3443 */
3444
3445 static int
ResultSetRowcountMethod(ClientData dummy,Tcl_Interp * interp,Tcl_ObjectContext context,int objc,Tcl_Obj * const objv[])3446 ResultSetRowcountMethod(
3447 ClientData dummy, /* Not used */
3448 Tcl_Interp* interp, /* Tcl interpreter */
3449 Tcl_ObjectContext context, /* Object context */
3450 int objc, /* Parameter count */
3451 Tcl_Obj *const objv[] /* Parameter vector */
3452 ) {
3453 Tcl_Object thisObject = Tcl_ObjectContextObject(context);
3454 /* The current result set object */
3455 ResultSetData* rdata = (ResultSetData*)
3456 Tcl_ObjectGetMetadata(thisObject, &resultSetDataType);
3457 /* Data pertaining to the current result set */
3458 (void)dummy;
3459
3460 if (objc != 2) {
3461 Tcl_WrongNumArgs(interp, 2, objv, "");
3462 return TCL_ERROR;
3463 }
3464 Tcl_SetObjResult(interp,
3465 Tcl_NewWideIntObj((Tcl_WideInt)(rdata->rowCount)));
3466 return TCL_OK;
3467 }
3468
3469 /*
3470 *-----------------------------------------------------------------------------
3471 *
3472 * DeleteResultSetMetadata, DeleteResultSet --
3473 *
3474 * Cleans up when a MySQL result set is no longer required.
3475 *
3476 * Side effects:
3477 * Frees all resources associated with the result set.
3478 *
3479 *-----------------------------------------------------------------------------
3480 */
3481
3482 static void
DeleteResultSetMetadata(ClientData clientData)3483 DeleteResultSetMetadata(
3484 ClientData clientData /* Instance data for the connection */
3485 ) {
3486 DecrResultSetRefCount((ResultSetData*)clientData);
3487 }
3488 static void
DeleteResultSet(ResultSetData * rdata)3489 DeleteResultSet(
3490 ResultSetData* rdata /* Metadata for the result set */
3491 ) {
3492 StatementData* sdata = rdata->sdata;
3493 int i;
3494 int nParams;
3495 int nColumns;
3496 Tcl_ListObjLength(NULL, sdata->subVars, &nParams);
3497 Tcl_ListObjLength(NULL, sdata->columnNames, &nColumns);
3498 for (i = 0; i < nColumns; ++i) {
3499 MysqlBindFreeBuffer(rdata->resultBindings, i);
3500 }
3501 ckfree((char*)(rdata->resultBindings));
3502 ckfree((char*)(rdata->resultLengths));
3503 ckfree((char*)(rdata->resultNulls));
3504 ckfree((char*)(rdata->resultErrors));
3505 ckfree((char*)(rdata->paramLengths));
3506 if (rdata->paramBindings != NULL) {
3507 for (i = 0; i < nParams; ++i) {
3508 if (MysqlBindGetBufferType(rdata->paramBindings, i)
3509 != MYSQL_TYPE_NULL) {
3510 MysqlBindFreeBuffer(rdata->paramBindings, i);
3511 }
3512 }
3513 ckfree((char*)(rdata->paramBindings));
3514 }
3515 if (rdata->paramValues != NULL) {
3516 Tcl_DecrRefCount(rdata->paramValues);
3517 }
3518 if (rdata->stmtPtr != NULL) {
3519 if (rdata->stmtPtr != sdata->stmtPtr) {
3520 mysql_stmt_close(rdata->stmtPtr);
3521 } else {
3522 sdata->flags &= ~ STMT_FLAG_BUSY;
3523 }
3524 }
3525 DecrStatementRefCount(rdata->sdata);
3526 ckfree((char*)rdata);
3527 }
3528
3529 /*
3530 *-----------------------------------------------------------------------------
3531 *
3532 * CloneResultSet --
3533 *
3534 * Attempts to clone a MySQL result set's metadata.
3535 *
3536 * Results:
3537 * Returns the new metadata
3538 *
3539 * At present, we don't attempt to clone result sets - it's not obvious
3540 * that such an action would ever even make sense. Instead, we throw an
3541 * error.
3542 *
3543 *-----------------------------------------------------------------------------
3544 */
3545
3546 static int
CloneResultSet(Tcl_Interp * interp,ClientData metadata,ClientData * newMetaData)3547 CloneResultSet(
3548 Tcl_Interp* interp, /* Tcl interpreter for error reporting */
3549 ClientData metadata, /* Metadata to be cloned */
3550 ClientData* newMetaData /* Where to put the cloned metadata */
3551 ) {
3552 (void)metadata;
3553 (void)newMetaData;
3554
3555 Tcl_SetObjResult(interp,
3556 Tcl_NewStringObj("MySQL result sets are not clonable",
3557 -1));
3558 return TCL_ERROR;
3559 }
3560
3561 /*
3562 *-----------------------------------------------------------------------------
3563 *
3564 * Tdbcmysql_Init --
3565 *
3566 * Initializes the TDBC-MYSQL bridge when this library is loaded.
3567 *
3568 * Side effects:
3569 * Creates the ::tdbc::mysql namespace and the commands that reside in it.
3570 * Initializes the MYSQL environment.
3571 *
3572 *-----------------------------------------------------------------------------
3573 */
3574
3575 #ifdef __cplusplus
3576 extern "C" {
3577 #endif /* __cplusplus */
3578 DLLEXPORT int
Tdbcmysql_Init(Tcl_Interp * interp)3579 Tdbcmysql_Init(
3580 Tcl_Interp* interp /* Tcl interpreter */
3581 ) {
3582 PerInterpData* pidata; /* Per-interpreter data for this package */
3583 Tcl_Obj* nameObj; /* Name of a class or method being looked up */
3584 Tcl_Object curClassObject; /* Tcl_Object representing the current class */
3585 Tcl_Class curClass; /* Tcl_Class representing the current class */
3586 int i;
3587
3588 /* Require all package dependencies */
3589
3590 if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
3591 return TCL_ERROR;
3592 }
3593 if (TclOOInitializeStubs(interp, "1.0") == NULL) {
3594 return TCL_ERROR;
3595 }
3596 if (Tdbc_InitStubs(interp) == NULL) {
3597 return TCL_ERROR;
3598 }
3599
3600 /* Provide the current package */
3601
3602 if (Tcl_PkgProvideEx(interp, "tdbc::mysql", PACKAGE_VERSION, NULL) == TCL_ERROR) {
3603 return TCL_ERROR;
3604 }
3605
3606 /*
3607 * Create per-interpreter data for the package
3608 */
3609
3610 pidata = (PerInterpData*) ckalloc(sizeof(PerInterpData));
3611 pidata->refCount = 1;
3612 for (i = 0; i < LIT__END; ++i) {
3613 pidata->literals[i] = Tcl_NewStringObj(LiteralValues[i], -1);
3614 Tcl_IncrRefCount(pidata->literals[i]);
3615 }
3616 Tcl_InitHashTable(&(pidata->typeNumHash), TCL_ONE_WORD_KEYS);
3617 for (i = 0; dataTypes[i].name != NULL; ++i) {
3618 int isNew;
3619 Tcl_HashEntry* entry =
3620 Tcl_CreateHashEntry(&(pidata->typeNumHash),
3621 INT2PTR(dataTypes[i].num),
3622 &isNew);
3623 Tcl_Obj* nameObj = Tcl_NewStringObj(dataTypes[i].name, -1);
3624 Tcl_IncrRefCount(nameObj);
3625 Tcl_SetHashValue(entry, (ClientData) nameObj);
3626 }
3627
3628 /*
3629 * Find the connection class, and attach an 'init' method to it.
3630 */
3631
3632 nameObj = Tcl_NewStringObj("::tdbc::mysql::connection", -1);
3633 Tcl_IncrRefCount(nameObj);
3634 if ((curClassObject = Tcl_GetObjectFromObj(interp, nameObj)) == NULL) {
3635 Tcl_DecrRefCount(nameObj);
3636 return TCL_ERROR;
3637 }
3638 Tcl_DecrRefCount(nameObj);
3639 curClass = Tcl_GetObjectAsClass(curClassObject);
3640
3641 /* Attach the constructor to the 'connection' class */
3642
3643 Tcl_ClassSetConstructor(interp, curClass,
3644 Tcl_NewMethod(interp, curClass, NULL, 1,
3645 &ConnectionConstructorType,
3646 (ClientData) pidata));
3647
3648 /* Attach the methods to the 'connection' class */
3649
3650 for (i = 0; ConnectionMethods[i] != NULL; ++i) {
3651 nameObj = Tcl_NewStringObj(ConnectionMethods[i]->name, -1);
3652 Tcl_IncrRefCount(nameObj);
3653 Tcl_NewMethod(interp, curClass, nameObj, 1, ConnectionMethods[i],
3654 (ClientData) NULL);
3655 Tcl_DecrRefCount(nameObj);
3656 }
3657
3658 /* Look up the 'statement' class */
3659
3660 nameObj = Tcl_NewStringObj("::tdbc::mysql::statement", -1);
3661 Tcl_IncrRefCount(nameObj);
3662 if ((curClassObject = Tcl_GetObjectFromObj(interp, nameObj)) == NULL) {
3663 Tcl_DecrRefCount(nameObj);
3664 return TCL_ERROR;
3665 }
3666 Tcl_DecrRefCount(nameObj);
3667 curClass = Tcl_GetObjectAsClass(curClassObject);
3668
3669 /* Attach the constructor to the 'statement' class */
3670
3671 Tcl_ClassSetConstructor(interp, curClass,
3672 Tcl_NewMethod(interp, curClass, NULL, 1,
3673 &StatementConstructorType,
3674 (ClientData) NULL));
3675
3676 /* Attach the methods to the 'statement' class */
3677
3678 for (i = 0; StatementMethods[i] != NULL; ++i) {
3679 nameObj = Tcl_NewStringObj(StatementMethods[i]->name, -1);
3680 Tcl_IncrRefCount(nameObj);
3681 Tcl_NewMethod(interp, curClass, nameObj, 1, StatementMethods[i],
3682 (ClientData) NULL);
3683 Tcl_DecrRefCount(nameObj);
3684 }
3685
3686 /* Look up the 'resultSet' class */
3687
3688 nameObj = Tcl_NewStringObj("::tdbc::mysql::resultset", -1);
3689 Tcl_IncrRefCount(nameObj);
3690 if ((curClassObject = Tcl_GetObjectFromObj(interp, nameObj)) == NULL) {
3691 Tcl_DecrRefCount(nameObj);
3692 return TCL_ERROR;
3693 }
3694 Tcl_DecrRefCount(nameObj);
3695 curClass = Tcl_GetObjectAsClass(curClassObject);
3696
3697 /* Attach the constructor to the 'resultSet' class */
3698
3699 Tcl_ClassSetConstructor(interp, curClass,
3700 Tcl_NewMethod(interp, curClass, NULL, 1,
3701 &ResultSetConstructorType,
3702 (ClientData) NULL));
3703
3704 /* Attach the methods to the 'resultSet' class */
3705
3706 for (i = 0; ResultSetMethods[i] != NULL; ++i) {
3707 nameObj = Tcl_NewStringObj(ResultSetMethods[i]->name, -1);
3708 Tcl_IncrRefCount(nameObj);
3709 Tcl_NewMethod(interp, curClass, nameObj, 1, ResultSetMethods[i],
3710 (ClientData) NULL);
3711 Tcl_DecrRefCount(nameObj);
3712 }
3713 nameObj = Tcl_NewStringObj("nextlist", -1);
3714 Tcl_IncrRefCount(nameObj);
3715 Tcl_NewMethod(interp, curClass, nameObj, 1, &ResultSetNextrowMethodType,
3716 (ClientData) 1);
3717 Tcl_DecrRefCount(nameObj);
3718 nameObj = Tcl_NewStringObj("nextdict", -1);
3719 Tcl_IncrRefCount(nameObj);
3720 Tcl_NewMethod(interp, curClass, nameObj, 1, &ResultSetNextrowMethodType,
3721 (ClientData) 0);
3722 Tcl_DecrRefCount(nameObj);
3723
3724 /*
3725 * Initialize the MySQL library if this is the first interp using it
3726 */
3727
3728 Tcl_MutexLock(&mysqlMutex);
3729 if (mysqlRefCount == 0) {
3730 if ((mysqlLoadHandle = MysqlInitStubs(interp)) == NULL) {
3731 Tcl_MutexUnlock(&mysqlMutex);
3732 return TCL_ERROR;
3733 }
3734 mysql_library_init(0, NULL, NULL);
3735 mysqlClientVersion = mysql_get_client_version();
3736 }
3737 ++mysqlRefCount;
3738 Tcl_MutexUnlock(&mysqlMutex);
3739
3740 /*
3741 * TODO: mysql_thread_init, and keep a TSD reference count of users.
3742 */
3743
3744 return TCL_OK;
3745 }
3746 #ifdef __cplusplus
3747 }
3748 #endif /* __cplusplus */
3749
3750 /*
3751 *-----------------------------------------------------------------------------
3752 *
3753 * DeletePerInterpData --
3754 *
3755 * Delete per-interpreter data when the MYSQL package is finalized
3756 *
3757 * Side effects:
3758 * Releases the (presumably last) reference on the environment handle,
3759 * cleans up the literal pool, and deletes the per-interp data structure.
3760 *
3761 *-----------------------------------------------------------------------------
3762 */
3763
3764 static void
DeletePerInterpData(PerInterpData * pidata)3765 DeletePerInterpData(
3766 PerInterpData* pidata /* Data structure to clean up */
3767 ) {
3768 int i;
3769
3770 Tcl_HashSearch search;
3771 Tcl_HashEntry *entry;
3772 for (entry = Tcl_FirstHashEntry(&(pidata->typeNumHash), &search);
3773 entry != NULL;
3774 entry = Tcl_NextHashEntry(&search)) {
3775 Tcl_Obj* nameObj = (Tcl_Obj*) Tcl_GetHashValue(entry);
3776 Tcl_DecrRefCount(nameObj);
3777 }
3778 Tcl_DeleteHashTable(&(pidata->typeNumHash));
3779
3780 for (i = 0; i < LIT__END; ++i) {
3781 Tcl_DecrRefCount(pidata->literals[i]);
3782 }
3783 ckfree((char *) pidata);
3784
3785 /*
3786 * TODO: decrease thread refcount and mysql_thread_end if need be
3787 */
3788
3789 Tcl_MutexLock(&mysqlMutex);
3790 if (--mysqlRefCount == 0) {
3791 mysql_library_end();
3792 Tcl_FSUnloadFile(NULL, mysqlLoadHandle);
3793 }
3794 Tcl_MutexUnlock(&mysqlMutex);
3795 }
3796