X-Git-Url: https://git.sven.stormbind.net/?p=sven%2Fmysqltcl.git;a=blobdiff_plain;f=mysqltcl_2.14.c;fp=mysqltcl_2.14.c;h=29b6321d4a3799b90a16381b84c457be42f4f1a2;hp=0000000000000000000000000000000000000000;hb=8b83892bf9d924349d5e09c88f16790a8086a950;hpb=b47a140e1d8fa10b34c244d077b2a3a7f36c7ff8 diff --git a/mysqltcl_2.14.c b/mysqltcl_2.14.c new file mode 100755 index 0000000..29b6321 --- /dev/null +++ b/mysqltcl_2.14.c @@ -0,0 +1,1631 @@ +/* + * $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 + #define PACKAGE "mysqltcl" + #define VERSION "2.14" +#endif + +#include +#include + +#include +#include +#include +#include + + +/* 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; idxres_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;iresult != 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 ; + } +}