generic/mysqltcl.c

   1 /*\r
   2  * $Eid: mysqltcl.c,v 1.2 2002/02/15 18:52:08 artur Exp $\r
   3  *\r
   4  * MYSQL interface to Tcl\r
   5  *\r
   6  * Hakan Soderstrom, hs@soderstrom.se\r
   7  *\r
   8  */\r
   9 \r
  10 /*\r
  11  * Copyright (c) 1994, 1995 Hakan Soderstrom and Tom Poindexter\r
  12  * \r
  13  * Permission to use, copy, modify, distribute, and sell this software\r
  14  * and its documentation for any purpose is hereby granted without fee,\r
  15  * provided that the above copyright notice and this permission notice\r
  16  * appear in all copies of the software and related documentation.\r
  17  * \r
  18  * THE SOFTWARE IS PROVIDED "AS-IS" AND WITHOUT WARRANTY OF ANY KIND,\r
  19  * EXPRESS, IMPLIED OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY\r
  20  * WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.\r
  21  *\r
  22  * IN NO EVENT SHALL HAKAN SODERSTROM OR SODERSTROM PROGRAMVARUVERKSTAD\r
  23  * AB BE LIABLE FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL\r
  24  * DAMAGES OF ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS\r
  25  * OF USE, DATA OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY\r
  26  * OF DAMAGE, AND ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN\r
  27  * CONNECTON WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.\r
  28  */\r
  29 \r
  30 /*\r
  31  Modified after version 2.0 by Artur Trzewik\r
  32  see http://www.xdobry.de/mysqltcl\r
  33  Patch for encoding option by Alexander Schoepe (version2.20)\r
  34 */\r
  35 \r
  36 #ifdef _WINDOWS\r
  37    #include <windows.h>\r
  38    #define PACKAGE "mysqltcl"\r
  39    #define PACKAGE_VERSION "3.051"\r
  40 #endif\r
  41 \r
  42 #include <tcl.h>\r
  43 #include <mysql.h>\r
  44 \r
  45 #include <errno.h>\r
  46 #include <string.h>\r
  47 #include <ctype.h>\r
  48 #include <stdlib.h>\r
  49 \r
  50 #define MYSQL_SMALL_SIZE  TCL_RESULT_SIZE /* Smaller buffer size. */\r
  51 #define MYSQL_NAME_LEN     80    /* Max. database name length. */\r
  52 /* #define PREPARED_STATEMENT */\r
  53 \r
  54 enum MysqlHandleType {HT_CONNECTION=1,HT_QUERY=2,HT_STATEMENT=3};\r
  55 \r
  56 typedef struct MysqlTclHandle {\r
  57   MYSQL * connection;         /* Connection handle, if connected; NULL otherwise. */\r
  58   char database[MYSQL_NAME_LEN];  /* Db name, if selected; NULL otherwise. */\r
  59   MYSQL_RES* result;              /* Stored result, if any; NULL otherwise. */\r
  60   int res_count;                 /* Count of unfetched rows in result. */\r
  61   int col_count;                 /* Column count in result, if any. */\r
  62   int number;                    /* handle id */\r
  63   enum MysqlHandleType type;                      /* handle type */\r
  64   Tcl_Encoding encoding;         /* encoding for connection */\r
  65 #ifdef PREPARED_STATEMENT\r
  66   MYSQL_STMT *statement;         /* used only by prepared statements*/\r
  67   MYSQL_BIND *bindParam;\r
  68   MYSQL_BIND *bindResult;\r
  69   MYSQL_RES *resultMetadata;\r
  70   MYSQL_RES *paramMetadata;\r
  71 #endif\r
  72 } MysqlTclHandle;\r
  73 \r
  74 typedef struct MysqltclState { \r
  75   Tcl_HashTable hash;\r
  76   int handleNum;\r
  77   char *MysqlNullvalue;\r
  78   // Tcl_Obj *nullObjPtr;\r
  79 } MysqltclState;\r
  80 \r
  81 static char *MysqlHandlePrefix = "mysql";\r
  82 /* Prefix string used to identify handles.\r
  83  * The following must be strlen(MysqlHandlePrefix).\r
  84  */\r
  85 #define MYSQL_HPREFIX_LEN 5\r
  86 \r
  87 /* Array for status info, and its elements. */\r
  88 #define MYSQL_STATUS_ARR "mysqlstatus"\r
  89 \r
  90 #define MYSQL_STATUS_CODE "code"\r
  91 #define MYSQL_STATUS_CMD  "command"\r
  92 #define MYSQL_STATUS_MSG  "message"\r
  93 #define MYSQL_STATUS_NULLV  "nullvalue"\r
  94 \r
  95 #define FUNCTION_NOT_AVAILABLE "function not available"\r
  96 \r
  97 /* C variable corresponding to mysqlstatus(nullvalue) */\r
  98 #define MYSQL_NULLV_INIT ""\r
  99 \r
 100 /* Check Level for mysql_prologue */\r
 101 enum CONNLEVEL {CL_PLAIN,CL_CONN,CL_DB,CL_RES};\r
 102 \r
 103 /* Prototypes for all functions. */\r
 104 \r
 105 static int Mysqltcl_Use(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 106 static int Mysqltcl_Escape(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 107 static int Mysqltcl_Sel(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 108 static int Mysqltcl_Fetch(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 109 static int Mysqltcl_Seek(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 110 static int Mysqltcl_Map(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 111 static int Mysqltcl_Exec(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 112 static int Mysqltcl_Close(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 113 static int Mysqltcl_Info(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 114 static int Mysqltcl_Result(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 115 static int Mysqltcl_Col(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 116 static int Mysqltcl_State(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 117 static int Mysqltcl_InsertId(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 118 static int Mysqltcl_Query(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 119 static int Mysqltcl_Receive(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);\r
 120 static int MysqlHandleSet _ANSI_ARGS_((Tcl_Interp *interp,Tcl_Obj *objPtr));\r
 121 static void MysqlHandleFree _ANSI_ARGS_((Tcl_Obj *objPtr));\r
 122 static int MysqlNullSet _ANSI_ARGS_((Tcl_Interp *interp,Tcl_Obj *objPtr));\r
 123 static Tcl_Obj *Mysqltcl_NewNullObj(MysqltclState *mysqltclState);\r
 124 static void UpdateStringOfNull _ANSI_ARGS_((Tcl_Obj *objPtr));\r
 125 \r
 126 /* handle object type \r
 127  * This section defince funtions for Handling new Tcl_Obj type */\r
 128   \r
 129 Tcl_ObjType mysqlHandleType = {\r
 130     "mysqlhandle", \r
 131     MysqlHandleFree,\r
 132     (Tcl_DupInternalRepProc *) NULL,\r
 133     NULL,\r
 134     MysqlHandleSet\r
 135 };\r
 136 Tcl_ObjType mysqlNullType = {\r
 137     "mysqlnull",\r
 138     (Tcl_FreeInternalRepProc *) NULL,\r
 139     (Tcl_DupInternalRepProc *) NULL,\r
 140     UpdateStringOfNull,\r
 141     MysqlNullSet\r
 142 };\r
 143 \r
 144 \r
 145 static MysqltclState *getMysqltclState(Tcl_Interp *interp) {\r
 146   Tcl_CmdInfo cmdInfo;\r
 147   if (Tcl_GetCommandInfo(interp,"mysqlconnect",&cmdInfo)==0) {\r
 148     return NULL;\r
 149   }\r
 150   return (MysqltclState *)cmdInfo.objClientData;\r
 151 }\r
 152 \r
 153 static int MysqlHandleSet(Tcl_Interp *interp, register Tcl_Obj *objPtr)\r
 154 {\r
 155     Tcl_ObjType *oldTypePtr = objPtr->typePtr;\r
 156     char *string;\r
 157     MysqlTclHandle *handle;\r
 158     Tcl_HashEntry *entryPtr;\r
 159     MysqltclState *statePtr;\r
 160 \r
 161     string = Tcl_GetStringFromObj(objPtr, NULL);  \r
 162     statePtr = getMysqltclState(interp);\r
 163     if (statePtr==NULL) return TCL_ERROR;\r
 164 \r
 165     entryPtr = Tcl_FindHashEntry(&statePtr->hash,string);\r
 166     if (entryPtr == NULL) {\r
 167 \r
 168       handle=0;\r
 169     } else {\r
 170       handle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);\r
 171     }\r
 172     if (!handle) {\r
 173         if (interp != NULL)\r
 174           return TCL_ERROR;\r
 175     }\r
 176     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {\r
 177         oldTypePtr->freeIntRepProc(objPtr);\r
 178     }\r
 179     \r
 180     objPtr->internalRep.otherValuePtr = (MysqlTclHandle *) handle;\r
 181     objPtr->typePtr = &mysqlHandleType;\r
 182     Tcl_Preserve((char *)handle);\r
 183     return TCL_OK;\r
 184 }\r
 185 static int MysqlNullSet(Tcl_Interp *interp, Tcl_Obj *objPtr)\r
 186 {\r
 187     Tcl_ObjType *oldTypePtr = objPtr->typePtr;\r
 188 \r
 189     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {\r
 190         oldTypePtr->freeIntRepProc(objPtr);\r
 191     }\r
 192     objPtr->typePtr = &mysqlNullType;\r
 193     return TCL_OK;\r
 194 }\r
 195 static void UpdateStringOfNull(Tcl_Obj *objPtr) {\r
 196         int valueLen;\r
 197         MysqltclState *state = (MysqltclState *)objPtr->internalRep.otherValuePtr;\r
 198 \r
 199         valueLen = strlen(state->MysqlNullvalue);\r
 200         objPtr->bytes = Tcl_Alloc(valueLen+1);\r
 201         strcpy(objPtr->bytes,state->MysqlNullvalue);\r
 202         objPtr->length = valueLen;\r
 203 }\r
 204 static void MysqlHandleFree(Tcl_Obj *obj)\r
 205 {\r
 206   MysqlTclHandle *handle = (MysqlTclHandle *)obj->internalRep.otherValuePtr;\r
 207   Tcl_Release((char *)handle);\r
 208 }\r
 209 \r
 210 static int GetHandleFromObj(Tcl_Interp *interp,Tcl_Obj *objPtr,MysqlTclHandle **handlePtr)\r
 211 {\r
 212     if (Tcl_ConvertToType(interp, objPtr, &mysqlHandleType) != TCL_OK)\r
 213         return TCL_ERROR;\r
 214     *handlePtr = (MysqlTclHandle *)objPtr->internalRep.otherValuePtr;\r
 215     return TCL_OK;\r
 216 }\r
 217 \r
 218 static Tcl_Obj *Tcl_NewHandleObj(MysqltclState *statePtr,MysqlTclHandle *handle)\r
 219 {\r
 220     register Tcl_Obj *objPtr;\r
 221     char buffer[MYSQL_HPREFIX_LEN+TCL_DOUBLE_SPACE+1];\r
 222     register int len;\r
 223     Tcl_HashEntry *entryPtr;\r
 224     int newflag;\r
 225 \r
 226     objPtr=Tcl_NewObj();\r
 227     /* the string for "query" can not be longer as MysqlHandlePrefix see buf variable */\r
 228     len=sprintf(buffer, "%s%d", (handle->type==HT_QUERY) ? "query" : MysqlHandlePrefix,handle->number);    \r
 229     objPtr->bytes = Tcl_Alloc((unsigned) len + 1);\r
 230     strcpy(objPtr->bytes, buffer);\r
 231     objPtr->length = len;\r
 232     \r
 233     entryPtr=Tcl_CreateHashEntry(&statePtr->hash,buffer,&newflag);\r
 234     Tcl_SetHashValue(entryPtr,handle);     \r
 235   \r
 236     objPtr->internalRep.otherValuePtr = handle;\r
 237     objPtr->typePtr = &mysqlHandleType;\r
 238 \r
 239     Tcl_Preserve((char *)handle);  \r
 240 \r
 241     return objPtr;\r
 242 }\r
 243 \r
 244 \r
 245 \r
 246 \r
 247 /* CONFLICT HANDLING\r
 248  *\r
 249  * Every command begins by calling 'mysql_prologue'.\r
 250  * This function resets mysqlstatus(code) to zero; the other array elements\r
 251  * retain their previous values.\r
 252  * The function also saves objc/objv in global variables.\r
 253  * After this the command processing proper begins.\r
 254  *\r
 255  * If there is a conflict, the message is taken from one of the following\r
 256  * sources,\r
 257  * -- this code (mysql_prim_confl),\r
 258  * -- the database server (mysql_server_confl),\r
 259  * A complete message is put together from the above plus the name of the\r
 260  * command where the conflict was detected.\r
 261  * The complete message is returned as the Tcl result and is also stored in\r
 262  * mysqlstatus(message).\r
 263  * mysqlstatus(code) is set to "-1" for a primitive conflict or to mysql_errno\r
 264  * for a server conflict\r
 265  * In addition, the whole command where the conflict was detected is put\r
 266  * together from the saved objc/objv and is copied into mysqlstatus(command).\r
 267  */\r
 268 \r
 269 /*\r
 270  *-----------------------------------------------------------\r
 271  * set_statusArr\r
 272  * Help procedure to set Tcl global array with mysqltcl internal\r
 273  * informations\r
 274  */\r
 275 \r
 276 static void set_statusArr(Tcl_Interp *interp,char *elem_name,Tcl_Obj *tobj)\r
 277 {\r
 278   Tcl_SetVar2Ex (interp,MYSQL_STATUS_ARR,elem_name,tobj,TCL_GLOBAL_ONLY); \r
 279 }\r
 280 \r
 281 /*\r
 282  *----------------------------------------------------------------------\r
 283  * clear_msg\r
 284  *\r
 285  * Clears all error and message elements in the global array variable.\r
 286  *\r
 287  */\r
 288 \r
 289 static void\r
 290 clear_msg(Tcl_Interp *interp)\r
 291 {\r
 292   set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(0));\r
 293   set_statusArr(interp,MYSQL_STATUS_CMD,Tcl_NewObj());\r
 294   set_statusArr(interp,MYSQL_STATUS_MSG,Tcl_NewObj());\r
 295 }\r
 296 \r
 297 /*\r
 298  *----------------------------------------------------------------------\r
 299  * mysql_reassemble\r
 300  * Reassembles the current command from the saved objv; copies it into\r
 301  * mysqlstatus(command).\r
 302  */\r
 303 \r
 304 static void mysql_reassemble(Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[])\r
 305 {\r
 306    set_statusArr(interp,MYSQL_STATUS_CMD,Tcl_NewListObj(objc, objv));\r
 307 }\r
 308 \r
 309 /*\r
 310  * free result from handle and consume left result of multresult statement \r
 311  */\r
 312 static void freeResult(MysqlTclHandle *handle)\r
 313 {\r
 314         MYSQL_RES* result;\r
 315         if (handle->result != NULL) {\r
 316                 mysql_free_result(handle->result);\r
 317                 handle->result = NULL ;\r
 318         }\r
 319 #if (MYSQL_VERSION_ID >= 50000)\r
 320         while (!mysql_next_result(handle->connection)) {\r
 321                 result = mysql_store_result(handle->connection);\r
 322                 if (result) {\r
 323                         mysql_free_result(result);\r
 324                 }\r
 325         }\r
 326 #endif\r
 327 }\r
 328 \r
 329 /*\r
 330  *----------------------------------------------------------------------\r
 331  * mysql_prim_confl\r
 332  * Conflict handling after a primitive conflict.\r
 333  *\r
 334  */\r
 335 \r
 336 static int mysql_prim_confl(Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[],char *msg)\r
 337 {\r
 338   set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(-1));\r
 339 \r
 340   Tcl_ResetResult(interp) ;\r
 341   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),\r
 342                           Tcl_GetString(objv[0]), ": ", msg, (char*)NULL);\r
 343 \r
 344   set_statusArr(interp,MYSQL_STATUS_MSG,Tcl_GetObjResult(interp));\r
 345 \r
 346   mysql_reassemble(interp,objc,objv) ;\r
 347   return TCL_ERROR ;\r
 348 }\r
 349 \r
 350 \r
 351 /*\r
 352  *----------------------------------------------------------------------\r
 353  * mysql_server_confl\r
 354  * Conflict handling after an mySQL conflict.\r
 355  * If error it set error message and return TCL_ERROR\r
 356  * If no error occurs it returns TCL_OK\r
 357  */\r
 358 \r
 359 static int mysql_server_confl(Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[],MYSQL * connection)\r
 360 {\r
 361   const char* mysql_errorMsg;\r
 362   if (mysql_errno(connection)) {\r
 363     mysql_errorMsg = mysql_error(connection);\r
 364 \r
 365     set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(mysql_errno(connection)));\r
 366 \r
 367 \r
 368     Tcl_ResetResult(interp) ;\r
 369     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),\r
 370                           Tcl_GetString(objv[0]), "/db server: ",\r
 371                           (mysql_errorMsg == NULL) ? "" : mysql_errorMsg,\r
 372                           (char*)NULL) ;\r
 373 \r
 374     set_statusArr(interp,MYSQL_STATUS_MSG,Tcl_GetObjResult(interp));\r
 375 \r
 376     mysql_reassemble(interp,objc,objv);\r
 377     return TCL_ERROR;\r
 378   } else {\r
 379     return TCL_OK;\r
 380   }\r
 381 }\r
 382 \r
 383 static  MysqlTclHandle *get_handle(Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[],int check_level) \r
 384 {\r
 385   MysqlTclHandle *handle;\r
 386   if (GetHandleFromObj(interp, objv[1], &handle) != TCL_OK) {\r
 387     mysql_prim_confl(interp,objc,objv,"not mysqltcl handle") ;\r
 388     return NULL;\r
 389   }\r
 390   if (check_level==CL_PLAIN) return handle;\r
 391   if (handle->connection == 0) {\r
 392       mysql_prim_confl(interp,objc,objv,"handle already closed (dangling pointer)") ;\r
 393       return NULL;\r
 394   }\r
 395   if (check_level==CL_CONN) return handle;\r
 396   if (check_level!=CL_RES) {\r
 397     if (handle->database[0] == '\0') {\r
 398       mysql_prim_confl(interp,objc,objv,"no current database") ;\r
 399       return NULL;\r
 400     }\r
 401     if (check_level==CL_DB) return handle;\r
 402   }\r
 403   if (handle->result == NULL) {\r
 404       mysql_prim_confl(interp,objc,objv,"no result pending") ;\r
 405       return NULL;\r
 406   }\r
 407   return handle;\r
 408 }\r
 409 \r
 410 /*----------------------------------------------------------------------\r
 411 \r
 412  * mysql_QueryTclObj\r
 413  * This to method control how tcl data is transfered to mysql and\r
 414  * how data is imported into tcl from mysql\r
 415  * Return value : Zero on success, Non-zero if an error occurred.\r
 416  */\r
 417 static int mysql_QueryTclObj(MysqlTclHandle *handle,Tcl_Obj *obj)\r
 418 {\r
 419   char *query;\r
 420   int result,queryLen;\r
 421 \r
 422   Tcl_DString queryDS;\r
 423 \r
 424   query=Tcl_GetStringFromObj(obj, &queryLen);\r
 425 \r
 426 \r
 427   if (handle->encoding==NULL) {\r
 428     query = (char *) Tcl_GetByteArrayFromObj(obj, &queryLen);\r
 429     result =  mysql_real_query(handle->connection,query,queryLen);\r
 430   } else {\r
 431     Tcl_UtfToExternalDString(handle->encoding, query, -1, &queryDS);\r
 432     queryLen = Tcl_DStringLength(&queryDS); \r
 433     result =  mysql_real_query(handle->connection,Tcl_DStringValue(&queryDS),queryLen);\r
 434     Tcl_DStringFree(&queryDS);\r
 435   }\r
 436   return result;\r
 437 } \r
 438 static Tcl_Obj *getRowCellAsObject(MysqltclState *mysqltclState,MysqlTclHandle *handle,MYSQL_ROW row,int length) \r
 439 {\r
 440   Tcl_Obj *obj;\r
 441   Tcl_DString ds;\r
 442 \r
 443   if (*row) {\r
 444     if (handle->encoding!=NULL) {\r
 445       Tcl_ExternalToUtfDString(handle->encoding, *row, length, &ds);\r
 446       obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));\r
 447       Tcl_DStringFree(&ds);\r
 448     } else {\r
 449       obj = Tcl_NewByteArrayObj((unsigned char *)*row,length);\r
 450     }\r
 451   } else {\r
 452     obj = Mysqltcl_NewNullObj(mysqltclState);\r
 453   } \r
 454   return obj;\r
 455 }\r
 456 \r
 457 static MysqlTclHandle *createMysqlHandle(MysqltclState *statePtr) \r
 458 {\r
 459   MysqlTclHandle *handle;\r
 460   handle=(MysqlTclHandle *)Tcl_Alloc(sizeof(MysqlTclHandle));\r
 461   memset(handle,0,sizeof(MysqlTclHandle));\r
 462   if (handle == 0) {\r
 463     panic("no memory for handle");\r
 464     return handle;\r
 465   }\r
 466   handle->type = HT_CONNECTION;\r
 467 \r
 468   /* MT-safe, because every thread in tcl has own interpreter */\r
 469   handle->number=statePtr->handleNum++;\r
 470   return handle;\r
 471 }\r
 472 \r
 473 static MysqlTclHandle *createHandleFrom(MysqltclState *statePtr,MysqlTclHandle *handle,enum MysqlHandleType handleType)\r
 474 {\r
 475   int number;\r
 476   MysqlTclHandle *qhandle;\r
 477   qhandle = createMysqlHandle(statePtr);\r
 478   /* do not overwrite the number */\r
 479   number = qhandle->number;\r
 480   if (!qhandle) return qhandle;\r
 481   memcpy(qhandle,handle,sizeof(MysqlTclHandle));\r
 482   qhandle->type=handleType;\r
 483   qhandle->number=number;\r
 484   return qhandle;\r
 485 }\r
 486 static void closeHandle(MysqlTclHandle *handle)\r
 487 {\r
 488   freeResult(handle);\r
 489   if (handle->type==HT_CONNECTION) {\r
 490     mysql_close(handle->connection);\r
 491   }\r
 492 #ifdef PREPARED_STATEMENT\r
 493   if (handle->type==HT_STATEMENT) {\r
 494     if (handle->statement!=NULL)\r
 495             mysql_stmt_close(handle->statement);\r
 496         if (handle->bindResult!=NULL)\r
 497                 Tcl_Free((char *)handle->bindResult);\r
 498     if (handle->bindParam!=NULL)\r
 499         Tcl_Free((char *)handle->bindParam);\r
 500     if (handle->resultMetadata!=NULL)\r
 501             mysql_free_result(handle->resultMetadata);\r
 502     if (handle->paramMetadata!=NULL)\r
 503             mysql_free_result(handle->paramMetadata);\r
 504   }\r
 505 #endif\r
 506   handle->connection = (MYSQL *)NULL;\r
 507   if (handle->encoding!=NULL && handle->type==HT_CONNECTION)\r
 508   {\r
 509     Tcl_FreeEncoding(handle->encoding);\r
 510     handle->encoding = NULL;\r
 511   }\r
 512   Tcl_EventuallyFree((char *)handle,TCL_DYNAMIC);\r
 513 }\r
 514 \r
 515 /*\r
 516  *----------------------------------------------------------------------\r
 517  * mysql_prologue\r
 518  *\r
 519  * Does most of standard command prologue; required for all commands\r
 520  * having conflict handling.\r
 521  * 'req_min_args' must be the minimum number of arguments for the command,\r
 522  * including the command word.\r
 523  * 'req_max_args' must be the maximum number of arguments for the command,\r
 524  * including the command word.\r
 525  * 'usage_msg' must be a usage message, leaving out the command name.\r
 526  * Checks the handle assumed to be present in objv[1] if 'check' is not NULL.\r
 527  * RETURNS: Handle index or -1 on failure.\r
 528  * SIDE EFFECT: Sets the Tcl result on failure.\r
 529  */\r
 530 \r
 531 static MysqlTclHandle *mysql_prologue(Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[],int req_min_args,int req_max_args,int check_level,char *usage_msg)\r
 532 {\r
 533   /* Check number of args. */\r
 534   if (objc < req_min_args || objc > req_max_args) {\r
 535       Tcl_WrongNumArgs(interp, 1, objv, usage_msg);\r
 536       return NULL;\r
 537   }\r
 538 \r
 539   /* Reset mysqlstatus(code). */\r
 540   set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(0));\r
 541 \r
 542   /* Check the handle.\r
 543    * The function is assumed to set the status array on conflict.\r
 544    */\r
 545   return (get_handle(interp,objc,objv,check_level));\r
 546 }\r
 547 \r
 548 /*\r
 549  *----------------------------------------------------------------------\r
 550  * mysql_colinfo\r
 551  *\r
 552  * Given an MYSQL_FIELD struct and a string keyword appends a piece of\r
 553  * column info (one item) to the Tcl result.\r
 554  * ASSUMES 'fld' is non-null.\r
 555  * RETURNS 0 on success, 1 otherwise.\r
 556  * SIDE EFFECT: Sets the result and status on failure.\r
 557  */\r
 558 \r
 559 static Tcl_Obj *mysql_colinfo(Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[],MYSQL_FIELD* fld,Tcl_Obj * keyw)\r
 560 {\r
 561   int idx ;\r
 562 \r
 563   static CONST char* MysqlColkey[] =\r
 564     {\r
 565       "table", "name", "type", "length", "prim_key", "non_null", "numeric", "decimals", NULL\r
 566     };\r
 567   enum coloptions {\r
 568     MYSQL_COL_TABLE_K, MYSQL_COL_NAME_K, MYSQL_COL_TYPE_K, MYSQL_COL_LENGTH_K, \r
 569     MYSQL_COL_PRIMKEY_K, MYSQL_COL_NONNULL_K, MYSQL_COL_NUMERIC_K, MYSQL_COL_DECIMALS_K};\r
 570 \r
 571   if (Tcl_GetIndexFromObj(interp, keyw, MysqlColkey, "option",\r
 572                           TCL_EXACT, &idx) != TCL_OK)\r
 573     return NULL;\r
 574 \r
 575   switch (idx)\r
 576     {\r
 577     case MYSQL_COL_TABLE_K:\r
 578       return Tcl_NewStringObj(fld->table, -1) ;\r
 579     case MYSQL_COL_NAME_K:\r
 580       return Tcl_NewStringObj(fld->name, -1) ;\r
 581     case MYSQL_COL_TYPE_K:\r
 582       switch (fld->type)\r
 583         {\r
 584 \r
 585 \r
 586         case FIELD_TYPE_DECIMAL:\r
 587           return Tcl_NewStringObj("decimal", -1);\r
 588         case FIELD_TYPE_TINY:\r
 589           return Tcl_NewStringObj("tiny", -1);\r
 590         case FIELD_TYPE_SHORT:\r
 591           return Tcl_NewStringObj("short", -1);\r
 592         case FIELD_TYPE_LONG:\r
 593           return Tcl_NewStringObj("long", -1) ;\r
 594         case FIELD_TYPE_FLOAT:\r
 595           return Tcl_NewStringObj("float", -1);\r
 596         case FIELD_TYPE_DOUBLE:\r
 597           return Tcl_NewStringObj("double", -1);\r
 598         case FIELD_TYPE_NULL:\r
 599           return Tcl_NewStringObj("null", -1);\r
 600         case FIELD_TYPE_TIMESTAMP:\r
 601           return Tcl_NewStringObj("timestamp", -1);\r
 602         case FIELD_TYPE_LONGLONG:\r
 603           return Tcl_NewStringObj("long long", -1);\r
 604         case FIELD_TYPE_INT24:\r
 605           return Tcl_NewStringObj("int24", -1);\r
 606         case FIELD_TYPE_DATE:\r
 607           return Tcl_NewStringObj("date", -1);\r
 608         case FIELD_TYPE_TIME:\r
 609           return Tcl_NewStringObj("time", -1);\r
 610         case FIELD_TYPE_DATETIME:\r
 611           return Tcl_NewStringObj("date time", -1);\r
 612         case FIELD_TYPE_YEAR:\r
 613           return Tcl_NewStringObj("year", -1);\r
 614         case FIELD_TYPE_NEWDATE:\r
 615           return Tcl_NewStringObj("new date", -1);\r
 616         case FIELD_TYPE_ENUM:\r
 617           return Tcl_NewStringObj("enum", -1); \r
 618         case FIELD_TYPE_SET:\r
 619           return Tcl_NewStringObj("set", -1);\r
 620         case FIELD_TYPE_TINY_BLOB:\r
 621           return Tcl_NewStringObj("tiny blob", -1);\r
 622         case FIELD_TYPE_MEDIUM_BLOB:\r
 623           return Tcl_NewStringObj("medium blob", -1);\r
 624         case FIELD_TYPE_LONG_BLOB:\r
 625           return Tcl_NewStringObj("long blob", -1);\r
 626         case FIELD_TYPE_BLOB:\r
 627           return Tcl_NewStringObj("blob", -1);\r
 628         case FIELD_TYPE_VAR_STRING:\r
 629           return Tcl_NewStringObj("var string", -1);\r
 630         case FIELD_TYPE_STRING:\r
 631           return Tcl_NewStringObj("string", -1);\r
 632 #if MYSQL_VERSION_ID >= 50000\r
 633         case MYSQL_TYPE_NEWDECIMAL:\r
 634            return Tcl_NewStringObj("newdecimal", -1);\r
 635         case MYSQL_TYPE_GEOMETRY:\r
 636            return Tcl_NewStringObj("geometry", -1);\r
 637         case MYSQL_TYPE_BIT:\r
 638            return Tcl_NewStringObj("bit", -1);\r
 639 #endif\r
 640         default:\r
 641           return Tcl_NewStringObj("unknown", -1);\r
 642         }\r
 643       break ;\r
 644     case MYSQL_COL_LENGTH_K:\r
 645       return Tcl_NewIntObj(fld->length) ;\r
 646     case MYSQL_COL_PRIMKEY_K:\r
 647       return Tcl_NewBooleanObj(IS_PRI_KEY(fld->flags));\r
 648     case MYSQL_COL_NONNULL_K:\r
 649       return Tcl_NewBooleanObj(IS_NOT_NULL(fld->flags));\r
 650     case MYSQL_COL_NUMERIC_K:\r
 651       return Tcl_NewBooleanObj(IS_NUM(fld->type));\r
 652     case MYSQL_COL_DECIMALS_K:\r
 653       return IS_NUM(fld->type)? Tcl_NewIntObj(fld->decimals): Tcl_NewIntObj(-1);\r
 654     default: /* should never happen */\r
 655       mysql_prim_confl(interp,objc,objv,"weirdness in mysql_colinfo");\r
 656       return NULL ;\r
 657     }\r
 658 }\r
 659 \r
 660 /*\r
 661  * Mysqltcl_CloseAll\r
 662  * Close all connections.\r
 663  */\r
 664 \r
 665 static void Mysqltcl_CloseAll(ClientData clientData)\r
 666 {\r
 667   MysqltclState *statePtr = (MysqltclState *)clientData; \r
 668   Tcl_HashSearch search;\r
 669   MysqlTclHandle *handle;\r
 670   Tcl_HashEntry *entryPtr; \r
 671   int wasdeleted=0;\r
 672 \r
 673   for (entryPtr=Tcl_FirstHashEntry(&statePtr->hash,&search); \r
 674        entryPtr!=NULL;\r
 675        entryPtr=Tcl_NextHashEntry(&search)) {\r
 676     wasdeleted=1;\r
 677     handle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);\r
 678 \r
 679     if (handle->connection == 0) continue;\r
 680     closeHandle(handle);\r
 681   }\r
 682   if (wasdeleted) {\r
 683     Tcl_DeleteHashTable(&statePtr->hash);\r
 684     Tcl_InitHashTable(&statePtr->hash, TCL_STRING_KEYS);\r
 685   }\r
 686 }\r
 687 /*\r
 688  * Invoked from Interpreter by removing mysqltcl command\r
 689 \r
 690  * Warnign: This procedure can be called only once\r
 691  */\r
 692 static void Mysqltcl_Kill(ClientData clientData) \r
 693 { \r
 694    MysqltclState *statePtr = (MysqltclState *)clientData; \r
 695    Tcl_HashEntry *entryPtr; \r
 696    MysqlTclHandle *handle;\r
 697    Tcl_HashSearch search; \r
 698 \r
 699    for (entryPtr=Tcl_FirstHashEntry(&statePtr->hash,&search); \r
 700        entryPtr!=NULL;\r
 701        entryPtr=Tcl_NextHashEntry(&search)) {\r
 702      handle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);\r
 703      if (handle->connection == 0) continue;\r
 704      closeHandle(handle);\r
 705    } \r
 706    Tcl_Free(statePtr->MysqlNullvalue);\r
 707    Tcl_Free((char *)statePtr); \r
 708 }\r
 709 \r
 710 /*\r
 711  *----------------------------------------------------------------------\r
 712  *\r
 713  * Mysqltcl_Connect\r
 714  * Implements the mysqlconnect command:\r
 715  * usage: mysqlconnect ?option value ...?\r
 716  *                      \r
 717  * Results:\r
 718  *      handle - a character string of newly open handle\r
 719  *      TCL_OK - connect successful\r
 720  *      TCL_ERROR - connect not successful - error message returned\r
 721  */\r
 722 \r
 723 static CONST char* MysqlConnectOpt[] =\r
 724     {\r
 725       "-host", "-user", "-password", "-db", "-port", "-socket","-encoding",\r
 726       "-ssl", "-compress", "-noschema","-odbc",\r
 727 #if (MYSQL_VERSION_ID >= 40107)\r
 728       "-multistatement","-multiresult",\r
 729 #endif\r
 730       "-localfiles","-ignorespace","-foundrows","-interactive","-sslkey","-sslcert",\r
 731       "-sslca","-sslcapath","-sslciphers","-reconnect", NULL\r
 732     };\r
 733 \r
 734 static int Mysqltcl_Connect(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
 735 {\r
 736   MysqltclState *statePtr = (MysqltclState *)clientData; \r
 737   int        i, idx;\r
 738   int        mysql_options_reconnect = 0;\r
 739   char *hostname = NULL;\r
 740   char *user = NULL;\r
 741   char *password = NULL;\r
 742   char *db = NULL;\r
 743   int port = 0, flags = 0, booleanflag;\r
 744   char *socket = NULL;\r
 745   char *encodingname = NULL;\r
 746 \r
 747 #if (MYSQL_VERSION_ID >= 40107)\r
 748   int isSSL = 0;\r
 749 #endif\r
 750   char *sslkey = NULL;\r
 751   char *sslcert = NULL;\r
 752   char *sslca = NULL;\r
 753   char *sslcapath = NULL;\r
 754   char *sslcipher = NULL;\r
 755   \r
 756   MysqlTclHandle *handle;\r
 757   const char *groupname = "mysqltcl";\r
 758 \r
 759   \r
 760   enum connectoption {\r
 761     MYSQL_CONNHOST_OPT, MYSQL_CONNUSER_OPT, MYSQL_CONNPASSWORD_OPT, \r
 762     MYSQL_CONNDB_OPT, MYSQL_CONNPORT_OPT, MYSQL_CONNSOCKET_OPT, MYSQL_CONNENCODING_OPT,\r
 763     MYSQL_CONNSSL_OPT, MYSQL_CONNCOMPRESS_OPT, MYSQL_CONNNOSCHEMA_OPT, MYSQL_CONNODBC_OPT,\r
 764 #if (MYSQL_VERSION_ID >= 40107)\r
 765     MYSQL_MULTISTATEMENT_OPT,MYSQL_MULTIRESULT_OPT,\r
 766 #endif\r
 767     MYSQL_LOCALFILES_OPT,MYSQL_IGNORESPACE_OPT,\r
 768     MYSQL_FOUNDROWS_OPT,MYSQL_INTERACTIVE_OPT,MYSQL_SSLKEY_OPT,MYSQL_SSLCERT_OPT,\r
 769     MYSQL_SSLCA_OPT,MYSQL_SSLCAPATH_OPT,MYSQL_SSLCIPHERS_OPT, MYSQL_RECONNECT_OPT\r
 770   };\r
 771 \r
 772   if (!(objc & 1) || \r
 773     objc>(sizeof(MysqlConnectOpt)/sizeof(MysqlConnectOpt[0]-1)*2+1)) {\r
 774     Tcl_WrongNumArgs(interp, 1, objv, "[-user xxx] [-db mysql] [-port 3306] [-host localhost] [-socket sock] [-password pass] [-encoding encoding] [-ssl boolean] [-compress boolean] [-odbc boolean] [-noschema boolean] [-reconnect boolean]"\r
 775     );\r
 776         return TCL_ERROR;\r
 777   }\r
 778               \r
 779   for (i = 1; i < objc; i++) {\r
 780     if (Tcl_GetIndexFromObj(interp, objv[i], MysqlConnectOpt, "option",\r
 781                           0, &idx) != TCL_OK)\r
 782       return TCL_ERROR;\r
 783     \r
 784     switch (idx) {\r
 785     case MYSQL_CONNHOST_OPT:\r
 786       hostname = Tcl_GetStringFromObj(objv[++i],NULL);\r
 787       break;\r
 788     case MYSQL_CONNUSER_OPT:\r
 789       user = Tcl_GetStringFromObj(objv[++i],NULL);\r
 790       break;\r
 791     case MYSQL_CONNPASSWORD_OPT:\r
 792       password = Tcl_GetStringFromObj(objv[++i],NULL);\r
 793       break;\r
 794     case MYSQL_CONNDB_OPT:\r
 795       db = Tcl_GetStringFromObj(objv[++i],NULL);\r
 796       break;\r
 797     case MYSQL_CONNPORT_OPT:\r
 798       if (Tcl_GetIntFromObj(interp, objv[++i], &port) != TCL_OK)\r
 799         return TCL_ERROR;\r
 800       break;\r
 801     case MYSQL_CONNSOCKET_OPT:\r
 802       socket = Tcl_GetStringFromObj(objv[++i],NULL);\r
 803       break;\r
 804     case MYSQL_CONNENCODING_OPT:\r
 805       encodingname = Tcl_GetStringFromObj(objv[++i],NULL);\r
 806       break;\r
 807     case MYSQL_CONNSSL_OPT:\r
 808 #if (MYSQL_VERSION_ID >= 40107)\r
 809       if (Tcl_GetBooleanFromObj(interp,objv[++i],&isSSL) != TCL_OK )\r
 810         return TCL_ERROR;\r
 811 #else\r
 812       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 813         return TCL_ERROR;\r
 814       if (booleanflag)\r
 815         flags |= CLIENT_SSL;\r
 816 #endif\r
 817       break;\r
 818     case MYSQL_CONNCOMPRESS_OPT:\r
 819       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 820         return TCL_ERROR;\r
 821       if (booleanflag)\r
 822         flags |= CLIENT_COMPRESS;\r
 823       break;\r
 824     case MYSQL_CONNNOSCHEMA_OPT: \r
 825       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 826         return TCL_ERROR;\r
 827       if (booleanflag)\r
 828         flags |= CLIENT_NO_SCHEMA;\r
 829       break;\r
 830     case MYSQL_CONNODBC_OPT:\r
 831       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 832         return TCL_ERROR;\r
 833       if (booleanflag)\r
 834         flags |= CLIENT_ODBC;\r
 835       break;\r
 836 #if (MYSQL_VERSION_ID >= 40107)\r
 837     case MYSQL_MULTISTATEMENT_OPT:\r
 838       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 839         return TCL_ERROR;\r
 840       if (booleanflag)\r
 841         flags |= CLIENT_MULTI_STATEMENTS;\r
 842       break;\r
 843     case MYSQL_MULTIRESULT_OPT:\r
 844       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 845         return TCL_ERROR;\r
 846       if (booleanflag)\r
 847         flags |= CLIENT_MULTI_RESULTS;\r
 848       break;\r
 849 #endif\r
 850     case MYSQL_LOCALFILES_OPT:\r
 851       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 852         return TCL_ERROR;\r
 853       if (booleanflag)\r
 854         flags |= CLIENT_LOCAL_FILES;\r
 855       break;\r
 856     case MYSQL_IGNORESPACE_OPT:\r
 857       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 858         return TCL_ERROR;\r
 859       if (booleanflag)\r
 860         flags |= CLIENT_IGNORE_SPACE;\r
 861       break;\r
 862     case MYSQL_FOUNDROWS_OPT:\r
 863       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 864         return TCL_ERROR;\r
 865       if (booleanflag)\r
 866         flags |= CLIENT_FOUND_ROWS;\r
 867       break;\r
 868     case MYSQL_INTERACTIVE_OPT:\r
 869       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 870         return TCL_ERROR;\r
 871       if (booleanflag)\r
 872         flags |= CLIENT_INTERACTIVE;\r
 873       break;\r
 874     case MYSQL_SSLKEY_OPT:\r
 875       sslkey = Tcl_GetStringFromObj(objv[++i],NULL);\r
 876       break;\r
 877     case MYSQL_SSLCERT_OPT:\r
 878       sslcert = Tcl_GetStringFromObj(objv[++i],NULL);\r
 879       break;\r
 880     case MYSQL_SSLCA_OPT:\r
 881       sslca = Tcl_GetStringFromObj(objv[++i],NULL);\r
 882       break;\r
 883     case MYSQL_SSLCAPATH_OPT:\r
 884       sslcapath = Tcl_GetStringFromObj(objv[++i],NULL);\r
 885       break;\r
 886     case MYSQL_SSLCIPHERS_OPT:\r
 887       sslcipher = Tcl_GetStringFromObj(objv[++i],NULL);\r
 888       break;\r
 889     case MYSQL_RECONNECT_OPT:\r
 890       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 891         return TCL_ERROR;\r
 892       if (booleanflag)\r
 893         mysql_options_reconnect = 1;\r
 894       break;\r
 895     default:\r
 896       return mysql_prim_confl(interp,objc,objv,"Weirdness in options");            \r
 897     }\r
 898   }\r
 899 \r
 900   handle = createMysqlHandle(statePtr);\r
 901 \r
 902   if (handle == 0) {\r
 903     panic("no memory for handle");\r
 904     return TCL_ERROR;\r
 905 \r
 906   }\r
 907 \r
 908   handle->connection = mysql_init(NULL);\r
 909 \r
 910   /* the function below caused in version pre 3.23.50 segmentation fault */\r
 911 #if (MYSQL_VERSION_ID>=32350)\r
 912   if(mysql_options_reconnect)\r
 913   {\r
 914       my_bool reconnect = 1;\r
 915       mysql_options(handle->connection, MYSQL_OPT_RECONNECT, &reconnect);\r
 916   }\r
 917   mysql_options(handle->connection,MYSQL_READ_DEFAULT_GROUP,groupname);\r
 918 #endif\r
 919 #if (MYSQL_VERSION_ID >= 40107)\r
 920   if (isSSL) {\r
 921       mysql_ssl_set(handle->connection,sslkey,sslcert, sslca, sslcapath, sslcipher);\r
 922   }\r
 923 #endif\r
 924 \r
 925   if (!mysql_real_connect(handle->connection, hostname, user,\r
 926                                 password, db, port, socket, flags)) {\r
 927       mysql_server_confl(interp,objc,objv,handle->connection);\r
 928       closeHandle(handle);\r
 929       return TCL_ERROR;\r
 930   }\r
 931 \r
 932   if (db) {\r
 933     strncpy(handle->database, db, MYSQL_NAME_LEN) ;\r
 934     handle->database[MYSQL_NAME_LEN - 1] = '\0' ;\r
 935   }\r
 936 \r
 937   if (encodingname==NULL || (encodingname!=NULL &&  strcmp(encodingname, "binary") != 0)) {\r
 938     if (encodingname==NULL)\r
 939       encodingname = (char *)Tcl_GetEncodingName(NULL);\r
 940     handle->encoding = Tcl_GetEncoding(interp, encodingname);\r
 941     if (handle->encoding == NULL)\r
 942       return TCL_ERROR;\r
 943   }\r
 944 \r
 945   Tcl_SetObjResult(interp, Tcl_NewHandleObj(statePtr,handle));\r
 946 \r
 947   return TCL_OK;\r
 948 \r
 949 }\r
 950 \r
 951 \r
 952 /*\r
 953  *----------------------------------------------------------------------\r
 954  *\r
 955  * Mysqltcl_Use\r
 956  *    Implements the mysqluse command:\r
 957 \r
 958  *    usage: mysqluse handle dbname\r
 959  *                      \r
 960  *    results:\r
 961  *      Sets current database to dbname.\r
 962  */\r
 963 \r
 964 static int Mysqltcl_Use(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
 965 {\r
 966   int len;\r
 967   char *db;\r
 968   MysqlTclHandle *handle;  \r
 969 \r
 970   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
 971                             "handle dbname")) == 0)\r
 972     return TCL_ERROR;\r
 973 \r
 974   db=Tcl_GetStringFromObj(objv[2], &len);\r
 975   if (len >= MYSQL_NAME_LEN) {\r
 976      mysql_prim_confl(interp,objc,objv,"database name too long");\r
 977      return TCL_ERROR;\r
 978   }\r
 979 \r
 980   if (mysql_select_db(handle->connection, db)!=0) {\r
 981     return mysql_server_confl(interp,objc,objv,handle->connection);\r
 982   }\r
 983   strcpy(handle->database, db);\r
 984   return TCL_OK;\r
 985 }\r
 986 \r
 987 \r
 988 \r
 989 /*\r
 990  *----------------------------------------------------------------------\r
 991  *\r
 992  * Mysqltcl_Escape\r
 993  *    Implements the mysqlescape command:\r
 994  *    usage: mysqlescape string\r
 995  *                      \r
 996  *    results:\r
 997  *      Escaped string for use in queries.\r
 998  */\r
 999 \r
1000 static int Mysqltcl_Escape(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1001 {\r
1002   int len;\r
1003   char *inString, *outString;\r
1004   MysqlTclHandle *handle;\r
1005   \r
1006   if (objc <2 || objc>3) {\r
1007       Tcl_WrongNumArgs(interp, 1, objv, "?handle? string");\r
1008       return TCL_ERROR;\r
1009   }\r
1010   if (objc==2) {\r
1011     inString=Tcl_GetStringFromObj(objv[1], &len);\r
1012     outString=Tcl_Alloc((len<<1) + 1);\r
1013     len=mysql_escape_string(outString, inString, len);\r
1014     Tcl_SetStringObj(Tcl_GetObjResult(interp), outString, len);\r
1015     Tcl_Free(outString);\r
1016   } else { \r
1017     if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
1018                             "handle string")) == 0)\r
1019       return TCL_ERROR;\r
1020     inString=Tcl_GetStringFromObj(objv[2], &len);\r
1021     outString=Tcl_Alloc((len<<1) + 1);\r
1022     len=mysql_real_escape_string(handle->connection, outString, inString, len);\r
1023     Tcl_SetStringObj(Tcl_GetObjResult(interp), outString, len);\r
1024     Tcl_Free(outString);\r
1025   }\r
1026   return TCL_OK;\r
1027 }\r
1028 \r
1029 \r
1030 \r
1031 /*\r
1032  *----------------------------------------------------------------------\r
1033  *\r
1034  * Mysqltcl_Sel\r
1035  *    Implements the mysqlsel command:\r
1036  *    usage: mysqlsel handle sel-query ?-list|-flatlist?\r
1037  *                      \r
1038  *    results:\r
1039  *\r
1040  *    SIDE EFFECT: Flushes any pending result, even in case of conflict.\r
1041  *    Stores new results.\r
1042  */\r
1043 \r
1044 static int Mysqltcl_Sel(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1045 {\r
1046   MysqltclState *statePtr = (MysqltclState *)clientData; \r
1047   Tcl_Obj *res, *resList;\r
1048   MYSQL_ROW row;\r
1049   MysqlTclHandle *handle;\r
1050   unsigned long *lengths;\r
1051 \r
1052 \r
1053   static CONST char* selOptions[] = {"-list", "-flatlist", NULL};\r
1054   /* Warning !! no option number */\r
1055   int i,selOption=2,colCount;\r
1056   \r
1057   if ((handle = mysql_prologue(interp, objc, objv, 3, 4, CL_CONN,\r
1058                             "handle sel-query ?-list|-flatlist?")) == 0)\r
1059     return TCL_ERROR;\r
1060 \r
1061 \r
1062   if (objc==4) {\r
1063     if (Tcl_GetIndexFromObj(interp, objv[3], selOptions, "option",\r
1064                             TCL_EXACT, &selOption) != TCL_OK)\r
1065       return TCL_ERROR;\r
1066   }\r
1067 \r
1068   /* Flush any previous result. */\r
1069   freeResult(handle);\r
1070 \r
1071   if (mysql_QueryTclObj(handle,objv[2])) {\r
1072     return mysql_server_confl(interp,objc,objv,handle->connection);\r
1073   }\r
1074   if (selOption<2) {\r
1075     /* If imadiatly result than do not store result in mysql client library cache */\r
1076     handle->result = mysql_use_result(handle->connection);\r
1077   } else {\r
1078     handle->result = mysql_store_result(handle->connection);\r
1079   }\r
1080   \r
1081   if (handle->result == NULL) {\r
1082     if (selOption==2) Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));\r
1083   } else {\r
1084     colCount = handle->col_count = mysql_num_fields(handle->result);\r
1085     res = Tcl_GetObjResult(interp);\r
1086     handle->res_count = 0;\r
1087     switch (selOption) {\r
1088     case 0: /* -list */\r
1089       while ((row = mysql_fetch_row(handle->result)) != NULL) {\r
1090         resList = Tcl_NewListObj(0, NULL);\r
1091         lengths = mysql_fetch_lengths(handle->result);\r
1092         for (i=0; i< colCount; i++, row++) {\r
1093           Tcl_ListObjAppendElement(interp, resList,getRowCellAsObject(statePtr,handle,row,lengths[i]));\r
1094         }\r
1095         Tcl_ListObjAppendElement(interp, res, resList);\r
1096       }  \r
1097       break;\r
1098     case 1: /* -flatlist */\r
1099       while ((row = mysql_fetch_row(handle->result)) != NULL) {\r
1100         lengths = mysql_fetch_lengths(handle->result);\r
1101         for (i=0; i< colCount; i++, row++) {\r
1102           Tcl_ListObjAppendElement(interp, res,getRowCellAsObject(statePtr,handle,row,lengths[i]));\r
1103         }\r
1104       }  \r
1105       break;\r
1106     case 2: /* No option */\r
1107       handle->res_count = mysql_num_rows(handle->result);\r
1108       Tcl_SetIntObj(res, handle->res_count);\r
1109       break;\r
1110     }\r
1111   }\r
1112   return TCL_OK;\r
1113 }\r
1114 /*\r
1115  * Mysqltcl_Query\r
1116  * Works as mysqltclsel but return an $query handle that allow to build\r
1117  * nested queries on simple handle\r
1118  */\r
1119 \r
1120 static int Mysqltcl_Query(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1121 {\r
1122   MysqltclState *statePtr = (MysqltclState *)clientData; \r
1123   MYSQL_RES *result;\r
1124   MysqlTclHandle *handle, *qhandle;\r
1125   \r
1126   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
1127 \r
1128                             "handle sqlstatement")) == 0)\r
1129     return TCL_ERROR;\r
1130        \r
1131   if (mysql_QueryTclObj(handle,objv[2])) {\r
1132     return mysql_server_confl(interp,objc,objv,handle->connection);\r
1133   }\r
1134 \r
1135   if ((result = mysql_store_result(handle->connection)) == NULL) {\r
1136     Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));\r
1137     return TCL_OK;\r
1138   } \r
1139   if ((qhandle = createHandleFrom(statePtr,handle,HT_QUERY)) == NULL) return TCL_ERROR;\r
1140   qhandle->result = result;\r
1141   qhandle->col_count = mysql_num_fields(qhandle->result) ;\r
1142 \r
1143 \r
1144   qhandle->res_count = mysql_num_rows(qhandle->result);\r
1145   Tcl_SetObjResult(interp, Tcl_NewHandleObj(statePtr,qhandle));\r
1146   return TCL_OK;\r
1147 }\r
1148 \r
1149 /*\r
1150  * Mysqltcl_Enquery\r
1151  * close and free a query handle\r
1152  * if handle is not query than the result will be discarted\r
1153  */\r
1154 \r
1155 static int Mysqltcl_EndQuery(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1156 {\r
1157   MysqltclState *statePtr = (MysqltclState *)clientData; \r
1158   Tcl_HashEntry *entryPtr;\r
1159   MysqlTclHandle *handle;\r
1160   \r
1161   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
1162                             "queryhandle")) == 0)\r
1163     return TCL_ERROR;\r
1164 \r
1165   if (handle->type==HT_QUERY) {\r
1166     entryPtr = Tcl_FindHashEntry(&statePtr->hash,Tcl_GetStringFromObj(objv[1],NULL));\r
1167     if (entryPtr) {\r
1168       Tcl_DeleteHashEntry(entryPtr);\r
1169     }\r
1170     closeHandle(handle);\r
1171   } else {\r
1172       freeResult(handle);\r
1173   }\r
1174   return TCL_OK;\r
1175 }\r
1176 \r
1177 /*\r
1178  *----------------------------------------------------------------------\r
1179  *\r
1180  * Mysqltcl_Exec\r
1181  * Implements the mysqlexec command:\r
1182  * usage: mysqlexec handle sql-statement\r
1183  *                      \r
1184  * Results:\r
1185  * Number of affected rows on INSERT, UPDATE or DELETE, 0 otherwise.\r
1186  *\r
1187  * SIDE EFFECT: Flushes any pending result, even in case of conflict.\r
1188  */\r
1189 \r
1190 \r
1191 \r
1192 static int Mysqltcl_Exec(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1193 {\r
1194         MysqlTclHandle *handle;\r
1195         int affected;\r
1196         Tcl_Obj *resList;\r
1197     if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,"handle sql-statement")) == 0)\r
1198         return TCL_ERROR;\r
1199 \r
1200         /* Flush any previous result. */\r
1201         freeResult(handle);\r
1202 \r
1203         if (mysql_QueryTclObj(handle,objv[2]))\r
1204         return mysql_server_confl(interp,objc,objv,handle->connection);\r
1205 \r
1206         if ((affected=mysql_affected_rows(handle->connection)) < 0) affected=0;\r
1207 \r
1208 #if (MYSQL_VERSION_ID >= 50000)\r
1209         if (!mysql_next_result(handle->connection)) {\r
1210                 resList = Tcl_GetObjResult(interp);\r
1211                 Tcl_ListObjAppendElement(interp, resList, Tcl_NewIntObj(affected));\r
1212                 do {\r
1213                         if ((affected=mysql_affected_rows(handle->connection)) < 0) affected=0;\r
1214                 Tcl_ListObjAppendElement(interp, resList, Tcl_NewIntObj(affected));\r
1215                 } while (!mysql_next_result(handle->connection));\r
1216                 return TCL_OK;\r
1217         }\r
1218 #endif\r
1219         Tcl_SetIntObj(Tcl_GetObjResult(interp),affected);  \r
1220         return TCL_OK ;\r
1221 }\r
1222 \r
1223 \r
1224 \r
1225 /*\r
1226  *----------------------------------------------------------------------\r
1227  *\r
1228  * Mysqltcl_Fetch\r
1229  *    Implements the mysqlnext command:\r
1230 \r
1231  *    usage: mysql::fetch handle\r
1232  *                      \r
1233  *    results:\r
1234  *      next row from pending results as tcl list, or null list.\r
1235  */\r
1236 \r
1237 static int Mysqltcl_Fetch(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1238 {\r
1239   MysqltclState *statePtr = (MysqltclState *)clientData; \r
1240   MysqlTclHandle *handle;\r
1241   int idx ;\r
1242   MYSQL_ROW row ;\r
1243   Tcl_Obj *resList;\r
1244   unsigned long *lengths;\r
1245 \r
1246   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_RES,"handle")) == 0)\r
1247     return TCL_ERROR;\r
1248 \r
1249 \r
1250   if (handle->res_count == 0)\r
1251     return TCL_OK ;\r
1252   else if ((row = mysql_fetch_row(handle->result)) == NULL) {\r
1253     handle->res_count = 0 ;\r
1254     return mysql_prim_confl(interp,objc,objv,"result counter out of sync") ;\r
1255   } else\r
1256     handle->res_count-- ;\r
1257   \r
1258   lengths = mysql_fetch_lengths(handle->result);\r
1259 \r
1260 \r
1261   resList = Tcl_GetObjResult(interp);\r
1262   for (idx = 0 ; idx < handle->col_count ; idx++, row++) {\r
1263     Tcl_ListObjAppendElement(interp, resList,getRowCellAsObject(statePtr,handle,row,lengths[idx]));\r
1264   }\r
1265   return TCL_OK;\r
1266 }\r
1267 \r
1268 \r
1269 /*\r
1270  *----------------------------------------------------------------------\r
1271  *\r
1272  * Mysqltcl_Seek\r
1273  *    Implements the mysqlseek command:\r
1274  *    usage: mysqlseek handle rownumber\r
1275  *                      \r
1276  *    results:\r
1277  *      number of remaining rows\r
1278  */\r
1279 \r
1280 static int Mysqltcl_Seek(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1281 {\r
1282     MysqlTclHandle *handle;\r
1283     int row;\r
1284     int total;\r
1285    \r
1286     if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_RES,\r
1287                               " handle row-index")) == 0)\r
1288       return TCL_ERROR;\r
1289 \r
1290     if (Tcl_GetIntFromObj(interp, objv[2], &row) != TCL_OK)\r
1291       return TCL_ERROR;\r
1292     \r
1293     total = mysql_num_rows(handle->result);\r
1294     \r
1295     if (total + row < 0) {\r
1296       mysql_data_seek(handle->result, 0);\r
1297 \r
1298       handle->res_count = total;\r
1299     } else if (row < 0) {\r
1300       mysql_data_seek(handle->result, total + row);\r
1301       handle->res_count = -row;\r
1302     } else if (row >= total) {\r
1303       mysql_data_seek(handle->result, row);\r
1304       handle->res_count = 0;\r
1305     } else {\r
1306       mysql_data_seek(handle->result, row);\r
1307       handle->res_count = total - row;\r
1308     }\r
1309 \r
1310     Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->res_count)) ;\r
1311     return TCL_OK;\r
1312 }\r
1313 \r
1314 \r
1315 /*\r
1316  *----------------------------------------------------------------------\r
1317  *\r
1318  * Mysqltcl_Map\r
1319  * Implements the mysqlmap command:\r
1320  * usage: mysqlmap handle binding-list script\r
1321  *                      \r
1322  * Results:\r
1323  * SIDE EFFECT: For each row the column values are bound to the variables\r
1324  * in the binding list and the script is evaluated.\r
1325  * The variables are created in the current context.\r
1326  * NOTE: mysqlmap works very much like a 'foreach' construct.\r
1327  * The 'continue' and 'break' commands may be used with their usual effect.\r
1328  */\r
1329 \r
1330 static int Mysqltcl_Map(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1331 {\r
1332   MysqltclState *statePtr = (MysqltclState *)clientData; \r
1333   int code ;\r
1334   int count ;\r
1335 \r
1336   MysqlTclHandle *handle;\r
1337   int idx;\r
1338   int listObjc;\r
1339   Tcl_Obj *tempObj,*varNameObj;\r
1340   MYSQL_ROW row;\r
1341   int *val;\r
1342   unsigned long *lengths;\r
1343   \r
1344   if ((handle = mysql_prologue(interp, objc, objv, 4, 4, CL_RES,\r
1345                             "handle binding-list script")) == 0)\r
1346     return TCL_ERROR;\r
1347 \r
1348   if (Tcl_ListObjLength(interp, objv[2], &listObjc) != TCL_OK)\r
1349         return TCL_ERROR ;\r
1350   \r
1351 \r
1352   if (listObjc > handle->col_count)\r
1353     {\r
1354       return mysql_prim_confl(interp,objc,objv,"too many variables in binding list") ;\r
1355     }\r
1356   else\r
1357     count = (listObjc < handle->col_count)?listObjc\r
1358       :handle->col_count ;\r
1359   \r
1360   val=(int*)Tcl_Alloc((count * sizeof(int)));\r
1361 \r
1362   for (idx=0; idx<count; idx++) {\r
1363     val[idx]=1;\r
1364     if (Tcl_ListObjIndex(interp, objv[2], idx, &varNameObj)!=TCL_OK)\r
1365         return TCL_ERROR;\r
1366     if (Tcl_GetStringFromObj(varNameObj,0)[0] != '-')\r
1367         val[idx]=1;\r
1368     else\r
1369         val[idx]=0;\r
1370   }\r
1371   \r
1372   while (handle->res_count > 0) {\r
1373     /* Get next row, decrement row counter. */\r
1374     if ((row = mysql_fetch_row(handle->result)) == NULL) {\r
1375       handle->res_count = 0 ;\r
1376       Tcl_Free((char *)val);\r
1377       return mysql_prim_confl(interp,objc,objv,"result counter out of sync") ;\r
1378     } else\r
1379       handle->res_count-- ;\r
1380       \r
1381     /* Bind variables to column values. */\r
1382     for (idx = 0; idx < count; idx++, row++) {\r
1383       lengths = mysql_fetch_lengths(handle->result);\r
1384       if (val[idx]) {\r
1385         tempObj = getRowCellAsObject(statePtr,handle,row,lengths[idx]);\r
1386         if (Tcl_ListObjIndex(interp, objv[2], idx, &varNameObj) != TCL_OK)\r
1387             goto error;\r
1388         if (Tcl_ObjSetVar2 (interp,varNameObj,NULL,tempObj,0) == NULL)\r
1389             goto error;\r
1390       }\r
1391     }\r
1392 \r
1393     /* Evaluate the script. */\r
1394     switch(code=Tcl_EvalObjEx(interp, objv[3],0)) {\r
1395     case TCL_CONTINUE:\r
1396     case TCL_OK:\r
1397       break ;\r
1398     case TCL_BREAK:\r
1399       Tcl_Free((char *)val);\r
1400       return TCL_OK ;\r
1401     default:\r
1402       Tcl_Free((char *)val);\r
1403       return code ;\r
1404     }\r
1405   }\r
1406   Tcl_Free((char *)val);\r
1407   return TCL_OK ;\r
1408 error:\r
1409   Tcl_Free((char *)val);\r
1410   return TCL_ERROR;    \r
1411 }\r
1412 \r
1413 /*\r
1414  *----------------------------------------------------------------------\r
1415  *\r
1416  * Mysqltcl_Receive\r
1417  * Implements the mysqlmap command:\r
1418  * usage: mysqlmap handle sqlquery binding-list script\r
1419  * \r
1420  * The method use internal mysql_use_result that no cache statment on client but\r
1421  * receive it direct from server \r
1422  *\r
1423  * Results:\r
1424  * SIDE EFFECT: For each row the column values are bound to the variables\r
1425  * in the binding list and the script is evaluated.\r
1426  * The variables are created in the current context.\r
1427  * NOTE: mysqlmap works very much like a 'foreach' construct.\r
1428  * The 'continue' and 'break' commands may be used with their usual effect.\r
1429 \r
1430  */\r
1431 \r
1432 static int Mysqltcl_Receive(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1433 {\r
1434   MysqltclState *statePtr = (MysqltclState *)clientData; \r
1435   int code=0;\r
1436   int count=0;\r
1437 \r
1438   MysqlTclHandle *handle;\r
1439   int idx;\r
1440   int listObjc;\r
1441   Tcl_Obj *tempObj,*varNameObj;\r
1442   MYSQL_ROW row;\r
1443   int *val = NULL;\r
1444   int breakLoop = 0;\r
1445   unsigned long *lengths;\r
1446   \r
1447   \r
1448   if ((handle = mysql_prologue(interp, objc, objv, 5, 5, CL_CONN,\r
1449                             "handle sqlquery binding-list script")) == 0)\r
1450     return TCL_ERROR;\r
1451   \r
1452   if (Tcl_ListObjLength(interp, objv[3], &listObjc) != TCL_OK)\r
1453         return TCL_ERROR;\r
1454   \r
1455   freeResult(handle);\r
1456   \r
1457   if (mysql_QueryTclObj(handle,objv[2])) {\r
1458     return mysql_server_confl(interp,objc,objv,handle->connection);\r
1459   }\r
1460 \r
1461   if ((handle->result = mysql_use_result(handle->connection)) == NULL) {\r
1462     return mysql_server_confl(interp,objc,objv,handle->connection);\r
1463   } else {\r
1464     while ((row = mysql_fetch_row(handle->result))!= NULL) {\r
1465       if (val==NULL) {\r
1466         /* first row compute all data */\r
1467         handle->col_count = mysql_num_fields(handle->result);\r
1468         if (listObjc > handle->col_count) {\r
1469           return mysql_prim_confl(interp,objc,objv,"too many variables in binding list") ;\r
1470         } else {\r
1471           count = (listObjc < handle->col_count)?listObjc:handle->col_count ;\r
1472         }\r
1473         val=(int*)Tcl_Alloc((count * sizeof(int)));\r
1474         for (idx=0; idx<count; idx++) {\r
1475           if (Tcl_ListObjIndex(interp, objv[3], idx, &varNameObj)!=TCL_OK)\r
1476             return TCL_ERROR;\r
1477           if (Tcl_GetStringFromObj(varNameObj,0)[0] != '-')\r
1478             val[idx]=1;\r
1479           else\r
1480             val[idx]=0;\r
1481         }       \r
1482       }\r
1483       for (idx = 0; idx < count; idx++, row++) {\r
1484          lengths = mysql_fetch_lengths(handle->result);\r
1485 \r
1486          if (val[idx]) {\r
1487             if (Tcl_ListObjIndex(interp, objv[3], idx, &varNameObj)!=TCL_OK) {\r
1488                 Tcl_Free((char *)val);\r
1489                 return TCL_ERROR;\r
1490             }\r
1491             tempObj = getRowCellAsObject(statePtr,handle,row,lengths[idx]);\r
1492             if (Tcl_ObjSetVar2 (interp,varNameObj,NULL,tempObj,TCL_LEAVE_ERR_MSG) == NULL) {\r
1493                Tcl_Free((char *)val);\r
1494                return TCL_ERROR ;\r
1495             }\r
1496          }\r
1497       }\r
1498       \r
1499       /* Evaluate the script. */\r
1500       switch(code=Tcl_EvalObjEx(interp, objv[4],0)) {\r
1501       case TCL_CONTINUE:\r
1502       case TCL_OK:\r
1503         break ;\r
1504       case TCL_BREAK:\r
1505         breakLoop=1;\r
1506         break;\r
1507       default:\r
1508         breakLoop=1;\r
1509         break;\r
1510       }\r
1511       if (breakLoop==1) break;\r
1512     }\r
1513   }\r
1514   if (val!=NULL) {\r
1515     Tcl_Free((char *)val);\r
1516   } \r
1517   /*  Read all rest rows that leave in error or break case */\r
1518   while ((row = mysql_fetch_row(handle->result))!= NULL);\r
1519   if (code!=TCL_CONTINUE && code!=TCL_OK && code!=TCL_BREAK) {\r
1520     return code;\r
1521   } else {\r
1522     return mysql_server_confl(interp,objc,objv,handle->connection);\r
1523   } \r
1524 }\r
1525 \r
1526 \r
1527 /*\r
1528  *----------------------------------------------------------------------\r
1529  *\r
1530  * Mysqltcl_Info\r
1531  * Implements the mysqlinfo command:\r
1532  * usage: mysqlinfo handle option\r
1533  *\r
1534 \r
1535 \r
1536  */\r
1537 \r
1538 static int Mysqltcl_Info(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1539 {\r
1540 \r
1541   int count ;\r
1542   MysqlTclHandle *handle;\r
1543   int idx ;\r
1544   MYSQL_RES* list ;\r
1545   MYSQL_ROW row ;\r
1546   const char* val ;\r
1547   Tcl_Obj *resList;\r
1548   static CONST char* MysqlDbOpt[] =\r
1549     {\r
1550       "dbname", "dbname?", "tables", "host", "host?", "databases",\r
1551       "info","serverversion",\r
1552 #if (MYSQL_VERSION_ID >= 40107)\r
1553       "serverversionid","sqlstate",\r
1554 #endif\r
1555       "state",NULL\r
1556     };\r
1557   enum dboption {\r
1558     MYSQL_INFNAME_OPT, MYSQL_INFNAMEQ_OPT, MYSQL_INFTABLES_OPT,\r
1559     MYSQL_INFHOST_OPT, MYSQL_INFHOSTQ_OPT, MYSQL_INFLIST_OPT, MYSQL_INFO,\r
1560     MYSQL_INF_SERVERVERSION,MYSQL_INFO_SERVERVERSION_ID,MYSQL_INFO_SQLSTATE,MYSQL_INFO_STATE\r
1561   };\r
1562   \r
1563   /* We can't fully check the handle at this stage. */\r
1564   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_PLAIN,\r
1565                             "handle option")) == 0)\r
1566     return TCL_ERROR;\r
1567 \r
1568   if (Tcl_GetIndexFromObj(interp, objv[2], MysqlDbOpt, "option",\r
1569                           TCL_EXACT, &idx) != TCL_OK)\r
1570     return TCL_ERROR;\r
1571 \r
1572   /* First check the handle. Checking depends on the option. */\r
1573   switch (idx) {\r
1574   case MYSQL_INFNAMEQ_OPT:\r
1575     if ((handle = get_handle(interp,objc,objv,CL_CONN))!=NULL) {\r
1576       if (handle->database[0] == '\0')\r
1577         return TCL_OK ; /* Return empty string if no current db. */\r
1578     }\r
1579     break ;\r
1580   case MYSQL_INFNAME_OPT:\r
1581   case MYSQL_INFTABLES_OPT:\r
1582   case MYSQL_INFHOST_OPT:\r
1583   case MYSQL_INFLIST_OPT:\r
1584     /* !!! */\r
1585     handle = get_handle(interp,objc,objv,CL_CONN);\r
1586     break;\r
1587   case MYSQL_INFO:\r
1588   case MYSQL_INF_SERVERVERSION:\r
1589 #if (MYSQL_VERSION_ID >= 40107)\r
1590   case MYSQL_INFO_SERVERVERSION_ID:\r
1591   case MYSQL_INFO_SQLSTATE:\r
1592 #endif\r
1593   case MYSQL_INFO_STATE:\r
1594     break;\r
1595 \r
1596   case MYSQL_INFHOSTQ_OPT:\r
1597     if (handle->connection == 0)\r
1598       return TCL_OK ; /* Return empty string if not connected. */\r
1599     break;\r
1600   default: /* should never happen */\r
1601     return mysql_prim_confl(interp,objc,objv,"weirdness in Mysqltcl_Info") ;\r
1602   }\r
1603   \r
1604   if (handle == 0) return TCL_ERROR ;\r
1605 \r
1606   /* Handle OK, return the requested info. */\r
1607   switch (idx) {\r
1608   case MYSQL_INFNAME_OPT:\r
1609   case MYSQL_INFNAMEQ_OPT:\r
1610     Tcl_SetObjResult(interp, Tcl_NewStringObj(handle->database, -1));\r
1611     break ;\r
1612   case MYSQL_INFTABLES_OPT:\r
1613     if ((list = mysql_list_tables(handle->connection,(char*)NULL)) == NULL)\r
1614       return mysql_server_confl(interp,objc,objv,handle->connection);\r
1615     \r
1616     resList = Tcl_GetObjResult(interp);\r
1617     for (count = mysql_num_rows(list); count > 0; count--) {\r
1618       val = *(row = mysql_fetch_row(list)) ;\r
1619       Tcl_ListObjAppendElement(interp, resList, Tcl_NewStringObj((val == NULL)?"":val,-1));\r
1620     }\r
1621     mysql_free_result(list) ;\r
1622     break ;\r
1623   case MYSQL_INFHOST_OPT:\r
1624 \r
1625   case MYSQL_INFHOSTQ_OPT:\r
1626     Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_get_host_info(handle->connection), -1));\r
1627     break ;\r
1628   case MYSQL_INFLIST_OPT:\r
1629     if ((list = mysql_list_dbs(handle->connection,(char*)NULL)) == NULL)\r
1630       return mysql_server_confl(interp,objc,objv,handle->connection);\r
1631     \r
1632     resList = Tcl_GetObjResult(interp);\r
1633     for (count = mysql_num_rows(list); count > 0; count--) {\r
1634       val = *(row = mysql_fetch_row(list)) ;\r
1635       Tcl_ListObjAppendElement(interp, resList,\r
1636                                 Tcl_NewStringObj((val == NULL)?"":val,-1));\r
1637     }\r
1638     mysql_free_result(list) ;\r
1639     break ;\r
1640   case MYSQL_INFO:\r
1641     val = mysql_info(handle->connection);\r
1642     if (val!=NULL) {\r
1643       Tcl_SetObjResult(interp, Tcl_NewStringObj(val,-1));      \r
1644     }\r
1645     break;\r
1646   case MYSQL_INF_SERVERVERSION:\r
1647      Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_get_server_info(handle->connection),-1));\r
1648      break;\r
1649 #if (MYSQL_VERSION_ID >= 40107)\r
1650   case MYSQL_INFO_SERVERVERSION_ID:\r
1651          Tcl_SetObjResult(interp, Tcl_NewIntObj(mysql_get_server_version(handle->connection)));\r
1652          break;\r
1653   case MYSQL_INFO_SQLSTATE:\r
1654      Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_sqlstate(handle->connection),-1));\r
1655      break;\r
1656 #endif\r
1657   case MYSQL_INFO_STATE:\r
1658      Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_stat(handle->connection),-1));\r
1659      break;\r
1660   default: /* should never happen */\r
1661     return mysql_prim_confl(interp,objc,objv,"weirdness in Mysqltcl_Info") ;\r
1662   }\r
1663 \r
1664   return TCL_OK ;\r
1665 }\r
1666 \r
1667 /*\r
1668  *----------------------------------------------------------------------\r
1669  *\r
1670  * Mysqltcl_BaseInfo\r
1671  * Implements the mysqlinfo command:\r
1672  * usage: mysqlbaseinfo option\r
1673  *\r
1674  */\r
1675 \r
1676 static int Mysqltcl_BaseInfo(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1677 {\r
1678   int idx ;\r
1679   Tcl_Obj *resList;\r
1680   char **option;\r
1681   static CONST char* MysqlInfoOpt[] =\r
1682     {\r
1683       "connectparameters", "clientversion",\r
1684 #if (MYSQL_VERSION_ID >= 40107)\r
1685       "clientversionid",\r
1686 #endif\r
1687       NULL\r
1688     };\r
1689   enum baseoption {\r
1690     MYSQL_BINFO_CONNECT, MYSQL_BINFO_CLIENTVERSION,MYSQL_BINFO_CLIENTVERSIONID\r
1691   };\r
1692 \r
1693   if (objc <2) {\r
1694       Tcl_WrongNumArgs(interp, 1, objv, "connectparameters | clientversion");\r
1695 \r
1696       return TCL_ERROR;\r
1697   }  \r
1698   if (Tcl_GetIndexFromObj(interp, objv[1], MysqlInfoOpt, "option",\r
1699                           TCL_EXACT, &idx) != TCL_OK)\r
1700     return TCL_ERROR;\r
1701 \r
1702   /* First check the handle. Checking depends on the option. */\r
1703   switch (idx) {\r
1704   case MYSQL_BINFO_CONNECT:\r
1705     option = (char **)MysqlConnectOpt;\r
1706     resList = Tcl_NewListObj(0, NULL);\r
1707 \r
1708     while (*option!=NULL) {\r
1709       Tcl_ListObjAppendElement(interp, resList, Tcl_NewStringObj(*option,-1));\r
1710       option++;\r
1711     }\r
1712     Tcl_SetObjResult(interp, resList);\r
1713     break ;\r
1714   case MYSQL_BINFO_CLIENTVERSION:\r
1715     Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_get_client_info(),-1));\r
1716     break;\r
1717 #if (MYSQL_VERSION_ID >= 40107)\r
1718   case MYSQL_BINFO_CLIENTVERSIONID:\r
1719     Tcl_SetObjResult(interp, Tcl_NewIntObj(mysql_get_client_version()));\r
1720     break;\r
1721 #endif\r
1722   }\r
1723   return TCL_OK ;\r
1724 }\r
1725 \r
1726 \r
1727 /*\r
1728  *----------------------------------------------------------------------\r
1729  *\r
1730  * Mysqltcl_Result\r
1731 \r
1732  * Implements the mysqlresult command:\r
1733  * usage: mysqlresult handle option\r
1734  *\r
1735  */\r
1736 \r
1737 static int Mysqltcl_Result(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1738 {\r
1739   int idx ;\r
1740   MysqlTclHandle *handle;\r
1741   static CONST char* MysqlResultOpt[] =\r
1742     {\r
1743      "rows", "rows?", "cols", "cols?", "current", "current?", NULL\r
1744     };\r
1745   enum resultoption {\r
1746     MYSQL_RESROWS_OPT, MYSQL_RESROWSQ_OPT, MYSQL_RESCOLS_OPT, \r
1747     MYSQL_RESCOLSQ_OPT, MYSQL_RESCUR_OPT, MYSQL_RESCURQ_OPT\r
1748   };\r
1749   /* We can't fully check the handle at this stage. */\r
1750   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_PLAIN,\r
1751                             " handle option")) == 0)\r
1752 \r
1753     return TCL_ERROR;\r
1754 \r
1755   if (Tcl_GetIndexFromObj(interp, objv[2], MysqlResultOpt, "option",\r
1756                           TCL_EXACT, &idx) != TCL_OK)\r
1757     return TCL_ERROR;\r
1758 \r
1759   /* First check the handle. Checking depends on the option. */\r
1760   switch (idx) {\r
1761   case MYSQL_RESROWS_OPT:\r
1762   case MYSQL_RESCOLS_OPT:\r
1763   case MYSQL_RESCUR_OPT:\r
1764     handle = get_handle(interp,objc,objv,CL_RES) ;\r
1765     break ;\r
1766   case MYSQL_RESROWSQ_OPT:\r
1767   case MYSQL_RESCOLSQ_OPT:\r
1768   case MYSQL_RESCURQ_OPT:\r
1769     if ((handle = get_handle(interp,objc,objv,CL_RES))== NULL)\r
1770       return TCL_OK ; /* Return empty string if no pending result. */\r
1771     break ;\r
1772   default: /* should never happen */\r
1773     return mysql_prim_confl(interp,objc,objv,"weirdness in Mysqltcl_Result") ;\r
1774   }\r
1775   \r
1776   \r
1777   if (handle == 0)\r
1778     return TCL_ERROR ;\r
1779 \r
1780   /* Handle OK; return requested info. */\r
1781   switch (idx) {\r
1782   case MYSQL_RESROWS_OPT:\r
1783   case MYSQL_RESROWSQ_OPT:\r
1784     Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->res_count));\r
1785     break ;\r
1786   case MYSQL_RESCOLS_OPT:\r
1787   case MYSQL_RESCOLSQ_OPT:\r
1788     Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->col_count));\r
1789     break ;\r
1790   case MYSQL_RESCUR_OPT:\r
1791   case MYSQL_RESCURQ_OPT:\r
1792     Tcl_SetObjResult(interp,\r
1793                        Tcl_NewIntObj(mysql_num_rows(handle->result)\r
1794                                      - handle->res_count)) ;\r
1795     break ;\r
1796   default:\r
1797     return mysql_prim_confl(interp,objc,objv,"weirdness in Mysqltcl_Result");\r
1798   }\r
1799   return TCL_OK ;\r
1800 }\r
1801 \r
1802 \r
1803 /*\r
1804  *----------------------------------------------------------------------\r
1805  *\r
1806  * Mysqltcl_Col\r
1807 \r
1808  *    Implements the mysqlcol command:\r
1809  *    usage: mysqlcol handle table-name option ?option ...?\r
1810  *           mysqlcol handle -current option ?option ...?\r
1811  * '-current' can only be used if there is a pending result.\r
1812  *                      \r
1813  *    results:\r
1814  *      List of lists containing column attributes.\r
1815  *      If a single attribute is requested the result is a simple list.\r
1816  *\r
1817  * SIDE EFFECT: '-current' disturbs the field position of the result.\r
1818  */\r
1819 \r
1820 static int Mysqltcl_Col(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1821 {\r
1822   int coln ;\r
1823   int current_db ;\r
1824   MysqlTclHandle *handle;\r
1825   int idx ;\r
1826   int listObjc ;\r
1827   Tcl_Obj **listObjv, *colinfo, *resList, *resSubList;\r
1828   MYSQL_FIELD* fld ;\r
1829   MYSQL_RES* result ;\r
1830   char *argv ;\r
1831   \r
1832   /* This check is enough only without '-current'. */\r
1833   if ((handle = mysql_prologue(interp, objc, objv, 4, 99, CL_CONN,\r
1834                             "handle table-name option ?option ...?")) == 0)\r
1835     return TCL_ERROR;\r
1836 \r
1837   /* Fetch column info.\r
1838    * Two ways: explicit database and table names, or current.\r
1839    */\r
1840   argv=Tcl_GetStringFromObj(objv[2],NULL);\r
1841   current_db = strcmp(argv, "-current") == 0;\r
1842   \r
1843   if (current_db) {\r
1844     if ((handle = get_handle(interp,objc,objv,CL_RES)) == 0)\r
1845       return TCL_ERROR ;\r
1846     else\r
1847       result = handle->result ;\r
1848   } else {\r
1849     if ((result = mysql_list_fields(handle->connection, argv, (char*)NULL)) == NULL) {\r
1850       return mysql_server_confl(interp,objc,objv,handle->connection) ;\r
1851     }\r
1852   }\r
1853   /* Must examine the first specifier at this point. */\r
1854   if (Tcl_ListObjGetElements(interp, objv[3], &listObjc, &listObjv) != TCL_OK)\r
1855     return TCL_ERROR ;\r
1856   resList = Tcl_GetObjResult(interp);\r
1857   if (objc == 4 && listObjc == 1) {\r
1858       mysql_field_seek(result, 0) ;\r
1859       while ((fld = mysql_fetch_field(result)) != NULL)\r
1860         if ((colinfo = mysql_colinfo(interp,objc,objv,fld, objv[3])) != NULL) {\r
1861             Tcl_ListObjAppendElement(interp, resList, colinfo);\r
1862         } else {\r
1863             goto conflict;\r
1864             }\r
1865   } else if (objc == 4 && listObjc > 1) {\r
1866       mysql_field_seek(result, 0) ;\r
1867       while ((fld = mysql_fetch_field(result)) != NULL) {\r
1868         resSubList = Tcl_NewListObj(0, NULL);\r
1869         for (coln = 0; coln < listObjc; coln++)\r
1870             if ((colinfo = mysql_colinfo(interp,objc,objv,fld, listObjv[coln])) != NULL) {\r
1871                 Tcl_ListObjAppendElement(interp, resSubList, colinfo);\r
1872             } else {\r
1873 \r
1874                goto conflict; \r
1875             }\r
1876         Tcl_ListObjAppendElement(interp, resList, resSubList);\r
1877         }\r
1878   } else {\r
1879       for (idx = 3; idx < objc; idx++) {\r
1880         resSubList = Tcl_NewListObj(0, NULL);\r
1881         mysql_field_seek(result, 0) ;\r
1882         while ((fld = mysql_fetch_field(result)) != NULL)\r
1883         if ((colinfo = mysql_colinfo(interp,objc,objv,fld, objv[idx])) != NULL) {\r
1884 \r
1885             Tcl_ListObjAppendElement(interp, resSubList, colinfo);\r
1886         } else {\r
1887             goto conflict; \r
1888         }\r
1889         Tcl_ListObjAppendElement(interp, resList, resSubList);\r
1890       }\r
1891   }\r
1892   if (!current_db) mysql_free_result(result) ;\r
1893   return TCL_OK;\r
1894   \r
1895   conflict:\r
1896     if (!current_db) mysql_free_result(result) ;\r
1897     return TCL_ERROR;\r
1898 }\r
1899 \r
1900 \r
1901 /*\r
1902  *----------------------------------------------------------------------\r
1903  *\r
1904  * Mysqltcl_State\r
1905  *    Implements the mysqlstate command:\r
1906  *    usage: mysqlstate handle ?-numeric?\r
1907 \r
1908  *                      \r
1909  */\r
1910 \r
1911 static int Mysqltcl_State(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1912 {\r
1913   MysqlTclHandle *handle;\r
1914   int numeric=0 ;\r
1915   Tcl_Obj *res;\r
1916 \r
1917   if (objc!=2 && objc!=3) {\r
1918       Tcl_WrongNumArgs(interp, 1, objv, "handle ?-numeric");\r
1919       return TCL_ERROR;\r
1920   }\r
1921 \r
1922   if (objc==3) {\r
1923     if (strcmp(Tcl_GetStringFromObj(objv[2],NULL), "-numeric"))\r
1924       return mysql_prim_confl(interp,objc,objv,"last parameter should be -numeric");\r
1925     else\r
1926 \r
1927       numeric=1;\r
1928   }\r
1929   \r
1930   if (GetHandleFromObj(interp, objv[1], &handle) != TCL_OK)\r
1931     res = (numeric)?Tcl_NewIntObj(0):Tcl_NewStringObj("NOT_A_HANDLE",-1);\r
1932   else if (handle->connection == 0)\r
1933     res = (numeric)?Tcl_NewIntObj(1):Tcl_NewStringObj("UNCONNECTED",-1);\r
1934   else if (handle->database[0] == '\0')\r
1935     res = (numeric)?Tcl_NewIntObj(2):Tcl_NewStringObj("CONNECTED",-1);\r
1936   else if (handle->result == NULL)\r
1937     res = (numeric)?Tcl_NewIntObj(3):Tcl_NewStringObj("IN_USE",-1);\r
1938   else\r
1939     res = (numeric)?Tcl_NewIntObj(4):Tcl_NewStringObj("RESULT_PENDING",-1);\r
1940 \r
1941   Tcl_SetObjResult(interp, res);\r
1942   return TCL_OK ;\r
1943 }\r
1944 \r
1945 \r
1946 /*\r
1947  *----------------------------------------------------------------------\r
1948  *\r
1949  * Mysqltcl_InsertId\r
1950  *    Implements the mysqlstate command:\r
1951  *    usage: mysqlinsertid handle \r
1952  *    Returns the auto increment id of the last INSERT statement\r
1953  *                      \r
1954  */\r
1955 \r
1956 static int Mysqltcl_InsertId(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1957 {\r
1958 \r
1959   MysqlTclHandle *handle;\r
1960   \r
1961   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
1962                             "handle")) == 0)\r
1963     return TCL_ERROR;\r
1964 \r
1965   Tcl_SetObjResult(interp, Tcl_NewIntObj(mysql_insert_id(handle->connection)));\r
1966 \r
1967   return TCL_OK;\r
1968 }\r
1969 \r
1970 /*\r
1971  *----------------------------------------------------------------------\r
1972  *\r
1973  * Mysqltcl_Ping\r
1974  *    usage: mysqlping handle\r
1975  *    It can be used to check and refresh (reconnect after time out) the connection\r
1976  *    Returns 0 if connection is OK\r
1977  */\r
1978 \r
1979 \r
1980 static int Mysqltcl_Ping(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1981 {\r
1982   MysqlTclHandle *handle;\r
1983   \r
1984   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
1985                             "handle")) == 0)\r
1986     return TCL_ERROR;\r
1987 \r
1988   Tcl_SetObjResult(interp, Tcl_NewBooleanObj(mysql_ping(handle->connection)==0));\r
1989 \r
1990   return TCL_OK;\r
1991 }\r
1992 \r
1993 /*\r
1994  *----------------------------------------------------------------------\r
1995  *\r
1996  * Mysqltcl_ChangeUser\r
1997  *    usage: mysqlchangeuser handle user password database\r
1998  *    return TCL_ERROR if operation failed\r
1999  */\r
2000 \r
2001 static int Mysqltcl_ChangeUser(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2002 {\r
2003   MysqlTclHandle *handle;\r
2004   int len;\r
2005   char *user,*password,*database=NULL;\r
2006   \r
2007   if ((handle = mysql_prologue(interp, objc, objv, 4, 5, CL_CONN,\r
2008                             "handle user password ?database?")) == 0)\r
2009     return TCL_ERROR;\r
2010 \r
2011   user = Tcl_GetStringFromObj(objv[2],NULL);\r
2012   password = Tcl_GetStringFromObj(objv[3],NULL);\r
2013   if (objc==5) {\r
2014     database = Tcl_GetStringFromObj(objv[4],&len);\r
2015     if (len >= MYSQL_NAME_LEN) {\r
2016        mysql_prim_confl(interp,objc,objv,"database name too long");\r
2017        return TCL_ERROR;\r
2018     }\r
2019   }\r
2020   if (mysql_change_user(handle->connection, user, password, database)!=0) {\r
2021       mysql_server_confl(interp,objc,objv,handle->connection);\r
2022       return TCL_ERROR;\r
2023   }\r
2024   if (database!=NULL) \r
2025           strcpy(handle->database, database);\r
2026   return TCL_OK;\r
2027 }\r
2028 /*\r
2029  *----------------------------------------------------------------------\r
2030  *\r
2031  * Mysqltcl_AutoCommit\r
2032  *    usage: mysql::autocommit bool\r
2033  *    set autocommit mode\r
2034  */\r
2035 \r
2036 static int Mysqltcl_AutoCommit(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2037 {\r
2038 #if (MYSQL_VERSION_ID < 40107)\r
2039   Tcl_AddErrorInfo(interp, FUNCTION_NOT_AVAILABLE);\r
2040   return TCL_ERROR;\r
2041 #else\r
2042   MysqlTclHandle *handle;\r
2043   int isAutocommit = 0;\r
2044 \r
2045   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
2046                             "handle bool")) == 0)\r
2047         return TCL_ERROR;\r
2048   if (Tcl_GetBooleanFromObj(interp,objv[2],&isAutocommit) != TCL_OK )\r
2049         return TCL_ERROR;\r
2050   if (mysql_autocommit(handle->connection, isAutocommit)!=0) {\r
2051         mysql_server_confl(interp,objc,objv,handle->connection);\r
2052   }\r
2053   return TCL_OK;\r
2054 #endif\r
2055 }\r
2056 /*\r
2057  *----------------------------------------------------------------------\r
2058  *\r
2059  * Mysqltcl_Commit\r
2060  *    usage: mysql::commit\r
2061  *    \r
2062  */\r
2063 \r
2064 static int Mysqltcl_Commit(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2065 {\r
2066 #if (MYSQL_VERSION_ID < 40107)\r
2067   Tcl_AddErrorInfo(interp, FUNCTION_NOT_AVAILABLE);\r
2068   return TCL_ERROR;\r
2069 #else\r
2070   MysqlTclHandle *handle;\r
2071 \r
2072   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
2073                             "handle")) == 0)\r
2074     return TCL_ERROR;\r
2075   if (mysql_commit(handle->connection)!=0) {\r
2076         mysql_server_confl(interp,objc,objv,handle->connection);\r
2077   }\r
2078   return TCL_OK;\r
2079 #endif\r
2080 }\r
2081 /*\r
2082  *----------------------------------------------------------------------\r
2083  *\r
2084  * Mysqltcl_Rollback\r
2085  *    usage: mysql::rollback\r
2086  *\r
2087  */\r
2088 \r
2089 static int Mysqltcl_Rollback(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2090 {\r
2091 #if (MYSQL_VERSION_ID < 40107)\r
2092   Tcl_AddErrorInfo(interp, FUNCTION_NOT_AVAILABLE);\r
2093   return TCL_ERROR;\r
2094 #else\r
2095   MysqlTclHandle *handle;\r
2096 \r
2097   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
2098                             "handle")) == 0)\r
2099     return TCL_ERROR;\r
2100   if (mysql_rollback(handle->connection)!=0) {\r
2101       mysql_server_confl(interp,objc,objv,handle->connection);\r
2102   }\r
2103   return TCL_OK;\r
2104 #endif\r
2105 }\r
2106 /*\r
2107  *----------------------------------------------------------------------\r
2108  *\r
2109  * Mysqltcl_MoreResult\r
2110  *    usage: mysql::moreresult handle\r
2111  *    return true if more results exists\r
2112  */\r
2113 \r
2114 static int Mysqltcl_MoreResult(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2115 {\r
2116 #if (MYSQL_VERSION_ID < 40107)\r
2117   Tcl_AddErrorInfo(interp, FUNCTION_NOT_AVAILABLE);\r
2118   return TCL_ERROR;\r
2119 #else\r
2120   MysqlTclHandle *handle;\r
2121   int boolResult = 0;\r
2122 \r
2123   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_RES,\r
2124                             "handle")) == 0)\r
2125     return TCL_ERROR;\r
2126   boolResult =  mysql_more_results(handle->connection);\r
2127   Tcl_SetObjResult(interp,Tcl_NewBooleanObj(boolResult));\r
2128   return TCL_OK;\r
2129 #endif\r
2130 }\r
2131 /*\r
2132 \r
2133  *----------------------------------------------------------------------\r
2134  *\r
2135  * Mysqltcl_NextResult\r
2136  *    usage: mysql::nextresult\r
2137  *\r
2138  *  return nummber of rows in result set. 0 if no next result\r
2139  */\r
2140 \r
2141 static int Mysqltcl_NextResult(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2142 {\r
2143 #if (MYSQL_VERSION_ID < 40107)\r
2144   Tcl_AddErrorInfo(interp, FUNCTION_NOT_AVAILABLE);\r
2145   return TCL_ERROR;\r
2146 #else\r
2147   MysqlTclHandle *handle;\r
2148   int result = 0;\r
2149 \r
2150   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_RES,\r
2151                             "handle")) == 0)\r
2152     return TCL_ERROR;\r
2153   if (handle->result != NULL) {\r
2154     mysql_free_result(handle->result) ;\r
2155     handle->result = NULL ;\r
2156   }\r
2157   result = mysql_next_result(handle->connection);\r
2158   if (result==-1) {\r
2159       Tcl_SetObjResult(interp, Tcl_NewIntObj(0));\r
2160       return TCL_OK;\r
2161   }\r
2162   if (result<0) {\r
2163       return mysql_server_confl(interp,objc,objv,handle->connection);\r
2164   }\r
2165   handle->result = mysql_store_result(handle->connection);\r
2166   if (handle->result == NULL) {\r
2167       Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));\r
2168   } else {\r
2169       handle->res_count = mysql_num_rows(handle->result);\r
2170       Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->res_count));\r
2171   }\r
2172   return TCL_OK;\r
2173 #endif\r
2174 }\r
2175 /*\r
2176  *----------------------------------------------------------------------\r
2177  *\r
2178  * Mysqltcl_WarningCount\r
2179  *    usage: mysql::warningcount\r
2180  *\r
2181  */\r
2182 \r
2183 static int Mysqltcl_WarningCount(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2184 {\r
2185 #if (MYSQL_VERSION_ID < 40107)\r
2186   Tcl_AddErrorInfo(interp, FUNCTION_NOT_AVAILABLE);\r
2187   return TCL_ERROR;\r
2188 #else\r
2189   MysqlTclHandle *handle;\r
2190   int count = 0;\r
2191 \r
2192   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
2193                             "handle")) == 0)\r
2194     return TCL_ERROR;\r
2195   count = mysql_warning_count(handle->connection);\r
2196   Tcl_SetObjResult(interp,Tcl_NewIntObj(count));\r
2197   return TCL_OK;\r
2198 #endif\r
2199 }\r
2200 /*\r
2201  *----------------------------------------------------------------------\r
2202  *\r
2203  * Mysqltcl_IsNull\r
2204  *    usage: mysql::isnull value\r
2205  *\r
2206  */\r
2207 \r
2208 static int Mysqltcl_IsNull(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2209 {\r
2210   int boolResult = 0;\r
2211   if (objc != 2) {\r
2212       Tcl_WrongNumArgs(interp, 1, objv, "value");\r
2213       return TCL_ERROR;\r
2214   }\r
2215   boolResult = objv[1]->typePtr == &mysqlNullType;\r
2216   Tcl_SetObjResult(interp,Tcl_NewBooleanObj(boolResult));\r
2217   return TCL_OK;\r
2218 \r
2219   return TCL_OK;\r
2220 }\r
2221 /*\r
2222  * Create new Mysql NullObject\r
2223  * (similar to Tcl API for example Tcl_NewIntObj)\r
2224  */\r
2225 static Tcl_Obj *Mysqltcl_NewNullObj(MysqltclState *mysqltclState) {\r
2226   Tcl_Obj *objPtr;\r
2227   objPtr = Tcl_NewObj();\r
2228   objPtr->bytes = NULL;\r
2229   objPtr->typePtr = &mysqlNullType;\r
2230   objPtr->internalRep.otherValuePtr = mysqltclState;\r
2231   return objPtr;\r
2232 }\r
2233 /*\r
2234  *----------------------------------------------------------------------\r
2235  *\r
2236  * Mysqltcl_NewNull\r
2237  *    usage: mysql::newnull\r
2238  *\r
2239  */\r
2240 \r
2241 static int Mysqltcl_NewNull(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2242 {\r
2243   if (objc != 1) {\r
2244       Tcl_WrongNumArgs(interp, 1, objv, "");\r
2245       return TCL_ERROR;\r
2246   }\r
2247   Tcl_SetObjResult(interp,Mysqltcl_NewNullObj((MysqltclState *)clientData));\r
2248   return TCL_OK;\r
2249 }\r
2250 /*\r
2251  *----------------------------------------------------------------------\r
2252  *\r
2253  * Mysqltcl_SetServerOption\r
2254  *    usage: mysql::setserveroption (-\r
2255  *\r
2256  */\r
2257 #if (MYSQL_VERSION_ID >= 40107)\r
2258 static CONST char* MysqlServerOpt[] =\r
2259     {\r
2260       "-multi_statment_on", "-multi_statment_off", "-auto_reconnect_on", "-auto_reconnect_off", NULL\r
2261     };\r
2262 #endif\r
2263  \r
2264 static int Mysqltcl_SetServerOption(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2265 {\r
2266 #if (MYSQL_VERSION_ID < 40107)\r
2267   Tcl_AddErrorInfo(interp, FUNCTION_NOT_AVAILABLE);\r
2268   return TCL_ERROR;\r
2269 #else\r
2270   MysqlTclHandle *handle;\r
2271   int idx;\r
2272   enum enum_mysql_set_option mysqlServerOption;\r
2273   \r
2274   enum serveroption {\r
2275     MYSQL_MSTATMENT_ON_SOPT, MYSQL_MSTATMENT_OFF_SOPT\r
2276   };\r
2277 \r
2278   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
2279                             "handle option")) == 0)\r
2280     return TCL_ERROR;\r
2281 \r
2282   if (Tcl_GetIndexFromObj(interp, objv[2], MysqlServerOpt, "option",\r
2283                           0, &idx) != TCL_OK)\r
2284       return TCL_ERROR;\r
2285 \r
2286   switch (idx) {\r
2287     case MYSQL_MSTATMENT_ON_SOPT:\r
2288       mysqlServerOption = MYSQL_OPTION_MULTI_STATEMENTS_ON;\r
2289       break;\r
2290     case MYSQL_MSTATMENT_OFF_SOPT:\r
2291       mysqlServerOption = MYSQL_OPTION_MULTI_STATEMENTS_OFF;\r
2292       break;\r
2293     default:\r
2294       return mysql_prim_confl(interp,objc,objv,"Weirdness in server options");\r
2295   }\r
2296   if (mysql_set_server_option(handle->connection,mysqlServerOption)!=0) {\r
2297         mysql_server_confl(interp,objc,objv,handle->connection);\r
2298   }\r
2299   return TCL_OK;\r
2300 #endif\r
2301 }\r
2302 /*\r
2303  *----------------------------------------------------------------------\r
2304  *\r
2305  * Mysqltcl_ShutDown\r
2306  *    usage: mysql::shutdown handle\r
2307  *\r
2308  */\r
2309 static int Mysqltcl_ShutDown(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2310 {\r
2311   MysqlTclHandle *handle;\r
2312 \r
2313   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
2314                             "handle")) == 0)\r
2315     return TCL_ERROR;\r
2316 #if (MYSQL_VERSION_ID >= 40107)\r
2317   if (mysql_shutdown(handle->connection,SHUTDOWN_DEFAULT)!=0) {\r
2318 #else\r
2319   if (mysql_shutdown(handle->connection)!=0) {\r
2320 #endif\r
2321         mysql_server_confl(interp,objc,objv,handle->connection);\r
2322   }\r
2323   return TCL_OK;\r
2324 }\r
2325 /*\r
2326  *----------------------------------------------------------------------\r
2327  *\r
2328  * Mysqltcl_Encoding\r
2329  *    usage: mysql::encoding handle ?encoding|binary?\r
2330  *\r
2331  */\r
2332 static int Mysqltcl_Encoding(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2333 {\r
2334   MysqltclState *statePtr = (MysqltclState *)clientData;\r
2335   Tcl_HashSearch search;\r
2336   Tcl_HashEntry *entryPtr;\r
2337   MysqlTclHandle *handle,*qhandle;\r
2338   char *encodingname;\r
2339   Tcl_Encoding encoding;\r
2340   \r
2341   if ((handle = mysql_prologue(interp, objc, objv, 2, 3, CL_CONN,\r
2342                             "handle")) == 0)\r
2343         return TCL_ERROR;\r
2344   if (objc==2) {\r
2345       if (handle->encoding == NULL)\r
2346          Tcl_SetObjResult(interp, Tcl_NewStringObj("binary",-1));\r
2347       else \r
2348          Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetEncodingName(handle->encoding),-1));\r
2349   } else {\r
2350       if (handle->type!=HT_CONNECTION) {\r
2351             Tcl_SetObjResult(interp, Tcl_NewStringObj("encoding set can be used only on connection handle",-1));\r
2352             return TCL_ERROR;\r
2353       }\r
2354       encodingname = Tcl_GetStringFromObj(objv[2],NULL);\r
2355       if (strcmp(encodingname, "binary") == 0) {\r
2356          encoding = NULL;       \r
2357       } else {\r
2358          encoding = Tcl_GetEncoding(interp, encodingname);\r
2359          if (encoding == NULL)\r
2360              return TCL_ERROR;\r
2361       }\r
2362       if (handle->encoding!=NULL)\r
2363           Tcl_FreeEncoding(handle->encoding);\r
2364       handle->encoding = encoding;\r
2365 \r
2366       /* change encoding of all subqueries */\r
2367       for (entryPtr=Tcl_FirstHashEntry(&statePtr->hash,&search);\r
2368                entryPtr!=NULL;\r
2369                 entryPtr=Tcl_NextHashEntry(&search)) {\r
2370             qhandle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);\r
2371             if (qhandle->type==HT_QUERY && handle->connection==qhandle->connection) {\r
2372                 qhandle->encoding = encoding;\r
2373             }\r
2374       }\r
2375 \r
2376   }\r
2377   return TCL_OK;\r
2378 }\r
2379 /*\r
2380  *----------------------------------------------------------------------\r
2381  *\r
2382  * Mysqltcl_Close --\r
2383  *    Implements the mysqlclose command:\r
2384  *    usage: mysqlclose ?handle?\r
2385  *                      \r
2386  *    results:\r
2387  *      null string\r
2388  */\r
2389 \r
2390 static int Mysqltcl_Close(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2391 \r
2392 {\r
2393   MysqltclState *statePtr = (MysqltclState *)clientData; \r
2394   MysqlTclHandle *handle,*thandle;\r
2395   Tcl_HashEntry *entryPtr;\r
2396   Tcl_HashEntry *qentries[16];\r
2397   Tcl_HashSearch search;\r
2398 \r
2399   int i,qfound = 0;\r
2400 \r
2401 \r
2402   /* If handle omitted, close all connections. */\r
2403   if (objc == 1) {\r
2404       Mysqltcl_CloseAll(clientData) ;\r
2405       return TCL_OK ;\r
2406   }\r
2407   \r
2408   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
2409                             "?handle?")) == 0)\r
2410     return TCL_ERROR;\r
2411 \r
2412 \r
2413   /* Search all queries and statements on this handle and close those */\r
2414   if (handle->type==HT_CONNECTION)  {\r
2415     while (1) {\r
2416       for (entryPtr=Tcl_FirstHashEntry(&statePtr->hash,&search); \r
2417            entryPtr!=NULL;\r
2418            entryPtr=Tcl_NextHashEntry(&search)) {\r
2419 \r
2420         thandle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);\r
2421         if (thandle->connection == handle->connection &&\r
2422             thandle->type!=HT_CONNECTION) {\r
2423           qentries[qfound++] = entryPtr;\r
2424         }\r
2425         if (qfound==16) break;\r
2426       }\r
2427       if (qfound>0) {\r
2428         for(i=0;i<qfound;i++) {\r
2429           entryPtr=qentries[i];\r
2430           thandle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);\r
2431           Tcl_DeleteHashEntry(entryPtr);\r
2432           closeHandle(thandle);\r
2433         }\r
2434       }\r
2435       if (qfound!=16) break;\r
2436       qfound = 0;\r
2437     }\r
2438   }\r
2439   entryPtr = Tcl_FindHashEntry(&statePtr->hash,Tcl_GetStringFromObj(objv[1],NULL));\r
2440   if (entryPtr) Tcl_DeleteHashEntry(entryPtr);\r
2441   closeHandle(handle);\r
2442   return TCL_OK;\r
2443 }\r
2444 \r
2445 #ifdef PREPARED_STATEMENT\r
2446 /*\r
2447  *----------------------------------------------------------------------\r
2448  *\r
2449  * Mysqltcl_Prepare --\r
2450  *    Implements the mysql::prepare command:\r
2451  *    usage: mysql::prepare handle statements\r
2452  *\r
2453  *    results:\r
2454  *          prepared statment handle\r
2455  */\r
2456 \r
2457 static int Mysqltcl_Prepare(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2458 {\r
2459   MysqltclState *statePtr = (MysqltclState *)clientData;\r
2460 \r
2461   MysqlTclHandle *handle;\r
2462   MysqlTclHandle *shandle;\r
2463   MYSQL_STMT *statement;\r
2464   char *query;\r
2465   int queryLen;\r
2466   int resultColumns;\r
2467   int paramCount;\r
2468 \r
2469   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
2470                             "handle sql-statement")) == 0)\r
2471     return TCL_ERROR;\r
2472 \r
2473   statement = mysql_stmt_init(handle->connection);\r
2474   if (statement==NULL) {\r
2475         return TCL_ERROR;\r
2476   }\r
2477   query = (char *)Tcl_GetByteArrayFromObj(objv[2], &queryLen);\r
2478   if (mysql_stmt_prepare(statement,query,queryLen)) {\r
2479 \r
2480         mysql_stmt_close(statement);\r
2481     return mysql_server_confl(interp,objc,objv,handle->connection);\r
2482   }\r
2483   if ((shandle = createHandleFrom(statePtr,handle,HT_STATEMENT)) == NULL) return TCL_ERROR;\r
2484   shandle->statement=statement;\r
2485   shandle->resultMetadata = mysql_stmt_result_metadata(statement);\r
2486   shandle->paramMetadata = mysql_stmt_param_metadata(statement);\r
2487   /* set result bind memory */\r
2488   resultColumns = mysql_stmt_field_count(statement);\r
2489   if (resultColumns>0) {\r
2490         shandle->bindResult = (MYSQL_BIND *)Tcl_Alloc(sizeof(MYSQL_BIND)*resultColumns);\r
2491     memset(shandle->bindResult,0,sizeof(MYSQL_BIND)*resultColumns);\r
2492   }\r
2493   paramCount = mysql_stmt_param_count(statement);\r
2494   if (resultColumns>0) {\r
2495         shandle->bindParam = (MYSQL_BIND *)Tcl_Alloc(sizeof(MYSQL_BIND)*paramCount);\r
2496     memset(shandle->bindParam,0,sizeof(MYSQL_BIND)*paramCount);\r
2497   }\r
2498   Tcl_SetObjResult(interp, Tcl_NewHandleObj(statePtr,shandle));\r
2499   return TCL_OK;\r
2500 }\r
2501 static int Mysqltcl_ParamMetaData(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2502 {\r
2503   MysqltclState *statePtr = (MysqltclState *)clientData;\r
2504   MysqlTclHandle *handle;\r
2505   MYSQL_RES *res;\r
2506   MYSQL_ROW row;\r
2507   Tcl_Obj *colinfo,*resObj;\r
2508   unsigned long *lengths;\r
2509   int i;\r
2510   int colCount;\r
2511   MYSQL_FIELD* fld;\r
2512 \r
2513   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
2514                             "statement-handle")) == 0)\r
2515     return TCL_ERROR;\r
2516   if(handle->type!=HT_STATEMENT)\r
2517         return TCL_ERROR;\r
2518 \r
2519   resObj = Tcl_GetObjResult(interp);\r
2520   printf("statement %p count %d\n",handle->statement,mysql_stmt_param_count(handle->statement));\r
2521   res = mysql_stmt_result_metadata(handle->statement);\r
2522   printf("res %p\n",res);\r
2523   if(res==NULL)\r
2524         return TCL_ERROR;\r
2525 \r
2526   mysql_field_seek(res, 0) ;\r
2527   while ((fld = mysql_fetch_field(res)) != NULL) {\r
2528         if ((colinfo = mysql_colinfo(interp,objc,objv,fld, objv[2])) != NULL) {\r
2529             Tcl_ListObjAppendElement(interp, resObj, colinfo);\r
2530         } else {\r
2531             goto conflict;\r
2532             }\r
2533   }\r
2534   conflict:\r
2535 \r
2536   mysql_free_result(res);\r
2537   return TCL_OK;\r
2538 }\r
2539 /*----------------------------------------------------------------------\r
2540  *\r
2541  * Mysqltcl_PSelect --\r
2542  *    Implements the mysql::pselect command:\r
2543  *    usage: mysql::pselect $statement_handle ?arguments...?\r
2544  *\r
2545  *    results:\r
2546  *          number of returned rows\r
2547  */\r
2548 \r
2549 static int Mysqltcl_PSelect(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2550 {\r
2551   MysqltclState *statePtr = (MysqltclState *)clientData;\r
2552   MysqlTclHandle *handle;\r
2553 \r
2554   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
2555                             "handle sql-statement")) == 0)\r
2556     return TCL_ERROR;\r
2557   if (handle->type!=HT_STATEMENT) {\r
2558         return TCL_ERROR;\r
2559   }\r
2560   mysql_stmt_reset(handle->statement);\r
2561   if (mysql_stmt_execute(handle->statement)) {\r
2562         return mysql_server_confl(interp,objc,objv,handle->connection);\r
2563   }\r
2564   mysql_stmt_bind_result(handle->statement, handle->bindResult);\r
2565   mysql_stmt_store_result(handle->statement);\r
2566   return TCL_OK;\r
2567 }\r
2568 /*----------------------------------------------------------------------\r
2569  *\r
2570  * Mysqltcl_PFetch --\r
2571  *    Implements the mysql::pfetch command:\r
2572  *    usage: mysql::pfetch $statement_handle\r
2573  *\r
2574  *    results:\r
2575  *          number of returned rows\r
2576  */\r
2577 \r
2578 static int Mysqltcl_PFetch(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2579 {\r
2580   MysqltclState *statePtr = (MysqltclState *)clientData;\r
2581   MysqlTclHandle *handle;\r
2582 \r
2583   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
2584                             "prep-stat-handle")) == 0)\r
2585     return TCL_ERROR;\r
2586   if (handle->type!=HT_STATEMENT) {\r
2587         return TCL_ERROR;\r
2588   }\r
2589   \r
2590   return TCL_OK;\r
2591 }\r
2592 /*----------------------------------------------------------------------\r
2593  *\r
2594  * Mysqltcl_PExecute --\r
2595  *    Implements the mysql::pexecute command:\r
2596  *    usage: mysql::pexecute statement-handle ?arguments...?\r
2597  *\r
2598  *    results:\r
2599  *          number of effected rows\r
2600  */\r
2601 \r
2602 static int Mysqltcl_PExecute(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2603 {\r
2604   MysqltclState *statePtr = (MysqltclState *)clientData;\r
2605   MysqlTclHandle *handle;\r
2606 \r
2607   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
2608                             "handle sql-statement")) == 0)\r
2609     return TCL_ERROR;\r
2610   if (handle->type!=HT_STATEMENT) {\r
2611         return TCL_ERROR;\r
2612   }\r
2613   mysql_stmt_reset(handle->statement);\r
2614 \r
2615   if (mysql_stmt_param_count(handle->statement)!=0) {\r
2616           Tcl_SetStringObj(Tcl_GetObjResult(interp),"works only for 0 params",-1);\r
2617           return TCL_ERROR;\r
2618   }\r
2619   if (mysql_stmt_execute(handle->statement))\r
2620   {\r
2621         Tcl_SetStringObj(Tcl_GetObjResult(interp),mysql_stmt_error(handle->statement),-1);\r
2622         return TCL_ERROR;\r
2623   }\r
2624   return TCL_OK;\r
2625 }\r
2626 #endif\r
2627 \r
2628 /*\r
2629  *----------------------------------------------------------------------\r
2630  * Mysqltcl_Init\r
2631  * Perform all initialization for the MYSQL to Tcl interface.\r
2632  * Adds additional commands to interp, creates message array, initializes\r
2633  * all handles.\r
2634  *\r
2635  * A call to Mysqltcl_Init should exist in Tcl_CreateInterp or\r
2636  * Tcl_CreateExtendedInterp.\r
2637 \r
2638  */\r
2639 \r
2640 \r
2641 #ifdef _WINDOWS\r
2642 __declspec( dllexport )\r
2643 #endif\r
2644 int Mysqltcl_Init(interp)\r
2645     Tcl_Interp *interp;\r
2646 {\r
2647   char nbuf[MYSQL_SMALL_SIZE];\r
2648   MysqltclState *statePtr;\r
2649  \r
2650   if (Tcl_InitStubs(interp, "8.1", 0) == NULL)\r
2651     return TCL_ERROR;\r
2652   if (Tcl_PkgRequire(interp, "Tcl", "8.1", 0) == NULL)\r
2653     return TCL_ERROR;\r
2654   if (Tcl_PkgProvide(interp, "mysqltcl" , PACKAGE_VERSION) != TCL_OK)\r
2655     return TCL_ERROR;\r
2656   /*\r
2657 \r
2658    * Initialize the new Tcl commands.\r
2659    * Deleting any command will close all connections.\r
2660    */\r
2661    statePtr = (MysqltclState*)Tcl_Alloc(sizeof(MysqltclState)); \r
2662    Tcl_InitHashTable(&statePtr->hash, TCL_STRING_KEYS);\r
2663    statePtr->handleNum = 0;\r
2664 \r
2665    Tcl_CreateObjCommand(interp,"mysqlconnect",Mysqltcl_Connect,(ClientData)statePtr, NULL);\r
2666    Tcl_CreateObjCommand(interp,"mysqluse", Mysqltcl_Use,(ClientData)statePtr, NULL);\r
2667    Tcl_CreateObjCommand(interp,"mysqlescape", Mysqltcl_Escape,(ClientData)statePtr, NULL);\r
2668    Tcl_CreateObjCommand(interp,"mysqlsel", Mysqltcl_Sel,(ClientData)statePtr, NULL);\r
2669    Tcl_CreateObjCommand(interp,"mysqlnext", Mysqltcl_Fetch,(ClientData)statePtr, NULL);\r
2670    Tcl_CreateObjCommand(interp,"mysqlseek", Mysqltcl_Seek,(ClientData)statePtr, NULL);\r
2671    Tcl_CreateObjCommand(interp,"mysqlmap", Mysqltcl_Map,(ClientData)statePtr, NULL);\r
2672    Tcl_CreateObjCommand(interp,"mysqlexec", Mysqltcl_Exec,(ClientData)statePtr, NULL);\r
2673    Tcl_CreateObjCommand(interp,"mysqlclose", Mysqltcl_Close,(ClientData)statePtr, NULL);\r
2674    Tcl_CreateObjCommand(interp,"mysqlinfo", Mysqltcl_Info,(ClientData)statePtr, NULL);\r
2675    Tcl_CreateObjCommand(interp,"mysqlresult", Mysqltcl_Result,(ClientData)statePtr, NULL);\r
2676    Tcl_CreateObjCommand(interp,"mysqlcol", Mysqltcl_Col,(ClientData)statePtr, NULL);\r
2677    Tcl_CreateObjCommand(interp,"mysqlstate", Mysqltcl_State,(ClientData)statePtr, NULL);\r
2678    Tcl_CreateObjCommand(interp,"mysqlinsertid", Mysqltcl_InsertId,(ClientData)statePtr, NULL);\r
2679    Tcl_CreateObjCommand(interp,"mysqlquery", Mysqltcl_Query,(ClientData)statePtr, NULL);\r
2680    Tcl_CreateObjCommand(interp,"mysqlendquery", Mysqltcl_EndQuery,(ClientData)statePtr, NULL);\r
2681    Tcl_CreateObjCommand(interp,"mysqlbaseinfo", Mysqltcl_BaseInfo,(ClientData)statePtr, NULL);\r
2682    Tcl_CreateObjCommand(interp,"mysqlping", Mysqltcl_Ping,(ClientData)statePtr, NULL);\r
2683    Tcl_CreateObjCommand(interp,"mysqlchangeuser", Mysqltcl_ChangeUser,(ClientData)statePtr, NULL);\r
2684    Tcl_CreateObjCommand(interp,"mysqlreceive", Mysqltcl_Receive,(ClientData)statePtr, NULL);\r
2685    \r
2686    Tcl_CreateObjCommand(interp,"::mysql::connect",Mysqltcl_Connect,(ClientData)statePtr, Mysqltcl_Kill);\r
2687    Tcl_CreateObjCommand(interp,"::mysql::use", Mysqltcl_Use,(ClientData)statePtr, NULL);\r
2688    Tcl_CreateObjCommand(interp,"::mysql::escape", Mysqltcl_Escape,(ClientData)statePtr, NULL);\r
2689    Tcl_CreateObjCommand(interp,"::mysql::sel", Mysqltcl_Sel,(ClientData)statePtr, NULL);\r
2690    Tcl_CreateObjCommand(interp,"::mysql::fetch", Mysqltcl_Fetch,(ClientData)statePtr, NULL);\r
2691    Tcl_CreateObjCommand(interp,"::mysql::seek", Mysqltcl_Seek,(ClientData)statePtr, NULL);\r
2692    Tcl_CreateObjCommand(interp,"::mysql::map", Mysqltcl_Map,(ClientData)statePtr, NULL);\r
2693    Tcl_CreateObjCommand(interp,"::mysql::exec", Mysqltcl_Exec,(ClientData)statePtr, NULL);\r
2694    Tcl_CreateObjCommand(interp,"::mysql::close", Mysqltcl_Close,(ClientData)statePtr, NULL);\r
2695    Tcl_CreateObjCommand(interp,"::mysql::info", Mysqltcl_Info,(ClientData)statePtr, NULL);\r
2696    Tcl_CreateObjCommand(interp,"::mysql::result", Mysqltcl_Result,(ClientData)statePtr, NULL);\r
2697    Tcl_CreateObjCommand(interp,"::mysql::col", Mysqltcl_Col,(ClientData)statePtr, NULL);\r
2698    Tcl_CreateObjCommand(interp,"::mysql::state", Mysqltcl_State,(ClientData)statePtr, NULL);\r
2699    Tcl_CreateObjCommand(interp,"::mysql::insertid", Mysqltcl_InsertId,(ClientData)statePtr, NULL);\r
2700    /* new in mysqltcl 2.0 */\r
2701    Tcl_CreateObjCommand(interp,"::mysql::query", Mysqltcl_Query,(ClientData)statePtr, NULL);\r
2702    Tcl_CreateObjCommand(interp,"::mysql::endquery", Mysqltcl_EndQuery,(ClientData)statePtr, NULL);\r
2703    Tcl_CreateObjCommand(interp,"::mysql::baseinfo", Mysqltcl_BaseInfo,(ClientData)statePtr, NULL);\r
2704    Tcl_CreateObjCommand(interp,"::mysql::ping", Mysqltcl_Ping,(ClientData)statePtr, NULL);\r
2705    Tcl_CreateObjCommand(interp,"::mysql::changeuser", Mysqltcl_ChangeUser,(ClientData)statePtr, NULL);\r
2706    Tcl_CreateObjCommand(interp,"::mysql::receive", Mysqltcl_Receive,(ClientData)statePtr, NULL);\r
2707    /* new in mysqltcl 3.0 */\r
2708    Tcl_CreateObjCommand(interp,"::mysql::autocommit", Mysqltcl_AutoCommit,(ClientData)statePtr, NULL);\r
2709    Tcl_CreateObjCommand(interp,"::mysql::commit", Mysqltcl_Commit,(ClientData)statePtr, NULL);\r
2710    Tcl_CreateObjCommand(interp,"::mysql::rollback", Mysqltcl_Rollback,(ClientData)statePtr, NULL);\r
2711    Tcl_CreateObjCommand(interp,"::mysql::nextresult", Mysqltcl_NextResult,(ClientData)statePtr, NULL);\r
2712    Tcl_CreateObjCommand(interp,"::mysql::moreresult", Mysqltcl_MoreResult,(ClientData)statePtr, NULL);\r
2713    Tcl_CreateObjCommand(interp,"::mysql::warningcount", Mysqltcl_WarningCount,(ClientData)statePtr, NULL);\r
2714    Tcl_CreateObjCommand(interp,"::mysql::isnull", Mysqltcl_IsNull,(ClientData)statePtr, NULL);\r
2715    Tcl_CreateObjCommand(interp,"::mysql::newnull", Mysqltcl_NewNull,(ClientData)statePtr, NULL);\r
2716    Tcl_CreateObjCommand(interp,"::mysql::setserveroption", Mysqltcl_SetServerOption,(ClientData)statePtr, NULL);\r
2717    Tcl_CreateObjCommand(interp,"::mysql::shutdown", Mysqltcl_ShutDown,(ClientData)statePtr, NULL);\r
2718    Tcl_CreateObjCommand(interp,"::mysql::encoding", Mysqltcl_Encoding,(ClientData)statePtr, NULL);\r
2719    /* prepared statements */\r
2720 \r
2721 #ifdef PREPARED_STATEMENT\r
2722    Tcl_CreateObjCommand(interp,"::mysql::prepare", Mysqltcl_Prepare,(ClientData)statePtr, NULL);\r
2723    // Tcl_CreateObjCommand(interp,"::mysql::parammetadata", Mysqltcl_ParamMetaData,(ClientData)statePtr, NULL);\r
2724    Tcl_CreateObjCommand(interp,"::mysql::pselect", Mysqltcl_PSelect,(ClientData)statePtr, NULL);\r
2725    Tcl_CreateObjCommand(interp,"::mysql::pselect", Mysqltcl_PFetch,(ClientData)statePtr, NULL);\r
2726    Tcl_CreateObjCommand(interp,"::mysql::pexecute", Mysqltcl_PExecute,(ClientData)statePtr, NULL);\r
2727 #endif\r
2728    \r
2729 \r
2730    \r
2731    /* Initialize mysqlstatus global array. */\r
2732    \r
2733    clear_msg(interp);\r
2734   \r
2735    /* Link the null value element to the corresponding C variable. */\r
2736    if ((statePtr->MysqlNullvalue = Tcl_Alloc (12)) == NULL) return TCL_ERROR;\r
2737    strcpy (statePtr->MysqlNullvalue, MYSQL_NULLV_INIT);\r
2738    sprintf (nbuf, "%s(%s)", MYSQL_STATUS_ARR, MYSQL_STATUS_NULLV);\r
2739 \r
2740    /* set null object in mysqltcl state */\r
2741    /* statePtr->nullObjPtr = Mysqltcl_NewNullObj(statePtr); */\r
2742    \r
2743    if (Tcl_LinkVar(interp,nbuf,(char *)&statePtr->MysqlNullvalue, TCL_LINK_STRING) != TCL_OK)\r
2744      return TCL_ERROR;\r
2745    \r
2746    /* Register the handle object type */\r
2747    Tcl_RegisterObjType(&mysqlHandleType);\r
2748    /* Register own null type object */\r
2749    Tcl_RegisterObjType(&mysqlNullType);\r
2750    \r
2751    /* A little sanity check.\r
2752     * If this message appears you must change the source code and recompile.\r
2753    */\r
2754    if (strlen(MysqlHandlePrefix) == MYSQL_HPREFIX_LEN)\r
2755      return TCL_OK;\r
2756    else {\r
2757      panic("*** mysqltcl (mysqltcl.c): handle prefix inconsistency!\n");\r
2758      return TCL_ERROR ;\r
2759    }\r
2760 }\r
2761 \r
2762 #ifdef _WINDOWS\r
2763 __declspec( dllexport )\r
2764 #endif\r
2765 int Mysqltcl_SafeInit(interp)\r
2766     Tcl_Interp *interp;\r
2767 {\r
2768   return Mysqltcl_Init(interp);\r
2769 }\r
2770