--- /dev/null
+/*
+ * $Eid: mysqltcl.c,v 1.2 2002/02/15 18:52:08 artur Exp $
+ *
+ * MYSQL interface to Tcl
+ *
+ * Hakan Soderstrom, hs@soderstrom.se
+ *
+ */
+
+/*
+ * Copyright (c) 1994, 1995 Hakan Soderstrom and Tom Poindexter
+ *
+ * Permission to use, copy, modify, distribute, and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice and this permission notice
+ * appear in all copies of the software and related documentation.
+ *
+ * THE SOFTWARE IS PROVIDED "AS-IS" AND WITHOUT WARRANTY OF ANY KIND,
+ * EXPRESS, IMPLIED OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
+ * WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
+ *
+ * IN NO EVENT SHALL HAKAN SODERSTROM OR SODERSTROM PROGRAMVARUVERKSTAD
+ * AB BE LIABLE FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL
+ * DAMAGES OF ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+ * OF USE, DATA OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY
+ * OF DAMAGE, AND ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN
+ * CONNECTON WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+#ifdef _WINDOWS
+ #include <windows.h>
+ #define PACKAGE "mysqltcl"
+ #define VERSION "2.14"
+#endif
+
+#include <tcl.h>
+#include <mysql.h>
+
+#include <errno.h>
+#include <string.h>
+#include <ctype.h>
+#include <stdlib.h>
+
+
+/* A few macros for making the code more readable */
+
+#define DECLARE_CMD(func) \
+static int func _ANSI_ARGS_((ClientData clientData, \
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
+
+#define DEFINE_CMD(func) \
+static int func(clientData, interp, objc, objv) \
+ ClientData clientData; \
+ Tcl_Interp *interp; \
+ int objc; \
+ Tcl_Obj *CONST objv[];
+
+#define ADD_CMD(cmdName, cmdProc) \
+Tcl_CreateObjCommand(interp, #cmdName, cmdProc, NULL, Mysqltcl_Kill)
+
+/* Compile-time constants */
+
+#define MYSQL_SMALL_SIZE TCL_RESULT_SIZE /* Smaller buffer size. */
+#define MYSQL_NAME_LEN 80 /* Max. host, database name length. */
+
+typedef struct MysqlTclHandle {
+ MYSQL * connection ; /* Connection handle, if connected; -1 otherwise. */
+ char host[MYSQL_NAME_LEN] ; /* Host name, if connected. */
+ char database[MYSQL_NAME_LEN] ; /* Db name, if selected; NULL otherwise. */
+ MYSQL_RES* result ; /* Stored result, if any; NULL otherwise. */
+ int res_count ; /* Count of unfetched rows in result. */
+ int col_count ; /* Column count in result, if any. */
+ int number;
+ int isquery;
+} MysqlTclHandle;
+
+/* one global Hash for mysql handles */
+static Tcl_HashTable handleTable;
+
+static char *MysqlHandlePrefix = "mysql";
+/* Prefix string used to identify handles.
+ * The following must be strlen(MysqlHandlePrefix).
+ */
+#define MYSQL_HPREFIX_LEN 5
+
+/* Array for status info, and its elements. */
+#define MYSQL_STATUS_ARR "mysqlstatus"
+
+#define MYSQL_STATUS_CODE "code"
+#define MYSQL_STATUS_CMD "command"
+#define MYSQL_STATUS_MSG "message"
+#define MYSQL_STATUS_NULLV "nullvalue"
+
+/* C variable corresponding to mysqlstatus(nullvalue) */
+static char *MysqlNullvalue = NULL ;
+#define MYSQL_NULLV_INIT ""
+
+/* Check Level for mysql_prologue */
+#define CL_PLAIN 0
+#define CL_CONN 1
+#define CL_DB 2
+#define CL_RES 3
+
+/* Prototypes for all functions. */
+
+DECLARE_CMD(Mysqltcl_Connect);
+DECLARE_CMD(Mysqltcl_Use);
+DECLARE_CMD(Mysqltcl_Escape);
+DECLARE_CMD(Mysqltcl_Sel);
+DECLARE_CMD(Mysqltcl_Next);
+DECLARE_CMD(Mysqltcl_Seek);
+DECLARE_CMD(Mysqltcl_Map);
+DECLARE_CMD(Mysqltcl_Exec);
+DECLARE_CMD(Mysqltcl_Close);
+DECLARE_CMD(Mysqltcl_Info);
+DECLARE_CMD(Mysqltcl_Result);
+DECLARE_CMD(Mysqltcl_Col);
+DECLARE_CMD(Mysqltcl_State);
+DECLARE_CMD(Mysqltcl_InsertId);
+DECLARE_CMD(Mysqltcl_Query);
+
+static int MysqlHandleSet _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static void MysqlHandleFree _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+
+/* handle object type
+ * This section defince funtions for Handling new Tcl_Obj type */
+
+Tcl_ObjType mysqlHandleType = {
+ "mysqlhandle",
+ MysqlHandleFree,
+ (Tcl_DupInternalRepProc *) NULL,
+ NULL,
+ MysqlHandleSet
+};
+
+static int
+MysqlHandleSet(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+ char *string;
+ MysqlTclHandle *handle;
+ Tcl_HashEntry *entryPtr;
+
+ string=Tcl_GetStringFromObj(objPtr, NULL);
+ entryPtr = Tcl_FindHashEntry(&handleTable,string);
+ if (entryPtr == NULL) {
+ handle=0;
+ } else {
+ handle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);
+ }
+ if (!handle) {
+ if (interp != NULL)
+ return TCL_ERROR;
+ }
+ if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+ oldTypePtr->freeIntRepProc(objPtr);
+ }
+
+ objPtr->internalRep.otherValuePtr = (MysqlTclHandle *) handle;
+ objPtr->typePtr = &mysqlHandleType;
+ Tcl_Preserve((char *)handle);
+ // printf("p set obj handle %i %x\n",handle->isquery,handle);
+
+ return TCL_OK;
+}
+static void
+MysqlHandleFree(Tcl_Obj *obj)
+{
+ MysqlTclHandle *handle = (MysqlTclHandle *)obj->internalRep.otherValuePtr;
+ Tcl_Release((char *)handle);
+ // printf("r free obj handle %i %x\n",handle->isquery,handle);
+}
+
+static int
+GetHandleFromObj(interp, objPtr, handlePtr)
+ Tcl_Interp *interp;
+ register Tcl_Obj *objPtr;
+ register MysqlTclHandle **handlePtr;
+{
+ if (Tcl_ConvertToType (interp, objPtr, &mysqlHandleType) != TCL_OK)
+ return TCL_ERROR;
+ *handlePtr = (MysqlTclHandle *)objPtr->internalRep.otherValuePtr;
+ return TCL_OK;
+}
+
+static Tcl_Obj *
+Tcl_NewHandleObj(handle)
+ register MysqlTclHandle* handle;
+{
+ register Tcl_Obj *objPtr;
+ char buffer[MYSQL_HPREFIX_LEN+TCL_DOUBLE_SPACE+1];
+ register int len;
+ Tcl_HashEntry *entryPtr;
+ int newflag;
+
+ objPtr=Tcl_NewObj();
+ /* the string for "query" can not be longer as MysqlHandlePrefix see buf variable */
+ len=sprintf(buffer, "%s%d", (handle->isquery) ? "query" : MysqlHandlePrefix,handle->number);
+ objPtr->bytes = Tcl_Alloc((unsigned) len + 1);
+ strcpy(objPtr->bytes, buffer);
+ objPtr->length = len;
+
+ entryPtr=Tcl_CreateHashEntry(&handleTable,buffer,&newflag);
+ Tcl_SetHashValue(entryPtr,handle);
+
+ objPtr->internalRep.otherValuePtr = handle;
+ objPtr->typePtr = &mysqlHandleType;
+
+ Tcl_Preserve((char *)handle);
+ // printf("p new obj handle %i %x\n",handle->isquery,handle);
+
+ return objPtr;
+}
+
+
+/* CONFLICT HANDLING
+ *
+ * Every command begins by calling 'mysql_prologue'.
+ * This function resets mysqlstatus(code) to zero; the other array elements
+ * retain their previous values.
+ * The function also saves objc/objv in global variables.
+ * After this the command processing proper begins.
+ *
+ * If there is a conflict, the message is taken from one of the following
+ * sources,
+ * -- this code (mysql_prim_confl),
+ * -- the database server (mysql_server_confl),
+ * A complete message is put together from the above plus the name of the
+ * command where the conflict was detected.
+ * The complete message is returned as the Tcl result and is also stored in
+ * mysqlstatus(message).
+ * mysqlstatus(code) is set to "-1" for a primitive conflict or to mysql_errno
+ * for a server conflict
+ * In addition, the whole command where the conflict was detected is put
+ * together from the saved objc/objv and is copied into mysqlstatus(command).
+ */
+
+/*
+ *-----------------------------------------------------------
+ * set_statusArr
+ * Help procedure to set Tcl global array with mysqltcl internal
+ * informations
+ */
+
+static void
+set_statusArr(Tcl_Interp *interp,char *elem_name,Tcl_Obj *tobj)
+{
+ Tcl_SetVar2Ex (interp,MYSQL_STATUS_ARR,elem_name,tobj,TCL_GLOBAL_ONLY);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * clear_msg
+ *
+ * Clears all error and message elements in the global array variable.
+ *
+ */
+
+static void
+clear_msg(Tcl_Interp *interp)
+{
+ set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(0));
+ set_statusArr(interp,MYSQL_STATUS_CMD,Tcl_NewObj());
+ set_statusArr(interp,MYSQL_STATUS_MSG,Tcl_NewObj());
+}
+
+/*
+ *----------------------------------------------------------------------
+ * mysql_reassemble
+ * Reassembles the current command from the saved objv; copies it into
+ * mysqlstatus(command).
+ */
+
+static void
+mysql_reassemble (Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[])
+{
+ set_statusArr(interp,MYSQL_STATUS_CMD,Tcl_NewListObj(objc, objv));
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ * mysql_prim_confl
+ * Conflict handling after a primitive conflict.
+ *
+ */
+
+static int
+mysql_prim_confl (Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[],char *msg)
+{
+ set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(-1));
+
+ Tcl_ResetResult (interp) ;
+ Tcl_AppendStringsToObj (Tcl_GetObjResult(interp),
+ Tcl_GetString(objv[0]), ": ", msg, (char*)NULL);
+
+ set_statusArr(interp,MYSQL_STATUS_MSG,Tcl_GetObjResult(interp));
+
+ mysql_reassemble (interp,objc,objv) ;
+ return TCL_ERROR ;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ * mysql_server_confl
+ * Conflict handling after an mySQL conflict.
+ *
+ */
+
+static int
+mysql_server_confl (Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[],MYSQL * connection)
+{
+ char* mysql_errorMsg;
+
+ mysql_errorMsg = mysql_error(connection);
+
+ set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(mysql_errno(connection)));
+
+ Tcl_ResetResult (interp) ;
+ Tcl_AppendStringsToObj (Tcl_GetObjResult(interp),
+ Tcl_GetString(objv[0]), "/db server: ",
+ (mysql_errorMsg == NULL) ? "" : mysql_errorMsg,
+ (char*)NULL) ;
+
+ set_statusArr(interp,MYSQL_STATUS_MSG,Tcl_GetObjResult(interp));
+
+ mysql_reassemble (interp,objc,objv) ;
+ return TCL_ERROR ;
+}
+
+static MysqlTclHandle *
+get_handle (Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[],int check_level)
+{
+ MysqlTclHandle *handle;
+ if (GetHandleFromObj(interp, objv[1], &handle) != TCL_OK) {
+ mysql_prim_confl (interp,objc,objv,"not mysqltcl handle") ;
+ return NULL;
+ }
+ if (check_level==CL_PLAIN) return handle;
+ if (handle->connection == 0) {
+ mysql_prim_confl (interp,objc,objv,"handle already closed (dangling pointer)") ;
+ return NULL;
+ }
+ if (check_level==CL_CONN) return handle;
+ if (check_level!=CL_RES) {
+ if (handle->database[0] == '\0') {
+ mysql_prim_confl (interp,objc,objv,"no current database") ;
+ return NULL;
+ }
+ if (check_level==CL_DB) return handle;
+ }
+ if (handle->result == NULL) {
+ mysql_prim_confl (interp,objc,objv,"no result pending") ;
+ return NULL;
+ }
+ return handle;
+}
+
+/*----------------------------------------------------------------------
+ * mysql_QueryTclObj
+ * getRowCellAsObject
+ * This to method control how tcl data is transfered to mysql and
+ * how data is imported into tcl from mysql
+ */
+static int mysql_QueryTclObj(MysqlTclHandle *handle,Tcl_Obj *obj)
+{
+ char *query;
+ int result,queryLen;
+ Tcl_DString queryDS;
+
+ query=Tcl_GetStringFromObj(obj, &queryLen);
+ Tcl_UtfToExternalDString(NULL, query, -1, &queryDS);
+ queryLen = Tcl_DStringLength(&queryDS);
+ result = mysql_real_query(handle->connection,Tcl_DStringValue(&queryDS),queryLen);
+ Tcl_DStringFree(&queryDS);
+ return result;
+}
+static Tcl_Obj *getRowCellAsObject(MYSQL_ROW row,int length)
+{
+ Tcl_Obj *obj;
+ if (*row) {
+ obj = Tcl_NewByteArrayObj(*row,length);
+ } else {
+ obj = Tcl_NewStringObj(MysqlNullvalue,-1);
+ }
+ return obj;
+}
+
+static MysqlTclHandle *createMysqlHandle()
+{
+ static int HandleNum=0;
+ MysqlTclHandle *handle;
+ handle=(MysqlTclHandle *)Tcl_Alloc(sizeof(MysqlTclHandle));
+ if (handle == 0) {
+ panic("no memory for handle");
+ return handle;
+ }
+ handle->connection = (MYSQL *)0 ;
+ handle->host[0] = '\0' ;
+ handle->database[0] = '\0' ;
+ handle->result = NULL ;
+ handle->res_count = 0 ;
+ handle->col_count = 0 ;
+ handle->isquery = 0;
+
+ //printf("p create handle %i %x\n",handle->isquery,handle);
+
+ /* not MT-safe, static */
+ handle->number=HandleNum++;
+ return handle;
+}
+
+static MysqlTclHandle *createQueryHandleFrom(MysqlTclHandle *handle)
+{
+ int number;
+ MysqlTclHandle *qhandle;
+ qhandle = createMysqlHandle();
+ number = qhandle->number;
+ if (!qhandle) return qhandle;
+ memcpy(qhandle,handle,sizeof(MysqlTclHandle));
+ qhandle->isquery=1;
+ qhandle->number=number;
+ return qhandle;
+}
+static void closeHandle(MysqlTclHandle *handle)
+{
+ handle->connection = (MYSQL *)0;
+ // printf("r close handle %i %x\n",handle->isquery,handle);
+ Tcl_EventuallyFree((char *)handle,TCL_DYNAMIC);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * mysql_prologue
+ *
+ * Does most of standard command prologue; required for all commands
+ * having conflict handling.
+ * 'req_min_args' must be the minimum number of arguments for the command,
+ * including the command word.
+ * 'req_max_args' must be the maximum number of arguments for the command,
+ * including the command word.
+ * 'usage_msg' must be a usage message, leaving out the command name.
+ * Checks the handle assumed to be present in objv[1] if 'check' is not NULL.
+ * RETURNS: Handle index or -1 on failure.
+ * SIDE EFFECT: Sets the Tcl result on failure.
+ */
+
+static MysqlTclHandle *
+mysql_prologue (interp, objc, objv, req_min_args, req_max_args, check_level, usage_msg)
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+ int req_min_args;
+ int req_max_args;
+ int check_level;
+ char *usage_msg;
+{
+ /* Check number of args. */
+ if (objc < req_min_args || objc > req_max_args) {
+ Tcl_WrongNumArgs(interp, 1, objv, usage_msg);
+ return NULL;
+ }
+
+ /* Reset mysqlstatus(code). */
+ set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(0));
+
+ /* Check the handle.
+ * The function is assumed to set the status array on conflict.
+ */
+ return (get_handle(interp,objc,objv,check_level));
+}
+
+/*
+ *----------------------------------------------------------------------
+ * mysql_colinfo
+ *
+ * Given an MYSQL_FIELD struct and a string keyword appends a piece of
+ * column info (one item) to the Tcl result.
+ * ASSUMES 'fld' is non-null.
+ * RETURNS 0 on success, 1 otherwise.
+ * SIDE EFFECT: Sets the result and status on failure.
+ */
+
+static Tcl_Obj *
+mysql_colinfo (interp,objc,objv,fld,keyw)
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+ MYSQL_FIELD* fld ;
+ Tcl_Obj * keyw ;
+{
+ char buf[MYSQL_SMALL_SIZE];
+ int idx ;
+
+ static CONST char* MysqlColkey[] =
+ {
+ "table", "name", "type", "length", "prim_key", "non_null", "numeric", "decimals", NULL
+ };
+ enum coloptions {
+ MYSQL_COL_TABLE_K, MYSQL_COL_NAME_K, MYSQL_COL_TYPE_K, MYSQL_COL_LENGTH_K, MYSQL_COL_PRIMKEY_K,
+ MYSQL_COL_NONNULL_K, MYSQL_COL_NUMERIC_K, MYSQL_COL_DECIMALS_K};
+
+ if (Tcl_GetIndexFromObj(interp, keyw, (char **)MysqlColkey, "option",
+ TCL_EXACT, &idx) != TCL_OK)
+ return NULL;
+
+ switch (idx)
+ {
+ case MYSQL_COL_TABLE_K:
+ return Tcl_NewStringObj(fld->table, -1) ;
+ case MYSQL_COL_NAME_K:
+ return Tcl_NewStringObj(fld->name, -1) ;
+ case MYSQL_COL_TYPE_K:
+ switch (fld->type)
+ {
+ case FIELD_TYPE_DECIMAL:
+ return Tcl_NewStringObj("decimal", -1);
+ case FIELD_TYPE_TINY:
+ return Tcl_NewStringObj("tiny", -1);
+ case FIELD_TYPE_SHORT:
+ return Tcl_NewStringObj("short", -1);
+ case FIELD_TYPE_LONG:
+ return Tcl_NewStringObj("long", -1) ;
+ case FIELD_TYPE_FLOAT:
+ return Tcl_NewStringObj("float", -1);
+ case FIELD_TYPE_DOUBLE:
+ return Tcl_NewStringObj("double", -1);
+ case FIELD_TYPE_NULL:
+ return Tcl_NewStringObj("null", -1);
+ case FIELD_TYPE_TIMESTAMP:
+ return Tcl_NewStringObj("timestamp", -1);
+ case FIELD_TYPE_LONGLONG:
+ return Tcl_NewStringObj("long long", -1);
+ case FIELD_TYPE_INT24:
+ return Tcl_NewStringObj("int24", -1);
+ case FIELD_TYPE_DATE:
+ return Tcl_NewStringObj("date", -1);
+ case FIELD_TYPE_TIME:
+ return Tcl_NewStringObj("time", -1);
+ case FIELD_TYPE_DATETIME:
+ return Tcl_NewStringObj("date time", -1);
+ case FIELD_TYPE_YEAR:
+ return Tcl_NewStringObj("year", -1);
+ case FIELD_TYPE_NEWDATE:
+ return Tcl_NewStringObj("new date", -1);
+ case FIELD_TYPE_ENUM:
+ return Tcl_NewStringObj("enum", -1); /* fyll p忿? */
+ case FIELD_TYPE_SET: /* samma */
+ return Tcl_NewStringObj("set", -1);
+ case FIELD_TYPE_TINY_BLOB:
+ return Tcl_NewStringObj("tiny blob", -1);
+ case FIELD_TYPE_MEDIUM_BLOB:
+ return Tcl_NewStringObj("medium blob", -1);
+ case FIELD_TYPE_LONG_BLOB:
+ return Tcl_NewStringObj("long blob", -1);
+ case FIELD_TYPE_BLOB:
+ return Tcl_NewStringObj("blob", -1);
+ case FIELD_TYPE_VAR_STRING:
+ return Tcl_NewStringObj("var string", -1);
+ case FIELD_TYPE_STRING:
+ return Tcl_NewStringObj("string", -1) ;
+ default:
+ sprintf (buf, "column '%s' has weird datatype", fld->name) ;
+ mysql_prim_confl (interp,objc,objv,buf) ;
+ return NULL ;
+ }
+ break ;
+ case MYSQL_COL_LENGTH_K:
+ return Tcl_NewIntObj(fld->length) ;
+ case MYSQL_COL_PRIMKEY_K:
+ return Tcl_NewBooleanObj(IS_PRI_KEY(fld->flags)) ;
+ case MYSQL_COL_NONNULL_K:
+ return Tcl_NewBooleanObj(IS_NOT_NULL(fld->flags)) ;
+ case MYSQL_COL_NUMERIC_K:
+ return Tcl_NewBooleanObj(IS_NUM(fld->type));
+ case MYSQL_COL_DECIMALS_K:
+ return IS_NUM(fld->type)? Tcl_NewIntObj(fld->decimals): Tcl_NewIntObj(-1);
+ default: /* should never happen */
+ mysql_prim_confl (interp,objc,objv,"weirdness in mysql_colinfo") ;
+ return NULL ;
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ * Mysqltcl_Kill
+ * Close all connections.
+ *
+ */
+
+static void
+Mysqltcl_Kill (clientData)
+ ClientData clientData;
+{
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ MysqlTclHandle *handle;
+ int wasdeleted=0;
+
+ for (entryPtr=Tcl_FirstHashEntry(&handleTable,&search);
+ entryPtr!=NULL;
+ entryPtr=Tcl_NextHashEntry(&search)) {
+ wasdeleted=1;
+ handle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);
+
+ if (handle->connection == 0) continue;
+
+ if (handle->result != NULL)
+ mysql_free_result (handle->result) ;
+
+ mysql_close (handle->connection);
+ closeHandle(handle);
+ }
+ if (wasdeleted) {
+ Tcl_DeleteHashTable(&handleTable);
+ Tcl_InitHashTable (&handleTable, TCL_STRING_KEYS);
+ }
+}
+
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mysqltcl_Connect
+ * Implements the mysqlconnect command:
+ * usage: mysqlconnect ?option value ...?
+ *
+ * Results:
+ * handle - a character string of newly open handle
+ * TCL_OK - connect successful
+ * TCL_ERROR - connect not successful - error message returned
+ */
+
+DEFINE_CMD(Mysqltcl_Connect)
+{
+ int i, idx;
+ char *hostname = NULL;
+ char *user = NULL;
+ char *password = NULL;
+ char *db = NULL;
+ int port = 0;
+ char *socket = NULL;
+ MysqlTclHandle *handle;
+ const char *groupname = "mysqltcl";
+
+ static CONST char* MysqlConnectOpt[] =
+ {
+ "-host", "-user", "-password", "-db", "-port", "-socket", NULL
+ };
+ enum connectoption {
+ MYSQL_CONNHOST_OPT, MYSQL_CONNUSER_OPT, MYSQL_CONNPASSWORD_OPT,
+ MYSQL_CONNDB_OPT, MYSQL_CONNPORT_OPT, MYSQL_CONNSOCKET_OPT
+ };
+ if (!(objc & 1) ||
+ objc>(sizeof(MysqlConnectOpt)/sizeof(MysqlConnectOpt[0]-1)*2+1)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "[-user xxx] [-db mysql] [-port 3306] [-host localhost] [-socket sock] [-password pass]");
+ return TCL_ERROR;
+ }
+
+ for (i = 1; i < objc; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], (char **)MysqlConnectOpt, "option",
+ 0, &idx) != TCL_OK)
+ return TCL_ERROR;
+
+ switch (idx)
+ {
+ case MYSQL_CONNHOST_OPT:
+ hostname = Tcl_GetStringFromObj(objv[++i],NULL);
+ break;
+ case MYSQL_CONNUSER_OPT:
+ user = Tcl_GetStringFromObj(objv[++i],NULL);
+ break;
+ case MYSQL_CONNPASSWORD_OPT:
+ password = Tcl_GetStringFromObj(objv[++i],NULL);
+ break;
+ case MYSQL_CONNDB_OPT:
+ db = Tcl_GetStringFromObj(objv[++i],NULL);
+ break;
+ case MYSQL_CONNPORT_OPT:
+ if(Tcl_GetIntFromObj(interp, objv[++i], &port) != TCL_OK)
+ return TCL_ERROR;
+ break;
+ case MYSQL_CONNSOCKET_OPT:
+ socket = Tcl_GetStringFromObj(objv[++i],NULL);
+ break;
+ default:
+ return mysql_prim_confl(interp,objc,objv,"Weirdness in options");
+ }
+ }
+
+ handle = createMysqlHandle();
+
+ if (handle == 0) {
+ panic("no memory for handle");
+ return TCL_ERROR;
+ }
+
+ handle->connection = mysql_init(NULL);
+
+ mysql_options(handle->connection,MYSQL_READ_DEFAULT_GROUP,groupname);
+
+ if (!mysql_real_connect (handle->connection, hostname, user,
+ password, db, port, socket, 0)) {
+ mysql_server_confl (interp,objc,objv,handle->connection);
+ mysql_close (handle->connection);
+ closeHandle(handle);
+ return TCL_ERROR;
+ }
+
+ if (hostname) {
+ strncpy (handle->host, hostname, MYSQL_NAME_LEN) ;
+ handle->host[MYSQL_NAME_LEN - 1] = '\0' ;
+ } else {
+ strcpy (handle->host, "localhost");
+ }
+
+ if (db) {
+ strncpy (handle->database, db, MYSQL_NAME_LEN) ;
+ handle->database[MYSQL_NAME_LEN - 1] = '\0' ;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewHandleObj(handle));
+
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mysqltcl_Use
+ * Implements the mysqluse command:
+ * usage: mysqluse handle dbname
+ *
+ * results:
+ * Sets current database to dbname.
+ */
+
+DEFINE_CMD(Mysqltcl_Use)
+{
+ int len;
+ char *db;
+ MysqlTclHandle *handle;
+
+ if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,
+ "handle dbname")) == 0)
+ return TCL_ERROR;
+
+ db=Tcl_GetStringFromObj(objv[2], &len);
+ if (len >= MYSQL_NAME_LEN)
+ return mysql_prim_confl (interp,objc,objv,"database name too long") ;
+ if (mysql_select_db (handle->connection, db) < 0)
+ return mysql_server_confl (interp,objc,objv,handle->connection) ;
+
+ strcpy (handle->database, db) ;
+ return TCL_OK;
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mysqltcl_Escape
+ * Implements the mysqlescape command:
+ * usage: mysqlescape string
+ *
+ * results:
+ * Escaped string for use in queries.
+ */
+
+DEFINE_CMD(Mysqltcl_Escape)
+{
+ int len;
+ char *inString, *outString;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string");
+ return TCL_ERROR;
+ }
+ /* !!! here the real_escape command should be used
+ this need a additional parameter connection */
+
+ inString=Tcl_GetStringFromObj(objv[1], &len);
+ outString=Tcl_Alloc((len<<1) + 1);
+ len=mysql_escape_string(outString, inString, len);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), outString, len);
+ Tcl_Free(outString);
+ return TCL_OK;
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mysqltcl_Sel
+ * Implements the mysqlsel command:
+ * usage: mysqlsel handle sel-query ?-list|-flatlist?
+ *
+ * results:
+ *
+ * SIDE EFFECT: Flushes any pending result, even in case of conflict.
+ * Stores new results.
+ */
+
+DEFINE_CMD(Mysqltcl_Sel)
+{
+ Tcl_Obj *res, *resList;
+ MYSQL_ROW row;
+ MysqlTclHandle *handle;
+ unsigned long *lengths;
+ static char* selOptions[] = {"-list", "-flatlist", NULL};
+ /* Warning !! no option number */
+ int i,selOption=2,colCount;
+
+ if ((handle = mysql_prologue(interp, objc, objv, 3, 4, CL_CONN,
+ "handle sel-query ?-list|-flatlist?")) == 0)
+ return TCL_ERROR;
+
+
+ if (objc==4) {
+ if (Tcl_GetIndexFromObj(interp, objv[3], (char **)selOptions, "option",
+ TCL_EXACT, &selOption) != TCL_OK)
+ return TCL_ERROR;
+ }
+
+ /* Flush any previous result. */
+ if (handle->result != NULL) {
+ mysql_free_result (handle->result) ;
+ handle->result = NULL ;
+ }
+
+ if (mysql_QueryTclObj(handle,objv[2])) {
+ return mysql_server_confl (interp,objc,objv,handle->connection);
+ }
+
+ if ((handle->result = mysql_store_result (handle->connection)) == NULL) {
+ if (selOption==2) Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
+ } else {
+ colCount = handle->col_count = mysql_num_fields (handle->result) ;
+ res = Tcl_GetObjResult(interp);
+ handle->res_count = 0;
+ switch (selOption) {
+ case 0: /* -list */
+ while ((row = mysql_fetch_row (handle->result)) != NULL) {
+ resList = Tcl_NewListObj(0, NULL);
+ lengths = mysql_fetch_lengths(handle->result);
+ for (i=0; i< colCount; i++, row++) {
+ Tcl_ListObjAppendElement (interp, resList,getRowCellAsObject(row,lengths[i]));
+ }
+ Tcl_ListObjAppendElement (interp, res, resList);
+ }
+ break;
+ case 1: /* -flatlist */
+ while ((row = mysql_fetch_row (handle->result)) != NULL) {
+ lengths = mysql_fetch_lengths(handle->result);
+ for (i=0; i< colCount; i++, row++) {
+ Tcl_ListObjAppendElement (interp, res,getRowCellAsObject(row,lengths[i]));
+ }
+ }
+ break;
+ case 2: /* No option */
+ handle->res_count = mysql_num_rows (handle->result);
+ Tcl_SetIntObj(res, handle->res_count);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+/*
+ * Mysqltcl_Query
+ * Works as mysqltclsel but return an $query handle that allow to build
+ * nested queries on simple handle
+ */
+DEFINE_CMD(Mysqltcl_Query)
+{
+ MYSQL_RES *result;
+ MysqlTclHandle *handle, *qhandle;
+
+ if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,
+ "handle sqlstatement")) == 0)
+ return TCL_ERROR;
+
+ if (mysql_QueryTclObj(handle,objv[2])) {
+ return mysql_server_confl (interp,objc,objv,handle->connection);
+ }
+
+ if ((result = mysql_store_result (handle->connection)) == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
+ return TCL_OK;
+ }
+ if ((qhandle = createQueryHandleFrom(handle)) == NULL) return TCL_ERROR;
+ qhandle->result = result;
+ qhandle->col_count = mysql_num_fields (qhandle->result) ;
+ qhandle->res_count = mysql_num_rows (qhandle->result);
+ Tcl_SetObjResult(interp, Tcl_NewHandleObj(qhandle));
+ return TCL_OK;
+}
+DEFINE_CMD(Mysqltcl_EndQuery)
+{
+ Tcl_HashEntry *entryPtr;
+ MysqlTclHandle *handle;
+
+ if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,
+ "queryhanle")) == 0)
+ return TCL_ERROR;
+
+ if (handle->result != NULL) {
+ mysql_free_result (handle->result) ;
+ handle->result = NULL ;
+ }
+ if (handle->isquery) {
+ entryPtr = Tcl_FindHashEntry(&handleTable,Tcl_GetStringFromObj(objv[1],NULL));
+ if (entryPtr) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ closeHandle(handle);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mysqltcl_Exec
+ * Implements the mysqlexec command:
+ * usage: mysqlexec handle sql-statement
+ *
+ * Results:
+ * Number of affected rows on INSERT, UPDATE or DELETE, 0 otherwise.
+ *
+ * SIDE EFFECT: Flushes any pending result, even in case of conflict.
+ */
+
+DEFINE_CMD(Mysqltcl_Exec)
+{
+ MysqlTclHandle *handle;
+ int affected;
+
+ if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,
+ "handle sql-statement")) == 0)
+ return TCL_ERROR;
+
+ /* Flush any previous result. */
+ if (handle->result != NULL) {
+ mysql_free_result (handle->result) ;
+ handle->result = NULL ;
+ }
+
+ if (mysql_QueryTclObj(handle,objv[2]))
+ return mysql_server_confl (interp,objc,objv,handle->connection);
+
+ if ((affected=mysql_affected_rows(handle->connection)) < 0) affected=0;
+ Tcl_SetIntObj(Tcl_GetObjResult(interp),affected);
+ return TCL_OK ;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mysqltcl_Next
+ * Implements the mysqlnext command:
+ * usage: mysqlnext handle
+ *
+ * results:
+ * next row from pending results as tcl list, or null list.
+ */
+
+DEFINE_CMD(Mysqltcl_Next)
+{
+ MysqlTclHandle *handle;
+ int idx ;
+ MYSQL_ROW row ;
+ Tcl_Obj *resList;
+ unsigned long *lengths;
+
+ if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_RES,
+ "handle")) == 0)
+ return TCL_ERROR;
+
+
+ if (handle->res_count == 0)
+ return TCL_OK ;
+ else if ((row = mysql_fetch_row (handle->result)) == NULL) {
+ handle->res_count = 0 ;
+ return mysql_prim_confl (interp,objc,objv,"result counter out of sync") ;
+ } else
+ handle->res_count-- ;
+
+ lengths = mysql_fetch_lengths(handle->result);
+
+ resList = Tcl_GetObjResult(interp);
+ for (idx = 0 ; idx < handle->col_count ; idx++, row++) {
+ Tcl_ListObjAppendElement (interp, resList,getRowCellAsObject(row,lengths[idx]));
+ }
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mysqltcl_Seek
+ * Implements the mysqlseek command:
+ * usage: mysqlseek handle rownumber
+ *
+ * results:
+ * number of remaining rows
+ */
+
+DEFINE_CMD(Mysqltcl_Seek)
+{
+ MysqlTclHandle *handle;
+ int row;
+ int total;
+
+ if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_RES,
+ " handle row-index")) == 0)
+ return TCL_ERROR;
+
+ if (Tcl_GetIntFromObj (interp, objv[2], &row) != TCL_OK)
+ return TCL_ERROR;
+
+ total = mysql_num_rows (handle->result);
+
+ if (total + row < 0) {
+ mysql_data_seek (handle->result, 0);
+ handle->res_count = total;
+ } else if (row < 0) {
+ mysql_data_seek (handle->result, total + row);
+ handle->res_count = -row;
+ } else if (row >= total) {
+ mysql_data_seek (handle->result, row);
+ handle->res_count = 0;
+ } else {
+ mysql_data_seek (handle->result, row);
+ handle->res_count = total - row;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->res_count)) ;
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mysqltcl_Map
+ * Implements the mysqlmap command:
+ * usage: mysqlmap handle binding-list script
+ *
+ * Results:
+ * SIDE EFFECT: For each row the column values are bound to the variables
+ * in the binding list and the script is evaluated.
+ * The variables are created in the current context.
+ * NOTE: mysqlmap works very much like a 'foreach' construct.
+ * The 'continue' and 'break' commands may be used with their usual effect.
+ */
+
+DEFINE_CMD(Mysqltcl_Map)
+{
+ int code ;
+ int count ;
+ MysqlTclHandle *handle;
+ int idx ;
+ int listObjc ;
+ Tcl_Obj** listObjv ;
+ MYSQL_ROW row ;
+ int *val;
+ unsigned long *lengths;
+
+
+ if ((handle = mysql_prologue(interp, objc, objv, 4, 4, CL_RES,
+ "handle binding-list script")) == 0)
+ return TCL_ERROR;
+
+ if (Tcl_ListObjGetElements (interp, objv[2], &listObjc, &listObjv) != TCL_OK)
+ return TCL_ERROR ;
+
+ if (listObjc > handle->col_count)
+ {
+ return mysql_prim_confl (interp,objc,objv,"too many variables in binding list") ;
+ }
+ else
+ count = (listObjc < handle->col_count)?listObjc
+ :handle->col_count ;
+
+ val=(int*)Tcl_Alloc((count * sizeof (int)));
+ for (idx=0; idx<count; idx++) {
+ if (Tcl_GetStringFromObj(listObjv[idx],0)[0] != '-')
+ val[idx]=1;
+ else
+ val[idx]=0;
+ }
+
+ while (handle->res_count > 0) {
+ /* Get next row, decrement row counter. */
+ if ((row = mysql_fetch_row (handle->result)) == NULL) {
+ handle->res_count = 0 ;
+ Tcl_Free((char *)val);
+ return mysql_prim_confl (interp,objc,objv,"result counter out of sync") ;
+ } else
+ handle->res_count-- ;
+
+ /* Bind variables to column values. */
+ for (idx = 0; idx < count; idx++, row++) {
+ lengths = mysql_fetch_lengths(handle->result);
+ if (val[idx]) {
+ if (Tcl_ObjSetVar2 (interp,
+ listObjv[idx], NULL,getRowCellAsObject(row,lengths[idx]),
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ Tcl_Free((char *)val);
+ return TCL_ERROR ;
+ }
+ }
+ }
+
+ /* Evaluate the script. */
+ switch(code=Tcl_EvalObjEx(interp, objv[3],0)) {
+ case TCL_CONTINUE:
+ case TCL_OK:
+ break ;
+ case TCL_BREAK:
+ Tcl_Free((char *)val);
+ return TCL_OK ;
+ default:
+ Tcl_Free((char *)val);
+ return code ;
+ }
+ }
+ Tcl_Free((char *)val);
+ return TCL_OK ;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mysqltcl_Info
+ * Implements the mysqlinfo command:
+ * usage: mysqlinfo handle option
+ *
+ */
+
+DEFINE_CMD(Mysqltcl_Info)
+{
+ int count ;
+ MysqlTclHandle *handle;
+ int idx ;
+ MYSQL_RES* list ;
+ MYSQL_ROW row ;
+ char* val ;
+ Tcl_Obj *resList;
+ static CONST char* MysqlDbOpt[] =
+ {
+ "dbname", "dbname?", "tables", "host", "host?", "databases","info", NULL
+ };
+ enum dboption {
+ MYSQL_INFNAME_OPT, MYSQL_INFNAMEQ_OPT, MYSQL_INFTABLES_OPT,
+ MYSQL_INFHOST_OPT, MYSQL_INFHOSTQ_OPT, MYSQL_INFLIST_OPT, MYSQL_INFO
+ };
+
+ /* We can't fully check the handle at this stage. */
+ if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_PLAIN,
+ "handle option")) == 0)
+ return TCL_ERROR;
+
+ if (Tcl_GetIndexFromObj(interp, objv[2], (char **)MysqlDbOpt, "option",
+ TCL_EXACT, &idx) != TCL_OK)
+ return TCL_ERROR;
+
+ /* First check the handle. Checking depends on the option. */
+ switch (idx) {
+ case MYSQL_INFNAMEQ_OPT:
+ if ((handle = get_handle(interp,objc,objv,CL_CONN))!=NULL) {
+ if (handle->database[0] == '\0')
+ return TCL_OK ; /* Return empty string if no current db. */
+ }
+ break ;
+ case MYSQL_INFNAME_OPT:
+ case MYSQL_INFTABLES_OPT:
+ case MYSQL_INFHOST_OPT:
+ case MYSQL_INFLIST_OPT:
+ /* !!! */
+ handle = get_handle(interp,objc,objv,CL_CONN);
+ break ;
+ case MYSQL_INFHOSTQ_OPT:
+ if (handle->connection == 0)
+ return TCL_OK ; /* Return empty string if not connected. */
+ break ;
+ case MYSQL_INFO:
+ if (handle->connection == 0)
+ return TCL_OK ; /* Return empty string if not connected. */
+ break;
+ default: /* should never happen */
+ return mysql_prim_confl (interp,objc,objv,"weirdness in Mysqltcl_Info") ;
+ }
+
+ if (handle == 0) return TCL_ERROR ;
+
+ /* Handle OK, return the requested info. */
+ switch (idx) {
+ case MYSQL_INFNAME_OPT:
+ case MYSQL_INFNAMEQ_OPT:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(handle->database, -1));
+ break ;
+ case MYSQL_INFTABLES_OPT:
+ if ((list = mysql_list_tables (handle->connection,(char*)NULL)) == NULL)
+ return mysql_server_confl (interp,objc,objv,handle->connection);
+
+ resList = Tcl_GetObjResult(interp);
+ for (count = mysql_num_rows (list); count > 0; count--) {
+ val = *(row = mysql_fetch_row (list)) ;
+ Tcl_ListObjAppendElement (interp, resList, Tcl_NewStringObj((val == NULL)?"":val,-1));
+ }
+ mysql_free_result (list) ;
+ break ;
+ case MYSQL_INFHOST_OPT:
+ case MYSQL_INFHOSTQ_OPT:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(handle->host, -1));
+ break ;
+ case MYSQL_INFLIST_OPT:
+ if ((list = mysql_list_dbs (handle->connection,(char*)NULL)) == NULL)
+ return mysql_server_confl (interp,objc,objv,handle->connection);
+
+ resList = Tcl_GetObjResult(interp);
+ for (count = mysql_num_rows (list); count > 0; count--) {
+ val = *(row = mysql_fetch_row (list)) ;
+ Tcl_ListObjAppendElement (interp, resList,
+ Tcl_NewStringObj((val == NULL)?"":val,-1));
+ }
+ mysql_free_result (list) ;
+ break ;
+ case MYSQL_INFO:
+ val = mysql_info(handle->connection);
+ if (val!=NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(val,-1));
+ }
+ break;
+ default: /* should never happen */
+ return mysql_prim_confl (interp,objc,objv,"weirdness in Mysqltcl_Info") ;
+ }
+ return TCL_OK ;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mysqltcl_Result
+ * Implements the mysqlresult command:
+ * usage: mysqlresult handle option
+ *
+ */
+
+DEFINE_CMD(Mysqltcl_Result)
+{
+ int idx ;
+ MysqlTclHandle *handle;
+ static CONST char* MysqlResultOpt[] =
+ {
+ "rows", "rows?", "cols", "cols?", "current", "current?", NULL
+ };
+ enum resultoption {
+ MYSQL_RESROWS_OPT, MYSQL_RESROWSQ_OPT, MYSQL_RESCOLS_OPT,
+ MYSQL_RESCOLSQ_OPT, MYSQL_RESCUR_OPT, MYSQL_RESCURQ_OPT
+ };
+ /* We can't fully check the handle at this stage. */
+ if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_PLAIN,
+ " handle option")) == 0)
+ return TCL_ERROR;
+
+ if (Tcl_GetIndexFromObj(interp, objv[2], (char **)MysqlResultOpt, "option",
+ TCL_EXACT, &idx) != TCL_OK)
+ return TCL_ERROR;
+
+ /* First check the handle. Checking depends on the option. */
+ switch (idx) {
+ case MYSQL_RESROWS_OPT:
+ case MYSQL_RESCOLS_OPT:
+ case MYSQL_RESCUR_OPT:
+ handle = get_handle (interp,objc,objv,CL_RES) ;
+ break ;
+ case MYSQL_RESROWSQ_OPT:
+ case MYSQL_RESCOLSQ_OPT:
+ case MYSQL_RESCURQ_OPT:
+ if ((handle = get_handle (interp,objc,objv,CL_RES))== NULL)
+ return TCL_OK ; /* Return empty string if no pending result. */
+ break ;
+ default: /* should never happen */
+ return mysql_prim_confl (interp,objc,objv,"weirdness in Mysqltcl_Result") ;
+ }
+
+
+ if (handle == 0)
+ return TCL_ERROR ;
+
+ /* Handle OK; return requested info. */
+ switch (idx) {
+ case MYSQL_RESROWS_OPT:
+ case MYSQL_RESROWSQ_OPT:
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->res_count));
+ break ;
+ case MYSQL_RESCOLS_OPT:
+ case MYSQL_RESCOLSQ_OPT:
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->col_count));
+ break ;
+ case MYSQL_RESCUR_OPT:
+ case MYSQL_RESCURQ_OPT:
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(mysql_num_rows (handle->result)
+ - handle->res_count)) ;
+ break ;
+ default:
+ return mysql_prim_confl (interp,objc,objv,"weirdness in Mysqltcl_Result");
+ }
+ return TCL_OK ;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mysqltcl_Col
+ * Implements the mysqlcol command:
+ * usage: mysqlcol handle table-name option ?option ...?
+ * mysqlcol handle -current option ?option ...?
+ * '-current' can only be used if there is a pending result.
+ *
+ * results:
+ * List of lists containing column attributes.
+ * If a single attribute is requested the result is a simple list.
+ *
+ * SIDE EFFECT: '-current' disturbs the field position of the result.
+ */
+
+DEFINE_CMD(Mysqltcl_Col)
+{
+ int coln ;
+ int current_db ;
+ MysqlTclHandle *handle;
+ int idx ;
+ int listObjc ;
+ Tcl_Obj **listObjv, *colinfo, *resList, *resSubList;
+ MYSQL_FIELD* fld ;
+ MYSQL_RES* result ;
+ char *argv ;
+
+ /* This check is enough only without '-current'. */
+ if ((handle = mysql_prologue(interp, objc, objv, 4, 99, CL_CONN,
+ "handle table-name option ?option ...?")) == 0)
+ return TCL_ERROR;
+
+ /* Fetch column info.
+ * Two ways: explicit database and table names, or current.
+ */
+ argv=Tcl_GetStringFromObj(objv[2],NULL);
+ current_db = strcmp (argv, "-current") == 0;
+
+ if (current_db) {
+ if ((handle = get_handle (interp,objc,objv,CL_RES)) == 0)
+ return TCL_ERROR ;
+ else
+ result = handle->result ;
+ } else {
+ if ((result = mysql_list_fields (handle->connection, argv, (char*)NULL)) == NULL) {
+ return mysql_server_confl (interp,objc,objv,handle->connection) ;
+ }
+ }
+ /* Must examine the first specifier at this point. */
+ if (Tcl_ListObjGetElements (interp, objv[3], &listObjc, &listObjv) != TCL_OK)
+ return TCL_ERROR ;
+ resList = Tcl_GetObjResult(interp);
+ if (objc == 4 && listObjc == 1) {
+ mysql_field_seek (result, 0) ;
+ while ((fld = mysql_fetch_field (result)) != NULL)
+ if ((colinfo = mysql_colinfo (interp,objc,objv,fld, objv[3])) != NULL) {
+ Tcl_ListObjAppendElement (interp, resList, colinfo);
+ } else {
+ goto conflict;
+ }
+ } else if (objc == 4 && listObjc > 1) {
+ mysql_field_seek (result, 0) ;
+ while ((fld = mysql_fetch_field (result)) != NULL) {
+ resSubList = Tcl_NewListObj(0, NULL);
+ for (coln = 0; coln < listObjc; coln++)
+ if ((colinfo = mysql_colinfo (interp,objc,objv,fld, listObjv[coln])) != NULL) {
+ Tcl_ListObjAppendElement (interp, resSubList, colinfo);
+ } else {
+ goto conflict;
+ }
+ Tcl_ListObjAppendElement (interp, resList, resSubList);
+ }
+ } else {
+ for (idx = 3; idx < objc; idx++) {
+ resSubList = Tcl_NewListObj(0, NULL);
+ mysql_field_seek (result, 0) ;
+ while ((fld = mysql_fetch_field (result)) != NULL)
+ if ((colinfo = mysql_colinfo (interp,objc,objv,fld, objv[idx])) != NULL) {
+ Tcl_ListObjAppendElement (interp, resSubList, colinfo);
+ } else {
+ goto conflict;
+ }
+ Tcl_ListObjAppendElement (interp, resList, resSubList);
+ }
+ }
+ if (!current_db) mysql_free_result (result) ;
+ return TCL_OK;
+
+ conflict:
+ if (!current_db) mysql_free_result (result) ;
+ return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mysqltcl_State
+ * Implements the mysqlstate command:
+ * usage: mysqlstate handle ?-numeric?
+ *
+ */
+
+DEFINE_CMD(Mysqltcl_State)
+{
+ MysqlTclHandle *handle;
+ int numeric=0 ;
+ Tcl_Obj *res;
+
+ if (mysql_prologue(interp, objc, objv, 2, 3, NULL, "handle ?-numeric?") == 0)
+ return TCL_ERROR;
+
+ if (objc==3) {
+ if (strcmp (Tcl_GetStringFromObj(objv[2],NULL), "-numeric"))
+ return mysql_prim_confl (interp,objc,objv,"last parameter should be -numeric") ;
+ else
+ numeric=1;
+ }
+
+ if (GetHandleFromObj(NULL, objv[1], &handle) != TCL_OK)
+ res = (numeric)?Tcl_NewIntObj(0):Tcl_NewStringObj("NOT_A_HANDLE",-1) ;
+ else if (handle->connection == 0)
+ res = (numeric)?Tcl_NewIntObj(1):Tcl_NewStringObj("UNCONNECTED",-1) ;
+ else if (handle->database[0] == '\0')
+ res = (numeric)?Tcl_NewIntObj(2):Tcl_NewStringObj("CONNECTED",-1) ;
+ else if (handle->result == NULL)
+ res = (numeric)?Tcl_NewIntObj(3):Tcl_NewStringObj("IN_USE",-1) ;
+ else
+ res = (numeric)?Tcl_NewIntObj(4):Tcl_NewStringObj("RESULT_PENDING",-1) ;
+
+ Tcl_SetObjResult(interp, res);
+ return TCL_OK ;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mysqltcl_InsertId
+ * Implements the mysqlstate command:
+ * usage: mysqlinsertid handle
+ * Returns the auto increment id of the last INSERT statement
+ *
+ */
+
+DEFINE_CMD(Mysqltcl_InsertId)
+{
+ MysqlTclHandle *handle;
+
+ if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,
+ "handle")) == 0)
+ return TCL_ERROR;
+
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(mysql_insert_id(handle->connection)));
+
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mysqltcl_Close --
+ * Implements the mysqlclose command:
+ * usage: mysqlclose ?handle?
+ *
+ * results:
+ * null string
+ */
+
+DEFINE_CMD(Mysqltcl_Close)
+{
+ MysqlTclHandle *handle,*thandle;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashEntry *qentries[16];
+ Tcl_HashSearch search;
+
+ int i,qfound = 0;
+
+ /* If handle omitted, close all connections. */
+ if (objc == 1) {
+ Mysqltcl_Kill ((ClientData)NULL) ;
+ return TCL_OK ;
+ }
+
+ if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,
+ "?handle?")) == 0)
+ return TCL_ERROR;
+
+ if (handle->result != NULL)
+ mysql_free_result (handle->result) ;
+
+ /* Search all queries on this handle and close those */
+ if (!handle->isquery) {
+ mysql_close(handle->connection);
+ while (1) {
+ for (entryPtr=Tcl_FirstHashEntry(&handleTable,&search);
+ entryPtr!=NULL;
+ entryPtr=Tcl_NextHashEntry(&search)) {
+
+ thandle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);
+ if (thandle->connection == handle->connection &&
+ thandle->isquery) {
+ qentries[qfound++] = entryPtr;
+ }
+ if (qfound==16) break;
+ }
+ if (qfound>0) {
+ for(i=0;i<qfound;i++) {
+ entryPtr=qentries[i];
+ thandle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);
+ Tcl_DeleteHashEntry(entryPtr);
+ if (thandle->result != NULL)
+ mysql_free_result (thandle->result);
+ closeHandle(thandle);
+ }
+ }
+ if (qfound!=16) break;
+ qfound = 0;
+ }
+ }
+ entryPtr = Tcl_FindHashEntry(&handleTable,Tcl_GetStringFromObj(objv[1],NULL));
+ if (entryPtr) Tcl_DeleteHashEntry(entryPtr);
+ closeHandle(handle);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ * Mysqltcl_Init
+ * Perform all initialization for the MYSQL to Tcl interface.
+ * Adds additional commands to interp, creates message array, initializes
+ * all handles.
+ *
+ * A call to Mysqltcl_Init should exist in Tcl_CreateInterp or
+ * Tcl_CreateExtendedInterp.
+ */
+
+#ifdef _WINDOWS
+__declspec( dllexport )
+#endif
+int Mysqltcl_Init (interp)
+ Tcl_Interp *interp;
+{
+ char nbuf[MYSQL_SMALL_SIZE];
+
+ if (Tcl_InitStubs(interp, "8.1", 0) == NULL)
+ return TCL_ERROR;
+ if (Tcl_PkgRequire(interp, "Tcl", "8.1", 0) == NULL)
+ return TCL_ERROR;
+ if (Tcl_PkgProvide(interp, "mysqltcl" , VERSION) != TCL_OK)
+ return TCL_ERROR;
+ /*
+ * Initialize the new Tcl commands.
+ * Deleting any command will close all connections.
+ */
+ ADD_CMD(mysqlconnect, Mysqltcl_Connect);
+ ADD_CMD(mysqluse, Mysqltcl_Use);
+ ADD_CMD(mysqlescape, Mysqltcl_Escape);
+ ADD_CMD(mysqlsel, Mysqltcl_Sel);
+ ADD_CMD(mysqlnext, Mysqltcl_Next);
+ ADD_CMD(mysqlseek, Mysqltcl_Seek);
+ ADD_CMD(mysqlmap, Mysqltcl_Map);
+ ADD_CMD(mysqlexec, Mysqltcl_Exec);
+ ADD_CMD(mysqlclose, Mysqltcl_Close);
+ ADD_CMD(mysqlinfo, Mysqltcl_Info);
+ ADD_CMD(mysqlresult, Mysqltcl_Result);
+ ADD_CMD(mysqlcol, Mysqltcl_Col);
+ ADD_CMD(mysqlstate, Mysqltcl_State);
+ ADD_CMD(mysqlinsertid, Mysqltcl_InsertId);
+ ADD_CMD(mysqlquery, Mysqltcl_Query);
+ ADD_CMD(mysqlendquery, Mysqltcl_EndQuery);
+
+ /* Initialize mysqlstatus global array. */
+
+ clear_msg(interp);
+
+ /* Initialize HashTable for mysql handles */
+ Tcl_InitHashTable (&handleTable, TCL_STRING_KEYS);
+
+ /* Link the null value element to the corresponding C variable. */
+ if ((MysqlNullvalue = (char*)Tcl_Alloc (12)) == NULL) return TCL_ERROR ;
+ strcpy (MysqlNullvalue, MYSQL_NULLV_INIT);
+ sprintf (nbuf, "%s(%s)", MYSQL_STATUS_ARR, MYSQL_STATUS_NULLV) ;
+
+ if (Tcl_LinkVar (interp,nbuf,(char *)&MysqlNullvalue, TCL_LINK_STRING) != TCL_OK)
+ return TCL_ERROR;
+
+ /* Register the handle object type */
+ Tcl_RegisterObjType(&mysqlHandleType);
+
+ /* A little sanity check.
+ * If this message appears you must change the source code and recompile.
+ */
+ if (strlen (MysqlHandlePrefix) == MYSQL_HPREFIX_LEN)
+ return TCL_OK;
+ else {
+ panic("*** mysqltcl (mysqltcl.c): handle prefix inconsistency!\n");
+ return TCL_ERROR ;
+ }
+}
projects / sven / mysqltcl.git / blobdiff