/* * tdbcmysql.c -- * * Bridge between TDBC (Tcl DataBase Connectivity) and MYSQL. * * Copyright (c) 2008, 2009 by Kevin B. Kenny. * * Please refer to the file, 'license.terms' for the conditions on * redistribution of this file and for a DISCLAIMER OF ALL WARRANTIES. * * $Id: $ * *----------------------------------------------------------------------------- */ #ifdef _MSC_VER # define _CRT_SECURE_NO_WARNINGS #endif #include #include #include #include "tdbcMysqlUuid.h" #include #include #ifdef HAVE_STDINT_H # include #endif #include "int2ptr_ptr2int.h" #include "fakemysql.h" #ifndef JOIN # define JOIN(a,b) JOIN1(a,b) # define JOIN1(a,b) a##b #endif #ifndef TCL_UNUSED # if defined(__cplusplus) # define TCL_UNUSED(T) T # elif defined(__GNUC__) && (__GNUC__ > 2) # define TCL_UNUSED(T) T JOIN(dummy, __LINE__) __attribute__((unused)) # else # define TCL_UNUSED(T) T JOIN(dummy, __LINE__) # endif #endif /* Static data contained in this file */ TCL_DECLARE_MUTEX(mysqlMutex); /* Mutex protecting the global environment * and its reference count */ static int mysqlRefCount = 0; /* Reference count on the global environment */ Tcl_LoadHandle mysqlLoadHandle = NULL; /* Handle to the MySQL library */ unsigned long mysqlClientVersion = 0; /* Version number of MySQL */ Tcl_Obj* mysqlClientLibName = NULL; /* Name of the MySQL client library */ int mysqlClientAtLeast51; /* Flag == 1 if MySQL client is at least * version 5.1.0 */ /* * Objects to create within the literal pool */ const char* LiteralValues[] = { "", "0", "1", "direction", "in", "inout", "name", "nullable", "out", "precision", "scale", "type", NULL }; enum LiteralIndex { LIT_EMPTY, LIT_0, LIT_1, LIT_DIRECTION, LIT_IN, LIT_INOUT, LIT_NAME, LIT_NULLABLE, LIT_OUT, LIT_PRECISION, LIT_SCALE, LIT_TYPE, LIT__END }; /* * Structure that holds per-interpreter data for the MYSQL package. */ typedef struct PerInterpData { size_t refCount; /* Reference count */ Tcl_Obj* literals[LIT__END]; /* Literal pool */ Tcl_HashTable typeNumHash; /* Lookup table for type numbers */ } PerInterpData; #define IncrPerInterpRefCount(x) \ do { \ ++((x)->refCount); \ } while(0) #define DecrPerInterpRefCount(x) \ do { \ PerInterpData* _pidata = x; \ if (_pidata->refCount-- <= 1) { \ DeletePerInterpData(_pidata); \ } \ } while(0) /* * Structure that carries the data for an MYSQL connection * * The ConnectionData structure is refcounted to simplify the * destruction of statements associated with a connection. * When a connection is destroyed, the subordinate namespace that * contains its statements is taken down, destroying them. It's * not safe to take down the ConnectionData until nothing is * referring to it, which avoids taking down the hDBC until the * other objects that refer to it vanish. */ typedef struct ConnectionData { size_t refCount; /* Reference count. */ PerInterpData* pidata; /* Per-interpreter data */ MYSQL* mysqlPtr; /* MySql connection handle */ unsigned int nCollations; /* Number of collations defined */ int* collationSizes; /* Character lengths indexed by collation ID */ int flags; } ConnectionData; /* * Flags for the state of an MYSQL connection */ #define CONN_FLAG_AUTOCOMMIT 0x1 /* Autocommit is set */ #define CONN_FLAG_IN_XCN 0x2 /* Transaction is in progress */ #define CONN_FLAG_INTERACTIVE 0x4 /* -interactive requested at connect */ #define IncrConnectionRefCount(x) \ do { \ ++((x)->refCount); \ } while(0) #define DecrConnectionRefCount(x) \ do { \ ConnectionData* conn = x; \ if (conn->refCount-- <= 1) { \ DeleteConnection(conn); \ } \ } while(0) /* * Structure that carries the data for a MySQL prepared statement. * * Just as with connections, statements need to defer taking down * their client data until other objects (i.e., result sets) that * refer to them have had a chance to clean up. Hence, this * structure is reference counted as well. */ typedef struct StatementData { size_t refCount; /* Reference count */ ConnectionData* cdata; /* Data for the connection to which this * statement pertains. */ Tcl_Obj* subVars; /* List of variables to be substituted, in the * order in which they appear in the * statement */ struct ParamData *params; /* Data types and attributes of parameters */ Tcl_Obj* nativeSql; /* Native SQL statement to pass into * MySQL */ MYSQL_STMT* stmtPtr; /* MySQL statement handle */ MYSQL_RES* metadataPtr; /* MySQL result set metadata */ Tcl_Obj* columnNames; /* Column names in the result set */ int flags; } StatementData; #define IncrStatementRefCount(x) \ do { \ ++((x)->refCount); \ } while (0) #define DecrStatementRefCount(x) \ do { \ StatementData* stmt = (x); \ if ((stmt->refCount--) <= 1) { \ DeleteStatement(stmt); \ } \ } while(0) /* Flags in the 'StatementData->flags' word */ #define STMT_FLAG_BUSY 0x1 /* Statement handle is in use */ /* * Structure describing the data types of substituted parameters in * a SQL statement. */ typedef struct ParamData { int flags; /* Flags regarding the parameters - see below */ int dataType; /* Data type */ int precision; /* Size of the expected data */ int scale; /* Digits after decimal point of the * expected data */ } ParamData; #define PARAM_KNOWN 1<<0 /* Something is known about the parameter */ #define PARAM_IN 1<<1 /* Parameter is an input parameter */ #define PARAM_OUT 1<<2 /* Parameter is an output parameter */ /* (Both bits are set if parameter is * an INOUT parameter) */ #define PARAM_BINARY 1<<3 /* Parameter is binary */ /* * Structure describing a MySQL result set. The object that the Tcl * API terms a "result set" actually has to be represented by a MySQL * "statement", since a MySQL statement can have only one set of results * at any given time. */ typedef struct ResultSetData { size_t refCount; /* Reference count */ StatementData* sdata; /* Statement that generated this result set */ MYSQL_STMT* stmtPtr; /* Handle to the MySQL statement object */ Tcl_Obj* paramValues; /* List of parameter values */ MYSQL_BIND* paramBindings; /* Parameter bindings */ unsigned long* paramLengths;/* Parameter lengths */ my_ulonglong rowCount; /* Number of affected rows */ my_bool* resultErrors; /* Failure indicators for retrieving columns */ my_bool* resultNulls; /* NULL indicators for retrieving columns */ unsigned long* resultLengths; /* Byte lengths of retrieved columns */ MYSQL_BIND* resultBindings; /* Bindings controlling column retrieval */ } ResultSetData; #define IncrResultSetRefCount(x) \ do { \ ++((x)->refCount); \ } while (0) #define DecrResultSetRefCount(x) \ do { \ ResultSetData* rs = (x); \ if (rs->refCount-- <= 1) { \ DeleteResultSet(rs); \ } \ } while(0) /* Table of MySQL type names */ #define IS_BINARY (1<<16) /* Flag to OR in if a param is binary */ typedef struct MysqlDataType { const char* name; /* Type name */ int num; /* Type number */ } MysqlDataType; static const MysqlDataType dataTypes[] = { { "tinyint", MYSQL_TYPE_TINY }, { "smallint", MYSQL_TYPE_SHORT }, { "integer", MYSQL_TYPE_LONG }, { "float", MYSQL_TYPE_FLOAT }, { "real", MYSQL_TYPE_FLOAT }, { "double", MYSQL_TYPE_DOUBLE }, { "NULL", MYSQL_TYPE_NULL }, { "timestamp", MYSQL_TYPE_TIMESTAMP }, { "bigint", MYSQL_TYPE_LONGLONG }, { "mediumint", MYSQL_TYPE_INT24 }, { "date", MYSQL_TYPE_NEWDATE }, { "date", MYSQL_TYPE_DATE }, { "time", MYSQL_TYPE_TIME }, { "datetime", MYSQL_TYPE_DATETIME }, { "year", MYSQL_TYPE_YEAR }, { "bit", MYSQL_TYPE_BIT | IS_BINARY }, { "numeric", MYSQL_TYPE_NEWDECIMAL }, { "decimal", MYSQL_TYPE_NEWDECIMAL }, { "numeric", MYSQL_TYPE_DECIMAL }, { "decimal", MYSQL_TYPE_DECIMAL }, { "enum", MYSQL_TYPE_ENUM }, { "set", MYSQL_TYPE_SET }, { "tinytext", MYSQL_TYPE_TINY_BLOB }, { "tinyblob", MYSQL_TYPE_TINY_BLOB | IS_BINARY }, { "mediumtext", MYSQL_TYPE_MEDIUM_BLOB }, { "mediumblob", MYSQL_TYPE_MEDIUM_BLOB | IS_BINARY }, { "longtext", MYSQL_TYPE_LONG_BLOB }, { "longblob", MYSQL_TYPE_LONG_BLOB | IS_BINARY }, { "text", MYSQL_TYPE_BLOB }, { "blob", MYSQL_TYPE_BLOB | IS_BINARY }, { "varbinary", MYSQL_TYPE_VAR_STRING | IS_BINARY }, { "varchar", MYSQL_TYPE_VAR_STRING }, { "varbinary", MYSQL_TYPE_VARCHAR | IS_BINARY }, { "varchar", MYSQL_TYPE_VARCHAR }, { "binary", MYSQL_TYPE_STRING | IS_BINARY }, { "char", MYSQL_TYPE_STRING }, { "geometry", MYSQL_TYPE_GEOMETRY }, { NULL, 0 } }; /* Configuration options for MySQL connections */ /* Data types of configuration options */ enum OptType { TYPE_STRING, /* Arbitrary character string */ TYPE_FLAG, /* Boolean flag */ TYPE_ENCODING, /* Encoding name */ TYPE_ISOLATION, /* Transaction isolation level */ TYPE_PORT, /* Port number */ TYPE_READONLY, /* Read-only indicator */ TYPE_TIMEOUT /* Timeout value */ }; /* Locations of the string options in the string array */ enum OptStringIndex { INDX_DB, INDX_HOST, INDX_PASSWD, INDX_SOCKET, INDX_SSLCA, INDX_SSLCAPATH, INDX_SSLCERT, INDX_SSLCIPHER, INDX_SSLKEY, INDX_USER, INDX_MAX }; /* Flags in the configuration table */ #define CONN_OPT_FLAG_MOD 0x1 /* Configuration value changable at runtime */ #define CONN_OPT_FLAG_SSL 0x2 /* Configuration change requires setting * SSL options */ #define CONN_OPT_FLAG_ALIAS 0x4 /* Configuration option is an alias */ /* Table of configuration options */ static const struct { const char * name; /* Option name */ enum OptType type; /* Option data type */ int info; /* Option index or flag value */ int flags; /* Flags - modifiable; SSL related; is an alias */ const char* query; /* How to determine the option value? */ } ConnOptions [] = { { "-compress", TYPE_FLAG, CLIENT_COMPRESS, 0, "SELECT '', @@SLAVE_COMPRESSED_PROTOCOL" }, { "-database", TYPE_STRING, INDX_DB, CONN_OPT_FLAG_MOD, "SELECT '', DATABASE();"}, { "-db", TYPE_STRING, INDX_DB, CONN_OPT_FLAG_MOD | CONN_OPT_FLAG_ALIAS, "SELECT '', DATABASE()" }, { "-encoding", TYPE_ENCODING, 0, 0, "SELECT '', 'utf-8'" }, { "-host", TYPE_STRING, INDX_HOST, 0, "SHOW SESSION VARIABLES WHERE VARIABLE_NAME = 'hostname'" }, { "-interactive", TYPE_FLAG, CLIENT_INTERACTIVE, 0, "SELECT '', 0" }, { "-isolation", TYPE_ISOLATION, 0, CONN_OPT_FLAG_MOD, "SELECT '', LCASE(REPLACE(@@TX_ISOLATION, '-', ''))" }, { "-passwd", TYPE_STRING, INDX_PASSWD, CONN_OPT_FLAG_MOD | CONN_OPT_FLAG_ALIAS, "SELECT '', ''" }, { "-password", TYPE_STRING, INDX_PASSWD, CONN_OPT_FLAG_MOD, "SELECT '', ''" }, { "-port", TYPE_PORT, 0, 0, "SHOW SESSION VARIABLES WHERE VARIABLE_NAME = 'port'" }, { "-readonly", TYPE_READONLY, 0, 0, "SELECT '', 0" }, { "-socket", TYPE_STRING, INDX_SOCKET, 0, "SHOW SESSION VARIABLES WHERE VARIABLE_NAME = 'socket'" }, { "-ssl_ca", TYPE_STRING, INDX_SSLCA, CONN_OPT_FLAG_SSL, "SELECT '', @@SSL_CA"}, { "-ssl_capath", TYPE_STRING, INDX_SSLCAPATH, CONN_OPT_FLAG_SSL, "SELECT '', @@SSL_CAPATH" }, { "-ssl_cert", TYPE_STRING, INDX_SSLCERT, CONN_OPT_FLAG_SSL, "SELECT '', @@SSL_CERT" }, { "-ssl_cipher", TYPE_STRING, INDX_SSLCIPHER, CONN_OPT_FLAG_SSL, "SELECT '', @@SSL_CIPHER" }, { "-ssl_cypher", TYPE_STRING, INDX_SSLCIPHER, CONN_OPT_FLAG_SSL | CONN_OPT_FLAG_ALIAS, "SELECT '', @@SSL_CIPHER" }, { "-ssl_key", TYPE_STRING, INDX_SSLKEY, CONN_OPT_FLAG_SSL, "SELECT '', @@SSL_KEY" }, { "-timeout", TYPE_TIMEOUT, 0, CONN_OPT_FLAG_MOD, "SELECT '', @@WAIT_TIMEOUT" }, { "-user", TYPE_STRING, INDX_USER, CONN_OPT_FLAG_MOD, "SELECT '', USER()" }, { NULL, TYPE_STRING, 0, 0, NULL } }; /* Tables of isolation levels: Tcl, SQL, and MySQL 'tx_isolation' */ static const char *const TclIsolationLevels[] = { "readuncommitted", "readcommitted", "repeatableread", "serializable", NULL }; static const char *const SqlIsolationLevels[] = { "SET SESSION TRANSACTION ISOLATION LEVEL READ UNCOMMITTED", "SET SESSION TRANSACTION ISOLATION LEVEL READ COMMITTED", "SET SESSION TRANSACTION ISOLATION LEVEL REPEATABLE READ", "SET SESSION TRANSACTION ISOLATION LEVEL SERIALIZABLE", NULL }; enum IsolationLevel { ISOL_READ_UNCOMMITTED, ISOL_READ_COMMITTED, ISOL_REPEATABLE_READ, ISOL_SERIALIZABLE, ISOL_NONE = -1 }; /* Declarations of static functions appearing in this file */ static MYSQL_BIND* MysqlBindAlloc(int nBindings); static MYSQL_BIND* MysqlBindIndex(MYSQL_BIND* b, int i); static void* MysqlBindAllocBuffer(MYSQL_BIND* b, int i, unsigned long len); static void MysqlBindFreeBuffer(MYSQL_BIND* b, int i); static void MysqlBindSetBufferType(MYSQL_BIND* b, int i, enum enum_field_types t); static void* MysqlBindGetBuffer(MYSQL_BIND* b, int i); static unsigned long MysqlBindGetBufferLength(MYSQL_BIND* b, int i); static void MysqlBindSetLength(MYSQL_BIND* b, int i, unsigned long* p); static void MysqlBindSetIsNull(MYSQL_BIND* b, int i, my_bool* p); static void MysqlBindSetError(MYSQL_BIND* b, int i, my_bool* p); static MYSQL_FIELD* MysqlFieldIndex(MYSQL_FIELD* fields, int i); static void TransferMysqlError(Tcl_Interp* interp, MYSQL* mysqlPtr); static void TransferMysqlStmtError(Tcl_Interp* interp, MYSQL_STMT* mysqlPtr); static Tcl_Obj* QueryConnectionOption(ConnectionData* cdata, Tcl_Interp* interp, int optionNum); static int ConfigureConnection(ConnectionData* cdata, Tcl_Interp* interp, size_t objc, Tcl_Obj *const objv[], size_t skip); static int ConnectionConstructor(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static int ConnectionBegintransactionMethod(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static int ConnectionColumnsMethod(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static int ConnectionCommitMethod(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static int ConnectionConfigureMethod(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static int ConnectionEvaldirectMethod(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static int ConnectionNeedCollationInfoMethod(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static int ConnectionRollbackMethod(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static int ConnectionSetCollationInfoMethod(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static int ConnectionTablesMethod(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static void DeleteConnectionMetadata(void *clientData); static void DeleteConnection(ConnectionData* cdata); static int CloneConnection(Tcl_Interp* interp, void *oldClientData, void **newClientData); static StatementData* NewStatement(ConnectionData* cdata); static MYSQL_STMT* AllocAndPrepareStatement(Tcl_Interp* interp, StatementData* sdata); static Tcl_Obj* ResultDescToTcl(MYSQL_RES* resultDesc, int flags); static int StatementConstructor(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static int StatementParamtypeMethod(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static int StatementParamsMethod(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static void DeleteStatementMetadata(void *clientData); static void DeleteStatement(StatementData* sdata); static int CloneStatement(Tcl_Interp* interp, void *oldClientData, void **newClientData); static int ResultSetConstructor(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static int ResultSetColumnsMethod(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static int ResultSetNextrowMethod(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static int ResultSetRowcountMethod(void *clientData, Tcl_Interp* interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const objv[]); static void DeleteResultSetMetadata(void *clientData); static void DeleteResultSet(ResultSetData* rdata); static int CloneResultSet(Tcl_Interp* interp, void *oldClientData, void **newClientData); static void DeleteCmd(void *clientData); static int CloneCmd(Tcl_Interp* interp, void *oldMetadata, void **newMetadata); static void DeletePerInterpData(PerInterpData* pidata); /* Metadata type that holds connection data */ const static Tcl_ObjectMetadataType connectionDataType = { TCL_OO_METADATA_VERSION_CURRENT, /* version */ "ConnectionData", /* name */ DeleteConnectionMetadata, /* deleteProc */ CloneConnection /* cloneProc - should cause an error * 'cuz connections aren't clonable */ }; /* Metadata type that holds statement data */ const static Tcl_ObjectMetadataType statementDataType = { TCL_OO_METADATA_VERSION_CURRENT, /* version */ "StatementData", /* name */ DeleteStatementMetadata, /* deleteProc */ CloneStatement /* cloneProc - should cause an error * 'cuz statements aren't clonable */ }; /* Metadata type for result set data */ const static Tcl_ObjectMetadataType resultSetDataType = { TCL_OO_METADATA_VERSION_CURRENT, /* version */ "ResultSetData", /* name */ DeleteResultSetMetadata, /* deleteProc */ CloneResultSet /* cloneProc - should cause an error * 'cuz result sets aren't clonable */ }; /* Method types of the connection methods that are implemented in C */ const static Tcl_MethodType ConnectionConstructorType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "CONSTRUCTOR", /* name */ ConnectionConstructor, /* callProc */ DeleteCmd, /* deleteProc */ CloneCmd /* cloneProc */ }; const static Tcl_MethodType ConnectionBegintransactionMethodType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "begintransaction", /* name */ ConnectionBegintransactionMethod, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; const static Tcl_MethodType ConnectionColumnsMethodType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "Columns", /* name */ ConnectionColumnsMethod, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; const static Tcl_MethodType ConnectionCommitMethodType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "commit", /* name */ ConnectionCommitMethod, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; const static Tcl_MethodType ConnectionConfigureMethodType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "configure", /* name */ ConnectionConfigureMethod, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; const static Tcl_MethodType ConnectionEvaldirectMethodType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "evaldirect", /* name */ ConnectionEvaldirectMethod, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; const static Tcl_MethodType ConnectionNeedCollationInfoMethodType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "NeedCollationInfo", /* name */ ConnectionNeedCollationInfoMethod, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; const static Tcl_MethodType ConnectionRollbackMethodType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "rollback", /* name */ ConnectionRollbackMethod, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; const static Tcl_MethodType ConnectionSetCollationInfoMethodType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "SetCollationInfo", /* name */ ConnectionSetCollationInfoMethod, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; const static Tcl_MethodType ConnectionTablesMethodType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "tables", /* name */ ConnectionTablesMethod, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; const static Tcl_MethodType* ConnectionMethods[] = { &ConnectionBegintransactionMethodType, &ConnectionColumnsMethodType, &ConnectionCommitMethodType, &ConnectionConfigureMethodType, &ConnectionEvaldirectMethodType, &ConnectionNeedCollationInfoMethodType, &ConnectionRollbackMethodType, &ConnectionSetCollationInfoMethodType, &ConnectionTablesMethodType, NULL }; /* Method types of the statement methods that are implemented in C */ const static Tcl_MethodType StatementConstructorType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "CONSTRUCTOR", /* name */ StatementConstructor, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; const static Tcl_MethodType StatementParamsMethodType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "params", /* name */ StatementParamsMethod, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; const static Tcl_MethodType StatementParamtypeMethodType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "paramtype", /* name */ StatementParamtypeMethod, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; /* * Methods to create on the statement class. */ const static Tcl_MethodType* StatementMethods[] = { &StatementParamsMethodType, &StatementParamtypeMethodType, NULL }; /* Method types of the result set methods that are implemented in C */ const static Tcl_MethodType ResultSetConstructorType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "CONSTRUCTOR", /* name */ ResultSetConstructor, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; const static Tcl_MethodType ResultSetColumnsMethodType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "columns", /* name */ ResultSetColumnsMethod, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; const static Tcl_MethodType ResultSetNextrowMethodType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "nextrow", /* name */ ResultSetNextrowMethod, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; const static Tcl_MethodType ResultSetRowcountMethodType = { TCL_OO_METHOD_VERSION_CURRENT, /* version */ "rowcount", /* name */ ResultSetRowcountMethod, /* callProc */ NULL, /* deleteProc */ NULL /* cloneProc */ }; /* Methods to create on the result set class */ const static Tcl_MethodType* ResultSetMethods[] = { &ResultSetColumnsMethodType, &ResultSetRowcountMethodType, NULL }; /* *----------------------------------------------------------------------------- * * MysqlBindAlloc -- * * Allocate a number of MYSQL_BIND structures. * * Results: * Returns a pointer to the array of structures, which will be zeroed out. * *----------------------------------------------------------------------------- */ static MYSQL_BIND* MysqlBindAlloc(int nBindings) { int size; void* retval = NULL; if (mysqlClientAtLeast51) { size = sizeof(struct st_mysql_bind_51); } else { size = sizeof(struct st_mysql_bind_50); } size *= nBindings; if (size != 0) { retval = ckalloc(size); memset(retval, 0, size); } return (MYSQL_BIND*) retval; } /* *----------------------------------------------------------------------------- * * MysqlBindIndex -- * * Returns a pointer to one of an array of MYSQL_BIND objects * *----------------------------------------------------------------------------- */ static MYSQL_BIND* MysqlBindIndex( MYSQL_BIND* b, /* Binding array to alter */ int i /* Index in the binding array */ ) { if (mysqlClientAtLeast51) { return (MYSQL_BIND*)(((struct st_mysql_bind_51*) b) + i); } else { return (MYSQL_BIND*)(((struct st_mysql_bind_50*) b) + i); } } /* *----------------------------------------------------------------------------- * * MysqlBindAllocBuffer -- * * Allocates the buffer in a MYSQL_BIND object * * Results: * Returns a pointer to the allocated buffer * *----------------------------------------------------------------------------- */ static void* MysqlBindAllocBuffer( MYSQL_BIND* b, /* Pointer to a binding array */ int i, /* Index into the array */ unsigned long len /* Length of the buffer to allocate or 0 */ ) { void* block = NULL; if (len != 0) { block = ckalloc(len); } if (mysqlClientAtLeast51) { ((struct st_mysql_bind_51*) b)[i].buffer = block; ((struct st_mysql_bind_51*) b)[i].buffer_length = len; } else { ((struct st_mysql_bind_50*) b)[i].buffer = block; ((struct st_mysql_bind_50*) b)[i].buffer_length = len; } return block; } /* *----------------------------------------------------------------------------- * * MysqlBindFreeBuffer -- * * Frees trhe buffer in a MYSQL_BIND object * * Results: * None. * * Side effects: * Buffer is returned to the system. * *----------------------------------------------------------------------------- */ static void MysqlBindFreeBuffer( MYSQL_BIND* b, /* Pointer to a binding array */ int i /* Index into the array */ ) { if (mysqlClientAtLeast51) { struct st_mysql_bind_51* bindings = (struct st_mysql_bind_51*) b; if (bindings[i].buffer) { ckfree(bindings[i].buffer); bindings[i].buffer = NULL; } bindings[i].buffer_length = 0; } else { struct st_mysql_bind_50* bindings = (struct st_mysql_bind_50*) b; if (bindings[i].buffer) { ckfree(bindings[i].buffer); bindings[i].buffer = NULL; } bindings[i].buffer_length = 0; } } /* *----------------------------------------------------------------------------- * * MysqlBindGetBufferLength, MysqlBindSetBufferType, MysqlBindGetBufferType, * MysqlBindSetLength, MysqlBindSetIsNull, * MysqlBindSetError -- * * Access the fields of a MYSQL_BIND object * *----------------------------------------------------------------------------- */ static void* MysqlBindGetBuffer( MYSQL_BIND* b, /* Binding array to alter */ int i /* Index in the binding array */ ) { if (mysqlClientAtLeast51) { return ((struct st_mysql_bind_51*) b)[i].buffer; } else { return ((struct st_mysql_bind_50*) b)[i].buffer; } } static unsigned long MysqlBindGetBufferLength( MYSQL_BIND* b, /* Binding array to alter */ int i /* Index in the binding array */ ) { if (mysqlClientAtLeast51) { return ((struct st_mysql_bind_51*) b)[i].buffer_length; } else { return ((struct st_mysql_bind_50*) b)[i].buffer_length; } } static enum enum_field_types MysqlBindGetBufferType( MYSQL_BIND* b, /* Binding array to alter */ int i /* Index in the binding array */ ) { if (mysqlClientAtLeast51) { return ((struct st_mysql_bind_51*) b)[i].buffer_type; } else { return ((struct st_mysql_bind_50*) b)[i].buffer_type; } } static void MysqlBindSetBufferType( MYSQL_BIND* b, /* Binding array to alter */ int i, /* Index in the binding array */ enum enum_field_types t /* Buffer type to assign */ ) { if (mysqlClientAtLeast51) { ((struct st_mysql_bind_51*) b)[i].buffer_type = t; } else { ((struct st_mysql_bind_50*) b)[i].buffer_type = t; } } static void MysqlBindSetLength( MYSQL_BIND* b, /* Binding array to alter */ int i, /* Index in the binding array */ unsigned long* p /* Length pointer to assign */ ) { if (mysqlClientAtLeast51) { ((struct st_mysql_bind_51*) b)[i].length = p; } else { ((struct st_mysql_bind_50*) b)[i].length = p; } } static void MysqlBindSetIsNull( MYSQL_BIND* b, /* Binding array to alter */ int i, /* Index in the binding array */ my_bool* p /* "Is null" indicator pointer to assign */ ) { if (mysqlClientAtLeast51) { ((struct st_mysql_bind_51*) b)[i].is_null = p; } else { ((struct st_mysql_bind_50*) b)[i].is_null = p; } } static void MysqlBindSetError( MYSQL_BIND* b, /* Binding array to alter */ int i, /* Index in the binding array */ my_bool* p /* Error indicator pointer to assign */ ) { if (mysqlClientAtLeast51) { ((struct st_mysql_bind_51*) b)[i].error = p; } else { ((struct st_mysql_bind_50*) b)[i].error = p; } } /* *----------------------------------------------------------------------------- * * MysqlFieldIndex -- * * Return a pointer to a given MYSQL_FIELD structure in an array * * The MYSQL_FIELD structure grows by one pointer between 5.0 and 5.1. * Our code never creates a MYSQL_FIELD, nor does it try to access that * pointer, so we handle things simply by casting the types. * *----------------------------------------------------------------------------- */ static MYSQL_FIELD* MysqlFieldIndex(MYSQL_FIELD* fields, /* Pointer to the array*/ int i) /* Index in the array */ { MYSQL_FIELD* retval; if (mysqlClientAtLeast51) { retval = (MYSQL_FIELD*)(((struct st_mysql_field_51*) fields)+i); } else { retval = (MYSQL_FIELD*)(((struct st_mysql_field_50*) fields)+i); } return retval; } /* *----------------------------------------------------------------------------- * * TransferMysqlError -- * * Obtains the error message, SQL state, and error number from the * MySQL client library and transfers them into the Tcl interpreter * * Results: * None. * * Side effects: * Sets the interpreter result and error code to describe the SQL error * *----------------------------------------------------------------------------- */ static void TransferMysqlError( Tcl_Interp* interp, /* Tcl interpreter */ MYSQL* mysqlPtr /* MySQL connection handle */ ) { const char* sqlstate = mysql_sqlstate(mysqlPtr); Tcl_Obj* errorCode = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj("TDBC", -1)); Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj(Tdbc_MapSqlState(sqlstate), -1)); Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj(sqlstate, -1)); Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj("MYSQL", -1)); Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewWideIntObj(mysql_errno(mysqlPtr))); Tcl_SetObjErrorCode(interp, errorCode); Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_error(mysqlPtr), -1)); } /* *----------------------------------------------------------------------------- * * TransferMysqlStmtError -- * * Obtains the error message, SQL state, and error number from the * MySQL client library and transfers them into the Tcl interpreter * * Results: * None. * * Side effects: * Sets the interpreter result and error code to describe the SQL error * *----------------------------------------------------------------------------- */ static void TransferMysqlStmtError( Tcl_Interp* interp, /* Tcl interpreter */ MYSQL_STMT* stmtPtr /* MySQL statment handle */ ) { const char* sqlstate = mysql_stmt_sqlstate(stmtPtr); Tcl_Obj* errorCode = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj("TDBC", -1)); Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj(Tdbc_MapSqlState(sqlstate), -1)); Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj(sqlstate, -1)); Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj("MYSQL", -1)); Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewWideIntObj(mysql_stmt_errno(stmtPtr))); Tcl_SetObjErrorCode(interp, errorCode); Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_stmt_error(stmtPtr), -1)); } /* *----------------------------------------------------------------------------- * * QueryConnectionOption -- * * Determine the current value of a connection option. * * Results: * Returns a Tcl object containing the value if successful, or NULL * if unsuccessful. If unsuccessful, stores error information in the * Tcl interpreter. * *----------------------------------------------------------------------------- */ static Tcl_Obj* QueryConnectionOption ( ConnectionData* cdata, /* Connection data */ Tcl_Interp* interp, /* Tcl interpreter */ int optionNum /* Position of the option in the table */ ) { MYSQL_RES* result; /* Result of the MySQL query for the option */ MYSQL_ROW row; /* Row of the result set */ int fieldCount; /* Number of fields in a row */ unsigned long* lengths; /* Character lengths of the fields */ Tcl_Obj* retval; /* Return value */ if (mysql_query(cdata->mysqlPtr, ConnOptions[optionNum].query)) { TransferMysqlError(interp, cdata->mysqlPtr); return NULL; } result = mysql_store_result(cdata->mysqlPtr); if (result == NULL) { TransferMysqlError(interp, cdata->mysqlPtr); return NULL; } fieldCount = mysql_num_fields(result); if (fieldCount < 2) { retval = cdata->pidata->literals[LIT_EMPTY]; } else { if ((row = mysql_fetch_row(result)) == NULL) { if (mysql_errno(cdata->mysqlPtr)) { TransferMysqlError(interp, cdata->mysqlPtr); mysql_free_result(result); return NULL; } else { retval = cdata->pidata->literals[LIT_EMPTY]; } } else { lengths = mysql_fetch_lengths(result); retval = Tcl_NewStringObj(row[1], lengths[1]); } } mysql_free_result(result); return retval; } /* *----------------------------------------------------------------------------- * * ConfigureConnection -- * * Applies configuration settings to a MySQL connection. * * Results: * Returns a Tcl result. If the result is TCL_ERROR, error information * is stored in the interpreter. * * Side effects: * Updates configuration in the connection data. Opens a connection * if none is yet open. * *----------------------------------------------------------------------------- */ static int ConfigureConnection( ConnectionData* cdata, /* Connection data */ Tcl_Interp* interp, /* Tcl interpreter */ size_t objc, /* Parameter count */ Tcl_Obj* const objv[], /* Parameter data */ size_t skip /* Number of parameters to skip */ ) { const char* stringOpts[INDX_MAX]; /* String-valued options */ unsigned long mysqlFlags=0; /* Connection flags */ int sslFlag = 0; /* Flag==1 if SSL configuration is needed */ int optionIndex; /* Index of the current option in ConnOptions */ int optionValue; /* Integer value of the current option */ unsigned short port = 0; /* Server port number */ int isolation = ISOL_NONE; /* Isolation level */ int timeout = 0; /* Timeout value */ size_t i; Tcl_Obj* retval; Tcl_Obj* optval; if (cdata->mysqlPtr != NULL) { /* Query configuration options on an existing connection */ if (objc == skip) { retval = Tcl_NewObj(); for (i = 0; ConnOptions[i].name != NULL; ++i) { if (ConnOptions[i].flags & CONN_OPT_FLAG_ALIAS) continue; optval = QueryConnectionOption(cdata, interp, i); if (optval == NULL) { return TCL_ERROR; } Tcl_DictObjPut(NULL, retval, Tcl_NewStringObj(ConnOptions[i].name, -1), optval); } Tcl_SetObjResult(interp, retval); return TCL_OK; } else if (objc == skip+1) { if (Tcl_GetIndexFromObjStruct(interp, objv[skip], (void*) ConnOptions, sizeof(ConnOptions[0]), "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } retval = QueryConnectionOption(cdata, interp, optionIndex); if (retval == NULL) { return TCL_ERROR; } else { Tcl_SetObjResult(interp, retval); return TCL_OK; } } } if ((objc-skip) % 2 != 0) { Tcl_WrongNumArgs(interp, skip, objv, "?-option value?..."); return TCL_ERROR; } /* Extract options from the command line */ for (i = 0; i < INDX_MAX; ++i) { stringOpts[i] = NULL; } for (i = skip; i < objc; i += 2) { /* Unknown option */ if (Tcl_GetIndexFromObjStruct(interp, objv[i], (void*) ConnOptions, sizeof(ConnOptions[0]), "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } /* Unmodifiable option */ if (cdata->mysqlPtr != NULL && !(ConnOptions[optionIndex].flags & CONN_OPT_FLAG_MOD)) { Tcl_Obj* msg = Tcl_NewStringObj("\"", -1); Tcl_AppendObjToObj(msg, objv[i]); Tcl_AppendToObj(msg, "\" option cannot be changed dynamically", -1); Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY000", "MYSQL", "-1", NULL); return TCL_ERROR; } /* Record option value */ switch (ConnOptions[optionIndex].type) { case TYPE_STRING: stringOpts[ConnOptions[optionIndex].info] = Tcl_GetString(objv[i+1]); break; case TYPE_FLAG: if (Tcl_GetBooleanFromObj(interp, objv[i+1], &optionValue) != TCL_OK) { return TCL_ERROR; } if (optionValue) { mysqlFlags |= ConnOptions[optionIndex].info; } break; case TYPE_ENCODING: if (strcmp(Tcl_GetString(objv[i+1]), "utf-8")) { Tcl_SetObjResult(interp, Tcl_NewStringObj("Only UTF-8 transfer " "encoding is supported.\n", -1)); Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY000", "MYSQL", "-1", NULL); return TCL_ERROR; } break; case TYPE_ISOLATION: if (Tcl_GetIndexFromObjStruct(interp, objv[i+1], TclIsolationLevels, sizeof(char *), "isolation level", TCL_EXACT, &isolation) != TCL_OK) { return TCL_ERROR; } break; case TYPE_PORT: if (Tcl_GetIntFromObj(interp, objv[i+1], &optionValue) != TCL_OK) { return TCL_ERROR; } if (optionValue < 0 || optionValue > 0xffff) { Tcl_SetObjResult(interp, Tcl_NewStringObj("port number must " "be in range " "[0..65535]", -1)); Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY000", "MYSQL", "-1", NULL); return TCL_ERROR; } port = optionValue; break; case TYPE_READONLY: if (Tcl_GetBooleanFromObj(interp, objv[i+1], &optionValue) != TCL_OK) { return TCL_ERROR; } if (optionValue != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("MySQL does not support " "readonly connections", -1)); Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY000", "MYSQL", "-1", NULL); return TCL_ERROR; } break; case TYPE_TIMEOUT: if (Tcl_GetIntFromObj(interp, objv[i+1], &timeout) != TCL_OK) { return TCL_ERROR; } break; } if (ConnOptions[optionIndex].flags & CONN_OPT_FLAG_SSL) { sslFlag = 1; } } if (cdata->mysqlPtr == NULL) { /* Configuring a new connection. Open the database */ cdata->mysqlPtr = mysql_init(NULL); if (cdata->mysqlPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("mysql_init() failed.", -1)); Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY001", "MYSQL", "NULL", NULL); return TCL_ERROR; } /* Set character set for the connection */ mysql_options(cdata->mysqlPtr, MYSQL_SET_CHARSET_NAME, "utf8"); /* Set SSL options if needed */ if (sslFlag) { mysql_ssl_set(cdata->mysqlPtr, stringOpts[INDX_SSLKEY], stringOpts[INDX_SSLCERT], stringOpts[INDX_SSLCA], stringOpts[INDX_SSLCAPATH], stringOpts[INDX_SSLCIPHER]); } /* Establish the connection */ /* * TODO - mutex around this unless linked to libmysqlclient_r ? */ if (mysql_real_connect(cdata->mysqlPtr, stringOpts[INDX_HOST], stringOpts[INDX_USER], stringOpts[INDX_PASSWD], stringOpts[INDX_DB], port, stringOpts[INDX_SOCKET], mysqlFlags) == NULL) { TransferMysqlError(interp, cdata->mysqlPtr); return TCL_ERROR; } cdata->flags |= CONN_FLAG_AUTOCOMMIT; } else { /* Already open connection */ if (stringOpts[INDX_USER] != NULL) { /* User name changed - log in again */ if (mysql_change_user(cdata->mysqlPtr, stringOpts[INDX_USER], stringOpts[INDX_PASSWD], stringOpts[INDX_DB])) { TransferMysqlError(interp, cdata->mysqlPtr); return TCL_ERROR; } } else if (stringOpts[INDX_DB] != NULL) { /* Database name changed - use the new database */ if (mysql_select_db(cdata->mysqlPtr, stringOpts[INDX_DB])) { TransferMysqlError(interp, cdata->mysqlPtr); return TCL_ERROR; } } } /* Transaction isolation level */ if (isolation != ISOL_NONE) { if (mysql_query(cdata->mysqlPtr, SqlIsolationLevels[isolation])) { TransferMysqlError(interp, cdata->mysqlPtr); return TCL_ERROR; } } /* Timeout */ if (timeout != 0) { int result; Tcl_Obj* query = Tcl_ObjPrintf("SET SESSION WAIT_TIMEOUT = %d\n", timeout); Tcl_IncrRefCount(query); result = mysql_query(cdata->mysqlPtr, Tcl_GetString(query)); Tcl_DecrRefCount(query); if (result) { TransferMysqlError(interp, cdata->mysqlPtr); return TCL_ERROR; } } return TCL_OK; } /* *----------------------------------------------------------------------------- * * ConnectionConstructor -- * * Constructor for ::tdbc::mysql::connection, which represents a * database connection. * * Results: * Returns a standard Tcl result. * * The ConnectionInitMethod takes alternating keywords and values giving * the configuration parameters of the connection, and attempts to connect * to the database. * *----------------------------------------------------------------------------- */ static int ConnectionConstructor( void *clientData, /* Environment handle */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext context, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { PerInterpData* pidata = (PerInterpData*) clientData; /* Per-interp data for the MYSQL package */ Tcl_Object thisObject = Tcl_ObjectContextObject(context); /* The current object */ size_t skip = Tcl_ObjectContextSkippedArgs(context); /* The number of leading arguments to skip */ ConnectionData* cdata; /* Per-connection data */ /* Hang client data on this connection */ cdata = (ConnectionData*) ckalloc(sizeof(ConnectionData)); cdata->refCount = 1; cdata->pidata = pidata; cdata->mysqlPtr = NULL; cdata->nCollations = 0; cdata->collationSizes = NULL; cdata->flags = 0; IncrPerInterpRefCount(pidata); Tcl_ObjectSetMetadata(thisObject, &connectionDataType, cdata); /* Configure the connection */ if (ConfigureConnection(cdata, interp, objc, objv, skip) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } /* *----------------------------------------------------------------------------- * * ConnectionBegintransactionMethod -- * * Method that requests that following operations on an OBBC connection * be executed as an atomic transaction. * * Usage: * $connection begintransaction * * Parameters: * None. * * Results: * Returns an empty result if successful, and throws an error otherwise. * *----------------------------------------------------------------------------- */ static int ConnectionBegintransactionMethod( TCL_UNUSED(void *), /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext objectContext, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* The current connection object */ ConnectionData* cdata = (ConnectionData*) Tcl_ObjectGetMetadata(thisObject, &connectionDataType); /* Check parameters */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, ""); return TCL_ERROR; } /* Reject attempts at nested transactions */ if (cdata->flags & CONN_FLAG_IN_XCN) { Tcl_SetObjResult(interp, Tcl_NewStringObj("MySQL does not support " "nested transactions", -1)); Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HYC00", "MYSQL", "-1", NULL); return TCL_ERROR; } cdata->flags |= CONN_FLAG_IN_XCN; /* Turn off autocommit for the duration of the transaction */ if (cdata->flags & CONN_FLAG_AUTOCOMMIT) { if (mysql_autocommit(cdata->mysqlPtr, 0)) { TransferMysqlError(interp, cdata->mysqlPtr); return TCL_ERROR; } cdata->flags &= ~CONN_FLAG_AUTOCOMMIT; } return TCL_OK; } /* *----------------------------------------------------------------------------- * * ConnectionColumnsMethod -- * * Method that asks for the names of columns in a table * in the database (optionally matching a given pattern) * * Usage: * $connection columns table ?pattern? * * Parameters: * None. * * Results: * Returns the list of tables * *----------------------------------------------------------------------------- */ static int ConnectionColumnsMethod( TCL_UNUSED(void *), /* Completion type */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext objectContext, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* The current connection object */ ConnectionData* cdata = (ConnectionData*) Tcl_ObjectGetMetadata(thisObject, &connectionDataType); /* Instance data */ PerInterpData* pidata = cdata->pidata; /* Per-interpreter data */ Tcl_Obj** literals = pidata->literals; /* Literal pool */ const char* patternStr; /* Pattern to match table names */ MYSQL_RES* results; /* Result set */ Tcl_Obj* retval; /* List of table names */ Tcl_Obj* name; /* Name of a column */ Tcl_Obj* attrs; /* Attributes of the column */ Tcl_HashEntry* entry; /* Hash entry for data type */ /* Check parameters */ if (objc == 3) { patternStr = NULL; } else if (objc == 4) { patternStr = Tcl_GetString(objv[3]); } else { Tcl_WrongNumArgs(interp, 2, objv, "table ?pattern?"); return TCL_ERROR; } results = mysql_list_fields(cdata->mysqlPtr, Tcl_GetString(objv[2]), patternStr); if (results == NULL) { TransferMysqlError(interp, cdata->mysqlPtr); return TCL_ERROR; } else { unsigned int fieldCount = mysql_num_fields(results); MYSQL_FIELD* fields = mysql_fetch_fields(results); unsigned int i; retval = Tcl_NewObj(); Tcl_IncrRefCount(retval); for (i = 0; i < fieldCount; ++i) { MYSQL_FIELD* field = MysqlFieldIndex(fields, i); attrs = Tcl_NewObj(); name = Tcl_NewStringObj(field->name, field->name_length); Tcl_DictObjPut(NULL, attrs, literals[LIT_NAME], name); /* TODO - Distinguish CHAR and BINARY */ entry = Tcl_FindHashEntry(&(pidata->typeNumHash), (char*) field->type); if (entry != NULL) { Tcl_DictObjPut(NULL, attrs, literals[LIT_TYPE], (Tcl_Obj*) Tcl_GetHashValue(entry)); } if (IS_NUM(field->type)) { Tcl_DictObjPut(NULL, attrs, literals[LIT_PRECISION], Tcl_NewWideIntObj(field->length)); } else if (field->charsetnr < cdata->nCollations) { Tcl_DictObjPut(NULL, attrs, literals[LIT_PRECISION], Tcl_NewWideIntObj(field->length / cdata->collationSizes[field->charsetnr])); } Tcl_DictObjPut(NULL, attrs, literals[LIT_SCALE], Tcl_NewWideIntObj(field->decimals)); Tcl_DictObjPut(NULL, attrs, literals[LIT_NULLABLE], Tcl_NewWideIntObj(!(field->flags & (NOT_NULL_FLAG)))); Tcl_DictObjPut(NULL, retval, name, attrs); } mysql_free_result(results); Tcl_SetObjResult(interp, retval); Tcl_DecrRefCount(retval); return TCL_OK; } } /* *----------------------------------------------------------------------------- * * ConnectionCommitMethod -- * * Method that requests that a pending transaction against a database * be committed. * * Usage: * $connection commit * * Parameters: * None. * * Results: * Returns an empty Tcl result if successful, and throws an error * otherwise. * *----------------------------------------------------------------------------- */ static int ConnectionCommitMethod( TCL_UNUSED(void *), /* Not used */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext objectContext, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* The current connection object */ ConnectionData* cdata = (ConnectionData*) Tcl_ObjectGetMetadata(thisObject, &connectionDataType); /* Instance data */ my_bool rc; /* MySQL status return */ /* Check parameters */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, ""); return TCL_ERROR; } /* Reject the request if no transaction is in progress */ if (!(cdata->flags & CONN_FLAG_IN_XCN)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("no transaction is in " "progress", -1)); Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY010", "MYSQL", "-1", NULL); return TCL_ERROR; } /* End transaction, turn off "transaction in progress", and report status */ rc = mysql_commit(cdata->mysqlPtr); cdata->flags &= ~ CONN_FLAG_IN_XCN; if (rc) { TransferMysqlError(interp, cdata->mysqlPtr); return TCL_ERROR; } return TCL_OK; } /* *----------------------------------------------------------------------------- * * ConnectionConfigureMethod -- * * Change configuration parameters on an open connection. * * Usage: * $connection configure ?-keyword? ?value? ?-keyword value ...? * * Parameters: * Keyword-value pairs (or a single keyword, or an empty set) * of configuration options. * * Options: * The following options are supported; * -database * Name of the database to use by default in queries * -encoding * Character encoding to use with the server. (Must be utf-8) * -isolation * Transaction isolation level. * -readonly * Read-only flag (must be a false Boolean value) * -timeout * Timeout value (both wait_timeout and interactive_timeout) * * Other options supported by the constructor are here in read-only * mode; any attempt to change them will result in an error. * *----------------------------------------------------------------------------- */ static int ConnectionConfigureMethod( TCL_UNUSED(void *), Tcl_Interp* interp, Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const objv[] ) { Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* The current connection object */ size_t skip = Tcl_ObjectContextSkippedArgs(objectContext); /* Number of arguments to skip */ ConnectionData* cdata = (ConnectionData*) Tcl_ObjectGetMetadata(thisObject, &connectionDataType); /* Instance data */ return ConfigureConnection(cdata, interp, objc, objv, skip); } /* *----------------------------------------------------------------------------- * * ConnectionEvaldirectMethod -- * * Evaluates a MySQL statement that is not supported by the prepared * statement API. * * Usage: * $connection evaldirect sql-statement * * Parameters: * sql-statement - * SQL statement to evaluate. The statement may not contain * substitutions. * * Results: * Returns a standard Tcl result. If the operation is successful, * the result consists of a list of rows (in the same form as * [$connection allrows -as dicts]). If the operation fails, the * result is an error message. * * Side effects: * Whatever the SQL statement does. * *----------------------------------------------------------------------------- */ static int ConnectionEvaldirectMethod( TCL_UNUSED(void *), /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext objectContext, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[]) /* Parameter vector */ { Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* Current connection object */ ConnectionData* cdata = (ConnectionData*) Tcl_ObjectGetMetadata(thisObject, &connectionDataType); /* Instance data */ int nColumns; /* Number of columns in the result set */ MYSQL_RES* resultPtr; /* MySQL result set */ MYSQL_ROW rowPtr; /* One row of the result set */ unsigned long* lengths; /* Lengths of the fields in a row */ Tcl_Obj* retObj; /* Result set as a Tcl list */ Tcl_Obj* rowObj; /* One row of the result set as a Tcl list */ Tcl_Obj* fieldObj; /* One field of the row */ int i; /* Check parameters */ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, ""); return TCL_ERROR; } /* Execute the given statement */ if (mysql_query(cdata->mysqlPtr, Tcl_GetString(objv[2]))) { TransferMysqlError(interp, cdata->mysqlPtr); return TCL_ERROR; } /* Retrieve the result set */ resultPtr = mysql_store_result(cdata->mysqlPtr); nColumns = mysql_field_count(cdata->mysqlPtr); if (resultPtr == NULL) { /* * Can't retrieve result set. Distinguish result-less statements * from MySQL errors. */ if (nColumns == 0) { Tcl_SetObjResult (interp, Tcl_NewWideIntObj(mysql_affected_rows(cdata->mysqlPtr))); return TCL_OK; } else { TransferMysqlError(interp, cdata->mysqlPtr); return TCL_ERROR; } } /* Make a list-of-lists of the result */ retObj = Tcl_NewObj(); while ((rowPtr = mysql_fetch_row(resultPtr)) != NULL) { rowObj = Tcl_NewObj(); lengths = mysql_fetch_lengths(resultPtr); for (i = 0; i < nColumns; ++i) { if (rowPtr[i] != NULL) { fieldObj = Tcl_NewStringObj(rowPtr[i], lengths[i]); } else { fieldObj = cdata->pidata->literals[LIT_EMPTY]; } Tcl_ListObjAppendElement(NULL, rowObj, fieldObj); } Tcl_ListObjAppendElement(NULL, retObj, rowObj); } Tcl_SetObjResult(interp, retObj); /* * Free the result set. */ mysql_free_result(resultPtr); return TCL_OK; } /* *----------------------------------------------------------------------------- * * ConnectionNeedCollationInfoMethod -- * * Internal method that determines whether the collation lengths * are known yet. * * Usage: * $connection NeedCollationInfo * * Parameters: * None. * * Results: * Returns a Boolean value. * *----------------------------------------------------------------------------- */ static int ConnectionNeedCollationInfoMethod( TCL_UNUSED(void *), /* Not used */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext objectContext, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* The current connection object */ ConnectionData* cdata = (ConnectionData*) Tcl_ObjectGetMetadata(thisObject, &connectionDataType); /* Instance data */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, ""); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(cdata->collationSizes == NULL)); return TCL_OK; } /* *----------------------------------------------------------------------------- * * ConnectionRollbackMethod -- * * Method that requests that a pending transaction against a database * be rolled back. * * Usage: * $connection rollback * * Parameters: * None. * * Results: * Returns an empty Tcl result if successful, and throws an error * otherwise. * *----------------------------------------------------------------------------- */ static int ConnectionRollbackMethod( TCL_UNUSED(void *), /* Not used */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext objectContext, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* The current connection object */ ConnectionData* cdata = (ConnectionData*) Tcl_ObjectGetMetadata(thisObject, &connectionDataType); /* Instance data */ my_bool rc; /* Result code from MySQL operations */ /* Check parameters */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, ""); return TCL_ERROR; } /* Reject the request if no transaction is in progress */ if (!(cdata->flags & CONN_FLAG_IN_XCN)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("no transaction is in " "progress", -1)); Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY010", "MYSQL", "-1", NULL); return TCL_ERROR; } /* End transaction, turn off "transaction in progress", and report status */ rc = mysql_rollback(cdata->mysqlPtr); cdata->flags &= ~CONN_FLAG_IN_XCN; if (rc) { TransferMysqlError(interp, cdata->mysqlPtr); return TCL_ERROR; } return TCL_OK; } /* *----------------------------------------------------------------------------- * * ConnectionSetCollationInfoMethod -- * * Internal method that saves the character lengths of the collations * * Usage: * $connection SetCollationInfo {collationNum size} ... * * Parameters: * One or more pairs of collation number and character length, * ordered in decreasing sequence by collation number. * * Results: * None. * * The [$connection columns $table] method needs to know the sizes * of characters in a given column's collation and character set. * This information is available by querying INFORMATION_SCHEMA, which * is easier to do from Tcl than C. This method passes in the results. * *----------------------------------------------------------------------------- */ static int ConnectionSetCollationInfoMethod( TCL_UNUSED(void *), /* Not used */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext objectContext, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* The current connection object */ ConnectionData* cdata = (ConnectionData*) Tcl_ObjectGetMetadata(thisObject, &connectionDataType); /* Instance data */ int listLen; Tcl_Obj* objPtr; unsigned int collationNum; int i; int t; if (objc <= 2) { Tcl_WrongNumArgs(interp, 2, objv, "{collationNum size}..."); return TCL_ERROR; } if (Tcl_ListObjIndex(interp, objv[2], 0, &objPtr) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objPtr, &t) != TCL_OK) { return TCL_ERROR; } cdata->nCollations = (unsigned int)(t+1); if (cdata->collationSizes) { ckfree((char*) cdata->collationSizes); } cdata->collationSizes = (int*) ckalloc(cdata->nCollations * sizeof(int)); memset(cdata->collationSizes, 0, cdata->nCollations * sizeof(int)); for (i = 2; i < objc; ++i) { if (Tcl_ListObjLength(interp, objv[i], &listLen) != TCL_OK) { return TCL_ERROR; } if (listLen != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("args must be 2-element " "lists", -1)); return TCL_ERROR; } if (Tcl_ListObjIndex(interp, objv[i], 0, &objPtr) != TCL_OK || Tcl_GetIntFromObj(interp, objPtr, &t) != TCL_OK) { return TCL_ERROR; } collationNum = (unsigned int) t; if (collationNum > cdata->nCollations) { Tcl_SetObjResult(interp, Tcl_NewStringObj("collations must be " "in decreasing sequence", -1)); return TCL_ERROR; } if ((Tcl_ListObjIndex(interp, objv[i], 1, &objPtr) != TCL_OK) || (Tcl_GetIntFromObj(interp, objPtr, cdata->collationSizes+collationNum) != TCL_OK)) { return TCL_ERROR; } } return TCL_OK; } /* *----------------------------------------------------------------------------- * * ConnectionTablesMethod -- * * Method that asks for the names of tables in the database (optionally * matching a given pattern * * Usage: * $connection tables ?pattern? * * Parameters: * None. * * Results: * Returns the list of tables * *----------------------------------------------------------------------------- */ static int ConnectionTablesMethod( TCL_UNUSED(void *), /* Not used */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext objectContext, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* The current connection object */ ConnectionData* cdata = (ConnectionData*) Tcl_ObjectGetMetadata(thisObject, &connectionDataType); /* Instance data */ Tcl_Obj** literals = cdata->pidata->literals; /* Literal pool */ const char* patternStr = NULL; /* Pattern to match table names */ MYSQL_RES* results = NULL; /* Result set */ MYSQL_ROW row = NULL; /* Row in the result set */ int status = TCL_OK; /* Return status */ Tcl_Obj* retval = NULL; /* List of table names */ /* Check parameters */ if (objc == 2) { patternStr = NULL; } else if (objc == 3) { patternStr = Tcl_GetString(objv[2]); } else { Tcl_WrongNumArgs(interp, 2, objv, ""); return TCL_ERROR; } results = mysql_list_tables(cdata->mysqlPtr, patternStr); if (results == NULL) { TransferMysqlError(interp, cdata->mysqlPtr); return TCL_ERROR; } else { retval = Tcl_NewObj(); Tcl_IncrRefCount(retval); while ((row = mysql_fetch_row(results)) != NULL) { unsigned long * lengths = mysql_fetch_lengths(results); if (row[0]) { Tcl_ListObjAppendElement(NULL, retval, Tcl_NewStringObj(row[0], (int)lengths[0])); Tcl_ListObjAppendElement(NULL, retval, literals[LIT_EMPTY]); } } if (mysql_errno(cdata->mysqlPtr)) { TransferMysqlError(interp, cdata->mysqlPtr); status = TCL_ERROR; } if (status == TCL_OK) { Tcl_SetObjResult(interp, retval); } Tcl_DecrRefCount(retval); mysql_free_result(results); return status; } } /* *----------------------------------------------------------------------------- * * DeleteCmd -- * * Callback executed when the initialization method of the connection * class is deleted. * * Side effects: * Dismisses the environment, which has the effect of shutting * down MYSQL when it is no longer required. * *----------------------------------------------------------------------------- */ static void DeleteCmd ( void *clientData /* Environment handle */ ) { PerInterpData* pidata = (PerInterpData*) clientData; DecrPerInterpRefCount(pidata); } /* *----------------------------------------------------------------------------- * * CloneCmd -- * * Callback executed when any of the MYSQL client methods is cloned. * * Results: * Returns TCL_OK to allow the method to be copied. * * Side effects: * Obtains a fresh copy of the environment handle, to keep the * refcounts accurate * *----------------------------------------------------------------------------- */ static int CloneCmd( TCL_UNUSED(Tcl_Interp *),/* Tcl interpreter */ void *oldClientData, /* Environment handle to be discarded */ void **newClientData /* New environment handle to be used */ ) { *newClientData = oldClientData; return TCL_OK; } /* *----------------------------------------------------------------------------- * * DeleteConnectionMetadata, DeleteConnection -- * * Cleans up when a database connection is deleted. * * Results: * None. * * Side effects: * Terminates the connection and frees all system resources associated * with it. * *----------------------------------------------------------------------------- */ static void DeleteConnectionMetadata( void *clientData /* Instance data for the connection */ ) { DecrConnectionRefCount((ConnectionData*)clientData); } static void DeleteConnection( ConnectionData* cdata /* Instance data for the connection */ ) { if (cdata->collationSizes != NULL) { ckfree((char*) cdata->collationSizes); } if (cdata->mysqlPtr != NULL) { mysql_close(cdata->mysqlPtr); } DecrPerInterpRefCount(cdata->pidata); ckfree((char*) cdata); } /* *----------------------------------------------------------------------------- * * CloneConnection -- * * Attempts to clone an MYSQL connection's metadata. * * Results: * Returns the new metadata * * At present, we don't attempt to clone connections - it's not obvious * that such an action would ever even make sense. Instead, we return NULL * to indicate that the metadata should not be cloned. (Note that this * action isn't right, either. What *is* right is to indicate that the object * is not clonable, but the API gives us no way to do that. * *----------------------------------------------------------------------------- */ static int CloneConnection( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ TCL_UNUSED(void *), /* Metadata to be cloned */ TCL_UNUSED(void **) /* Where to put the cloned metadata */ ) { Tcl_SetObjResult(interp, Tcl_NewStringObj("MYSQL connections are not clonable", -1)); return TCL_ERROR; } /* *----------------------------------------------------------------------------- * * NewStatement -- * * Creates an empty object to hold statement data. * * Results: * Returns a pointer to the newly-created object. * *----------------------------------------------------------------------------- */ static StatementData* NewStatement( ConnectionData* cdata /* Instance data for the connection */ ) { StatementData* sdata = (StatementData*) ckalloc(sizeof(StatementData)); sdata->refCount = 1; sdata->cdata = cdata; IncrConnectionRefCount(cdata); sdata->subVars = Tcl_NewObj(); Tcl_IncrRefCount(sdata->subVars); sdata->params = NULL; sdata->nativeSql = NULL; sdata->stmtPtr = NULL; sdata->metadataPtr = NULL; sdata->columnNames = NULL; sdata->flags = 0; return sdata; } /* *----------------------------------------------------------------------------- * * AllocAndPrepareStatement -- * * Allocate space for a MySQL prepared statement, and prepare the * statement. * * Results: * Returns the statement handle if successful, and NULL on failure. * * Side effects: * Prepares the statement. * Stores error message and error code in the interpreter on failure. * *----------------------------------------------------------------------------- */ static MYSQL_STMT* AllocAndPrepareStatement( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ StatementData* sdata /* Statement data */ ) { ConnectionData* cdata = sdata->cdata; /* Connection data */ MYSQL_STMT* stmtPtr; /* Statement handle */ const char* nativeSqlStr; /* Native SQL statement to prepare */ int nativeSqlLen; /* Length of the statement */ /* Allocate space for the prepared statement */ stmtPtr = mysql_stmt_init(cdata->mysqlPtr); /* * MySQL allows only one writable cursor open at a time, and * the default cursor type is writable. Make all our cursors * read-only to avoid 'Commands out of sync' errors. */ if (stmtPtr == NULL) { TransferMysqlError(interp, cdata->mysqlPtr); } else { /* Prepare the statement */ nativeSqlStr = Tcl_GetStringFromObj(sdata->nativeSql, &nativeSqlLen); if (mysql_stmt_prepare(stmtPtr, nativeSqlStr, nativeSqlLen)) { TransferMysqlStmtError(interp, stmtPtr); mysql_stmt_close(stmtPtr); stmtPtr = NULL; } } return stmtPtr; } /* *----------------------------------------------------------------------------- * * ResultDescToTcl -- * * Converts a MySQL result description for return as a Tcl list. * * Results: * Returns a Tcl object holding the result description * * If any column names are duplicated, they are disambiguated by * appending '#n' where n increments once for each occurrence of the * column name. * *----------------------------------------------------------------------------- */ static Tcl_Obj* ResultDescToTcl( MYSQL_RES* result, /* Result set description */ TCL_UNUSED(int) /* Flags governing the conversion */ ) { Tcl_Obj* retval = Tcl_NewObj(); Tcl_HashTable names; /* Hash table to resolve name collisions */ Tcl_Obj* nameObj; /* Name of a result column */ int isNew; /* Flag == 1 if a result column is unique */ Tcl_HashEntry* entry; /* Hash table entry for a column name */ int count; /* Number used to disambiguate a column name */ Tcl_InitHashTable(&names, TCL_STRING_KEYS); if (result != NULL) { unsigned int fieldCount = mysql_num_fields(result); MYSQL_FIELD* fields = mysql_fetch_fields(result); unsigned int i; char numbuf[16]; for (i = 0; i < fieldCount; ++i) { MYSQL_FIELD* field = MysqlFieldIndex(fields, i); nameObj = Tcl_NewStringObj(field->name, field->name_length); Tcl_IncrRefCount(nameObj); entry = Tcl_CreateHashEntry(&names, field->name, &isNew); count = 1; while (!isNew) { count = PTR2INT(Tcl_GetHashValue(entry)); ++count; Tcl_SetHashValue(entry, INT2PTR(count)); sprintf(numbuf, "#%d", count); Tcl_AppendToObj(nameObj, numbuf, -1); entry = Tcl_CreateHashEntry(&names, Tcl_GetString(nameObj), &isNew); } Tcl_SetHashValue(entry, INT2PTR(count)); Tcl_ListObjAppendElement(NULL, retval, nameObj); Tcl_DecrRefCount(nameObj); } } Tcl_DeleteHashTable(&names); return retval; } /* *----------------------------------------------------------------------------- * * StatementConstructor -- * * C-level initialization for the object representing an MySQL prepared * statement. * * Usage: * statement new connection statementText * statement create name connection statementText * * Parameters: * connection -- the MySQL connection object * statementText -- text of the statement to prepare. * * Results: * Returns a standard Tcl result * * Side effects: * Prepares the statement, and stores it (plus a reference to the * connection) in instance metadata. * *----------------------------------------------------------------------------- */ static int StatementConstructor( TCL_UNUSED(void *), /* Not used */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext context, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { Tcl_Object thisObject = Tcl_ObjectContextObject(context); /* The current statement object */ size_t skip = Tcl_ObjectContextSkippedArgs(context); /* Number of args to skip before the * payload arguments */ Tcl_Object connectionObject; /* The database connection as a Tcl_Object */ ConnectionData* cdata; /* The connection object's data */ StatementData* sdata; /* The statement's object data */ Tcl_Obj* tokens; /* The tokens of the statement to be prepared */ int tokenc; /* Length of the 'tokens' list */ Tcl_Obj** tokenv; /* Exploded tokens from the list */ Tcl_Obj* nativeSql; /* SQL statement mapped to native form */ char* tokenStr; /* Token string */ int tokenLen; /* Length of a token */ int nParams; /* Number of parameters of the statement */ int i; /* Find the connection object, and get its data. */ thisObject = Tcl_ObjectContextObject(context); if ((size_t)objc != skip+2) { Tcl_WrongNumArgs(interp, skip, objv, "connection statementText"); return TCL_ERROR; } connectionObject = Tcl_GetObjectFromObj(interp, objv[skip]); if (connectionObject == NULL) { return TCL_ERROR; } cdata = (ConnectionData*) Tcl_ObjectGetMetadata(connectionObject, &connectionDataType); if (cdata == NULL) { Tcl_AppendResult(interp, Tcl_GetString(objv[skip]), " does not refer to a MySQL connection", NULL); return TCL_ERROR; } /* * Allocate an object to hold data about this statement */ sdata = NewStatement(cdata); /* Tokenize the statement */ tokens = Tdbc_TokenizeSql(interp, Tcl_GetString(objv[skip+1])); if (tokens == NULL) { goto freeSData; } Tcl_IncrRefCount(tokens); /* * Rewrite the tokenized statement to MySQL syntax. Reject the * statement if it is actually multiple statements. */ if (Tcl_ListObjGetElements(interp, tokens, &tokenc, &tokenv) != TCL_OK) { goto freeTokens; } nativeSql = Tcl_NewObj(); Tcl_IncrRefCount(nativeSql); for (i = 0; i < tokenc; ++i) { tokenStr = Tcl_GetStringFromObj(tokenv[i], &tokenLen); switch (tokenStr[0]) { case '$': case ':': case '@': Tcl_AppendToObj(nativeSql, "?", 1); Tcl_ListObjAppendElement(NULL, sdata->subVars, Tcl_NewStringObj(tokenStr+1, tokenLen-1)); break; case ';': Tcl_SetObjResult(interp, Tcl_NewStringObj("tdbc::mysql" " does not support semicolons " "in statements", -1)); goto freeNativeSql; break; default: Tcl_AppendToObj(nativeSql, tokenStr, tokenLen); break; } } sdata->nativeSql = nativeSql; Tcl_DecrRefCount(tokens); /* Prepare the statement */ sdata->stmtPtr = AllocAndPrepareStatement(interp, sdata); if (sdata->stmtPtr == NULL) { goto freeSData; } /* Get result set metadata */ sdata->metadataPtr = mysql_stmt_result_metadata(sdata->stmtPtr); if (mysql_stmt_errno(sdata->stmtPtr)) { TransferMysqlStmtError(interp, sdata->stmtPtr); goto freeSData; } sdata->columnNames = ResultDescToTcl(sdata->metadataPtr, 0); Tcl_IncrRefCount(sdata->columnNames); Tcl_ListObjLength(NULL, sdata->subVars, &nParams); sdata->params = (ParamData*) ckalloc(nParams * sizeof(ParamData)); for (i = 0; i < nParams; ++i) { sdata->params[i].flags = PARAM_IN; sdata->params[i].dataType = MYSQL_TYPE_VARCHAR; sdata->params[i].precision = 0; sdata->params[i].scale = 0; } /* Attach the current statement data as metadata to the current object */ Tcl_ObjectSetMetadata(thisObject, &statementDataType, sdata); return TCL_OK; /* On error, unwind all the resource allocations */ freeNativeSql: Tcl_DecrRefCount(nativeSql); freeTokens: Tcl_DecrRefCount(tokens); freeSData: DecrStatementRefCount(sdata); return TCL_ERROR; } /* *----------------------------------------------------------------------------- * * StatementParamsMethod -- * * Lists the parameters in a MySQL statement. * * Usage: * $statement params * * Results: * Returns a standard Tcl result containing a dictionary. The keys * of the dictionary are parameter names, and the values are parameter * types, themselves expressed as dictionaries containing the keys, * 'name', 'direction', 'type', 'precision', 'scale' and 'nullable'. * * *----------------------------------------------------------------------------- */ static int StatementParamsMethod( TCL_UNUSED(void *), /* Not used */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext context, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { Tcl_Object thisObject = Tcl_ObjectContextObject(context); /* The current statement object */ StatementData* sdata /* The current statement */ = (StatementData*) Tcl_ObjectGetMetadata(thisObject, &statementDataType); ConnectionData* cdata = sdata->cdata; PerInterpData* pidata = cdata->pidata; /* Per-interp data */ Tcl_Obj** literals = pidata->literals; /* Literal pool */ int nParams; /* Number of parameters to the statement */ Tcl_Obj* paramName; /* Name of a parameter */ Tcl_Obj* paramDesc; /* Description of one parameter */ Tcl_Obj* dataTypeName; /* Name of a parameter's data type */ Tcl_Obj* retVal; /* Return value from this command */ Tcl_HashEntry* typeHashEntry; int i; if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, ""); return TCL_ERROR; } retVal = Tcl_NewObj(); Tcl_ListObjLength(NULL, sdata->subVars, &nParams); for (i = 0; i < nParams; ++i) { paramDesc = Tcl_NewObj(); Tcl_ListObjIndex(NULL, sdata->subVars, i, ¶mName); Tcl_DictObjPut(NULL, paramDesc, literals[LIT_NAME], paramName); switch (sdata->params[i].flags & (PARAM_IN | PARAM_OUT)) { case PARAM_IN: Tcl_DictObjPut(NULL, paramDesc, literals[LIT_DIRECTION], literals[LIT_IN]); break; case PARAM_OUT: Tcl_DictObjPut(NULL, paramDesc, literals[LIT_DIRECTION], literals[LIT_OUT]); break; case PARAM_IN | PARAM_OUT: Tcl_DictObjPut(NULL, paramDesc, literals[LIT_DIRECTION], literals[LIT_INOUT]); break; default: break; } typeHashEntry = Tcl_FindHashEntry(&(pidata->typeNumHash), INT2PTR(sdata->params[i].dataType)); if (typeHashEntry != NULL) { dataTypeName = (Tcl_Obj*) Tcl_GetHashValue(typeHashEntry); Tcl_DictObjPut(NULL, paramDesc, literals[LIT_TYPE], dataTypeName); } Tcl_DictObjPut(NULL, paramDesc, literals[LIT_PRECISION], Tcl_NewWideIntObj(sdata->params[i].precision)); Tcl_DictObjPut(NULL, paramDesc, literals[LIT_SCALE], Tcl_NewWideIntObj(sdata->params[i].scale)); Tcl_DictObjPut(NULL, retVal, paramName, paramDesc); } Tcl_SetObjResult(interp, retVal); return TCL_OK; } /* *----------------------------------------------------------------------------- * * StatementParamtypeMethod -- * * Defines a parameter type in a MySQL statement. * * Usage: * $statement paramtype paramName ?direction? type ?precision ?scale?? * * Results: * Returns a standard Tcl result. * * Side effects: * Updates the description of the given parameter. * *----------------------------------------------------------------------------- */ static int StatementParamtypeMethod( TCL_UNUSED(void *), /* Not used */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext context, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { Tcl_Object thisObject = Tcl_ObjectContextObject(context); /* The current statement object */ StatementData* sdata /* The current statement */ = (StatementData*) Tcl_ObjectGetMetadata(thisObject, &statementDataType); static const struct { const char* name; int flags; } directions[] = { { "in", PARAM_IN }, { "out", PARAM_OUT }, { "inout", PARAM_IN | PARAM_OUT }, { NULL, 0 } }; int direction; int typeNum; /* Data type number of a parameter */ int precision; /* Data precision */ int scale; /* Data scale */ int nParams; /* Number of parameters to the statement */ const char* paramName; /* Name of the parameter being set */ Tcl_Obj* targetNameObj; /* Name of the ith parameter in the statement */ const char* targetName; /* Name of a candidate parameter in the * statement */ int matchCount = 0; /* Number of parameters matching the name */ Tcl_Obj* errorObj; /* Error message */ int i; int j; /* Check parameters */ if (objc < 4) { goto wrongNumArgs; } i = 3; if (Tcl_GetIndexFromObjStruct(interp, objv[i], directions, sizeof(directions[0]), "direction", TCL_EXACT, &direction) != TCL_OK) { direction = PARAM_IN; Tcl_ResetResult(interp); } else { ++i; } if (i >= objc) goto wrongNumArgs; if (Tcl_GetIndexFromObjStruct(interp, objv[i], dataTypes, sizeof(dataTypes[0]), "SQL data type", TCL_EXACT, &typeNum) == TCL_OK) { ++i; } else { return TCL_ERROR; } if (i < objc) { if (Tcl_GetIntFromObj(interp, objv[i], &precision) == TCL_OK) { ++i; } else { return TCL_ERROR; } } if (i < objc) { if (Tcl_GetIntFromObj(interp, objv[i], &scale) == TCL_OK) { ++i; } else { return TCL_ERROR; } } if (i != objc) { goto wrongNumArgs; } /* Look up parameters by name. */ Tcl_ListObjLength(NULL, sdata->subVars, &nParams); paramName = Tcl_GetString(objv[2]); for (j = 0; j < nParams; ++j) { Tcl_ListObjIndex(NULL, sdata->subVars, j, &targetNameObj); targetName = Tcl_GetString(targetNameObj); if (!strcmp(paramName, targetName)) { ++matchCount; sdata->params[j].flags = direction; sdata->params[j].dataType = dataTypes[typeNum].num; sdata->params[j].precision = precision; sdata->params[j].scale = scale; } } if (matchCount == 0) { errorObj = Tcl_NewStringObj("unknown parameter \"", -1); Tcl_AppendToObj(errorObj, paramName, -1); Tcl_AppendToObj(errorObj, "\": must be ", -1); for (j = 0; j < nParams; ++j) { Tcl_ListObjIndex(NULL, sdata->subVars, j, &targetNameObj); Tcl_AppendObjToObj(errorObj, targetNameObj); if (j < nParams-2) { Tcl_AppendToObj(errorObj, ", ", -1); } else if (j == nParams-2) { Tcl_AppendToObj(errorObj, " or ", -1); } } Tcl_SetObjResult(interp, errorObj); return TCL_ERROR; } return TCL_OK; wrongNumArgs: Tcl_WrongNumArgs(interp, 2, objv, "name ?direction? type ?precision ?scale??"); return TCL_ERROR; } /* *----------------------------------------------------------------------------- * * DeleteStatementMetadata, DeleteStatement -- * * Cleans up when a MySQL statement is no longer required. * * Side effects: * Frees all resources associated with the statement. * *----------------------------------------------------------------------------- */ static void DeleteStatementMetadata( void *clientData /* Instance data for the connection */ ) { DecrStatementRefCount((StatementData*)clientData); } static void DeleteStatement( StatementData* sdata /* Metadata for the statement */ ) { if (sdata->columnNames != NULL) { Tcl_DecrRefCount(sdata->columnNames); } if (sdata->metadataPtr != NULL) { mysql_free_result(sdata->metadataPtr); } if (sdata->stmtPtr != NULL) { mysql_stmt_close(sdata->stmtPtr); } if (sdata->nativeSql != NULL) { Tcl_DecrRefCount(sdata->nativeSql); } if (sdata->params != NULL) { ckfree((char*)sdata->params); } Tcl_DecrRefCount(sdata->subVars); DecrConnectionRefCount(sdata->cdata); ckfree((char*)sdata); } /* *----------------------------------------------------------------------------- * * CloneStatement -- * * Attempts to clone a MySQL statement's metadata. * * Results: * Returns the new metadata * * At present, we don't attempt to clone statements - it's not obvious * that such an action would ever even make sense. Instead, we return NULL * to indicate that the metadata should not be cloned. (Note that this * action isn't right, either. What *is* right is to indicate that the object * is not clonable, but the API gives us no way to do that. * *----------------------------------------------------------------------------- */ static int CloneStatement( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ TCL_UNUSED(void *), /* Metadata to be cloned */ TCL_UNUSED(void **) /* Where to put the cloned metadata */ ) { Tcl_SetObjResult(interp, Tcl_NewStringObj("MySQL statements are not clonable", -1)); return TCL_ERROR; } /* *----------------------------------------------------------------------------- * * ResultSetConstructor -- * * Constructs a new result set. * * Usage: * $resultSet new statement ?dictionary? * $resultSet create name statement ?dictionary? * * Parameters: * statement -- Statement handle to which this resultset belongs * dictionary -- Dictionary containing the substitutions for named * parameters in the given statement. * * Results: * Returns a standard Tcl result. On error, the interpreter result * contains an appropriate message. * *----------------------------------------------------------------------------- */ static int ResultSetConstructor( TCL_UNUSED(void *), /* Not used */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext context, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { Tcl_Object thisObject = Tcl_ObjectContextObject(context); /* The current result set object */ size_t skip = Tcl_ObjectContextSkippedArgs(context); /* Number of args to skip */ Tcl_Object statementObject; /* The current statement object */ ConnectionData* cdata; /* The MySQL connection object's data */ StatementData* sdata; /* The statement object's data */ ResultSetData* rdata; /* THe result set object's data */ int nParams; /* The parameter count on the statement */ int nBound; /* Number of parameters bound so far */ Tcl_Obj* paramNameObj; /* Name of the current parameter */ const char* paramName; /* Name of the current parameter */ Tcl_Obj* paramValObj; /* Value of the current parameter */ const char* paramValStr; /* String value of the current parameter */ char* bufPtr; /* Pointer to the parameter buffer */ int len; /* Length of a bound parameter */ int nColumns; /* Number of columns in the result set */ MYSQL_FIELD* fields = NULL; /* Description of columns of the result set */ MYSQL_BIND* resultBindings; /* Bindings of the columns of the result set */ unsigned long* resultLengths; /* Lengths of the columns of the result set */ int i; /* Check parameter count */ if ((size_t)objc != skip+1 && objc != (size_t)skip+2) { Tcl_WrongNumArgs(interp, skip, objv, "statement ?dictionary?"); return TCL_ERROR; } /* Initialize the base classes */ Tcl_ObjectContextInvokeNext(interp, context, skip, objv, skip); /* Find the statement object, and get the statement data */ statementObject = Tcl_GetObjectFromObj(interp, objv[skip]); if (statementObject == NULL) { return TCL_ERROR; } sdata = (StatementData*) Tcl_ObjectGetMetadata(statementObject, &statementDataType); if (sdata == NULL) { Tcl_AppendResult(interp, Tcl_GetString(objv[skip]), " does not refer to a MySQL statement", NULL); return TCL_ERROR; } Tcl_ListObjLength(NULL, sdata->columnNames, &nColumns); cdata = sdata->cdata; /* * If there is no transaction in progress, turn on auto-commit so that * this statement will execute directly. */ if ((cdata->flags & (CONN_FLAG_IN_XCN | CONN_FLAG_AUTOCOMMIT)) == 0) { if (mysql_autocommit(cdata->mysqlPtr, 1)) { TransferMysqlError(interp, cdata->mysqlPtr); return TCL_ERROR; } cdata->flags |= CONN_FLAG_AUTOCOMMIT; } /* Allocate an object to hold data about this result set */ rdata = (ResultSetData*) ckalloc(sizeof(ResultSetData)); rdata->refCount = 1; rdata->sdata = sdata; rdata->stmtPtr = NULL; rdata->paramValues = NULL; rdata->paramBindings = NULL; rdata->paramLengths = NULL; rdata->rowCount = 0; rdata->resultErrors = (my_bool*) ckalloc(nColumns * sizeof(my_bool)); rdata->resultNulls = (my_bool*) ckalloc(nColumns * sizeof(my_bool)); resultLengths = rdata->resultLengths = (unsigned long*) ckalloc(nColumns * sizeof(unsigned long)); rdata->resultBindings = resultBindings = MysqlBindAlloc(nColumns); IncrStatementRefCount(sdata); Tcl_ObjectSetMetadata(thisObject, &resultSetDataType, rdata); /* Make bindings for all the result columns. Defer binding variable * length fields until first execution. */ if (nColumns > 0) { fields = mysql_fetch_fields(sdata->metadataPtr); } for (i = 0; i < nColumns; ++i) { MYSQL_FIELD* field = MysqlFieldIndex(fields, i); switch (field->type) { case MYSQL_TYPE_FLOAT: case MYSQL_TYPE_DOUBLE: MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_DOUBLE); MysqlBindAllocBuffer(resultBindings, i, sizeof(double)); resultLengths[i] = sizeof(double); break; case MYSQL_TYPE_BIT: MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_BIT); MysqlBindAllocBuffer(resultBindings, i, field->length); resultLengths[i] = field->length; break; case MYSQL_TYPE_LONGLONG: MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_LONGLONG); MysqlBindAllocBuffer(resultBindings, i, sizeof(Tcl_WideInt)); resultLengths[i] = sizeof(Tcl_WideInt); break; case MYSQL_TYPE_TINY: case MYSQL_TYPE_SHORT: case MYSQL_TYPE_INT24: case MYSQL_TYPE_LONG: MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_LONG); MysqlBindAllocBuffer(resultBindings, i, sizeof(int)); resultLengths[i] = sizeof(int); break; default: MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_STRING); MysqlBindAllocBuffer(resultBindings, i, 0); resultLengths[i] = 0; break; } MysqlBindSetLength(resultBindings, i, rdata->resultLengths + i); rdata->resultNulls[i] = 0; MysqlBindSetIsNull(resultBindings, i, rdata->resultNulls + i); rdata->resultErrors[i] = 0; MysqlBindSetError(resultBindings, i, rdata->resultErrors + i); } /* * Find a statement handle that we can use to execute the SQL code. * If the main statement handle associated with the statement * is idle, we can use it. Otherwise, we have to allocate and * prepare a fresh one. */ if (sdata->flags & STMT_FLAG_BUSY) { rdata->stmtPtr = AllocAndPrepareStatement(interp, sdata); if (rdata->stmtPtr == NULL) { return TCL_ERROR; } } else { rdata->stmtPtr = sdata->stmtPtr; sdata->flags |= STMT_FLAG_BUSY; } /* Allocate the parameter bindings */ Tcl_ListObjLength(NULL, sdata->subVars, &nParams); rdata->paramValues = Tcl_NewObj(); Tcl_IncrRefCount(rdata->paramValues); rdata->paramBindings = MysqlBindAlloc(nParams); rdata->paramLengths = (unsigned long*) ckalloc(nParams * sizeof(unsigned long)); for (nBound = 0; nBound < nParams; ++nBound) { MysqlBindSetBufferType(rdata->paramBindings, nBound, MYSQL_TYPE_NULL); } /* Bind the substituted parameters */ for (nBound = 0; nBound < nParams; ++nBound) { Tcl_ListObjIndex(NULL, sdata->subVars, nBound, ¶mNameObj); paramName = Tcl_GetString(paramNameObj); if ((size_t)objc == skip+2) { /* Param from a dictionary */ if (Tcl_DictObjGet(interp, objv[skip+1], paramNameObj, ¶mValObj) != TCL_OK) { return TCL_ERROR; } } else { /* Param from a variable */ paramValObj = Tcl_GetVar2Ex(interp, paramName, NULL, TCL_LEAVE_ERR_MSG); } /* * At this point, paramValObj contains the parameter to bind. * Convert the parameters to the appropriate data types for * MySQL's prepared statement interface, and bind them. */ if (paramValObj != NULL) { switch (sdata->params[nBound].dataType & 0xffff) { case MYSQL_TYPE_NEWDECIMAL: case MYSQL_TYPE_DECIMAL: if (sdata->params[nBound].scale == 0) { if (sdata->params[nBound].precision < 10) { goto smallinteger; } else if (sdata->params[nBound].precision < 19) { goto biginteger; } else { goto charstring; } } else if (sdata->params[nBound].precision < 17) { goto real; } else { goto charstring; } case MYSQL_TYPE_FLOAT: case MYSQL_TYPE_DOUBLE: real: MysqlBindSetBufferType(rdata->paramBindings, nBound, MYSQL_TYPE_DOUBLE); bufPtr = (char *)MysqlBindAllocBuffer(rdata->paramBindings, nBound, sizeof(double)); rdata->paramLengths[nBound] = sizeof(double); MysqlBindSetLength(rdata->paramBindings, nBound, &(rdata->paramLengths[nBound])); if (Tcl_GetDoubleFromObj(interp, paramValObj, (double*) bufPtr) != TCL_OK) { return TCL_ERROR; } break; case MYSQL_TYPE_BIT: case MYSQL_TYPE_LONGLONG: biginteger: MysqlBindSetBufferType(rdata->paramBindings, nBound, MYSQL_TYPE_LONGLONG); bufPtr = (char *)MysqlBindAllocBuffer(rdata->paramBindings, nBound, sizeof(Tcl_WideInt)); rdata->paramLengths[nBound] = sizeof(Tcl_WideInt); MysqlBindSetLength(rdata->paramBindings, nBound, &(rdata->paramLengths[nBound])); if (Tcl_GetWideIntFromObj(interp, paramValObj, (Tcl_WideInt*) bufPtr) != TCL_OK) { return TCL_ERROR; } break; case MYSQL_TYPE_TINY: case MYSQL_TYPE_SHORT: case MYSQL_TYPE_INT24: case MYSQL_TYPE_LONG: smallinteger: MysqlBindSetBufferType(rdata->paramBindings, nBound, MYSQL_TYPE_LONG); bufPtr = (char *)MysqlBindAllocBuffer(rdata->paramBindings, nBound, sizeof(int)); rdata->paramLengths[nBound] = sizeof(int); MysqlBindSetLength(rdata->paramBindings, nBound, &(rdata->paramLengths[nBound])); if (Tcl_GetIntFromObj(interp, paramValObj, (int*) bufPtr) != TCL_OK) { return TCL_ERROR; } break; default: charstring: Tcl_ListObjAppendElement(NULL, rdata->paramValues, paramValObj); if (sdata->params[nBound].dataType & IS_BINARY) { MysqlBindSetBufferType(rdata->paramBindings, nBound, MYSQL_TYPE_BLOB); paramValStr = (char*) Tcl_GetByteArrayFromObj(paramValObj, &len); } else { MysqlBindSetBufferType(rdata->paramBindings, nBound, MYSQL_TYPE_STRING); paramValStr = Tcl_GetStringFromObj(paramValObj, &len); } bufPtr = (char *)MysqlBindAllocBuffer(rdata->paramBindings, nBound, len+1); memcpy(bufPtr, paramValStr, len); rdata->paramLengths[nBound] = len; MysqlBindSetLength(rdata->paramBindings, nBound, &(rdata->paramLengths[nBound])); break; } } else { MysqlBindSetBufferType(rdata->paramBindings, nBound, MYSQL_TYPE_NULL); } } /* Execute the statement */ /* * It is tempting to conserve client memory here by omitting * the call to 'mysql_stmt_store_result', but doing so causes * 'calls out of sync' errors when attempting to prepare a * statement while a result set is open. Certain of these errors * can, in turn, be avoided by using mysql_stmt_set_attr * and turning on "CURSOR_MODE_READONLY", but that, in turn * causes the server summarily to disconnect the client in * some tests. */ if (mysql_stmt_bind_param(rdata->stmtPtr, rdata->paramBindings) || ((nColumns > 0) && mysql_stmt_bind_result(rdata->stmtPtr, resultBindings)) || mysql_stmt_execute(rdata->stmtPtr) || mysql_stmt_store_result(rdata->stmtPtr) ) { TransferMysqlStmtError(interp, sdata->stmtPtr); return TCL_ERROR; } /* Determine and store the row count */ rdata->rowCount = mysql_stmt_affected_rows(sdata->stmtPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * ResultSetColumnsMethod -- * * Retrieves the list of columns from a result set. * * Usage: * $resultSet columns * * Results: * Returns the count of columns * *----------------------------------------------------------------------------- */ static int ResultSetColumnsMethod( TCL_UNUSED(void *), /* Not used */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext context, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { Tcl_Object thisObject = Tcl_ObjectContextObject(context); /* The current result set object */ ResultSetData* rdata = (ResultSetData*) Tcl_ObjectGetMetadata(thisObject, &resultSetDataType); StatementData* sdata = (StatementData*) rdata->sdata; if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, "?pattern?"); return TCL_ERROR; } Tcl_SetObjResult(interp, sdata->columnNames); return TCL_OK; } /* *----------------------------------------------------------------------------- * * ResultSetNextrowMethod -- * * Retrieves the next row from a result set. * * Usage: * $resultSet nextrow ?-as lists|dicts? ?--? variableName * * Options: * -as Selects the desired form for returning the results. * * Parameters: * variableName -- Variable in which the results are to be returned * * Results: * Returns a standard Tcl result. The interpreter result is 1 if there * are more rows remaining, and 0 if no more rows remain. * * Side effects: * Stores in the given variable either a list or a dictionary * containing one row of the result set. * *----------------------------------------------------------------------------- */ static int ResultSetNextrowMethod( void *clientData, /* Not used */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext context, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { int lists = PTR2INT(clientData); /* Flag == 1 if lists are to be returned, * 0 if dicts are to be returned */ Tcl_Object thisObject = Tcl_ObjectContextObject(context); /* The current result set object */ ResultSetData* rdata = (ResultSetData*) Tcl_ObjectGetMetadata(thisObject, &resultSetDataType); /* Data pertaining to the current result set */ StatementData* sdata = (StatementData*) rdata->sdata; /* Statement that yielded the result set */ ConnectionData* cdata = (ConnectionData*) sdata->cdata; /* Connection that opened the statement */ PerInterpData* pidata = (PerInterpData*) cdata->pidata; /* Per interpreter data */ Tcl_Obj** literals = pidata->literals; /* Literal pool */ int nColumns = 0; /* Number of columns in the result set */ Tcl_Obj* colName; /* Name of the current column */ Tcl_Obj* resultRow; /* Row of the result set under construction */ Tcl_Obj* colObj; /* Column obtained from the row */ int status = TCL_ERROR; /* Status return from this command */ MYSQL_FIELD* fields; /* Fields of the result set */ MYSQL_BIND* resultBindings = rdata->resultBindings; /* Descriptions of the results */ unsigned long* resultLengths = rdata->resultLengths; /* String lengths of the results */ my_bool* resultNulls = rdata->resultNulls; /* Indicators that the results are null */ void* bufPtr; /* Pointer to a result's buffer */ unsigned char byte; /* One byte extracted from a bit field */ Tcl_WideInt bitVal; /* Value of a bit field */ int mysqlStatus; /* Status return from MySQL */ int i; unsigned int j; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varName"); return TCL_ERROR; } /* Get the column names in the result set. */ Tcl_ListObjLength(NULL, sdata->columnNames, &nColumns); if (nColumns == 0) { Tcl_SetObjResult(interp, literals[LIT_0]); return TCL_OK; } resultRow = Tcl_NewObj(); Tcl_IncrRefCount(resultRow); /* * Try to rebind the result set before doing the next fetch */ fields = mysql_fetch_fields(sdata->metadataPtr); if (mysql_stmt_bind_result(rdata->stmtPtr, resultBindings)) { goto cleanup; } /* Fetch the row to determine sizes. */ mysqlStatus = mysql_stmt_fetch(rdata->stmtPtr); if (mysqlStatus != 0 && mysqlStatus != MYSQL_DATA_TRUNCATED) { if (mysqlStatus == MYSQL_NO_DATA) { Tcl_SetObjResult(interp, literals[LIT_0]); status = TCL_OK; } goto cleanup; } /* Retrieve one column at a time. */ for (i = 0; i < nColumns; ++i) { MYSQL_FIELD* field = MysqlFieldIndex(fields, i); colObj = NULL; if (!resultNulls[i]) { if (resultLengths[i] > MysqlBindGetBufferLength(resultBindings, i)) { MysqlBindFreeBuffer(resultBindings, i); MysqlBindAllocBuffer(resultBindings, i, resultLengths[i] + 1); if (mysql_stmt_fetch_column(rdata->stmtPtr, MysqlBindIndex(resultBindings, i), i, 0)) { goto cleanup; } } bufPtr = MysqlBindGetBuffer(resultBindings, i); switch (MysqlBindGetBufferType(resultBindings, i)) { case MYSQL_TYPE_BIT: bitVal = 0; for (j = 0; j < resultLengths[i]; ++j) { byte = ((unsigned char*) bufPtr)[resultLengths[i]-1-j]; bitVal |= (byte << (8*j)); } colObj = Tcl_NewWideIntObj(bitVal); break; case MYSQL_TYPE_DOUBLE: colObj = Tcl_NewDoubleObj(*(double*) bufPtr); break; case MYSQL_TYPE_LONG: colObj = Tcl_NewWideIntObj(*(int*) bufPtr); break; case MYSQL_TYPE_LONGLONG: colObj = Tcl_NewWideIntObj(*(Tcl_WideInt*) bufPtr); break; default: if (field->charsetnr == 63) { colObj = Tcl_NewByteArrayObj((unsigned char*) bufPtr, resultLengths[i]); } else { colObj = Tcl_NewStringObj((char*) bufPtr, resultLengths[i]); } break; } } if (lists) { if (colObj == NULL) { colObj = literals[LIT_EMPTY]; } Tcl_ListObjAppendElement(NULL, resultRow, colObj); } else { if (colObj != NULL) { Tcl_ListObjIndex(NULL, sdata->columnNames, i, &colName); Tcl_DictObjPut(NULL, resultRow, colName, colObj); } } } /* Save the row in the given variable */ if (Tcl_SetVar2Ex(interp, Tcl_GetString(objv[2]), NULL, resultRow, TCL_LEAVE_ERR_MSG) == NULL) { goto cleanup; } Tcl_SetObjResult(interp, literals[LIT_1]); status = TCL_OK; cleanup: if (status != TCL_OK) { TransferMysqlStmtError(interp, rdata->stmtPtr); } Tcl_DecrRefCount(resultRow); return status; } /* *----------------------------------------------------------------------------- * * ResultSetRowcountMethod -- * * Returns (if known) the number of rows affected by a MySQL statement. * * Usage: * $resultSet rowcount * * Results: * Returns a standard Tcl result giving the number of affected rows. * *----------------------------------------------------------------------------- */ static int ResultSetRowcountMethod( TCL_UNUSED(void *), /* Not used */ Tcl_Interp* interp, /* Tcl interpreter */ Tcl_ObjectContext context, /* Object context */ int objc, /* Parameter count */ Tcl_Obj *const objv[] /* Parameter vector */ ) { Tcl_Object thisObject = Tcl_ObjectContextObject(context); /* The current result set object */ ResultSetData* rdata = (ResultSetData*) Tcl_ObjectGetMetadata(thisObject, &resultSetDataType); /* Data pertaining to the current result set */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, ""); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)(rdata->rowCount))); return TCL_OK; } /* *----------------------------------------------------------------------------- * * DeleteResultSetMetadata, DeleteResultSet -- * * Cleans up when a MySQL result set is no longer required. * * Side effects: * Frees all resources associated with the result set. * *----------------------------------------------------------------------------- */ static void DeleteResultSetMetadata( void *clientData /* Instance data for the connection */ ) { DecrResultSetRefCount((ResultSetData*)clientData); } static void DeleteResultSet( ResultSetData* rdata /* Metadata for the result set */ ) { StatementData* sdata = rdata->sdata; int i; int nParams; int nColumns; Tcl_ListObjLength(NULL, sdata->subVars, &nParams); Tcl_ListObjLength(NULL, sdata->columnNames, &nColumns); for (i = 0; i < nColumns; ++i) { MysqlBindFreeBuffer(rdata->resultBindings, i); } ckfree((char*)(rdata->resultBindings)); ckfree((char*)(rdata->resultLengths)); ckfree((char*)(rdata->resultNulls)); ckfree((char*)(rdata->resultErrors)); ckfree((char*)(rdata->paramLengths)); if (rdata->paramBindings != NULL) { for (i = 0; i < nParams; ++i) { if (MysqlBindGetBufferType(rdata->paramBindings, i) != MYSQL_TYPE_NULL) { MysqlBindFreeBuffer(rdata->paramBindings, i); } } ckfree((char*)(rdata->paramBindings)); } if (rdata->paramValues != NULL) { Tcl_DecrRefCount(rdata->paramValues); } if (rdata->stmtPtr != NULL) { if (rdata->stmtPtr != sdata->stmtPtr) { mysql_stmt_close(rdata->stmtPtr); } else { sdata->flags &= ~ STMT_FLAG_BUSY; } } DecrStatementRefCount(rdata->sdata); ckfree((char*)rdata); } /* *----------------------------------------------------------------------------- * * CloneResultSet -- * * Attempts to clone a MySQL result set's metadata. * * Results: * Returns the new metadata * * At present, we don't attempt to clone result sets - it's not obvious * that such an action would ever even make sense. Instead, we throw an * error. * *----------------------------------------------------------------------------- */ static int CloneResultSet( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ TCL_UNUSED(void *), /* Metadata to be cloned */ TCL_UNUSED(void **) /* Where to put the cloned metadata */ ) { Tcl_SetObjResult(interp, Tcl_NewStringObj("MySQL result sets are not clonable", -1)); return TCL_ERROR; } /* *----------------------------------------------------------------------------- * * Tdbcmysql_Init -- * * Initializes the TDBC-MYSQL bridge when this library is loaded. * * Side effects: * Creates the ::tdbc::mysql namespace and the commands that reside in it. * Initializes the MYSQL environment. * *----------------------------------------------------------------------------- */ #ifndef STRINGIFY # define STRINGIFY(x) STRINGIFY1(x) # define STRINGIFY1(x) #x #endif #ifdef __cplusplus extern "C" { #endif /* __cplusplus */ DLLEXPORT int Tdbcmysql_Init( Tcl_Interp* interp /* Tcl interpreter */ ) { PerInterpData* pidata; /* Per-interpreter data for this package */ Tcl_Obj* nameObj; /* Name of a class or method being looked up */ Tcl_Object curClassObject; /* Tcl_Object representing the current class */ Tcl_Class curClass; /* Tcl_Class representing the current class */ int i; Tcl_CmdInfo info; /* Require all package dependencies */ if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } if (TclOOInitializeStubs(interp, "1.0") == NULL) { return TCL_ERROR; } if (Tdbc_InitStubs(interp) == NULL) { return TCL_ERROR; } if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) { Tcl_CreateObjCommand(interp, "::tdbc::mysql::build-info", info.objProc, (void *)( PACKAGE_VERSION "+" STRINGIFY(TDBC_MYSQL_VERSION_UUID) #if defined(__clang__) && defined(__clang_major__) ".clang-" STRINGIFY(__clang_major__) #if __clang_minor__ < 10 "0" #endif STRINGIFY(__clang_minor__) #endif #if defined(__cplusplus) && !defined(__OBJC__) ".cplusplus" #endif #ifndef NDEBUG ".debug" #endif #if !defined(__clang__) && !defined(__INTEL_COMPILER) && defined(__GNUC__) ".gcc-" STRINGIFY(__GNUC__) #if __GNUC_MINOR__ < 10 "0" #endif STRINGIFY(__GNUC_MINOR__) #endif #ifdef __INTEL_COMPILER ".icc-" STRINGIFY(__INTEL_COMPILER) #endif #ifdef TCL_MEM_DEBUG ".memdebug" #endif #if defined(_MSC_VER) ".msvc-" STRINGIFY(_MSC_VER) #endif #ifdef USE_NMAKE ".nmake" #endif #ifndef TCL_CFG_OPTIMIZED ".no-optimize" #endif #ifdef __OBJC__ ".objective-c" #if defined(__cplusplus) "plusplus" #endif #endif #ifdef TCL_CFG_PROFILED ".profile" #endif #ifdef PURIFY ".purify" #endif #ifdef STATIC_BUILD ".static" #endif ), NULL); } /* Provide the current package */ if (Tcl_PkgProvideEx(interp, "tdbc::mysql", PACKAGE_VERSION, NULL) == TCL_ERROR) { return TCL_ERROR; } /* * Create per-interpreter data for the package */ pidata = (PerInterpData*) ckalloc(sizeof(PerInterpData)); pidata->refCount = 1; for (i = 0; i < LIT__END; ++i) { pidata->literals[i] = Tcl_NewStringObj(LiteralValues[i], -1); Tcl_IncrRefCount(pidata->literals[i]); } Tcl_InitHashTable(&(pidata->typeNumHash), TCL_ONE_WORD_KEYS); for (i = 0; dataTypes[i].name != NULL; ++i) { int isNew; Tcl_HashEntry* entry = Tcl_CreateHashEntry(&(pidata->typeNumHash), INT2PTR(dataTypes[i].num), &isNew); Tcl_Obj* nameObj = Tcl_NewStringObj(dataTypes[i].name, -1); Tcl_IncrRefCount(nameObj); Tcl_SetHashValue(entry, (void *)nameObj); } /* * Find the connection class, and attach an 'init' method to it. */ nameObj = Tcl_NewStringObj("::tdbc::mysql::connection", -1); Tcl_IncrRefCount(nameObj); if ((curClassObject = Tcl_GetObjectFromObj(interp, nameObj)) == NULL) { Tcl_DecrRefCount(nameObj); return TCL_ERROR; } Tcl_DecrRefCount(nameObj); curClass = Tcl_GetObjectAsClass(curClassObject); /* Attach the constructor to the 'connection' class */ Tcl_ClassSetConstructor(interp, curClass, Tcl_NewMethod(interp, curClass, NULL, 1, &ConnectionConstructorType, pidata)); /* Attach the methods to the 'connection' class */ for (i = 0; ConnectionMethods[i] != NULL; ++i) { nameObj = Tcl_NewStringObj(ConnectionMethods[i]->name, -1); Tcl_IncrRefCount(nameObj); Tcl_NewMethod(interp, curClass, nameObj, 1, ConnectionMethods[i], NULL); Tcl_DecrRefCount(nameObj); } /* Look up the 'statement' class */ nameObj = Tcl_NewStringObj("::tdbc::mysql::statement", -1); Tcl_IncrRefCount(nameObj); if ((curClassObject = Tcl_GetObjectFromObj(interp, nameObj)) == NULL) { Tcl_DecrRefCount(nameObj); return TCL_ERROR; } Tcl_DecrRefCount(nameObj); curClass = Tcl_GetObjectAsClass(curClassObject); /* Attach the constructor to the 'statement' class */ Tcl_ClassSetConstructor(interp, curClass, Tcl_NewMethod(interp, curClass, NULL, 1, &StatementConstructorType, NULL)); /* Attach the methods to the 'statement' class */ for (i = 0; StatementMethods[i] != NULL; ++i) { nameObj = Tcl_NewStringObj(StatementMethods[i]->name, -1); Tcl_IncrRefCount(nameObj); Tcl_NewMethod(interp, curClass, nameObj, 1, StatementMethods[i], NULL); Tcl_DecrRefCount(nameObj); } /* Look up the 'resultSet' class */ nameObj = Tcl_NewStringObj("::tdbc::mysql::resultset", -1); Tcl_IncrRefCount(nameObj); if ((curClassObject = Tcl_GetObjectFromObj(interp, nameObj)) == NULL) { Tcl_DecrRefCount(nameObj); return TCL_ERROR; } Tcl_DecrRefCount(nameObj); curClass = Tcl_GetObjectAsClass(curClassObject); /* Attach the constructor to the 'resultSet' class */ Tcl_ClassSetConstructor(interp, curClass, Tcl_NewMethod(interp, curClass, NULL, 1, &ResultSetConstructorType, NULL)); /* Attach the methods to the 'resultSet' class */ for (i = 0; ResultSetMethods[i] != NULL; ++i) { nameObj = Tcl_NewStringObj(ResultSetMethods[i]->name, -1); Tcl_IncrRefCount(nameObj); Tcl_NewMethod(interp, curClass, nameObj, 1, ResultSetMethods[i], NULL); Tcl_DecrRefCount(nameObj); } nameObj = Tcl_NewStringObj("nextlist", -1); Tcl_IncrRefCount(nameObj); Tcl_NewMethod(interp, curClass, nameObj, 1, &ResultSetNextrowMethodType, INT2PTR(1)); Tcl_DecrRefCount(nameObj); nameObj = Tcl_NewStringObj("nextdict", -1); Tcl_IncrRefCount(nameObj); Tcl_NewMethod(interp, curClass, nameObj, 1, &ResultSetNextrowMethodType, INT2PTR(0)); Tcl_DecrRefCount(nameObj); /* * Initialize the MySQL library if this is the first interp using it */ Tcl_MutexLock(&mysqlMutex); if (mysqlRefCount == 0) { if ((mysqlLoadHandle = MysqlInitStubs(interp)) == NULL) { Tcl_MutexUnlock(&mysqlMutex); return TCL_ERROR; } mysql_library_init(0, NULL, NULL); mysqlClientVersion = mysql_get_client_version(); mysqlClientLibName = Tcl_GetObjResult(interp); Tcl_IncrRefCount(mysqlClientLibName); if (strstr(Tcl_GetString(mysqlClientLibName), "maria") != NULL || mysqlClientVersion >= 50100) { mysqlClientAtLeast51 = 1; } else { mysqlClientAtLeast51 = 0; } } ++mysqlRefCount; Tcl_MutexUnlock(&mysqlMutex); /* * TODO: mysql_thread_init, and keep a TSD reference count of users. */ return TCL_OK; } #ifdef __cplusplus } #endif /* __cplusplus */ /* *----------------------------------------------------------------------------- * * DeletePerInterpData -- * * Delete per-interpreter data when the MYSQL package is finalized * * Side effects: * Releases the (presumably last) reference on the environment handle, * cleans up the literal pool, and deletes the per-interp data structure. * *----------------------------------------------------------------------------- */ static void DeletePerInterpData( PerInterpData* pidata /* Data structure to clean up */ ) { int i; Tcl_HashSearch search; Tcl_HashEntry *entry; for (entry = Tcl_FirstHashEntry(&(pidata->typeNumHash), &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { Tcl_Obj* nameObj = (Tcl_Obj*) Tcl_GetHashValue(entry); Tcl_DecrRefCount(nameObj); } Tcl_DeleteHashTable(&(pidata->typeNumHash)); for (i = 0; i < LIT__END; ++i) { Tcl_DecrRefCount(pidata->literals[i]); } ckfree((char *) pidata); /* * TODO: decrease thread refcount and mysql_thread_end if need be */ Tcl_MutexLock(&mysqlMutex); if (--mysqlRefCount == 0) { mysql_library_end(); Tcl_FSUnloadFile(NULL, mysqlLoadHandle); if (mysqlClientLibName != NULL) { Tcl_DecrRefCount(mysqlClientLibName); mysqlClientLibName = NULL; } } Tcl_MutexUnlock(&mysqlMutex); }