3796 lines
111 KiB
C
3796 lines
111 KiB
C
/*
|
||
* tdbcmysql.c --
|
||
*
|
||
* Bridge between TDBC (Tcl DataBase Connectivity) and MYSQL.
|
||
*
|
||
* Copyright (c) 2008, 2009 by Kevin B. Kenny.
|
||
*
|
||
* Please refer to the file, 'license.terms' for the conditions on
|
||
* redistribution of this file and for a DISCLAIMER OF ALL WARRANTIES.
|
||
*
|
||
* $Id: $
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
#ifdef _MSC_VER
|
||
# define _CRT_SECURE_NO_WARNINGS
|
||
#endif
|
||
|
||
#include <tcl.h>
|
||
#include <tclOO.h>
|
||
#include <tdbc.h>
|
||
|
||
#include <stdio.h>
|
||
#include <string.h>
|
||
|
||
#ifdef HAVE_STDINT_H
|
||
# include <stdint.h>
|
||
#endif
|
||
|
||
#include "int2ptr_ptr2int.h"
|
||
|
||
#include "fakemysql.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 */
|
||
Tcl_LoadHandle mysqlLoadHandle = NULL;
|
||
/* Handle to the MySQL library */
|
||
unsigned long mysqlClientVersion;
|
||
/* Version number of MySQL */
|
||
|
||
/*
|
||
* Objects to create within the literal pool
|
||
*/
|
||
|
||
const char* LiteralValues[] = {
|
||
"",
|
||
"0",
|
||
"1",
|
||
"direction",
|
||
"in",
|
||
"inout",
|
||
"name",
|
||
"nullable",
|
||
"out",
|
||
"precision",
|
||
"scale",
|
||
"type",
|
||
NULL
|
||
};
|
||
enum LiteralIndex {
|
||
LIT_EMPTY,
|
||
LIT_0,
|
||
LIT_1,
|
||
LIT_DIRECTION,
|
||
LIT_IN,
|
||
LIT_INOUT,
|
||
LIT_NAME,
|
||
LIT_NULLABLE,
|
||
LIT_OUT,
|
||
LIT_PRECISION,
|
||
LIT_SCALE,
|
||
LIT_TYPE,
|
||
LIT__END
|
||
};
|
||
|
||
/*
|
||
* Structure that holds per-interpreter data for the MYSQL package.
|
||
*/
|
||
|
||
typedef struct PerInterpData {
|
||
size_t refCount; /* Reference count */
|
||
Tcl_Obj* literals[LIT__END];
|
||
/* Literal pool */
|
||
Tcl_HashTable typeNumHash; /* Lookup table for type numbers */
|
||
} PerInterpData;
|
||
#define IncrPerInterpRefCount(x) \
|
||
do { \
|
||
++((x)->refCount); \
|
||
} while(0)
|
||
#define DecrPerInterpRefCount(x) \
|
||
do { \
|
||
PerInterpData* _pidata = x; \
|
||
if (((_pidata->refCount))-- <= 1) { \
|
||
DeletePerInterpData(_pidata); \
|
||
} \
|
||
} while(0)
|
||
|
||
/*
|
||
* Structure that carries the data for an MYSQL connection
|
||
*
|
||
* The ConnectionData structure is refcounted to simplify the
|
||
* destruction of statements associated with a connection.
|
||
* When a connection is destroyed, the subordinate namespace that
|
||
* contains its statements is taken down, destroying them. It's
|
||
* not safe to take down the ConnectionData until nothing is
|
||
* referring to it, which avoids taking down the hDBC until the
|
||
* other objects that refer to it vanish.
|
||
*/
|
||
|
||
typedef struct ConnectionData {
|
||
size_t refCount; /* Reference count. */
|
||
PerInterpData* pidata; /* Per-interpreter data */
|
||
MYSQL* mysqlPtr; /* MySql connection handle */
|
||
unsigned int nCollations; /* Number of collations defined */
|
||
int* collationSizes; /* Character lengths indexed by collation ID */
|
||
int flags;
|
||
} ConnectionData;
|
||
|
||
/*
|
||
* Flags for the state of an MYSQL connection
|
||
*/
|
||
|
||
#define CONN_FLAG_AUTOCOMMIT 0x1 /* Autocommit is set */
|
||
#define CONN_FLAG_IN_XCN 0x2 /* Transaction is in progress */
|
||
#define CONN_FLAG_INTERACTIVE 0x4 /* -interactive requested at connect */
|
||
|
||
#define IncrConnectionRefCount(x) \
|
||
do { \
|
||
++((x)->refCount); \
|
||
} while(0)
|
||
#define DecrConnectionRefCount(x) \
|
||
do { \
|
||
ConnectionData* conn = x; \
|
||
if (((conn->refCount)--) <= 01) { \
|
||
DeleteConnection(conn); \
|
||
} \
|
||
} while(0)
|
||
|
||
/*
|
||
* Structure that carries the data for a MySQL prepared statement.
|
||
*
|
||
* Just as with connections, statements need to defer taking down
|
||
* their client data until other objects (i.e., result sets) that
|
||
* refer to them have had a chance to clean up. Hence, this
|
||
* structure is reference counted as well.
|
||
*/
|
||
|
||
typedef struct StatementData {
|
||
size_t refCount; /* Reference count */
|
||
ConnectionData* cdata; /* Data for the connection to which this
|
||
* statement pertains. */
|
||
Tcl_Obj* subVars; /* List of variables to be substituted, in the
|
||
* order in which they appear in the
|
||
* statement */
|
||
struct ParamData *params; /* Data types and attributes of parameters */
|
||
Tcl_Obj* nativeSql; /* Native SQL statement to pass into
|
||
* MySQL */
|
||
MYSQL_STMT* stmtPtr; /* MySQL statement handle */
|
||
MYSQL_RES* metadataPtr; /* MySQL result set metadata */
|
||
Tcl_Obj* columnNames; /* Column names in the result set */
|
||
int flags;
|
||
} StatementData;
|
||
#define IncrStatementRefCount(x) \
|
||
do { \
|
||
++((x)->refCount); \
|
||
} while (0)
|
||
#define DecrStatementRefCount(x) \
|
||
do { \
|
||
StatementData* stmt = (x); \
|
||
if ((stmt->refCount--) <= 1) { \
|
||
DeleteStatement(stmt); \
|
||
} \
|
||
} while(0)
|
||
|
||
/* Flags in the 'StatementData->flags' word */
|
||
|
||
#define STMT_FLAG_BUSY 0x1 /* Statement handle is in use */
|
||
|
||
/*
|
||
* Structure describing the data types of substituted parameters in
|
||
* a SQL statement.
|
||
*/
|
||
|
||
typedef struct ParamData {
|
||
int flags; /* Flags regarding the parameters - see below */
|
||
int dataType; /* Data type */
|
||
int precision; /* Size of the expected data */
|
||
int scale; /* Digits after decimal point of the
|
||
* expected data */
|
||
} ParamData;
|
||
|
||
#define PARAM_KNOWN 1<<0 /* Something is known about the parameter */
|
||
#define PARAM_IN 1<<1 /* Parameter is an input parameter */
|
||
#define PARAM_OUT 1<<2 /* Parameter is an output parameter */
|
||
/* (Both bits are set if parameter is
|
||
* an INOUT parameter) */
|
||
#define PARAM_BINARY 1<<3 /* Parameter is binary */
|
||
|
||
/*
|
||
* Structure describing a MySQL result set. The object that the Tcl
|
||
* API terms a "result set" actually has to be represented by a MySQL
|
||
* "statement", since a MySQL statement can have only one set of results
|
||
* at any given time.
|
||
*/
|
||
|
||
typedef struct ResultSetData {
|
||
size_t refCount; /* Reference count */
|
||
StatementData* sdata; /* Statement that generated this result set */
|
||
MYSQL_STMT* stmtPtr; /* Handle to the MySQL statement object */
|
||
Tcl_Obj* paramValues; /* List of parameter values */
|
||
MYSQL_BIND* paramBindings; /* Parameter bindings */
|
||
unsigned long* paramLengths;/* Parameter lengths */
|
||
my_ulonglong rowCount; /* Number of affected rows */
|
||
my_bool* resultErrors; /* Failure indicators for retrieving columns */
|
||
my_bool* resultNulls; /* NULL indicators for retrieving columns */
|
||
unsigned long* resultLengths;
|
||
/* Byte lengths of retrieved columns */
|
||
MYSQL_BIND* resultBindings; /* Bindings controlling column retrieval */
|
||
} ResultSetData;
|
||
#define IncrResultSetRefCount(x) \
|
||
do { \
|
||
++((x)->refCount); \
|
||
} while (0)
|
||
#define DecrResultSetRefCount(x) \
|
||
do { \
|
||
ResultSetData* rs = (x); \
|
||
if (rs->refCount-- <= 1) { \
|
||
DeleteResultSet(rs); \
|
||
} \
|
||
} while(0)
|
||
|
||
/* Table of MySQL type names */
|
||
|
||
#define IS_BINARY (1<<16) /* Flag to OR in if a param is binary */
|
||
typedef struct MysqlDataType {
|
||
const char* name; /* Type name */
|
||
int num; /* Type number */
|
||
} MysqlDataType;
|
||
static const MysqlDataType dataTypes[] = {
|
||
{ "tinyint", MYSQL_TYPE_TINY },
|
||
{ "smallint", MYSQL_TYPE_SHORT },
|
||
{ "integer", MYSQL_TYPE_LONG },
|
||
{ "float", MYSQL_TYPE_FLOAT },
|
||
{ "real", MYSQL_TYPE_FLOAT },
|
||
{ "double", MYSQL_TYPE_DOUBLE },
|
||
{ "NULL", MYSQL_TYPE_NULL },
|
||
{ "timestamp", MYSQL_TYPE_TIMESTAMP },
|
||
{ "bigint", MYSQL_TYPE_LONGLONG },
|
||
{ "mediumint", MYSQL_TYPE_INT24 },
|
||
{ "date", MYSQL_TYPE_NEWDATE },
|
||
{ "date", MYSQL_TYPE_DATE },
|
||
{ "time", MYSQL_TYPE_TIME },
|
||
{ "datetime", MYSQL_TYPE_DATETIME },
|
||
{ "year", MYSQL_TYPE_YEAR },
|
||
{ "bit", MYSQL_TYPE_BIT | IS_BINARY },
|
||
{ "numeric", MYSQL_TYPE_NEWDECIMAL },
|
||
{ "decimal", MYSQL_TYPE_NEWDECIMAL },
|
||
{ "numeric", MYSQL_TYPE_DECIMAL },
|
||
{ "decimal", MYSQL_TYPE_DECIMAL },
|
||
{ "enum", MYSQL_TYPE_ENUM },
|
||
{ "set", MYSQL_TYPE_SET },
|
||
{ "tinytext", MYSQL_TYPE_TINY_BLOB },
|
||
{ "tinyblob", MYSQL_TYPE_TINY_BLOB | IS_BINARY },
|
||
{ "mediumtext", MYSQL_TYPE_MEDIUM_BLOB },
|
||
{ "mediumblob", MYSQL_TYPE_MEDIUM_BLOB | IS_BINARY },
|
||
{ "longtext", MYSQL_TYPE_LONG_BLOB },
|
||
{ "longblob", MYSQL_TYPE_LONG_BLOB | IS_BINARY },
|
||
{ "text", MYSQL_TYPE_BLOB },
|
||
{ "blob", MYSQL_TYPE_BLOB | IS_BINARY },
|
||
{ "varbinary", MYSQL_TYPE_VAR_STRING | IS_BINARY },
|
||
{ "varchar", MYSQL_TYPE_VAR_STRING },
|
||
{ "varbinary", MYSQL_TYPE_VARCHAR | IS_BINARY },
|
||
{ "varchar", MYSQL_TYPE_VARCHAR },
|
||
{ "binary", MYSQL_TYPE_STRING | IS_BINARY },
|
||
{ "char", MYSQL_TYPE_STRING },
|
||
{ "geometry", MYSQL_TYPE_GEOMETRY },
|
||
{ NULL, 0 }
|
||
};
|
||
|
||
/* Configuration options for MySQL connections */
|
||
|
||
/* Data types of configuration options */
|
||
|
||
enum OptType {
|
||
TYPE_STRING, /* Arbitrary character string */
|
||
TYPE_FLAG, /* Boolean flag */
|
||
TYPE_ENCODING, /* Encoding name */
|
||
TYPE_ISOLATION, /* Transaction isolation level */
|
||
TYPE_PORT, /* Port number */
|
||
TYPE_READONLY, /* Read-only indicator */
|
||
TYPE_TIMEOUT /* Timeout value */
|
||
};
|
||
|
||
/* Locations of the string options in the string array */
|
||
|
||
enum OptStringIndex {
|
||
INDX_DB, INDX_HOST, INDX_PASSWD, INDX_SOCKET,
|
||
INDX_SSLCA, INDX_SSLCAPATH, INDX_SSLCERT, INDX_SSLCIPHER, INDX_SSLKEY,
|
||
INDX_USER,
|
||
INDX_MAX
|
||
};
|
||
|
||
/* Flags in the configuration table */
|
||
|
||
#define CONN_OPT_FLAG_MOD 0x1 /* Configuration value changable at runtime */
|
||
#define CONN_OPT_FLAG_SSL 0x2 /* Configuration change requires setting
|
||
* SSL options */
|
||
#define CONN_OPT_FLAG_ALIAS 0x4 /* Configuration option is an alias */
|
||
|
||
/* Table of configuration options */
|
||
|
||
static const struct {
|
||
const char * name; /* Option name */
|
||
enum OptType type; /* Option data type */
|
||
int info; /* Option index or flag value */
|
||
int flags; /* Flags - modifiable; SSL related; is an alias */
|
||
const char* query; /* How to determine the option value? */
|
||
} ConnOptions [] = {
|
||
{ "-compress", TYPE_FLAG, CLIENT_COMPRESS, 0,
|
||
"SELECT '', @@SLAVE_COMPRESSED_PROTOCOL" },
|
||
{ "-database", TYPE_STRING, INDX_DB, CONN_OPT_FLAG_MOD,
|
||
"SELECT '', DATABASE();"},
|
||
{ "-db", TYPE_STRING, INDX_DB, CONN_OPT_FLAG_MOD
|
||
| CONN_OPT_FLAG_ALIAS,
|
||
"SELECT '', DATABASE()" },
|
||
{ "-encoding", TYPE_ENCODING, 0, 0,
|
||
"SELECT '', 'utf-8'" },
|
||
{ "-host", TYPE_STRING, INDX_HOST, 0,
|
||
"SHOW SESSION VARIABLES WHERE VARIABLE_NAME = 'hostname'" },
|
||
{ "-interactive", TYPE_FLAG, CLIENT_INTERACTIVE, 0,
|
||
"SELECT '', 0" },
|
||
{ "-isolation", TYPE_ISOLATION, 0, CONN_OPT_FLAG_MOD,
|
||
"SELECT '', LCASE(REPLACE(@@TX_ISOLATION, '-', ''))" },
|
||
{ "-passwd", TYPE_STRING, INDX_PASSWD, CONN_OPT_FLAG_MOD
|
||
| CONN_OPT_FLAG_ALIAS,
|
||
"SELECT '', ''" },
|
||
{ "-password", TYPE_STRING, INDX_PASSWD, CONN_OPT_FLAG_MOD,
|
||
"SELECT '', ''" },
|
||
{ "-port", TYPE_PORT, 0, 0,
|
||
"SHOW SESSION VARIABLES WHERE VARIABLE_NAME = 'port'" },
|
||
{ "-readonly", TYPE_READONLY, 0, 0,
|
||
"SELECT '', 0" },
|
||
{ "-socket", TYPE_STRING, INDX_SOCKET, 0,
|
||
"SHOW SESSION VARIABLES WHERE VARIABLE_NAME = 'socket'" },
|
||
{ "-ssl_ca", TYPE_STRING, INDX_SSLCA, CONN_OPT_FLAG_SSL,
|
||
"SELECT '', @@SSL_CA"},
|
||
{ "-ssl_capath", TYPE_STRING, INDX_SSLCAPATH, CONN_OPT_FLAG_SSL,
|
||
"SELECT '', @@SSL_CAPATH" },
|
||
{ "-ssl_cert", TYPE_STRING, INDX_SSLCERT, CONN_OPT_FLAG_SSL,
|
||
"SELECT '', @@SSL_CERT" },
|
||
{ "-ssl_cipher", TYPE_STRING, INDX_SSLCIPHER, CONN_OPT_FLAG_SSL,
|
||
"SELECT '', @@SSL_CIPHER" },
|
||
{ "-ssl_cypher", TYPE_STRING, INDX_SSLCIPHER, CONN_OPT_FLAG_SSL
|
||
| CONN_OPT_FLAG_ALIAS,
|
||
"SELECT '', @@SSL_CIPHER" },
|
||
{ "-ssl_key", TYPE_STRING, INDX_SSLKEY, CONN_OPT_FLAG_SSL,
|
||
"SELECT '', @@SSL_KEY" },
|
||
{ "-timeout", TYPE_TIMEOUT, 0, CONN_OPT_FLAG_MOD,
|
||
"SELECT '', @@WAIT_TIMEOUT" },
|
||
{ "-user", TYPE_STRING, INDX_USER, CONN_OPT_FLAG_MOD,
|
||
"SELECT '', USER()" },
|
||
{ NULL, TYPE_STRING, 0, 0, NULL }
|
||
};
|
||
|
||
/* Tables of isolation levels: Tcl, SQL, and MySQL 'tx_isolation' */
|
||
|
||
static const char *const TclIsolationLevels[] = {
|
||
"readuncommitted",
|
||
"readcommitted",
|
||
"repeatableread",
|
||
"serializable",
|
||
NULL
|
||
};
|
||
static const char *const SqlIsolationLevels[] = {
|
||
"SET 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 MYSQL_BIND* MysqlBindAlloc(int nBindings);
|
||
static MYSQL_BIND* MysqlBindIndex(MYSQL_BIND* b, int i);
|
||
static void* MysqlBindAllocBuffer(MYSQL_BIND* b, int i, unsigned long len);
|
||
static void MysqlBindFreeBuffer(MYSQL_BIND* b, int i);
|
||
static void MysqlBindSetBufferType(MYSQL_BIND* b, int i,
|
||
enum enum_field_types t);
|
||
static void* MysqlBindGetBuffer(MYSQL_BIND* b, int i);
|
||
static unsigned long MysqlBindGetBufferLength(MYSQL_BIND* b, int i);
|
||
static void MysqlBindSetLength(MYSQL_BIND* b, int i, unsigned long* p);
|
||
static void MysqlBindSetIsNull(MYSQL_BIND* b, int i, my_bool* p);
|
||
static void MysqlBindSetError(MYSQL_BIND* b, int i, my_bool* p);
|
||
|
||
static MYSQL_FIELD* MysqlFieldIndex(MYSQL_FIELD* fields, int i);
|
||
|
||
static void TransferMysqlError(Tcl_Interp* interp, MYSQL* mysqlPtr);
|
||
static void TransferMysqlStmtError(Tcl_Interp* interp, MYSQL_STMT* mysqlPtr);
|
||
|
||
static Tcl_Obj* QueryConnectionOption(ConnectionData* cdata, Tcl_Interp* interp,
|
||
int optionNum);
|
||
static int ConfigureConnection(ConnectionData* cdata, Tcl_Interp* interp,
|
||
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 ConnectionEvaldirectMethod(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 ConnectionEvaldirectMethodType = {
|
||
TCL_OO_METHOD_VERSION_CURRENT,
|
||
/* version */
|
||
"evaldirect", /* name */
|
||
ConnectionEvaldirectMethod, /* callProc */
|
||
NULL, /* deleteProc */
|
||
NULL /* cloneProc */
|
||
};
|
||
const static Tcl_MethodType ConnectionNeedCollationInfoMethodType = {
|
||
TCL_OO_METHOD_VERSION_CURRENT,
|
||
/* version */
|
||
"NeedCollationInfo", /* name */
|
||
ConnectionNeedCollationInfoMethod, /* callProc */
|
||
NULL, /* deleteProc */
|
||
NULL /* cloneProc */
|
||
};
|
||
const static Tcl_MethodType ConnectionRollbackMethodType = {
|
||
TCL_OO_METHOD_VERSION_CURRENT,
|
||
/* version */
|
||
"rollback", /* name */
|
||
ConnectionRollbackMethod, /* callProc */
|
||
NULL, /* deleteProc */
|
||
NULL /* cloneProc */
|
||
};
|
||
const static Tcl_MethodType ConnectionSetCollationInfoMethodType = {
|
||
TCL_OO_METHOD_VERSION_CURRENT,
|
||
/* version */
|
||
"SetCollationInfo", /* name */
|
||
ConnectionSetCollationInfoMethod, /* callProc */
|
||
NULL, /* deleteProc */
|
||
NULL /* cloneProc */
|
||
};
|
||
const static Tcl_MethodType ConnectionTablesMethodType = {
|
||
TCL_OO_METHOD_VERSION_CURRENT,
|
||
/* version */
|
||
"tables", /* name */
|
||
ConnectionTablesMethod, /* callProc */
|
||
NULL, /* deleteProc */
|
||
NULL /* cloneProc */
|
||
};
|
||
|
||
const static Tcl_MethodType* ConnectionMethods[] = {
|
||
&ConnectionBegintransactionMethodType,
|
||
&ConnectionColumnsMethodType,
|
||
&ConnectionCommitMethodType,
|
||
&ConnectionConfigureMethodType,
|
||
&ConnectionEvaldirectMethodType,
|
||
&ConnectionNeedCollationInfoMethodType,
|
||
&ConnectionRollbackMethodType,
|
||
&ConnectionSetCollationInfoMethodType,
|
||
&ConnectionTablesMethodType,
|
||
NULL
|
||
};
|
||
|
||
/* Method types of the statement methods that are implemented in C */
|
||
|
||
const static Tcl_MethodType StatementConstructorType = {
|
||
TCL_OO_METHOD_VERSION_CURRENT,
|
||
/* version */
|
||
"CONSTRUCTOR", /* name */
|
||
StatementConstructor, /* callProc */
|
||
NULL, /* deleteProc */
|
||
NULL /* cloneProc */
|
||
};
|
||
const static Tcl_MethodType StatementParamsMethodType = {
|
||
TCL_OO_METHOD_VERSION_CURRENT,
|
||
/* version */
|
||
"params", /* name */
|
||
StatementParamsMethod, /* callProc */
|
||
NULL, /* deleteProc */
|
||
NULL /* cloneProc */
|
||
};
|
||
const static Tcl_MethodType StatementParamtypeMethodType = {
|
||
TCL_OO_METHOD_VERSION_CURRENT,
|
||
/* version */
|
||
"paramtype", /* name */
|
||
StatementParamtypeMethod, /* callProc */
|
||
NULL, /* deleteProc */
|
||
NULL /* cloneProc */
|
||
};
|
||
|
||
/*
|
||
* Methods to create on the statement class.
|
||
*/
|
||
|
||
const static Tcl_MethodType* StatementMethods[] = {
|
||
&StatementParamsMethodType,
|
||
&StatementParamtypeMethodType,
|
||
NULL
|
||
};
|
||
|
||
/* Method types of the result set methods that are implemented in C */
|
||
|
||
const static Tcl_MethodType ResultSetConstructorType = {
|
||
TCL_OO_METHOD_VERSION_CURRENT,
|
||
/* version */
|
||
"CONSTRUCTOR", /* name */
|
||
ResultSetConstructor, /* callProc */
|
||
NULL, /* deleteProc */
|
||
NULL /* cloneProc */
|
||
};
|
||
const static Tcl_MethodType ResultSetColumnsMethodType = {
|
||
TCL_OO_METHOD_VERSION_CURRENT,
|
||
/* version */ "columns", /* name */
|
||
ResultSetColumnsMethod, /* callProc */
|
||
NULL, /* deleteProc */
|
||
NULL /* cloneProc */
|
||
};
|
||
const static Tcl_MethodType ResultSetNextrowMethodType = {
|
||
TCL_OO_METHOD_VERSION_CURRENT,
|
||
/* version */
|
||
"nextrow", /* name */
|
||
ResultSetNextrowMethod, /* callProc */
|
||
NULL, /* deleteProc */
|
||
NULL /* cloneProc */
|
||
};
|
||
const static Tcl_MethodType ResultSetRowcountMethodType = {
|
||
TCL_OO_METHOD_VERSION_CURRENT,
|
||
/* version */
|
||
"rowcount", /* name */
|
||
ResultSetRowcountMethod, /* callProc */
|
||
NULL, /* deleteProc */
|
||
NULL /* cloneProc */
|
||
};
|
||
|
||
|
||
/* Methods to create on the result set class */
|
||
|
||
const static Tcl_MethodType* ResultSetMethods[] = {
|
||
&ResultSetColumnsMethodType,
|
||
&ResultSetRowcountMethodType,
|
||
NULL
|
||
};
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* MysqlBindAlloc --
|
||
*
|
||
* Allocate a number of MYSQL_BIND structures.
|
||
*
|
||
* Results:
|
||
* Returns a pointer to the array of structures, which will be zeroed out.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static MYSQL_BIND*
|
||
MysqlBindAlloc(int nBindings)
|
||
{
|
||
int size;
|
||
void* retval = NULL;
|
||
if (mysqlClientVersion >= 50100) {
|
||
size = sizeof(struct st_mysql_bind_51);
|
||
} else {
|
||
size = sizeof(struct st_mysql_bind_50);
|
||
}
|
||
size *= nBindings;
|
||
if (size != 0) {
|
||
retval = ckalloc(size);
|
||
memset(retval, 0, size);
|
||
}
|
||
return (MYSQL_BIND*) retval;
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* MysqlBindIndex --
|
||
*
|
||
* Returns a pointer to one of an array of MYSQL_BIND objects
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static MYSQL_BIND*
|
||
MysqlBindIndex(
|
||
MYSQL_BIND* b, /* Binding array to alter */
|
||
int i /* Index in the binding array */
|
||
) {
|
||
if (mysqlClientVersion >= 50100) {
|
||
return (MYSQL_BIND*)(((struct st_mysql_bind_51*) b) + i);
|
||
} else {
|
||
return (MYSQL_BIND*)(((struct st_mysql_bind_50*) b) + i);
|
||
}
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* MysqlBindAllocBuffer --
|
||
*
|
||
* Allocates the buffer in a MYSQL_BIND object
|
||
*
|
||
* Results:
|
||
* Returns a pointer to the allocated buffer
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static void*
|
||
MysqlBindAllocBuffer(
|
||
MYSQL_BIND* b, /* Pointer to a binding array */
|
||
int i, /* Index into the array */
|
||
unsigned long len /* Length of the buffer to allocate or 0 */
|
||
) {
|
||
void* block = NULL;
|
||
if (len != 0) {
|
||
block = ckalloc(len);
|
||
}
|
||
if (mysqlClientVersion >= 50100) {
|
||
((struct st_mysql_bind_51*) b)[i].buffer = block;
|
||
((struct st_mysql_bind_51*) b)[i].buffer_length = len;
|
||
} else {
|
||
((struct st_mysql_bind_50*) b)[i].buffer = block;
|
||
((struct st_mysql_bind_50*) b)[i].buffer_length = len;
|
||
}
|
||
return block;
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* MysqlBindFreeBuffer --
|
||
*
|
||
* Frees trhe buffer in a MYSQL_BIND object
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* Buffer is returned to the system.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
static void
|
||
MysqlBindFreeBuffer(
|
||
MYSQL_BIND* b, /* Pointer to a binding array */
|
||
int i /* Index into the array */
|
||
) {
|
||
if (mysqlClientVersion >= 50100) {
|
||
struct st_mysql_bind_51* bindings = (struct st_mysql_bind_51*) b;
|
||
if (bindings[i].buffer) {
|
||
ckfree(bindings[i].buffer);
|
||
bindings[i].buffer = NULL;
|
||
}
|
||
bindings[i].buffer_length = 0;
|
||
} else {
|
||
struct st_mysql_bind_50* bindings = (struct st_mysql_bind_50*) b;
|
||
if (bindings[i].buffer) {
|
||
ckfree(bindings[i].buffer);
|
||
bindings[i].buffer = NULL;
|
||
}
|
||
bindings[i].buffer_length = 0;
|
||
}
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* MysqlBindGetBufferLength, MysqlBindSetBufferType, MysqlBindGetBufferType,
|
||
* MysqlBindSetLength, MysqlBindSetIsNull,
|
||
* MysqlBindSetError --
|
||
*
|
||
* Access the fields of a MYSQL_BIND object
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static void*
|
||
MysqlBindGetBuffer(
|
||
MYSQL_BIND* b, /* Binding array to alter */
|
||
int i /* Index in the binding array */
|
||
) {
|
||
if (mysqlClientVersion >= 50100) {
|
||
return ((struct st_mysql_bind_51*) b)[i].buffer;
|
||
} else {
|
||
return ((struct st_mysql_bind_50*) b)[i].buffer;
|
||
}
|
||
}
|
||
|
||
static unsigned long
|
||
MysqlBindGetBufferLength(
|
||
MYSQL_BIND* b, /* Binding array to alter */
|
||
int i /* Index in the binding array */
|
||
) {
|
||
if (mysqlClientVersion >= 50100) {
|
||
return ((struct st_mysql_bind_51*) b)[i].buffer_length;
|
||
} else {
|
||
return ((struct st_mysql_bind_50*) b)[i].buffer_length;
|
||
}
|
||
|
||
}
|
||
|
||
static enum enum_field_types
|
||
MysqlBindGetBufferType(
|
||
MYSQL_BIND* b, /* Binding array to alter */
|
||
int i /* Index in the binding array */
|
||
) {
|
||
if (mysqlClientVersion >= 50100) {
|
||
return ((struct st_mysql_bind_51*) b)[i].buffer_type;
|
||
} else {
|
||
return ((struct st_mysql_bind_50*) b)[i].buffer_type;
|
||
}
|
||
}
|
||
|
||
static void
|
||
MysqlBindSetBufferType(
|
||
MYSQL_BIND* b, /* Binding array to alter */
|
||
int i, /* Index in the binding array */
|
||
enum enum_field_types t /* Buffer type to assign */
|
||
) {
|
||
if (mysqlClientVersion >= 50100) {
|
||
((struct st_mysql_bind_51*) b)[i].buffer_type = t;
|
||
} else {
|
||
((struct st_mysql_bind_50*) b)[i].buffer_type = t;
|
||
}
|
||
}
|
||
|
||
static void
|
||
MysqlBindSetLength(
|
||
MYSQL_BIND* b, /* Binding array to alter */
|
||
int i, /* Index in the binding array */
|
||
unsigned long* p /* Length pointer to assign */
|
||
) {
|
||
if (mysqlClientVersion >= 50100) {
|
||
((struct st_mysql_bind_51*) b)[i].length = p;
|
||
} else {
|
||
((struct st_mysql_bind_50*) b)[i].length = p;
|
||
}
|
||
}
|
||
|
||
static void
|
||
MysqlBindSetIsNull(
|
||
MYSQL_BIND* b, /* Binding array to alter */
|
||
int i, /* Index in the binding array */
|
||
my_bool* p /* "Is null" indicator pointer to assign */
|
||
) {
|
||
if (mysqlClientVersion >= 50100) {
|
||
((struct st_mysql_bind_51*) b)[i].is_null = p;
|
||
} else {
|
||
((struct st_mysql_bind_50*) b)[i].is_null = p;
|
||
}
|
||
}
|
||
|
||
static void
|
||
MysqlBindSetError(
|
||
MYSQL_BIND* b, /* Binding array to alter */
|
||
int i, /* Index in the binding array */
|
||
my_bool* p /* Error indicator pointer to assign */
|
||
) {
|
||
if (mysqlClientVersion >= 50100) {
|
||
((struct st_mysql_bind_51*) b)[i].error = p;
|
||
} else {
|
||
((struct st_mysql_bind_50*) b)[i].error = p;
|
||
}
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* MysqlFieldIndex --
|
||
*
|
||
* Return a pointer to a given MYSQL_FIELD structure in an array
|
||
*
|
||
* The MYSQL_FIELD structure grows by one pointer between 5.0 and 5.1.
|
||
* Our code never creates a MYSQL_FIELD, nor does it try to access that
|
||
* pointer, so we handle things simply by casting the types.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static MYSQL_FIELD*
|
||
MysqlFieldIndex(MYSQL_FIELD* fields,
|
||
/* Pointer to the array*/
|
||
int i) /* Index in the array */
|
||
{
|
||
MYSQL_FIELD* retval;
|
||
if (mysqlClientVersion >= 50100) {
|
||
retval = (MYSQL_FIELD*)(((struct st_mysql_field_51*) fields)+i);
|
||
} else {
|
||
retval = (MYSQL_FIELD*)(((struct st_mysql_field_50*) fields)+i);
|
||
}
|
||
return retval;
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* TransferMysqlError --
|
||
*
|
||
* Obtains the error message, SQL state, and error number from the
|
||
* MySQL client library and transfers them into the Tcl interpreter
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* Sets the interpreter result and error code to describe the SQL error
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static void
|
||
TransferMysqlError(
|
||
Tcl_Interp* interp, /* Tcl interpreter */
|
||
MYSQL* mysqlPtr /* MySQL connection handle */
|
||
) {
|
||
const char* sqlstate = mysql_sqlstate(mysqlPtr);
|
||
Tcl_Obj* errorCode = Tcl_NewObj();
|
||
Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj("TDBC", -1));
|
||
Tcl_ListObjAppendElement(NULL, errorCode,
|
||
Tcl_NewStringObj(Tdbc_MapSqlState(sqlstate), -1));
|
||
Tcl_ListObjAppendElement(NULL, errorCode,
|
||
Tcl_NewStringObj(sqlstate, -1));
|
||
Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj("MYSQL", -1));
|
||
Tcl_ListObjAppendElement(NULL, errorCode,
|
||
Tcl_NewWideIntObj(mysql_errno(mysqlPtr)));
|
||
Tcl_SetObjErrorCode(interp, errorCode);
|
||
Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_error(mysqlPtr), -1));
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* TransferMysqlStmtError --
|
||
*
|
||
* Obtains the error message, SQL state, and error number from the
|
||
* MySQL client library and transfers them into the Tcl interpreter
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* Sets the interpreter result and error code to describe the SQL error
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static void
|
||
TransferMysqlStmtError(
|
||
Tcl_Interp* interp, /* Tcl interpreter */
|
||
MYSQL_STMT* stmtPtr /* MySQL statment handle */
|
||
) {
|
||
const char* sqlstate = mysql_stmt_sqlstate(stmtPtr);
|
||
Tcl_Obj* errorCode = Tcl_NewObj();
|
||
Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj("TDBC", -1));
|
||
Tcl_ListObjAppendElement(NULL, errorCode,
|
||
Tcl_NewStringObj(Tdbc_MapSqlState(sqlstate), -1));
|
||
Tcl_ListObjAppendElement(NULL, errorCode,
|
||
Tcl_NewStringObj(sqlstate, -1));
|
||
Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj("MYSQL", -1));
|
||
Tcl_ListObjAppendElement(NULL, errorCode,
|
||
Tcl_NewWideIntObj(mysql_stmt_errno(stmtPtr)));
|
||
Tcl_SetObjErrorCode(interp, errorCode);
|
||
Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_stmt_error(stmtPtr), -1));
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* QueryConnectionOption --
|
||
*
|
||
* Determine the current value of a connection option.
|
||
*
|
||
* Results:
|
||
* Returns a Tcl object containing the value if successful, or NULL
|
||
* if unsuccessful. If unsuccessful, stores error information in the
|
||
* Tcl interpreter.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static Tcl_Obj*
|
||
QueryConnectionOption (
|
||
ConnectionData* cdata, /* Connection data */
|
||
Tcl_Interp* interp, /* Tcl interpreter */
|
||
int optionNum /* Position of the option in the table */
|
||
) {
|
||
MYSQL_RES* result; /* Result of the MySQL query for the option */
|
||
MYSQL_ROW row; /* Row of the result set */
|
||
int fieldCount; /* Number of fields in a row */
|
||
unsigned long* lengths; /* Character lengths of the fields */
|
||
Tcl_Obj* retval; /* Return value */
|
||
|
||
if (mysql_query(cdata->mysqlPtr, ConnOptions[optionNum].query)) {
|
||
TransferMysqlError(interp, cdata->mysqlPtr);
|
||
return NULL;
|
||
}
|
||
result = mysql_store_result(cdata->mysqlPtr);
|
||
if (result == NULL) {
|
||
TransferMysqlError(interp, cdata->mysqlPtr);
|
||
return NULL;
|
||
}
|
||
fieldCount = mysql_num_fields(result);
|
||
if (fieldCount < 2) {
|
||
retval = cdata->pidata->literals[LIT_EMPTY];
|
||
} else {
|
||
if ((row = mysql_fetch_row(result)) == NULL) {
|
||
if (mysql_errno(cdata->mysqlPtr)) {
|
||
TransferMysqlError(interp, cdata->mysqlPtr);
|
||
mysql_free_result(result);
|
||
return NULL;
|
||
} else {
|
||
retval = cdata->pidata->literals[LIT_EMPTY];
|
||
}
|
||
} else {
|
||
lengths = mysql_fetch_lengths(result);
|
||
retval = Tcl_NewStringObj(row[1], lengths[1]);
|
||
}
|
||
}
|
||
mysql_free_result(result);
|
||
return retval;
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* ConfigureConnection --
|
||
*
|
||
* Applies configuration settings to a MySQL connection.
|
||
*
|
||
* Results:
|
||
* Returns a Tcl result. If the result is TCL_ERROR, error information
|
||
* is stored in the interpreter.
|
||
*
|
||
* Side effects:
|
||
* Updates configuration in the connection data. Opens a connection
|
||
* if none is yet open.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
ConfigureConnection(
|
||
ConnectionData* cdata, /* Connection data */
|
||
Tcl_Interp* interp, /* Tcl interpreter */
|
||
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_GetIndexFromObjStruct(interp, objv[i+1], TclIsolationLevels,
|
||
sizeof(char *), "isolation level", TCL_EXACT, &isolation)
|
||
!= TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
break;
|
||
case TYPE_PORT:
|
||
if (Tcl_GetIntFromObj(interp, objv[i+1], &optionValue) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (optionValue < 0 || optionValue > 0xffff) {
|
||
Tcl_SetObjResult(interp, Tcl_NewStringObj("port number must "
|
||
"be in range "
|
||
"[0..65535]", -1));
|
||
Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY000",
|
||
"MYSQL", "-1", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
port = optionValue;
|
||
break;
|
||
case TYPE_READONLY:
|
||
if (Tcl_GetBooleanFromObj(interp, objv[i+1], &optionValue)
|
||
!= TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (optionValue != 0) {
|
||
Tcl_SetObjResult(interp,
|
||
Tcl_NewStringObj("MySQL does not support "
|
||
"readonly connections", -1));
|
||
Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY000",
|
||
"MYSQL", "-1", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
break;
|
||
case TYPE_TIMEOUT:
|
||
if (Tcl_GetIntFromObj(interp, objv[i+1], &timeout) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
break;
|
||
}
|
||
if (ConnOptions[optionIndex].flags & CONN_OPT_FLAG_SSL) {
|
||
sslFlag = 1;
|
||
}
|
||
}
|
||
|
||
if (cdata->mysqlPtr == NULL) {
|
||
|
||
/* Configuring a new connection. Open the database */
|
||
|
||
cdata->mysqlPtr = mysql_init(NULL);
|
||
if (cdata->mysqlPtr == NULL) {
|
||
Tcl_SetObjResult(interp,
|
||
Tcl_NewStringObj("mysql_init() failed.", -1));
|
||
Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR", "HY001",
|
||
"MYSQL", "NULL", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/* Set character set for the connection */
|
||
|
||
mysql_options(cdata->mysqlPtr, MYSQL_SET_CHARSET_NAME, "utf8");
|
||
|
||
/* Set SSL options if needed */
|
||
|
||
if (sslFlag) {
|
||
mysql_ssl_set(cdata->mysqlPtr, stringOpts[INDX_SSLKEY],
|
||
stringOpts[INDX_SSLCERT], stringOpts[INDX_SSLCA],
|
||
stringOpts[INDX_SSLCAPATH],
|
||
stringOpts[INDX_SSLCIPHER]);
|
||
}
|
||
|
||
/* Establish the connection */
|
||
|
||
/*
|
||
* TODO - mutex around this unless linked to libmysqlclient_r ?
|
||
*/
|
||
|
||
if (mysql_real_connect(cdata->mysqlPtr, stringOpts[INDX_HOST],
|
||
stringOpts[INDX_USER], stringOpts[INDX_PASSWD],
|
||
stringOpts[INDX_DB], port,
|
||
stringOpts[INDX_SOCKET], mysqlFlags) == NULL) {
|
||
TransferMysqlError(interp, cdata->mysqlPtr);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
cdata->flags |= CONN_FLAG_AUTOCOMMIT;
|
||
|
||
} else {
|
||
|
||
/* Already open connection */
|
||
|
||
if (stringOpts[INDX_USER] != NULL) {
|
||
|
||
/* User name changed - log in again */
|
||
|
||
if (mysql_change_user(cdata->mysqlPtr,
|
||
stringOpts[INDX_USER],
|
||
stringOpts[INDX_PASSWD],
|
||
stringOpts[INDX_DB])) {
|
||
TransferMysqlError(interp, cdata->mysqlPtr);
|
||
return TCL_ERROR;
|
||
}
|
||
} else if (stringOpts[INDX_DB] != NULL) {
|
||
|
||
/* Database name changed - use the new database */
|
||
|
||
if (mysql_select_db(cdata->mysqlPtr, stringOpts[INDX_DB])) {
|
||
TransferMysqlError(interp, cdata->mysqlPtr);
|
||
return TCL_ERROR;
|
||
}
|
||
}
|
||
}
|
||
|
||
/* Transaction isolation level */
|
||
|
||
if (isolation != ISOL_NONE) {
|
||
if (mysql_query(cdata->mysqlPtr, SqlIsolationLevels[isolation])) {
|
||
TransferMysqlError(interp, cdata->mysqlPtr);
|
||
return TCL_ERROR;
|
||
}
|
||
}
|
||
|
||
/* Timeout */
|
||
|
||
if (timeout != 0) {
|
||
int result;
|
||
Tcl_Obj* query = Tcl_ObjPrintf("SET SESSION WAIT_TIMEOUT = %d\n",
|
||
timeout);
|
||
Tcl_IncrRefCount(query);
|
||
result = mysql_query(cdata->mysqlPtr, Tcl_GetString(query));
|
||
Tcl_DecrRefCount(query);
|
||
if (result) {
|
||
TransferMysqlError(interp, cdata->mysqlPtr);
|
||
return TCL_ERROR;
|
||
}
|
||
}
|
||
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* ConnectionConstructor --
|
||
*
|
||
* Constructor for ::tdbc::mysql::connection, which represents a
|
||
* database connection.
|
||
*
|
||
* Results:
|
||
* Returns a standard Tcl result.
|
||
*
|
||
* The ConnectionInitMethod takes alternating keywords and values giving
|
||
* the configuration parameters of the connection, and attempts to connect
|
||
* to the database.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
ConnectionConstructor(
|
||
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 dummy, /* 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);
|
||
(void)dummy;
|
||
|
||
/* 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 dummy, /* 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 */
|
||
(void)dummy;
|
||
|
||
/* Check parameters */
|
||
|
||
if (objc == 3) {
|
||
patternStr = NULL;
|
||
} else if (objc == 4) {
|
||
patternStr = Tcl_GetString(objv[3]);
|
||
} else {
|
||
Tcl_WrongNumArgs(interp, 2, objv, "table ?pattern?");
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
results = mysql_list_fields(cdata->mysqlPtr, Tcl_GetString(objv[2]),
|
||
patternStr);
|
||
if (results == NULL) {
|
||
TransferMysqlError(interp, cdata->mysqlPtr);
|
||
return TCL_ERROR;
|
||
} else {
|
||
unsigned int fieldCount = mysql_num_fields(results);
|
||
MYSQL_FIELD* fields = mysql_fetch_fields(results);
|
||
unsigned int i;
|
||
retval = Tcl_NewObj();
|
||
Tcl_IncrRefCount(retval);
|
||
for (i = 0; i < fieldCount; ++i) {
|
||
MYSQL_FIELD* field = MysqlFieldIndex(fields, i);
|
||
attrs = Tcl_NewObj();
|
||
name = Tcl_NewStringObj(field->name, field->name_length);
|
||
|
||
Tcl_DictObjPut(NULL, attrs, literals[LIT_NAME], name);
|
||
/* TODO - Distinguish CHAR and BINARY */
|
||
entry = Tcl_FindHashEntry(&(pidata->typeNumHash),
|
||
(char*) field->type);
|
||
if (entry != NULL) {
|
||
Tcl_DictObjPut(NULL, attrs, literals[LIT_TYPE],
|
||
(Tcl_Obj*) Tcl_GetHashValue(entry));
|
||
}
|
||
if (IS_NUM(field->type)) {
|
||
Tcl_DictObjPut(NULL, attrs, literals[LIT_PRECISION],
|
||
Tcl_NewWideIntObj(field->length));
|
||
} else if (field->charsetnr < cdata->nCollations) {
|
||
Tcl_DictObjPut(NULL, attrs, literals[LIT_PRECISION],
|
||
Tcl_NewWideIntObj(field->length
|
||
/ cdata->collationSizes[field->charsetnr]));
|
||
}
|
||
Tcl_DictObjPut(NULL, attrs, literals[LIT_SCALE],
|
||
Tcl_NewWideIntObj(field->decimals));
|
||
Tcl_DictObjPut(NULL, attrs, literals[LIT_NULLABLE],
|
||
Tcl_NewWideIntObj(!(field->flags
|
||
& (NOT_NULL_FLAG))));
|
||
Tcl_DictObjPut(NULL, retval, name, attrs);
|
||
}
|
||
mysql_free_result(results);
|
||
Tcl_SetObjResult(interp, retval);
|
||
Tcl_DecrRefCount(retval);
|
||
return TCL_OK;
|
||
}
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* ConnectionCommitMethod --
|
||
*
|
||
* Method that requests that a pending transaction against a database
|
||
* be committed.
|
||
*
|
||
* Usage:
|
||
* $connection commit
|
||
*
|
||
* Parameters:
|
||
* None.
|
||
*
|
||
* Results:
|
||
* Returns an empty Tcl result if successful, and throws an error
|
||
* otherwise.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
ConnectionCommitMethod(
|
||
ClientData dummy, /* Not used */
|
||
Tcl_Interp* interp, /* Tcl interpreter */
|
||
Tcl_ObjectContext objectContext, /* Object context */
|
||
int objc, /* Parameter count */
|
||
Tcl_Obj *const objv[] /* Parameter vector */
|
||
) {
|
||
Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
|
||
/* The current connection object */
|
||
ConnectionData* cdata = (ConnectionData*)
|
||
Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
|
||
/* Instance data */
|
||
my_bool rc; /* MySQL status return */
|
||
(void)dummy;
|
||
|
||
/* 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 dummy,
|
||
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);
|
||
(void)dummy;
|
||
|
||
/* Instance data */
|
||
return ConfigureConnection(cdata, interp, objc, objv, skip);
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* ConnectionEvaldirectMethod --
|
||
*
|
||
* Evaluates a MySQL statement that is not supported by the prepared
|
||
* statement API.
|
||
*
|
||
* Usage:
|
||
* $connection evaldirect sql-statement
|
||
*
|
||
* Parameters:
|
||
* sql-statement -
|
||
* SQL statement to evaluate. The statement may not contain
|
||
* substitutions.
|
||
*
|
||
* Results:
|
||
* Returns a standard Tcl result. If the operation is successful,
|
||
* the result consists of a list of rows (in the same form as
|
||
* [$connection allrows -as dicts]). If the operation fails, the
|
||
* result is an error message.
|
||
*
|
||
* Side effects:
|
||
* Whatever the SQL statement does.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
ConnectionEvaldirectMethod(
|
||
ClientData dummy, /* Unused */
|
||
Tcl_Interp* interp, /* Tcl interpreter */
|
||
Tcl_ObjectContext objectContext, /* Object context */
|
||
int objc, /* Parameter count */
|
||
Tcl_Obj *const objv[]) /* Parameter vector */
|
||
{
|
||
Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
|
||
/* Current connection object */
|
||
ConnectionData* cdata = (ConnectionData*)
|
||
Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
|
||
/* Instance data */
|
||
int nColumns; /* Number of columns in the result set */
|
||
MYSQL_RES* resultPtr; /* MySQL result set */
|
||
MYSQL_ROW rowPtr; /* One row of the result set */
|
||
unsigned long* lengths; /* Lengths of the fields in a row */
|
||
Tcl_Obj* retObj; /* Result set as a Tcl list */
|
||
Tcl_Obj* rowObj; /* One row of the result set as a Tcl list */
|
||
Tcl_Obj* fieldObj; /* One field of the row */
|
||
int i;
|
||
(void)dummy;
|
||
|
||
/* Check parameters */
|
||
|
||
if (objc != 3) {
|
||
Tcl_WrongNumArgs(interp, 2, objv, "");
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/* Execute the given statement */
|
||
|
||
if (mysql_query(cdata->mysqlPtr, Tcl_GetString(objv[2]))) {
|
||
TransferMysqlError(interp, cdata->mysqlPtr);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/* Retrieve the result set */
|
||
|
||
resultPtr = mysql_store_result(cdata->mysqlPtr);
|
||
nColumns = mysql_field_count(cdata->mysqlPtr);
|
||
if (resultPtr == NULL) {
|
||
/*
|
||
* Can't retrieve result set. Distinguish result-less statements
|
||
* from MySQL errors.
|
||
*/
|
||
if (nColumns == 0) {
|
||
Tcl_SetObjResult
|
||
(interp,
|
||
Tcl_NewWideIntObj(mysql_affected_rows(cdata->mysqlPtr)));
|
||
return TCL_OK;
|
||
} else {
|
||
TransferMysqlError(interp, cdata->mysqlPtr);
|
||
return TCL_ERROR;
|
||
}
|
||
}
|
||
|
||
/* Make a list-of-lists of the result */
|
||
|
||
retObj = Tcl_NewObj();
|
||
while ((rowPtr = mysql_fetch_row(resultPtr)) != NULL) {
|
||
rowObj = Tcl_NewObj();
|
||
lengths = mysql_fetch_lengths(resultPtr);
|
||
for (i = 0; i < nColumns; ++i) {
|
||
if (rowPtr[i] != NULL) {
|
||
fieldObj = Tcl_NewStringObj(rowPtr[i], lengths[i]);
|
||
} else {
|
||
fieldObj = cdata->pidata->literals[LIT_EMPTY];
|
||
}
|
||
Tcl_ListObjAppendElement(NULL, rowObj, fieldObj);
|
||
}
|
||
Tcl_ListObjAppendElement(NULL, retObj, rowObj);
|
||
}
|
||
Tcl_SetObjResult(interp, retObj);
|
||
|
||
/*
|
||
* Free the result set.
|
||
*/
|
||
mysql_free_result(resultPtr);
|
||
|
||
return TCL_OK;
|
||
}
|
||
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* ConnectionNeedCollationInfoMethod --
|
||
*
|
||
* Internal method that determines whether the collation lengths
|
||
* are known yet.
|
||
*
|
||
* Usage:
|
||
* $connection NeedCollationInfo
|
||
*
|
||
* Parameters:
|
||
* None.
|
||
*
|
||
* Results:
|
||
* Returns a Boolean value.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
ConnectionNeedCollationInfoMethod(
|
||
ClientData dummy, /* Not used */
|
||
Tcl_Interp* interp, /* Tcl interpreter */
|
||
Tcl_ObjectContext objectContext, /* Object context */
|
||
int objc, /* Parameter count */
|
||
Tcl_Obj *const objv[] /* Parameter vector */
|
||
) {
|
||
Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
|
||
/* The current connection object */
|
||
ConnectionData* cdata = (ConnectionData*)
|
||
Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
|
||
/* Instance data */
|
||
(void)dummy;
|
||
|
||
if (objc != 2) {
|
||
Tcl_WrongNumArgs(interp, 2, objv, "");
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(cdata->collationSizes == NULL));
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* ConnectionRollbackMethod --
|
||
*
|
||
* Method that requests that a pending transaction against a database
|
||
* be rolled back.
|
||
*
|
||
* Usage:
|
||
* $connection rollback
|
||
*
|
||
* Parameters:
|
||
* None.
|
||
*
|
||
* Results:
|
||
* Returns an empty Tcl result if successful, and throws an error
|
||
* otherwise.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
ConnectionRollbackMethod(
|
||
ClientData dummy, /* Not used */
|
||
Tcl_Interp* interp, /* Tcl interpreter */
|
||
Tcl_ObjectContext objectContext, /* Object context */
|
||
int objc, /* Parameter count */
|
||
Tcl_Obj *const objv[] /* Parameter vector */
|
||
) {
|
||
Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
|
||
/* The current connection object */
|
||
ConnectionData* cdata = (ConnectionData*)
|
||
Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
|
||
/* Instance data */
|
||
my_bool rc; /* Result code from MySQL operations */
|
||
(void)dummy;
|
||
|
||
/* 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 dummy, /* Not used */
|
||
Tcl_Interp* interp, /* Tcl interpreter */
|
||
Tcl_ObjectContext objectContext, /* Object context */
|
||
int objc, /* Parameter count */
|
||
Tcl_Obj *const objv[] /* Parameter vector */
|
||
) {
|
||
Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
|
||
/* The current connection object */
|
||
ConnectionData* cdata = (ConnectionData*)
|
||
Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
|
||
/* Instance data */
|
||
int listLen;
|
||
Tcl_Obj* objPtr;
|
||
unsigned int collationNum;
|
||
int i;
|
||
int t;
|
||
(void)dummy;
|
||
|
||
if (objc <= 2) {
|
||
Tcl_WrongNumArgs(interp, 2, objv, "{collationNum size}...");
|
||
return TCL_ERROR;
|
||
}
|
||
if (Tcl_ListObjIndex(interp, objv[2], 0, &objPtr) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (Tcl_GetIntFromObj(interp, objPtr, &t) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
cdata->nCollations = (unsigned int)(t+1);
|
||
if (cdata->collationSizes) {
|
||
ckfree((char*) cdata->collationSizes);
|
||
}
|
||
cdata->collationSizes =
|
||
(int*) ckalloc(cdata->nCollations * sizeof(int));
|
||
memset(cdata->collationSizes, 0, cdata->nCollations * sizeof(int));
|
||
for (i = 2; i < objc; ++i) {
|
||
if (Tcl_ListObjLength(interp, objv[i], &listLen) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (listLen != 2) {
|
||
Tcl_SetObjResult(interp, Tcl_NewStringObj("args must be 2-element "
|
||
"lists", -1));
|
||
return TCL_ERROR;
|
||
}
|
||
if (Tcl_ListObjIndex(interp, objv[i], 0, &objPtr) != TCL_OK
|
||
|| Tcl_GetIntFromObj(interp, objPtr, &t) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
collationNum = (unsigned int) t;
|
||
if (collationNum > cdata->nCollations) {
|
||
Tcl_SetObjResult(interp, Tcl_NewStringObj("collations must be "
|
||
"in decreasing sequence",
|
||
-1));
|
||
return TCL_ERROR;
|
||
}
|
||
if ((Tcl_ListObjIndex(interp, objv[i], 1, &objPtr) != TCL_OK)
|
||
|| (Tcl_GetIntFromObj(interp, objPtr,
|
||
cdata->collationSizes+collationNum)
|
||
!= TCL_OK)) {
|
||
return TCL_ERROR;
|
||
}
|
||
}
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* ConnectionTablesMethod --
|
||
*
|
||
* Method that asks for the names of tables in the database (optionally
|
||
* matching a given pattern
|
||
*
|
||
* Usage:
|
||
* $connection tables ?pattern?
|
||
*
|
||
* Parameters:
|
||
* None.
|
||
*
|
||
* Results:
|
||
* Returns the list of tables
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
ConnectionTablesMethod(
|
||
ClientData dummy, /* Not used */
|
||
Tcl_Interp* interp, /* Tcl interpreter */
|
||
Tcl_ObjectContext objectContext, /* Object context */
|
||
int objc, /* Parameter count */
|
||
Tcl_Obj *const objv[] /* Parameter vector */
|
||
) {
|
||
Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
|
||
/* The current connection object */
|
||
ConnectionData* cdata = (ConnectionData*)
|
||
Tcl_ObjectGetMetadata(thisObject, &connectionDataType);
|
||
/* Instance data */
|
||
Tcl_Obj** literals = cdata->pidata->literals;
|
||
/* Literal pool */
|
||
const char* patternStr = NULL;
|
||
/* Pattern to match table names */
|
||
MYSQL_RES* results = NULL; /* Result set */
|
||
MYSQL_ROW row = NULL; /* Row in the result set */
|
||
int status = TCL_OK; /* Return status */
|
||
Tcl_Obj* retval = NULL; /* List of table names */
|
||
(void)dummy;
|
||
|
||
/* 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* dummy, /* Tcl interpreter */
|
||
ClientData oldClientData, /* Environment handle to be discarded */
|
||
ClientData* newClientData /* New environment handle to be used */
|
||
) {
|
||
(void)dummy;
|
||
|
||
*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 */
|
||
) {
|
||
(void)metadata;
|
||
(void)newMetaData;
|
||
|
||
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_Obj* nameObj; /* Name of a result column */
|
||
int isNew; /* Flag == 1 if a result column is unique */
|
||
Tcl_HashEntry* entry; /* Hash table entry for a column name */
|
||
int count; /* Number used to disambiguate a column name */
|
||
(void)flags;
|
||
|
||
Tcl_InitHashTable(&names, TCL_STRING_KEYS);
|
||
if (result != NULL) {
|
||
unsigned int fieldCount = mysql_num_fields(result);
|
||
MYSQL_FIELD* fields = mysql_fetch_fields(result);
|
||
unsigned int i;
|
||
char numbuf[16];
|
||
for (i = 0; i < fieldCount; ++i) {
|
||
MYSQL_FIELD* field = MysqlFieldIndex(fields, i);
|
||
nameObj = Tcl_NewStringObj(field->name, field->name_length);
|
||
Tcl_IncrRefCount(nameObj);
|
||
entry = Tcl_CreateHashEntry(&names, field->name, &isNew);
|
||
count = 1;
|
||
while (!isNew) {
|
||
count = PTR2INT(Tcl_GetHashValue(entry));
|
||
++count;
|
||
Tcl_SetHashValue(entry, INT2PTR(count));
|
||
sprintf(numbuf, "#%d", count);
|
||
Tcl_AppendToObj(nameObj, numbuf, -1);
|
||
entry = Tcl_CreateHashEntry(&names, Tcl_GetString(nameObj),
|
||
&isNew);
|
||
}
|
||
Tcl_SetHashValue(entry, INT2PTR(count));
|
||
Tcl_ListObjAppendElement(NULL, retval, nameObj);
|
||
Tcl_DecrRefCount(nameObj);
|
||
}
|
||
}
|
||
Tcl_DeleteHashTable(&names);
|
||
return retval;
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* StatementConstructor --
|
||
*
|
||
* C-level initialization for the object representing an MySQL prepared
|
||
* statement.
|
||
*
|
||
* Usage:
|
||
* statement new connection statementText
|
||
* statement create name connection statementText
|
||
*
|
||
* Parameters:
|
||
* connection -- the MySQL connection object
|
||
* statementText -- text of the statement to prepare.
|
||
*
|
||
* Results:
|
||
* Returns a standard Tcl result
|
||
*
|
||
* Side effects:
|
||
* Prepares the statement, and stores it (plus a reference to the
|
||
* connection) in instance metadata.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
StatementConstructor(
|
||
ClientData dummy, /* 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;
|
||
(void)dummy;
|
||
|
||
/* 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 dummy, /* 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;
|
||
(void)dummy;
|
||
|
||
if (objc != 2) {
|
||
Tcl_WrongNumArgs(interp, 2, objv, "");
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
retVal = Tcl_NewObj();
|
||
Tcl_ListObjLength(NULL, sdata->subVars, &nParams);
|
||
for (i = 0; i < nParams; ++i) {
|
||
paramDesc = Tcl_NewObj();
|
||
Tcl_ListObjIndex(NULL, sdata->subVars, i, ¶mName);
|
||
Tcl_DictObjPut(NULL, paramDesc, literals[LIT_NAME], paramName);
|
||
switch (sdata->params[i].flags & (PARAM_IN | PARAM_OUT)) {
|
||
case PARAM_IN:
|
||
Tcl_DictObjPut(NULL, paramDesc, literals[LIT_DIRECTION],
|
||
literals[LIT_IN]);
|
||
break;
|
||
case PARAM_OUT:
|
||
Tcl_DictObjPut(NULL, paramDesc, literals[LIT_DIRECTION],
|
||
literals[LIT_OUT]);
|
||
break;
|
||
case PARAM_IN | PARAM_OUT:
|
||
Tcl_DictObjPut(NULL, paramDesc, literals[LIT_DIRECTION],
|
||
literals[LIT_INOUT]);
|
||
break;
|
||
default:
|
||
break;
|
||
}
|
||
typeHashEntry =
|
||
Tcl_FindHashEntry(&(pidata->typeNumHash),
|
||
INT2PTR(sdata->params[i].dataType));
|
||
if (typeHashEntry != NULL) {
|
||
dataTypeName = (Tcl_Obj*) Tcl_GetHashValue(typeHashEntry);
|
||
Tcl_DictObjPut(NULL, paramDesc, literals[LIT_TYPE], dataTypeName);
|
||
}
|
||
Tcl_DictObjPut(NULL, paramDesc, literals[LIT_PRECISION],
|
||
Tcl_NewWideIntObj(sdata->params[i].precision));
|
||
Tcl_DictObjPut(NULL, paramDesc, literals[LIT_SCALE],
|
||
Tcl_NewWideIntObj(sdata->params[i].scale));
|
||
Tcl_DictObjPut(NULL, retVal, paramName, paramDesc);
|
||
}
|
||
|
||
Tcl_SetObjResult(interp, retVal);
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* StatementParamtypeMethod --
|
||
*
|
||
* Defines a parameter type in a MySQL statement.
|
||
*
|
||
* Usage:
|
||
* $statement paramtype paramName ?direction? type ?precision ?scale??
|
||
*
|
||
* Results:
|
||
* Returns a standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* Updates the description of the given parameter.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
StatementParamtypeMethod(
|
||
ClientData dummy, /* Not used */
|
||
Tcl_Interp* interp, /* Tcl interpreter */
|
||
Tcl_ObjectContext context, /* Object context */
|
||
int objc, /* Parameter count */
|
||
Tcl_Obj *const objv[] /* Parameter vector */
|
||
) {
|
||
Tcl_Object thisObject = Tcl_ObjectContextObject(context);
|
||
/* The current statement object */
|
||
StatementData* sdata /* The current statement */
|
||
= (StatementData*) Tcl_ObjectGetMetadata(thisObject,
|
||
&statementDataType);
|
||
static const struct {
|
||
const char* name;
|
||
int flags;
|
||
} directions[] = {
|
||
{ "in", PARAM_IN },
|
||
{ "out", PARAM_OUT },
|
||
{ "inout", PARAM_IN | PARAM_OUT },
|
||
{ NULL, 0 }
|
||
};
|
||
int direction;
|
||
int typeNum; /* Data type number of a parameter */
|
||
int precision; /* Data precision */
|
||
int scale; /* Data scale */
|
||
|
||
int nParams; /* Number of parameters to the statement */
|
||
const char* paramName; /* Name of the parameter being set */
|
||
Tcl_Obj* targetNameObj; /* Name of the ith parameter in the statement */
|
||
const char* targetName; /* Name of a candidate parameter in the
|
||
* statement */
|
||
int matchCount = 0; /* Number of parameters matching the name */
|
||
Tcl_Obj* errorObj; /* Error message */
|
||
|
||
int i;
|
||
(void)dummy;
|
||
|
||
/* 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 */
|
||
) {
|
||
(void)metadata;
|
||
(void)newMetaData;
|
||
|
||
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 dummy, /* 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 */
|
||
ConnectionData* cdata; /* The MySQL connection object's data */
|
||
StatementData* sdata; /* The statement object's data */
|
||
ResultSetData* rdata; /* THe result set object's data */
|
||
int nParams; /* The parameter count on the statement */
|
||
int nBound; /* Number of parameters bound so far */
|
||
Tcl_Obj* paramNameObj; /* Name of the current parameter */
|
||
const char* paramName; /* Name of the current parameter */
|
||
Tcl_Obj* paramValObj; /* Value of the current parameter */
|
||
const char* paramValStr; /* String value of the current parameter */
|
||
char* bufPtr; /* Pointer to the parameter buffer */
|
||
int len; /* Length of a bound parameter */
|
||
int nColumns; /* Number of columns in the result set */
|
||
MYSQL_FIELD* fields = NULL; /* Description of columns of the result set */
|
||
MYSQL_BIND* resultBindings; /* Bindings of the columns of the result set */
|
||
unsigned long* resultLengths;
|
||
/* Lengths of the columns of the result set */
|
||
int i;
|
||
(void)dummy;
|
||
|
||
/* 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;
|
||
}
|
||
|
||
/* Allocate an object to hold data about this result set */
|
||
|
||
rdata = (ResultSetData*) ckalloc(sizeof(ResultSetData));
|
||
rdata->refCount = 1;
|
||
rdata->sdata = sdata;
|
||
rdata->stmtPtr = NULL;
|
||
rdata->paramValues = NULL;
|
||
rdata->paramBindings = NULL;
|
||
rdata->paramLengths = NULL;
|
||
rdata->rowCount = 0;
|
||
rdata->resultErrors = (my_bool*) ckalloc(nColumns * sizeof(my_bool));
|
||
rdata->resultNulls = (my_bool*) ckalloc(nColumns * sizeof(my_bool));
|
||
resultLengths = rdata->resultLengths = (unsigned long*)
|
||
ckalloc(nColumns * sizeof(unsigned long));
|
||
rdata->resultBindings = resultBindings = MysqlBindAlloc(nColumns);
|
||
IncrStatementRefCount(sdata);
|
||
Tcl_ObjectSetMetadata(thisObject, &resultSetDataType, (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) {
|
||
MYSQL_FIELD* field = MysqlFieldIndex(fields, i);
|
||
switch (field->type) {
|
||
|
||
case MYSQL_TYPE_FLOAT:
|
||
case MYSQL_TYPE_DOUBLE:
|
||
MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_DOUBLE);
|
||
MysqlBindAllocBuffer(resultBindings, i, sizeof(double));
|
||
resultLengths[i] = sizeof(double);
|
||
break;
|
||
|
||
case MYSQL_TYPE_BIT:
|
||
MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_BIT);
|
||
MysqlBindAllocBuffer(resultBindings, i, field->length);
|
||
resultLengths[i] = field->length;
|
||
break;
|
||
|
||
case MYSQL_TYPE_LONGLONG:
|
||
MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_LONGLONG);
|
||
MysqlBindAllocBuffer(resultBindings, i, sizeof(Tcl_WideInt));
|
||
resultLengths[i] = sizeof(Tcl_WideInt);
|
||
break;
|
||
|
||
case MYSQL_TYPE_TINY:
|
||
case MYSQL_TYPE_SHORT:
|
||
case MYSQL_TYPE_INT24:
|
||
case MYSQL_TYPE_LONG:
|
||
MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_LONG);
|
||
MysqlBindAllocBuffer(resultBindings, i, sizeof(int));
|
||
resultLengths[i] = sizeof(int);
|
||
break;
|
||
|
||
default:
|
||
MysqlBindSetBufferType(resultBindings, i, MYSQL_TYPE_STRING);
|
||
MysqlBindAllocBuffer(resultBindings, i, 0);
|
||
resultLengths[i] = 0;
|
||
break;
|
||
}
|
||
MysqlBindSetLength(resultBindings, i, rdata->resultLengths + i);
|
||
rdata->resultNulls[i] = 0;
|
||
MysqlBindSetIsNull(resultBindings, i, rdata->resultNulls + i);
|
||
rdata->resultErrors[i] = 0;
|
||
MysqlBindSetError(resultBindings, i, rdata->resultErrors + i);
|
||
}
|
||
|
||
/*
|
||
* Find a statement handle that we can use to execute the SQL code.
|
||
* If the main statement handle associated with the statement
|
||
* is idle, we can use it. Otherwise, we have to allocate and
|
||
* prepare a fresh one.
|
||
*/
|
||
|
||
if (sdata->flags & STMT_FLAG_BUSY) {
|
||
rdata->stmtPtr = AllocAndPrepareStatement(interp, sdata);
|
||
if (rdata->stmtPtr == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
} else {
|
||
rdata->stmtPtr = sdata->stmtPtr;
|
||
sdata->flags |= STMT_FLAG_BUSY;
|
||
}
|
||
|
||
/* Allocate the parameter bindings */
|
||
|
||
Tcl_ListObjLength(NULL, sdata->subVars, &nParams);
|
||
rdata->paramValues = Tcl_NewObj();
|
||
Tcl_IncrRefCount(rdata->paramValues);
|
||
rdata->paramBindings = MysqlBindAlloc(nParams);
|
||
rdata->paramLengths = (unsigned long*) ckalloc(nParams
|
||
* sizeof(unsigned long));
|
||
for (nBound = 0; nBound < nParams; ++nBound) {
|
||
MysqlBindSetBufferType(rdata->paramBindings, nBound, MYSQL_TYPE_NULL);
|
||
}
|
||
|
||
/* Bind the substituted parameters */
|
||
|
||
for (nBound = 0; nBound < nParams; ++nBound) {
|
||
Tcl_ListObjIndex(NULL, sdata->subVars, nBound, ¶mNameObj);
|
||
paramName = Tcl_GetString(paramNameObj);
|
||
if (objc == skip+2) {
|
||
|
||
/* Param from a dictionary */
|
||
|
||
if (Tcl_DictObjGet(interp, objv[skip+1],
|
||
paramNameObj, ¶mValObj) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
} else {
|
||
|
||
/* Param from a variable */
|
||
|
||
paramValObj = Tcl_GetVar2Ex(interp, paramName, NULL,
|
||
TCL_LEAVE_ERR_MSG);
|
||
}
|
||
|
||
/*
|
||
* At this point, paramValObj contains the parameter to bind.
|
||
* Convert the parameters to the appropriate data types for
|
||
* MySQL's prepared statement interface, and bind them.
|
||
*/
|
||
|
||
if (paramValObj != NULL) {
|
||
switch (sdata->params[nBound].dataType & 0xffff) {
|
||
|
||
case MYSQL_TYPE_NEWDECIMAL:
|
||
case MYSQL_TYPE_DECIMAL:
|
||
if (sdata->params[nBound].scale == 0) {
|
||
if (sdata->params[nBound].precision < 10) {
|
||
goto smallinteger;
|
||
} else if (sdata->params[nBound].precision < 19) {
|
||
goto biginteger;
|
||
} else {
|
||
goto charstring;
|
||
}
|
||
} else if (sdata->params[nBound].precision < 17) {
|
||
goto real;
|
||
} else {
|
||
goto charstring;
|
||
}
|
||
|
||
case MYSQL_TYPE_FLOAT:
|
||
case MYSQL_TYPE_DOUBLE:
|
||
real:
|
||
MysqlBindSetBufferType(rdata->paramBindings, nBound,
|
||
MYSQL_TYPE_DOUBLE);
|
||
bufPtr = (char *)MysqlBindAllocBuffer(rdata->paramBindings,
|
||
nBound, sizeof(double));
|
||
rdata->paramLengths[nBound] = sizeof(double);
|
||
MysqlBindSetLength(rdata->paramBindings, nBound,
|
||
&(rdata->paramLengths[nBound]));
|
||
if (Tcl_GetDoubleFromObj(interp, paramValObj,
|
||
(double*) bufPtr) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
break;
|
||
|
||
case MYSQL_TYPE_BIT:
|
||
case MYSQL_TYPE_LONGLONG:
|
||
biginteger:
|
||
MysqlBindSetBufferType(rdata->paramBindings, nBound,
|
||
MYSQL_TYPE_LONGLONG);
|
||
bufPtr = (char *)MysqlBindAllocBuffer(rdata->paramBindings, nBound,
|
||
sizeof(Tcl_WideInt));
|
||
rdata->paramLengths[nBound] = sizeof(Tcl_WideInt);
|
||
MysqlBindSetLength(rdata->paramBindings, nBound,
|
||
&(rdata->paramLengths[nBound]));
|
||
if (Tcl_GetWideIntFromObj(interp, paramValObj,
|
||
(Tcl_WideInt*) bufPtr) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
break;
|
||
|
||
case MYSQL_TYPE_TINY:
|
||
case MYSQL_TYPE_SHORT:
|
||
case MYSQL_TYPE_INT24:
|
||
case MYSQL_TYPE_LONG:
|
||
smallinteger:
|
||
MysqlBindSetBufferType(rdata->paramBindings, nBound,
|
||
MYSQL_TYPE_LONG);
|
||
bufPtr = (char *)MysqlBindAllocBuffer(rdata->paramBindings, nBound,
|
||
sizeof(int));
|
||
rdata->paramLengths[nBound] = sizeof(int);
|
||
MysqlBindSetLength(rdata->paramBindings, nBound,
|
||
&(rdata->paramLengths[nBound]));
|
||
if (Tcl_GetIntFromObj(interp, paramValObj,
|
||
(int*) bufPtr) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
break;
|
||
|
||
default:
|
||
charstring:
|
||
Tcl_ListObjAppendElement(NULL, rdata->paramValues, paramValObj);
|
||
if (sdata->params[nBound].dataType & IS_BINARY) {
|
||
MysqlBindSetBufferType(rdata->paramBindings, nBound,
|
||
MYSQL_TYPE_BLOB);
|
||
paramValStr = (char*)
|
||
Tcl_GetByteArrayFromObj(paramValObj, &len);
|
||
} else {
|
||
MysqlBindSetBufferType(rdata->paramBindings, nBound,
|
||
MYSQL_TYPE_STRING);
|
||
paramValStr = Tcl_GetStringFromObj(paramValObj, &len);
|
||
}
|
||
bufPtr = (char *)MysqlBindAllocBuffer(rdata->paramBindings, nBound,
|
||
len+1);
|
||
memcpy(bufPtr, paramValStr, len);
|
||
rdata->paramLengths[nBound] = len;
|
||
MysqlBindSetLength(rdata->paramBindings, nBound,
|
||
&(rdata->paramLengths[nBound]));
|
||
break;
|
||
|
||
}
|
||
} else {
|
||
MysqlBindSetBufferType(rdata->paramBindings, nBound,
|
||
MYSQL_TYPE_NULL);
|
||
}
|
||
}
|
||
|
||
/* Execute the statement */
|
||
|
||
/*
|
||
* It is tempting to conserve client memory here by omitting
|
||
* the call to 'mysql_stmt_store_result', but doing so causes
|
||
* 'calls out of sync' errors when attempting to prepare a
|
||
* statement while a result set is open. Certain of these errors
|
||
* can, in turn, be avoided by using mysql_stmt_set_attr
|
||
* and turning on "CURSOR_MODE_READONLY", but that, in turn
|
||
* causes the server summarily to disconnect the client in
|
||
* some tests.
|
||
*/
|
||
|
||
if (mysql_stmt_bind_param(rdata->stmtPtr, rdata->paramBindings)
|
||
|| ((nColumns > 0) && mysql_stmt_bind_result(rdata->stmtPtr,
|
||
resultBindings))
|
||
|| mysql_stmt_execute(rdata->stmtPtr)
|
||
|| mysql_stmt_store_result(rdata->stmtPtr) ) {
|
||
TransferMysqlStmtError(interp, sdata->stmtPtr);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/* Determine and store the row count */
|
||
|
||
rdata->rowCount = mysql_stmt_affected_rows(sdata->stmtPtr);
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* ResultSetColumnsMethod --
|
||
*
|
||
* Retrieves the list of columns from a result set.
|
||
*
|
||
* Usage:
|
||
* $resultSet columns
|
||
*
|
||
* Results:
|
||
* Returns the count of columns
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
ResultSetColumnsMethod(
|
||
ClientData dummy, /* 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;
|
||
(void)dummy;
|
||
|
||
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 = PTR2INT(clientData);
|
||
/* Flag == 1 if lists are to be returned,
|
||
* 0 if dicts are to be returned */
|
||
|
||
Tcl_Object thisObject = Tcl_ObjectContextObject(context);
|
||
/* The current result set object */
|
||
ResultSetData* rdata = (ResultSetData*)
|
||
Tcl_ObjectGetMetadata(thisObject, &resultSetDataType);
|
||
/* Data pertaining to the current result set */
|
||
StatementData* sdata = (StatementData*) rdata->sdata;
|
||
/* Statement that yielded the result set */
|
||
ConnectionData* cdata = (ConnectionData*) sdata->cdata;
|
||
/* Connection that opened the statement */
|
||
PerInterpData* pidata = (PerInterpData*) cdata->pidata;
|
||
/* Per interpreter data */
|
||
Tcl_Obj** literals = pidata->literals;
|
||
/* Literal pool */
|
||
|
||
int nColumns = 0; /* Number of columns in the result set */
|
||
Tcl_Obj* colName; /* Name of the current column */
|
||
Tcl_Obj* resultRow; /* Row of the result set under construction */
|
||
|
||
Tcl_Obj* colObj; /* Column obtained from the row */
|
||
int status = TCL_ERROR; /* Status return from this command */
|
||
MYSQL_FIELD* fields; /* Fields of the result set */
|
||
MYSQL_BIND* resultBindings = rdata->resultBindings;
|
||
/* Descriptions of the results */
|
||
unsigned long* resultLengths = rdata->resultLengths;
|
||
/* String lengths of the results */
|
||
my_bool* resultNulls = rdata->resultNulls;
|
||
/* Indicators that the results are null */
|
||
void* bufPtr; /* Pointer to a result's buffer */
|
||
unsigned char byte; /* One byte extracted from a bit field */
|
||
Tcl_WideInt bitVal; /* Value of a bit field */
|
||
int mysqlStatus; /* Status return from MySQL */
|
||
int i;
|
||
unsigned int j;
|
||
|
||
if (objc != 3) {
|
||
Tcl_WrongNumArgs(interp, 2, objv, "varName");
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
|
||
/* Get the column names in the result set. */
|
||
|
||
Tcl_ListObjLength(NULL, sdata->columnNames, &nColumns);
|
||
if (nColumns == 0) {
|
||
Tcl_SetObjResult(interp, literals[LIT_0]);
|
||
return TCL_OK;
|
||
}
|
||
|
||
resultRow = Tcl_NewObj();
|
||
Tcl_IncrRefCount(resultRow);
|
||
|
||
/*
|
||
* Try to rebind the result set before doing the next fetch
|
||
*/
|
||
|
||
fields = mysql_fetch_fields(sdata->metadataPtr);
|
||
if (mysql_stmt_bind_result(rdata->stmtPtr, resultBindings)) {
|
||
goto cleanup;
|
||
}
|
||
|
||
/* Fetch the row to determine sizes. */
|
||
|
||
mysqlStatus = mysql_stmt_fetch(rdata->stmtPtr);
|
||
if (mysqlStatus != 0 && mysqlStatus != MYSQL_DATA_TRUNCATED) {
|
||
if (mysqlStatus == MYSQL_NO_DATA) {
|
||
Tcl_SetObjResult(interp, literals[LIT_0]);
|
||
status = TCL_OK;
|
||
}
|
||
goto cleanup;
|
||
}
|
||
|
||
/* Retrieve one column at a time. */
|
||
|
||
for (i = 0; i < nColumns; ++i) {
|
||
MYSQL_FIELD* field = MysqlFieldIndex(fields, i);
|
||
colObj = NULL;
|
||
if (!resultNulls[i]) {
|
||
if (resultLengths[i]
|
||
> MysqlBindGetBufferLength(resultBindings, i)) {
|
||
MysqlBindFreeBuffer(resultBindings, i);
|
||
MysqlBindAllocBuffer(resultBindings, i, resultLengths[i] + 1);
|
||
if (mysql_stmt_fetch_column(rdata->stmtPtr,
|
||
MysqlBindIndex(resultBindings, i),
|
||
i, 0)) {
|
||
goto cleanup;
|
||
}
|
||
}
|
||
bufPtr = MysqlBindGetBuffer(resultBindings, i);
|
||
switch (MysqlBindGetBufferType(resultBindings, i)) {
|
||
|
||
case MYSQL_TYPE_BIT:
|
||
bitVal = 0;
|
||
for (j = 0; j < resultLengths[i]; ++j) {
|
||
byte = ((unsigned char*) bufPtr)[resultLengths[i]-1-j];
|
||
bitVal |= (byte << (8*j));
|
||
}
|
||
colObj = Tcl_NewWideIntObj(bitVal);
|
||
break;
|
||
|
||
case MYSQL_TYPE_DOUBLE:
|
||
colObj = Tcl_NewDoubleObj(*(double*) bufPtr);
|
||
break;
|
||
|
||
case MYSQL_TYPE_LONG:
|
||
colObj = Tcl_NewWideIntObj(*(int*) bufPtr);
|
||
break;
|
||
|
||
case MYSQL_TYPE_LONGLONG:
|
||
colObj = Tcl_NewWideIntObj(*(Tcl_WideInt*) bufPtr);
|
||
break;
|
||
|
||
default:
|
||
if (field->charsetnr == 63) {
|
||
colObj = Tcl_NewByteArrayObj((unsigned char*) bufPtr,
|
||
resultLengths[i]);
|
||
} else {
|
||
colObj = Tcl_NewStringObj((char*) bufPtr,
|
||
resultLengths[i]);
|
||
}
|
||
break;
|
||
}
|
||
}
|
||
|
||
if (lists) {
|
||
if (colObj == NULL) {
|
||
colObj = literals[LIT_EMPTY];
|
||
}
|
||
Tcl_ListObjAppendElement(NULL, resultRow, colObj);
|
||
} else {
|
||
if (colObj != NULL) {
|
||
Tcl_ListObjIndex(NULL, sdata->columnNames, i, &colName);
|
||
Tcl_DictObjPut(NULL, resultRow, colName, colObj);
|
||
}
|
||
}
|
||
}
|
||
|
||
/* Save the row in the given variable */
|
||
|
||
if (Tcl_SetVar2Ex(interp, Tcl_GetString(objv[2]), NULL,
|
||
resultRow, TCL_LEAVE_ERR_MSG) == NULL) {
|
||
goto cleanup;
|
||
}
|
||
|
||
Tcl_SetObjResult(interp, literals[LIT_1]);
|
||
status = TCL_OK;
|
||
|
||
cleanup:
|
||
if (status != TCL_OK) {
|
||
TransferMysqlStmtError(interp, rdata->stmtPtr);
|
||
}
|
||
Tcl_DecrRefCount(resultRow);
|
||
return status;
|
||
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* ResultSetRowcountMethod --
|
||
*
|
||
* Returns (if known) the number of rows affected by a MySQL statement.
|
||
*
|
||
* Usage:
|
||
* $resultSet rowcount
|
||
*
|
||
* Results:
|
||
* Returns a standard Tcl result giving the number of affected rows.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
ResultSetRowcountMethod(
|
||
ClientData dummy, /* 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 */
|
||
(void)dummy;
|
||
|
||
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) {
|
||
MysqlBindFreeBuffer(rdata->resultBindings, i);
|
||
}
|
||
ckfree((char*)(rdata->resultBindings));
|
||
ckfree((char*)(rdata->resultLengths));
|
||
ckfree((char*)(rdata->resultNulls));
|
||
ckfree((char*)(rdata->resultErrors));
|
||
ckfree((char*)(rdata->paramLengths));
|
||
if (rdata->paramBindings != NULL) {
|
||
for (i = 0; i < nParams; ++i) {
|
||
if (MysqlBindGetBufferType(rdata->paramBindings, i)
|
||
!= MYSQL_TYPE_NULL) {
|
||
MysqlBindFreeBuffer(rdata->paramBindings, i);
|
||
}
|
||
}
|
||
ckfree((char*)(rdata->paramBindings));
|
||
}
|
||
if (rdata->paramValues != NULL) {
|
||
Tcl_DecrRefCount(rdata->paramValues);
|
||
}
|
||
if (rdata->stmtPtr != NULL) {
|
||
if (rdata->stmtPtr != sdata->stmtPtr) {
|
||
mysql_stmt_close(rdata->stmtPtr);
|
||
} else {
|
||
sdata->flags &= ~ STMT_FLAG_BUSY;
|
||
}
|
||
}
|
||
DecrStatementRefCount(rdata->sdata);
|
||
ckfree((char*)rdata);
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* CloneResultSet --
|
||
*
|
||
* Attempts to clone a MySQL result set's metadata.
|
||
*
|
||
* Results:
|
||
* Returns the new metadata
|
||
*
|
||
* At present, we don't attempt to clone result sets - it's not obvious
|
||
* that such an action would ever even make sense. Instead, we throw an
|
||
* error.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
CloneResultSet(
|
||
Tcl_Interp* interp, /* Tcl interpreter for error reporting */
|
||
ClientData metadata, /* Metadata to be cloned */
|
||
ClientData* newMetaData /* Where to put the cloned metadata */
|
||
) {
|
||
(void)metadata;
|
||
(void)newMetaData;
|
||
|
||
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.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
#ifdef __cplusplus
|
||
extern "C" {
|
||
#endif /* __cplusplus */
|
||
DLLEXPORT int
|
||
Tdbcmysql_Init(
|
||
Tcl_Interp* interp /* Tcl interpreter */
|
||
) {
|
||
PerInterpData* pidata; /* Per-interpreter data for this package */
|
||
Tcl_Obj* nameObj; /* Name of a class or method being looked up */
|
||
Tcl_Object curClassObject; /* Tcl_Object representing the current class */
|
||
Tcl_Class curClass; /* Tcl_Class representing the current class */
|
||
int i;
|
||
|
||
/* Require all package dependencies */
|
||
|
||
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (TclOOInitializeStubs(interp, "1.0") == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (Tdbc_InitStubs(interp) == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/* Provide the current package */
|
||
|
||
if (Tcl_PkgProvideEx(interp, "tdbc::mysql", PACKAGE_VERSION, NULL) == TCL_ERROR) {
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/*
|
||
* Create per-interpreter data for the package
|
||
*/
|
||
|
||
pidata = (PerInterpData*) ckalloc(sizeof(PerInterpData));
|
||
pidata->refCount = 1;
|
||
for (i = 0; i < LIT__END; ++i) {
|
||
pidata->literals[i] = Tcl_NewStringObj(LiteralValues[i], -1);
|
||
Tcl_IncrRefCount(pidata->literals[i]);
|
||
}
|
||
Tcl_InitHashTable(&(pidata->typeNumHash), TCL_ONE_WORD_KEYS);
|
||
for (i = 0; dataTypes[i].name != NULL; ++i) {
|
||
int isNew;
|
||
Tcl_HashEntry* entry =
|
||
Tcl_CreateHashEntry(&(pidata->typeNumHash),
|
||
INT2PTR(dataTypes[i].num),
|
||
&isNew);
|
||
Tcl_Obj* nameObj = Tcl_NewStringObj(dataTypes[i].name, -1);
|
||
Tcl_IncrRefCount(nameObj);
|
||
Tcl_SetHashValue(entry, (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) {
|
||
if ((mysqlLoadHandle = MysqlInitStubs(interp)) == NULL) {
|
||
Tcl_MutexUnlock(&mysqlMutex);
|
||
return TCL_ERROR;
|
||
}
|
||
mysql_library_init(0, NULL, NULL);
|
||
mysqlClientVersion = mysql_get_client_version();
|
||
}
|
||
++mysqlRefCount;
|
||
Tcl_MutexUnlock(&mysqlMutex);
|
||
|
||
/*
|
||
* TODO: mysql_thread_init, and keep a TSD reference count of users.
|
||
*/
|
||
|
||
return TCL_OK;
|
||
}
|
||
#ifdef __cplusplus
|
||
}
|
||
#endif /* __cplusplus */
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* DeletePerInterpData --
|
||
*
|
||
* Delete per-interpreter data when the MYSQL package is finalized
|
||
*
|
||
* Side effects:
|
||
* Releases the (presumably last) reference on the environment handle,
|
||
* cleans up the literal pool, and deletes the per-interp data structure.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
static void
|
||
DeletePerInterpData(
|
||
PerInterpData* pidata /* Data structure to clean up */
|
||
) {
|
||
int i;
|
||
|
||
Tcl_HashSearch search;
|
||
Tcl_HashEntry *entry;
|
||
for (entry = Tcl_FirstHashEntry(&(pidata->typeNumHash), &search);
|
||
entry != NULL;
|
||
entry = Tcl_NextHashEntry(&search)) {
|
||
Tcl_Obj* nameObj = (Tcl_Obj*) Tcl_GetHashValue(entry);
|
||
Tcl_DecrRefCount(nameObj);
|
||
}
|
||
Tcl_DeleteHashTable(&(pidata->typeNumHash));
|
||
|
||
for (i = 0; i < LIT__END; ++i) {
|
||
Tcl_DecrRefCount(pidata->literals[i]);
|
||
}
|
||
ckfree((char *) pidata);
|
||
|
||
/*
|
||
* TODO: decrease thread refcount and mysql_thread_end if need be
|
||
*/
|
||
|
||
Tcl_MutexLock(&mysqlMutex);
|
||
if (--mysqlRefCount == 0) {
|
||
mysql_library_end();
|
||
Tcl_FSUnloadFile(NULL, mysqlLoadHandle);
|
||
}
|
||
Tcl_MutexUnlock(&mysqlMutex);
|
||
}
|