/*
* 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: $
*
*-----------------------------------------------------------------------------
*/
#include <tcl.h>
#include <tclOO.h>
#include <tdbc.h>
#include <stdio.h>
#include <string.h>
#ifdef HAVE_MYSQL_MY_GLOBAL_H
#include <mysql/my_global.h>
#endif
#include <mysql/mysql.h>
/* 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 */
/*
* 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 {
int 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)) <= 0) { \
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 {
int refCount; /* Reference count. */
PerInterpData* pidata; /* Per-interpreter data */
MYSQL* mysqlPtr; /* MySql connection handle */
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)) <= 0) { \
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 {
int 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) <= 0) { \
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 {
int 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) <= 0) { \
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, 0, 0, 0 }
};
/* Tables of isolation levels: Tcl, SQL, and MySQL 'tx_isolation' */
static const char* TclIsolationLevels[] = {
"readuncommitted",
"readcommitted",
"repeatableread",
"serializable",
NULL
};
static const char* SqlIsolationLevels[] = {
"SET TRANSACTION ISOLATION LEVEL READ UNCOMMITTED",
"SET TRANSACTION ISOLATION LEVEL READ COMMITTED",
"SET TRANSACTION ISOLATION LEVEL REPEATABLE READ",
"SET 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 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,
int objc, Tcl_Obj *const objv[], int skip);
static int ConnectionConstructor(ClientData clientData, Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static int ConnectionBegintransactionMethod(ClientData clientData,
Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static int ConnectionColumnsMethod(ClientData clientData, Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static int ConnectionCommitMethod(ClientData clientData, Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static int ConnectionConfigureMethod(ClientData clientData, Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static int ConnectionNeedCollationInfoMethod(ClientData clientData,
Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static int ConnectionRollbackMethod(ClientData clientData, Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static int ConnectionSetCollationInfoMethod(ClientData clientData,
Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static int ConnectionTablesMethod(ClientData clientData, Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static void DeleteConnectionMetadata(ClientData clientData);
static void DeleteConnection(ConnectionData* cdata);
static int CloneConnection(Tcl_Interp* interp, ClientData oldClientData,
ClientData* 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(ClientData clientData, Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static int StatementParamtypeMethod(ClientData clientData, Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static int StatementParamsMethod(ClientData clientData, Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static void DeleteStatementMetadata(ClientData clientData);
static void DeleteStatement(StatementData* sdata);
static int CloneStatement(Tcl_Interp* interp, ClientData oldClientData,
ClientData* newClientData);
static int ResultSetConstructor(ClientData clientData, Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static int ResultSetColumnsMethod(ClientData clientData, Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static int ResultSetNextrowMethod(ClientData clientData, Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static int ResultSetRowcountMethod(ClientData clientData, Tcl_Interp* interp,
Tcl_ObjectContext context,
int objc, Tcl_Obj *const objv[]);
static void DeleteResultSetMetadata(ClientData clientData);
static void DeleteResultSet(ResultSetData* rdata);
static int CloneResultSet(Tcl_Interp* interp, ClientData oldClientData,
ClientData* newClientData);
static void DeleteCmd(ClientData clientData);
static int CloneCmd(Tcl_Interp* interp,
ClientData oldMetadata, ClientData* 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 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,
&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
};
/* Initialization script */
static const char initScript[] =
"namespace eval ::tdbc::mysql {}\n"
"tcl_findLibrary tdbcmysql " PACKAGE_VERSION " " PACKAGE_VERSION
" tdbcmysql.tcl TDBCMYSQL_LIBRARY ::tdbc::mysql::Library";
/*
*-----------------------------------------------------------------------------
*
* 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_NewIntObj(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_NewIntObj(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 */
int objc, /* Parameter count */
Tcl_Obj* const objv[], /* Parameter data */
int 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 */
int 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_GetIndexFromObj(interp, objv[i+1], TclIsolationLevels,
"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) {
Tcl_Obj* query = Tcl_ObjPrintf("SET SESSION WAIT_TIMEOUT = %d\n",
timeout);
Tcl_IncrRefCount(query);
int 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(
ClientData 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 */
int 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, (ClientData) 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(
ClientData clientData, /* 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(
ClientData clientData, /* 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) {
attrs = Tcl_NewObj();
name = Tcl_NewStringObj(fields[i].name, fields[i].name_length);
Tcl_DictObjPut(NULL, attrs, literals[LIT_NAME], name);
/* TODO - Distinguish CHAR and BINARY */
entry = Tcl_FindHashEntry(&(pidata->typeNumHash),
(char*) fields[i].type);
if (entry != NULL) {
Tcl_DictObjPut(NULL, attrs, literals[LIT_TYPE],
(Tcl_Obj*) Tcl_GetHashValue(entry));
}
if (IS_NUM(fields[i].type)) {
Tcl_DictObjPut(NULL, attrs, literals[LIT_PRECISION],
Tcl_NewIntObj(fields[i].length));
} else if (fields[i].charsetnr < cdata->nCollations) {
Tcl_DictObjPut(NULL, attrs, literals[LIT_PRECISION],
Tcl_NewIntObj(fields[i].length
/ cdata->collationSizes[fields[i].charsetnr]));
}
Tcl_DictObjPut(NULL, attrs, literals[LIT_SCALE],
Tcl_NewIntObj(fields[i].decimals));
Tcl_DictObjPut(NULL, attrs, literals[LIT_NULLABLE],
Tcl_NewIntObj(!(fields[i].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(
ClientData clientData, /* 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 */
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(
ClientData clientData,
Tcl_Interp* interp,
Tcl_ObjectContext objectContext,
int objc,
Tcl_Obj *const objv[]
) {
Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
/* The current connection object */
int 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);
}
/*
*-----------------------------------------------------------------------------
*
* 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(
ClientData clientData, /* 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 */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, "");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(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(
ClientData clientData, /* 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 */
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(
ClientData clientData, /* 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 */
int listLen;
Tcl_Obj* objPtr;
int collationNum;
int i;
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, &(cdata->nCollations)) != TCL_OK) {
return TCL_ERROR;
}
++cdata->nCollations;
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, &collationNum) != TCL_OK) {
return TCL_ERROR;
}
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(
ClientData clientData, /* 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 */
Tcl_Obj** literals = cdata->pidata->literals;
/* Literal pool */
const char* patternStr; /* Pattern to match table names */
MYSQL_RES* results; /* Result set */
MYSQL_ROW row; /* Row in the result set */
int status = TCL_OK; /* Return status */
Tcl_Obj* retval; /* 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 (
ClientData 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_Interp* interp, /* Tcl interpreter */
ClientData oldClientData, /* Environment handle to be discarded */
ClientData* 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(
ClientData 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 */
ClientData metadata, /* Metadata to be cloned */
ClientData* newMetaData /* 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 */
int flags /* Flags governing the conversion */
) {
Tcl_Obj* retval = Tcl_NewObj();
Tcl_HashTable names; /* Hash table to resolve name collisions */
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) {
Tcl_Obj* nameObj = Tcl_NewStringObj(fields[i].name,
fields[i].name_length);
Tcl_IncrRefCount(nameObj);
int new;
Tcl_HashEntry* entry =
Tcl_CreateHashEntry(&names, fields[i].name, &new);
int count = 1;
while (!new) {
count = (int) Tcl_GetHashValue(entry);
++count;
Tcl_SetHashValue(entry, (ClientData) count);
sprintf(numbuf, "#%d", count);
Tcl_AppendToObj(nameObj, numbuf, -1);
entry = Tcl_CreateHashEntry(&names, Tcl_GetString(nameObj),
&new);
}
Tcl_SetHashValue(entry, (ClientData) 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(
ClientData clientData, /* 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 */
int 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 (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, (ClientData) 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(
ClientData clientData, /* 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),
(const char*) (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_NewIntObj(sdata->params[i].precision));
Tcl_DictObjPut(NULL, paramDesc, literals[LIT_SCALE],
Tcl_NewIntObj(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(
ClientData clientData, /* 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);
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;
/* 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 (i = 0; i < nParams; ++i) {
Tcl_ListObjIndex(NULL, sdata->subVars, i, &targetNameObj);
targetName = Tcl_GetString(targetNameObj);
if (!strcmp(paramName, targetName)) {
++matchCount;
sdata->params[i].flags = direction;
sdata->params[i].dataType = dataTypes[typeNum].num;
sdata->params[i].precision = precision;
sdata->params[i].scale = scale;
}
}
if (matchCount == 0) {
errorObj = Tcl_NewStringObj("unknown parameter \"", -1);
Tcl_AppendToObj(errorObj, paramName, -1);
Tcl_AppendToObj(errorObj, "\": must be ", -1);
for (i = 0; i < nParams; ++i) {
Tcl_ListObjIndex(NULL, sdata->subVars, i, &targetNameObj);
Tcl_AppendObjToObj(errorObj, targetNameObj);
if (i < nParams-2) {
Tcl_AppendToObj(errorObj, ", ", -1);
} else if (i == 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(
ClientData 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 */
ClientData metadata, /* Metadata to be cloned */
ClientData* newMetaData /* 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(
ClientData clientData, /* 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 */
int skip = Tcl_ObjectContextSkippedArgs(context);
/* Number of args to skip */
Tcl_Object statementObject; /* The current statement object */
PerInterpData* pidata; /* The per-interpreter data for this package */
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; /* 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 (objc != skip+1 && objc != 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;
}
pidata = cdata->pidata;
/* 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));
resultBindings = rdata->resultBindings = (MYSQL_BIND*)
ckalloc(nColumns * sizeof(MYSQL_BIND));
memset(resultBindings, 0, nColumns * sizeof(MYSQL_BIND));
IncrStatementRefCount(sdata);
Tcl_ObjectSetMetadata(thisObject, &resultSetDataType, (ClientData) 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) {
switch (fields[i].type) {
case MYSQL_TYPE_FLOAT:
case MYSQL_TYPE_DOUBLE:
resultBindings[i].buffer_type = MYSQL_TYPE_DOUBLE;
resultBindings[i].buffer = ckalloc(sizeof(double));
resultBindings[i].buffer_length = sizeof(double);
resultLengths[i] = sizeof(double);
break;
case MYSQL_TYPE_BIT:
resultBindings[i].buffer_type = MYSQL_TYPE_BIT;
resultBindings[i].buffer = ckalloc(fields[i].length);
resultBindings[i].buffer_length = fields[i].length;
resultLengths[i] = fields[i].length;
break;
case MYSQL_TYPE_LONGLONG:
resultBindings[i].buffer_type = MYSQL_TYPE_LONGLONG;
resultBindings[i].buffer = ckalloc(sizeof(Tcl_WideInt));
resultBindings[i].buffer_length = 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:
resultBindings[i].buffer_type = MYSQL_TYPE_LONG;
resultBindings[i].buffer = ckalloc(sizeof(long));
resultBindings[i].buffer_length = sizeof(long);
resultLengths[i] = sizeof(long);
break;
default:
resultBindings[i].buffer_type = MYSQL_TYPE_STRING;
resultBindings[i].buffer = NULL;
resultBindings[i].buffer_length = 0;
resultLengths[i] = 0;
break;
}
resultBindings[i].length = resultLengths + i;
rdata->resultNulls[i] = 0;
resultBindings[i].is_null = rdata->resultNulls + i;
rdata->resultErrors[i] = 0;
resultBindings[i].error = 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 = (MYSQL_BIND*) ckalloc(nParams * sizeof(MYSQL_BIND));
rdata->paramLengths = (unsigned long*) ckalloc(nParams
* sizeof(unsigned long));
memset(rdata->paramBindings, 0, nParams * sizeof(MYSQL_BIND));
for (nBound = 0; nBound < nParams; ++nBound) {
rdata->paramBindings[nBound].buffer_type = 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 (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:
rdata->paramBindings[nBound].buffer_type = MYSQL_TYPE_DOUBLE;
rdata->paramBindings[nBound].buffer = bufPtr
= ckalloc(sizeof(double));
rdata->paramLengths[nBound] = sizeof(double);
rdata->paramBindings[nBound].buffer_length = sizeof(double);
rdata->paramBindings[nBound].length =
&(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:
rdata->paramBindings[nBound].buffer_type = MYSQL_TYPE_LONGLONG;
rdata->paramBindings[nBound].buffer = bufPtr
= ckalloc(sizeof(Tcl_WideInt));
rdata->paramLengths[nBound] = sizeof(Tcl_WideInt);
rdata->paramBindings[nBound].buffer_length
= sizeof(Tcl_WideInt);
rdata->paramBindings[nBound].length =
&(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:
rdata->paramBindings[nBound].buffer_type = MYSQL_TYPE_LONG;
rdata->paramBindings[nBound].buffer = bufPtr
= ckalloc(sizeof(long));
rdata->paramLengths[nBound] = sizeof(int);
rdata->paramBindings[nBound].buffer_length = sizeof(long);
rdata->paramBindings[nBound].length =
&(rdata->paramLengths[nBound]);
if (Tcl_GetLongFromObj(interp, paramValObj,
(long*) bufPtr) != TCL_OK) {
return TCL_ERROR;
}
break;
default:
charstring:
Tcl_ListObjAppendElement(NULL, rdata->paramValues, paramValObj);
if (sdata->params[nBound].dataType & IS_BINARY) {
rdata->paramBindings[nBound].buffer_type
= MYSQL_TYPE_BLOB;
paramValStr = (char*)
Tcl_GetByteArrayFromObj(paramValObj, &len);
} else {
rdata->paramBindings[nBound].buffer_type
= MYSQL_TYPE_STRING;
paramValStr = Tcl_GetStringFromObj(paramValObj, &len);
}
rdata->paramBindings[nBound].buffer = ckalloc(len+1);
memcpy(rdata->paramBindings[nBound].buffer, paramValStr, len);
rdata->paramLengths[nBound] = len;
rdata->paramBindings[nBound].buffer_length = len;
rdata->paramBindings[nBound].length =
&(rdata->paramLengths[nBound]);
break;
}
} else {
rdata->paramBindings[nBound].buffer_type = 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(
ClientData clientData, /* 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(
ClientData 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 = (int) 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 */
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, 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) {
colObj = NULL;
if (!resultNulls[i]) {
if (resultLengths[i] > resultBindings[i].buffer_length) {
if (resultBindings[i].buffer != NULL) {
ckfree(resultBindings[i].buffer);
}
resultBindings[i].buffer = ckalloc(resultLengths[i] + 1);
resultBindings[i].buffer_length = resultLengths[i] + 1;
if (mysql_stmt_fetch_column(rdata->stmtPtr, resultBindings + i,
i, 0)) {
goto cleanup;
}
}
switch (resultBindings[i].buffer_type) {
case MYSQL_TYPE_BIT:
bitVal = 0;
for (j = 0; j < resultLengths[i]; ++j) {
byte = ((unsigned char*) resultBindings[i].buffer)
[resultLengths[i]-1-j];
bitVal |= (byte << (8*j));
}
colObj = Tcl_NewWideIntObj(bitVal);
break;
case MYSQL_TYPE_DOUBLE:
colObj = Tcl_NewDoubleObj(*(double*)(resultBindings[i].buffer));
break;
case MYSQL_TYPE_LONG:
colObj = Tcl_NewLongObj(*(long*)(resultBindings[i].buffer));
break;
case MYSQL_TYPE_LONGLONG:
colObj = Tcl_NewWideIntObj
(*(Tcl_WideInt*)(resultBindings[i].buffer));
break;
default:
if (fields[i].charsetnr == 63) {
colObj = Tcl_NewByteArrayObj(resultBindings[i].buffer,
resultLengths[i]);
} else {
colObj = Tcl_NewStringObj(resultBindings[i].buffer,
resultLengths[i]);
}
break;
}
}
if (lists) {
if (colObj == NULL) {
colObj = Tcl_NewObj();
}
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(
ClientData clientData, /* 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(
ClientData 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) {
if (rdata->resultBindings[i].buffer != NULL) {
ckfree(rdata->resultBindings[i].buffer);
}
}
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 (rdata->paramBindings[i].buffer_type != MYSQL_TYPE_NULL) {
ckfree((char*) rdata->paramBindings[i].buffer);
}
}
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 */
ClientData metadata, /* Metadata to be cloned */
ClientData* newMetaData /* 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.
*
*-----------------------------------------------------------------------------
*/
extern 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;
/* Require all package dependencies */
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_OOInitStubs(interp) == NULL) {
return TCL_ERROR;
}
if (Tdbc_InitStubs(interp) == NULL) {
return TCL_ERROR;
}
/* Provide the current package */
if (Tcl_PkgProvide(interp, "tdbc::mysql", PACKAGE_VERSION) == TCL_ERROR) {
return TCL_ERROR;
}
/*
* Evaluate the initialization script to make the connection class
*/
if (Tcl_Eval(interp, initScript) != TCL_OK) {
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 new;
Tcl_HashEntry* entry =
Tcl_CreateHashEntry(&(pidata->typeNumHash),
(const char*) (int) (dataTypes[i].num),
&new);
Tcl_Obj* nameObj = Tcl_NewStringObj(dataTypes[i].name, -1);
Tcl_IncrRefCount(nameObj);
Tcl_SetHashValue(entry, (ClientData) 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,
(ClientData) 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],
(ClientData) 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,
(ClientData) 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],
(ClientData) 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,
(ClientData) 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],
(ClientData) NULL);
Tcl_DecrRefCount(nameObj);
}
nameObj = Tcl_NewStringObj("nextlist", -1);
Tcl_IncrRefCount(nameObj);
Tcl_NewMethod(interp, curClass, nameObj, 1, &ResultSetNextrowMethodType,
(ClientData) 1);
Tcl_DecrRefCount(nameObj);
nameObj = Tcl_NewStringObj("nextdict", -1);
Tcl_IncrRefCount(nameObj);
Tcl_NewMethod(interp, curClass, nameObj, 1, &ResultSetNextrowMethodType,
(ClientData) 0);
Tcl_DecrRefCount(nameObj);
/*
* Initialize the MySQL library if this is the first interp using it
*/
Tcl_MutexLock(&mysqlMutex);
if (mysqlRefCount == 0) {
mysql_library_init(0, NULL, NULL);
}
++mysqlRefCount;
Tcl_MutexUnlock(&mysqlMutex);
/*
* TODO: mysql_thread_init, and keep a TSD reference count of users.
*/
return TCL_OK;
}
/*
*-----------------------------------------------------------------------------
*
* 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_MutexUnlock(&mysqlMutex);
}