/* * $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 ; } }