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.04"\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",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   char *hostname = NULL;\r
 739   char *user = NULL;\r
 740   char *password = NULL;\r
 741   char *db = NULL;\r
 742   int port = 0, flags = 0, booleanflag;\r
 743   char *socket = NULL;\r
 744   char *encodingname = NULL;\r
 745 \r
 746 #if (MYSQL_VERSION_ID >= 40107)\r
 747   int isSSL = 0;\r
 748 #endif\r
 749   char *sslkey = NULL;\r
 750   char *sslcert = NULL;\r
 751   char *sslca = NULL;\r
 752   char *sslcapath = NULL;\r
 753   char *sslcipher = NULL;\r
 754   \r
 755   MysqlTclHandle *handle;\r
 756   const char *groupname = "mysqltcl";\r
 757 \r
 758   \r
 759   enum connectoption {\r
 760     MYSQL_CONNHOST_OPT, MYSQL_CONNUSER_OPT, MYSQL_CONNPASSWORD_OPT, \r
 761     MYSQL_CONNDB_OPT, MYSQL_CONNPORT_OPT, MYSQL_CONNSOCKET_OPT, MYSQL_CONNENCODING_OPT,\r
 762     MYSQL_CONNSSL_OPT, MYSQL_CONNCOMPRESS_OPT, MYSQL_CONNNOSCHEMA_OPT, MYSQL_CONNODBC_OPT,\r
 763 #if (MYSQL_VERSION_ID >= 40107)\r
 764     MYSQL_MULTISTATEMENT_OPT,MYSQL_MULTIRESULT_OPT,\r
 765 #endif\r
 766     MYSQL_LOCALFILES_OPT,MYSQL_IGNORESPACE_OPT,\r
 767     MYSQL_FOUNDROWS_OPT,MYSQL_INTERACTIVE_OPT,MYSQL_SSLKEY_OPT,MYSQL_SSLCERT_OPT,\r
 768     MYSQL_SSLCA_OPT,MYSQL_SSLCAPATH_OPT,MYSQL_SSLCIPHERS_OPT\r
 769   };\r
 770 \r
 771   if (!(objc & 1) || \r
 772     objc>(sizeof(MysqlConnectOpt)/sizeof(MysqlConnectOpt[0]-1)*2+1)) {\r
 773     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]"\r
 774     );\r
 775         return TCL_ERROR;\r
 776   }\r
 777               \r
 778   for (i = 1; i < objc; i++) {\r
 779     if (Tcl_GetIndexFromObj(interp, objv[i], MysqlConnectOpt, "option",\r
 780                           0, &idx) != TCL_OK)\r
 781       return TCL_ERROR;\r
 782     \r
 783     switch (idx) {\r
 784     case MYSQL_CONNHOST_OPT:\r
 785       hostname = Tcl_GetStringFromObj(objv[++i],NULL);\r
 786       break;\r
 787     case MYSQL_CONNUSER_OPT:\r
 788       user = Tcl_GetStringFromObj(objv[++i],NULL);\r
 789       break;\r
 790     case MYSQL_CONNPASSWORD_OPT:\r
 791       password = Tcl_GetStringFromObj(objv[++i],NULL);\r
 792       break;\r
 793     case MYSQL_CONNDB_OPT:\r
 794       db = Tcl_GetStringFromObj(objv[++i],NULL);\r
 795       break;\r
 796     case MYSQL_CONNPORT_OPT:\r
 797       if (Tcl_GetIntFromObj(interp, objv[++i], &port) != TCL_OK)\r
 798         return TCL_ERROR;\r
 799       break;\r
 800     case MYSQL_CONNSOCKET_OPT:\r
 801       socket = Tcl_GetStringFromObj(objv[++i],NULL);\r
 802       break;\r
 803     case MYSQL_CONNENCODING_OPT:\r
 804       encodingname = Tcl_GetStringFromObj(objv[++i],NULL);\r
 805       break;\r
 806     case MYSQL_CONNSSL_OPT:\r
 807 #if (MYSQL_VERSION_ID >= 40107)\r
 808       if (Tcl_GetBooleanFromObj(interp,objv[++i],&isSSL) != TCL_OK )\r
 809         return TCL_ERROR;\r
 810 #else\r
 811       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 812         return TCL_ERROR;\r
 813       if (booleanflag)\r
 814         flags |= CLIENT_SSL;\r
 815 #endif\r
 816       break;\r
 817     case MYSQL_CONNCOMPRESS_OPT:\r
 818       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 819         return TCL_ERROR;\r
 820       if (booleanflag)\r
 821         flags |= CLIENT_COMPRESS;\r
 822       break;\r
 823     case MYSQL_CONNNOSCHEMA_OPT: \r
 824       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 825         return TCL_ERROR;\r
 826       if (booleanflag)\r
 827         flags |= CLIENT_NO_SCHEMA;\r
 828       break;\r
 829     case MYSQL_CONNODBC_OPT:\r
 830       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 831         return TCL_ERROR;\r
 832       if (booleanflag)\r
 833         flags |= CLIENT_ODBC;\r
 834       break;\r
 835 #if (MYSQL_VERSION_ID >= 40107)\r
 836     case MYSQL_MULTISTATEMENT_OPT:\r
 837       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 838         return TCL_ERROR;\r
 839       if (booleanflag)\r
 840         flags |= CLIENT_MULTI_STATEMENTS;\r
 841       break;\r
 842     case MYSQL_MULTIRESULT_OPT:\r
 843       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 844         return TCL_ERROR;\r
 845       if (booleanflag)\r
 846         flags |= CLIENT_MULTI_RESULTS;\r
 847       break;\r
 848 #endif\r
 849     case MYSQL_LOCALFILES_OPT:\r
 850       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 851         return TCL_ERROR;\r
 852       if (booleanflag)\r
 853         flags |= CLIENT_LOCAL_FILES;\r
 854       break;\r
 855     case MYSQL_IGNORESPACE_OPT:\r
 856       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 857         return TCL_ERROR;\r
 858       if (booleanflag)\r
 859         flags |= CLIENT_IGNORE_SPACE;\r
 860       break;\r
 861     case MYSQL_FOUNDROWS_OPT:\r
 862       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 863         return TCL_ERROR;\r
 864       if (booleanflag)\r
 865         flags |= CLIENT_FOUND_ROWS;\r
 866       break;\r
 867     case MYSQL_INTERACTIVE_OPT:\r
 868       if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK )\r
 869         return TCL_ERROR;\r
 870       if (booleanflag)\r
 871         flags |= CLIENT_INTERACTIVE;\r
 872       break;\r
 873     case MYSQL_SSLKEY_OPT:\r
 874       sslkey = Tcl_GetStringFromObj(objv[++i],NULL);\r
 875       break;\r
 876     case MYSQL_SSLCERT_OPT:\r
 877       sslcert = Tcl_GetStringFromObj(objv[++i],NULL);\r
 878       break;\r
 879     case MYSQL_SSLCA_OPT:\r
 880       sslca = Tcl_GetStringFromObj(objv[++i],NULL);\r
 881       break;\r
 882     case MYSQL_SSLCAPATH_OPT:\r
 883       sslcapath = Tcl_GetStringFromObj(objv[++i],NULL);\r
 884       break;\r
 885     case MYSQL_SSLCIPHERS_OPT:\r
 886       sslcipher = Tcl_GetStringFromObj(objv[++i],NULL);\r
 887       break;\r
 888     default:\r
 889       return mysql_prim_confl(interp,objc,objv,"Weirdness in options");            \r
 890     }\r
 891   }\r
 892 \r
 893   handle = createMysqlHandle(statePtr);\r
 894 \r
 895   if (handle == 0) {\r
 896     panic("no memory for handle");\r
 897     return TCL_ERROR;\r
 898 \r
 899   }\r
 900 \r
 901   handle->connection = mysql_init(NULL);\r
 902 \r
 903   /* the function below caused in version pre 3.23.50 segmentation fault */\r
 904 #if (MYSQL_VERSION_ID>=32350)\r
 905   mysql_options(handle->connection,MYSQL_READ_DEFAULT_GROUP,groupname);\r
 906 #endif\r
 907 #if (MYSQL_VERSION_ID >= 40107)\r
 908   if (isSSL) {\r
 909       mysql_ssl_set(handle->connection,sslkey,sslcert, sslca, sslcapath, sslcipher);\r
 910   }\r
 911 #endif\r
 912 \r
 913   if (!mysql_real_connect(handle->connection, hostname, user,\r
 914                                 password, db, port, socket, flags)) {\r
 915       mysql_server_confl(interp,objc,objv,handle->connection);\r
 916       closeHandle(handle);\r
 917       return TCL_ERROR;\r
 918   }\r
 919 \r
 920   if (db) {\r
 921     strncpy(handle->database, db, MYSQL_NAME_LEN) ;\r
 922     handle->database[MYSQL_NAME_LEN - 1] = '\0' ;\r
 923   }\r
 924 \r
 925   if (encodingname==NULL || (encodingname!=NULL &&  strcmp(encodingname, "binary") != 0)) {\r
 926     if (encodingname==NULL)\r
 927       encodingname = (char *)Tcl_GetEncodingName(NULL);\r
 928     handle->encoding = Tcl_GetEncoding(interp, encodingname);\r
 929     if (handle->encoding == NULL)\r
 930       return TCL_ERROR;\r
 931   }\r
 932 \r
 933   Tcl_SetObjResult(interp, Tcl_NewHandleObj(statePtr,handle));\r
 934 \r
 935   return TCL_OK;\r
 936 \r
 937 }\r
 938 \r
 939 \r
 940 /*\r
 941  *----------------------------------------------------------------------\r
 942  *\r
 943  * Mysqltcl_Use\r
 944  *    Implements the mysqluse command:\r
 945 \r
 946  *    usage: mysqluse handle dbname\r
 947  *                      \r
 948  *    results:\r
 949  *      Sets current database to dbname.\r
 950  */\r
 951 \r
 952 static int Mysqltcl_Use(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
 953 {\r
 954   int len;\r
 955   char *db;\r
 956   MysqlTclHandle *handle;  \r
 957 \r
 958   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
 959                             "handle dbname")) == 0)\r
 960     return TCL_ERROR;\r
 961 \r
 962   db=Tcl_GetStringFromObj(objv[2], &len);\r
 963   if (len >= MYSQL_NAME_LEN) {\r
 964      mysql_prim_confl(interp,objc,objv,"database name too long");\r
 965      return TCL_ERROR;\r
 966   }\r
 967 \r
 968   if (mysql_select_db(handle->connection, db)!=0) {\r
 969     return mysql_server_confl(interp,objc,objv,handle->connection);\r
 970   }\r
 971   strcpy(handle->database, db);\r
 972   return TCL_OK;\r
 973 }\r
 974 \r
 975 \r
 976 \r
 977 /*\r
 978  *----------------------------------------------------------------------\r
 979  *\r
 980  * Mysqltcl_Escape\r
 981  *    Implements the mysqlescape command:\r
 982  *    usage: mysqlescape string\r
 983  *                      \r
 984  *    results:\r
 985  *      Escaped string for use in queries.\r
 986  */\r
 987 \r
 988 static int Mysqltcl_Escape(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
 989 {\r
 990   int len;\r
 991   char *inString, *outString;\r
 992   MysqlTclHandle *handle;\r
 993   \r
 994   if (objc <2 || objc>3) {\r
 995       Tcl_WrongNumArgs(interp, 1, objv, "?handle? string");\r
 996       return TCL_ERROR;\r
 997   }\r
 998   if (objc==2) {\r
 999     inString=Tcl_GetStringFromObj(objv[1], &len);\r
1000     outString=Tcl_Alloc((len<<1) + 1);\r
1001     len=mysql_escape_string(outString, inString, len);\r
1002     Tcl_SetStringObj(Tcl_GetObjResult(interp), outString, len);\r
1003     Tcl_Free(outString);\r
1004   } else { \r
1005     if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
1006                             "handle string")) == 0)\r
1007       return TCL_ERROR;\r
1008     inString=Tcl_GetStringFromObj(objv[2], &len);\r
1009     outString=Tcl_Alloc((len<<1) + 1);\r
1010     len=mysql_real_escape_string(handle->connection, outString, inString, len);\r
1011     Tcl_SetStringObj(Tcl_GetObjResult(interp), outString, len);\r
1012     Tcl_Free(outString);\r
1013   }\r
1014   return TCL_OK;\r
1015 }\r
1016 \r
1017 \r
1018 \r
1019 /*\r
1020  *----------------------------------------------------------------------\r
1021  *\r
1022  * Mysqltcl_Sel\r
1023  *    Implements the mysqlsel command:\r
1024  *    usage: mysqlsel handle sel-query ?-list|-flatlist?\r
1025  *                      \r
1026  *    results:\r
1027  *\r
1028  *    SIDE EFFECT: Flushes any pending result, even in case of conflict.\r
1029  *    Stores new results.\r
1030  */\r
1031 \r
1032 static int Mysqltcl_Sel(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1033 {\r
1034   MysqltclState *statePtr = (MysqltclState *)clientData; \r
1035   Tcl_Obj *res, *resList;\r
1036   MYSQL_ROW row;\r
1037   MysqlTclHandle *handle;\r
1038   unsigned long *lengths;\r
1039 \r
1040 \r
1041   static CONST char* selOptions[] = {"-list", "-flatlist", NULL};\r
1042   /* Warning !! no option number */\r
1043   int i,selOption=2,colCount;\r
1044   \r
1045   if ((handle = mysql_prologue(interp, objc, objv, 3, 4, CL_CONN,\r
1046                             "handle sel-query ?-list|-flatlist?")) == 0)\r
1047     return TCL_ERROR;\r
1048 \r
1049 \r
1050   if (objc==4) {\r
1051     if (Tcl_GetIndexFromObj(interp, objv[3], selOptions, "option",\r
1052                             TCL_EXACT, &selOption) != TCL_OK)\r
1053       return TCL_ERROR;\r
1054   }\r
1055 \r
1056   /* Flush any previous result. */\r
1057   freeResult(handle);\r
1058 \r
1059   if (mysql_QueryTclObj(handle,objv[2])) {\r
1060     return mysql_server_confl(interp,objc,objv,handle->connection);\r
1061   }\r
1062   if (selOption<2) {\r
1063     /* If imadiatly result than do not store result in mysql client library cache */\r
1064     handle->result = mysql_use_result(handle->connection);\r
1065   } else {\r
1066     handle->result = mysql_store_result(handle->connection);\r
1067   }\r
1068   \r
1069   if (handle->result == NULL) {\r
1070     if (selOption==2) Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));\r
1071   } else {\r
1072     colCount = handle->col_count = mysql_num_fields(handle->result);\r
1073     res = Tcl_GetObjResult(interp);\r
1074     handle->res_count = 0;\r
1075     switch (selOption) {\r
1076     case 0: /* -list */\r
1077       while ((row = mysql_fetch_row(handle->result)) != NULL) {\r
1078         resList = Tcl_NewListObj(0, NULL);\r
1079         lengths = mysql_fetch_lengths(handle->result);\r
1080         for (i=0; i< colCount; i++, row++) {\r
1081           Tcl_ListObjAppendElement(interp, resList,getRowCellAsObject(statePtr,handle,row,lengths[i]));\r
1082         }\r
1083         Tcl_ListObjAppendElement(interp, res, resList);\r
1084       }  \r
1085       break;\r
1086     case 1: /* -flatlist */\r
1087       while ((row = mysql_fetch_row(handle->result)) != NULL) {\r
1088         lengths = mysql_fetch_lengths(handle->result);\r
1089         for (i=0; i< colCount; i++, row++) {\r
1090           Tcl_ListObjAppendElement(interp, res,getRowCellAsObject(statePtr,handle,row,lengths[i]));\r
1091         }\r
1092       }  \r
1093       break;\r
1094     case 2: /* No option */\r
1095       handle->res_count = mysql_num_rows(handle->result);\r
1096       Tcl_SetIntObj(res, handle->res_count);\r
1097       break;\r
1098     }\r
1099   }\r
1100   return TCL_OK;\r
1101 }\r
1102 /*\r
1103  * Mysqltcl_Query\r
1104  * Works as mysqltclsel but return an $query handle that allow to build\r
1105  * nested queries on simple handle\r
1106  */\r
1107 \r
1108 static int Mysqltcl_Query(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1109 {\r
1110   MysqltclState *statePtr = (MysqltclState *)clientData; \r
1111   MYSQL_RES *result;\r
1112   MysqlTclHandle *handle, *qhandle;\r
1113   \r
1114   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
1115 \r
1116                             "handle sqlstatement")) == 0)\r
1117     return TCL_ERROR;\r
1118        \r
1119   if (mysql_QueryTclObj(handle,objv[2])) {\r
1120     return mysql_server_confl(interp,objc,objv,handle->connection);\r
1121   }\r
1122 \r
1123   if ((result = mysql_store_result(handle->connection)) == NULL) {\r
1124     Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));\r
1125     return TCL_OK;\r
1126   } \r
1127   if ((qhandle = createHandleFrom(statePtr,handle,HT_QUERY)) == NULL) return TCL_ERROR;\r
1128   qhandle->result = result;\r
1129   qhandle->col_count = mysql_num_fields(qhandle->result) ;\r
1130 \r
1131 \r
1132   qhandle->res_count = mysql_num_rows(qhandle->result);\r
1133   Tcl_SetObjResult(interp, Tcl_NewHandleObj(statePtr,qhandle));\r
1134   return TCL_OK;\r
1135 }\r
1136 \r
1137 /*\r
1138  * Mysqltcl_Enquery\r
1139  * close and free a query handle\r
1140  * if handle is not query than the result will be discarted\r
1141  */\r
1142 \r
1143 static int Mysqltcl_EndQuery(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1144 {\r
1145   MysqltclState *statePtr = (MysqltclState *)clientData; \r
1146   Tcl_HashEntry *entryPtr;\r
1147   MysqlTclHandle *handle;\r
1148   \r
1149   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
1150                             "queryhandle")) == 0)\r
1151     return TCL_ERROR;\r
1152 \r
1153   if (handle->type==HT_QUERY) {\r
1154     entryPtr = Tcl_FindHashEntry(&statePtr->hash,Tcl_GetStringFromObj(objv[1],NULL));\r
1155     if (entryPtr) {\r
1156       Tcl_DeleteHashEntry(entryPtr);\r
1157     }\r
1158     closeHandle(handle);\r
1159   } else {\r
1160       freeResult(handle);\r
1161   }\r
1162   return TCL_OK;\r
1163 }\r
1164 \r
1165 /*\r
1166  *----------------------------------------------------------------------\r
1167  *\r
1168  * Mysqltcl_Exec\r
1169  * Implements the mysqlexec command:\r
1170  * usage: mysqlexec handle sql-statement\r
1171  *                      \r
1172  * Results:\r
1173  * Number of affected rows on INSERT, UPDATE or DELETE, 0 otherwise.\r
1174  *\r
1175  * SIDE EFFECT: Flushes any pending result, even in case of conflict.\r
1176  */\r
1177 \r
1178 \r
1179 \r
1180 static int Mysqltcl_Exec(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1181 {\r
1182         MysqlTclHandle *handle;\r
1183         int affected;\r
1184         Tcl_Obj *resList;\r
1185     if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,"handle sql-statement")) == 0)\r
1186         return TCL_ERROR;\r
1187 \r
1188         /* Flush any previous result. */\r
1189         freeResult(handle);\r
1190 \r
1191         if (mysql_QueryTclObj(handle,objv[2]))\r
1192         return mysql_server_confl(interp,objc,objv,handle->connection);\r
1193 \r
1194         if ((affected=mysql_affected_rows(handle->connection)) < 0) affected=0;\r
1195 \r
1196 #if (MYSQL_VERSION_ID >= 50000)\r
1197         if (!mysql_next_result(handle->connection)) {\r
1198                 resList = Tcl_GetObjResult(interp);\r
1199                 Tcl_ListObjAppendElement(interp, resList, Tcl_NewIntObj(affected));\r
1200                 do {\r
1201                         if ((affected=mysql_affected_rows(handle->connection)) < 0) affected=0;\r
1202                 Tcl_ListObjAppendElement(interp, resList, Tcl_NewIntObj(affected));\r
1203                 } while (!mysql_next_result(handle->connection));\r
1204                 return TCL_OK;\r
1205         }\r
1206 #endif\r
1207         Tcl_SetIntObj(Tcl_GetObjResult(interp),affected);  \r
1208         return TCL_OK ;\r
1209 }\r
1210 \r
1211 \r
1212 \r
1213 /*\r
1214  *----------------------------------------------------------------------\r
1215  *\r
1216  * Mysqltcl_Fetch\r
1217  *    Implements the mysqlnext command:\r
1218 \r
1219  *    usage: mysql::fetch handle\r
1220  *                      \r
1221  *    results:\r
1222  *      next row from pending results as tcl list, or null list.\r
1223  */\r
1224 \r
1225 static int Mysqltcl_Fetch(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1226 {\r
1227   MysqltclState *statePtr = (MysqltclState *)clientData; \r
1228   MysqlTclHandle *handle;\r
1229   int idx ;\r
1230   MYSQL_ROW row ;\r
1231   Tcl_Obj *resList;\r
1232   unsigned long *lengths;\r
1233 \r
1234   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_RES,"handle")) == 0)\r
1235     return TCL_ERROR;\r
1236 \r
1237 \r
1238   if (handle->res_count == 0)\r
1239     return TCL_OK ;\r
1240   else if ((row = mysql_fetch_row(handle->result)) == NULL) {\r
1241     handle->res_count = 0 ;\r
1242     return mysql_prim_confl(interp,objc,objv,"result counter out of sync") ;\r
1243   } else\r
1244     handle->res_count-- ;\r
1245   \r
1246   lengths = mysql_fetch_lengths(handle->result);\r
1247 \r
1248 \r
1249   resList = Tcl_GetObjResult(interp);\r
1250   for (idx = 0 ; idx < handle->col_count ; idx++, row++) {\r
1251     Tcl_ListObjAppendElement(interp, resList,getRowCellAsObject(statePtr,handle,row,lengths[idx]));\r
1252   }\r
1253   return TCL_OK;\r
1254 }\r
1255 \r
1256 \r
1257 /*\r
1258  *----------------------------------------------------------------------\r
1259  *\r
1260  * Mysqltcl_Seek\r
1261  *    Implements the mysqlseek command:\r
1262  *    usage: mysqlseek handle rownumber\r
1263  *                      \r
1264  *    results:\r
1265  *      number of remaining rows\r
1266  */\r
1267 \r
1268 static int Mysqltcl_Seek(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1269 {\r
1270     MysqlTclHandle *handle;\r
1271     int row;\r
1272     int total;\r
1273    \r
1274     if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_RES,\r
1275                               " handle row-index")) == 0)\r
1276       return TCL_ERROR;\r
1277 \r
1278     if (Tcl_GetIntFromObj(interp, objv[2], &row) != TCL_OK)\r
1279       return TCL_ERROR;\r
1280     \r
1281     total = mysql_num_rows(handle->result);\r
1282     \r
1283     if (total + row < 0) {\r
1284       mysql_data_seek(handle->result, 0);\r
1285 \r
1286       handle->res_count = total;\r
1287     } else if (row < 0) {\r
1288       mysql_data_seek(handle->result, total + row);\r
1289       handle->res_count = -row;\r
1290     } else if (row >= total) {\r
1291       mysql_data_seek(handle->result, row);\r
1292       handle->res_count = 0;\r
1293     } else {\r
1294       mysql_data_seek(handle->result, row);\r
1295       handle->res_count = total - row;\r
1296     }\r
1297 \r
1298     Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->res_count)) ;\r
1299     return TCL_OK;\r
1300 }\r
1301 \r
1302 \r
1303 /*\r
1304  *----------------------------------------------------------------------\r
1305  *\r
1306  * Mysqltcl_Map\r
1307  * Implements the mysqlmap command:\r
1308  * usage: mysqlmap handle binding-list script\r
1309  *                      \r
1310  * Results:\r
1311  * SIDE EFFECT: For each row the column values are bound to the variables\r
1312  * in the binding list and the script is evaluated.\r
1313  * The variables are created in the current context.\r
1314  * NOTE: mysqlmap works very much like a 'foreach' construct.\r
1315  * The 'continue' and 'break' commands may be used with their usual effect.\r
1316  */\r
1317 \r
1318 static int Mysqltcl_Map(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1319 {\r
1320   MysqltclState *statePtr = (MysqltclState *)clientData; \r
1321   int code ;\r
1322   int count ;\r
1323 \r
1324   MysqlTclHandle *handle;\r
1325   int idx;\r
1326   int listObjc;\r
1327   Tcl_Obj *tempObj,*varNameObj;\r
1328   MYSQL_ROW row;\r
1329   int *val;\r
1330   unsigned long *lengths;\r
1331   \r
1332   if ((handle = mysql_prologue(interp, objc, objv, 4, 4, CL_RES,\r
1333                             "handle binding-list script")) == 0)\r
1334     return TCL_ERROR;\r
1335 \r
1336   if (Tcl_ListObjLength(interp, objv[2], &listObjc) != TCL_OK)\r
1337         return TCL_ERROR ;\r
1338   \r
1339 \r
1340   if (listObjc > handle->col_count)\r
1341     {\r
1342       return mysql_prim_confl(interp,objc,objv,"too many variables in binding list") ;\r
1343     }\r
1344   else\r
1345     count = (listObjc < handle->col_count)?listObjc\r
1346       :handle->col_count ;\r
1347   \r
1348   val=(int*)Tcl_Alloc((count * sizeof(int)));\r
1349 \r
1350   for (idx=0; idx<count; idx++) {\r
1351     val[idx]=1;\r
1352     if (Tcl_ListObjIndex(interp, objv[2], idx, &varNameObj)!=TCL_OK)\r
1353         return TCL_ERROR;\r
1354     if (Tcl_GetStringFromObj(varNameObj,0)[0] != '-')\r
1355         val[idx]=1;\r
1356     else\r
1357         val[idx]=0;\r
1358   }\r
1359   \r
1360   while (handle->res_count > 0) {\r
1361     /* Get next row, decrement row counter. */\r
1362     if ((row = mysql_fetch_row(handle->result)) == NULL) {\r
1363       handle->res_count = 0 ;\r
1364       Tcl_Free((char *)val);\r
1365       return mysql_prim_confl(interp,objc,objv,"result counter out of sync") ;\r
1366     } else\r
1367       handle->res_count-- ;\r
1368       \r
1369     /* Bind variables to column values. */\r
1370     for (idx = 0; idx < count; idx++, row++) {\r
1371       lengths = mysql_fetch_lengths(handle->result);\r
1372       if (val[idx]) {\r
1373         tempObj = getRowCellAsObject(statePtr,handle,row,lengths[idx]);\r
1374         if (Tcl_ListObjIndex(interp, objv[2], idx, &varNameObj) != TCL_OK)\r
1375             goto error;\r
1376         if (Tcl_ObjSetVar2 (interp,varNameObj,NULL,tempObj,0) == NULL)\r
1377             goto error;\r
1378       }\r
1379     }\r
1380 \r
1381     /* Evaluate the script. */\r
1382     switch(code=Tcl_EvalObjEx(interp, objv[3],0)) {\r
1383     case TCL_CONTINUE:\r
1384     case TCL_OK:\r
1385       break ;\r
1386     case TCL_BREAK:\r
1387       Tcl_Free((char *)val);\r
1388       return TCL_OK ;\r
1389     default:\r
1390       Tcl_Free((char *)val);\r
1391       return code ;\r
1392     }\r
1393   }\r
1394   Tcl_Free((char *)val);\r
1395   return TCL_OK ;\r
1396 error:\r
1397   Tcl_Free((char *)val);\r
1398   return TCL_ERROR;    \r
1399 }\r
1400 \r
1401 /*\r
1402  *----------------------------------------------------------------------\r
1403  *\r
1404  * Mysqltcl_Receive\r
1405  * Implements the mysqlmap command:\r
1406  * usage: mysqlmap handle sqlquery binding-list script\r
1407  * \r
1408  * The method use internal mysql_use_result that no cache statment on client but\r
1409  * receive it direct from server \r
1410  *\r
1411  * Results:\r
1412  * SIDE EFFECT: For each row the column values are bound to the variables\r
1413  * in the binding list and the script is evaluated.\r
1414  * The variables are created in the current context.\r
1415  * NOTE: mysqlmap works very much like a 'foreach' construct.\r
1416  * The 'continue' and 'break' commands may be used with their usual effect.\r
1417 \r
1418  */\r
1419 \r
1420 static int Mysqltcl_Receive(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1421 {\r
1422   MysqltclState *statePtr = (MysqltclState *)clientData; \r
1423   int code=0;\r
1424   int count=0;\r
1425 \r
1426   MysqlTclHandle *handle;\r
1427   int idx;\r
1428   int listObjc;\r
1429   Tcl_Obj *tempObj,*varNameObj;\r
1430   MYSQL_ROW row;\r
1431   int *val = NULL;\r
1432   int breakLoop = 0;\r
1433   unsigned long *lengths;\r
1434   \r
1435   \r
1436   if ((handle = mysql_prologue(interp, objc, objv, 5, 5, CL_CONN,\r
1437                             "handle sqlquery binding-list script")) == 0)\r
1438     return TCL_ERROR;\r
1439   \r
1440   if (Tcl_ListObjLength(interp, objv[3], &listObjc) != TCL_OK)\r
1441         return TCL_ERROR;\r
1442   \r
1443   freeResult(handle);\r
1444   \r
1445   if (mysql_QueryTclObj(handle,objv[2])) {\r
1446     return mysql_server_confl(interp,objc,objv,handle->connection);\r
1447   }\r
1448 \r
1449   if ((handle->result = mysql_use_result(handle->connection)) == NULL) {\r
1450     return mysql_server_confl(interp,objc,objv,handle->connection);\r
1451   } else {\r
1452     while ((row = mysql_fetch_row(handle->result))!= NULL) {\r
1453       if (val==NULL) {\r
1454         /* first row compute all data */\r
1455         handle->col_count = mysql_num_fields(handle->result);\r
1456         if (listObjc > handle->col_count) {\r
1457           return mysql_prim_confl(interp,objc,objv,"too many variables in binding list") ;\r
1458         } else {\r
1459           count = (listObjc < handle->col_count)?listObjc:handle->col_count ;\r
1460         }\r
1461         val=(int*)Tcl_Alloc((count * sizeof(int)));\r
1462         for (idx=0; idx<count; idx++) {\r
1463           if (Tcl_ListObjIndex(interp, objv[3], idx, &varNameObj)!=TCL_OK)\r
1464             return TCL_ERROR;\r
1465           if (Tcl_GetStringFromObj(varNameObj,0)[0] != '-')\r
1466             val[idx]=1;\r
1467           else\r
1468             val[idx]=0;\r
1469         }       \r
1470       }\r
1471       for (idx = 0; idx < count; idx++, row++) {\r
1472          lengths = mysql_fetch_lengths(handle->result);\r
1473 \r
1474          if (val[idx]) {\r
1475             if (Tcl_ListObjIndex(interp, objv[3], idx, &varNameObj)!=TCL_OK) {\r
1476                 Tcl_Free((char *)val);\r
1477                 return TCL_ERROR;\r
1478             }\r
1479             tempObj = getRowCellAsObject(statePtr,handle,row,lengths[idx]);\r
1480             if (Tcl_ObjSetVar2 (interp,varNameObj,NULL,tempObj,TCL_LEAVE_ERR_MSG) == NULL) {\r
1481                Tcl_Free((char *)val);\r
1482                return TCL_ERROR ;\r
1483             }\r
1484          }\r
1485       }\r
1486       \r
1487       /* Evaluate the script. */\r
1488       switch(code=Tcl_EvalObjEx(interp, objv[4],0)) {\r
1489       case TCL_CONTINUE:\r
1490       case TCL_OK:\r
1491         break ;\r
1492       case TCL_BREAK:\r
1493         breakLoop=1;\r
1494         break;\r
1495       default:\r
1496         breakLoop=1;\r
1497         break;\r
1498       }\r
1499       if (breakLoop==1) break;\r
1500     }\r
1501   }\r
1502   if (val!=NULL) {\r
1503     Tcl_Free((char *)val);\r
1504   } \r
1505   /*  Read all rest rows that leave in error or break case */\r
1506   while ((row = mysql_fetch_row(handle->result))!= NULL);\r
1507   if (code!=TCL_CONTINUE && code!=TCL_OK && code!=TCL_BREAK) {\r
1508     return code;\r
1509   } else {\r
1510     return mysql_server_confl(interp,objc,objv,handle->connection);\r
1511   } \r
1512 }\r
1513 \r
1514 \r
1515 /*\r
1516  *----------------------------------------------------------------------\r
1517  *\r
1518  * Mysqltcl_Info\r
1519  * Implements the mysqlinfo command:\r
1520  * usage: mysqlinfo handle option\r
1521  *\r
1522 \r
1523 \r
1524  */\r
1525 \r
1526 static int Mysqltcl_Info(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1527 {\r
1528 \r
1529   int count ;\r
1530   MysqlTclHandle *handle;\r
1531   int idx ;\r
1532   MYSQL_RES* list ;\r
1533   MYSQL_ROW row ;\r
1534   const char* val ;\r
1535   Tcl_Obj *resList;\r
1536   static CONST char* MysqlDbOpt[] =\r
1537     {\r
1538       "dbname", "dbname?", "tables", "host", "host?", "databases",\r
1539       "info","serverversion",\r
1540 #if (MYSQL_VERSION_ID >= 40107)\r
1541       "serverversionid","sqlstate",\r
1542 #endif\r
1543       "state",NULL\r
1544     };\r
1545   enum dboption {\r
1546     MYSQL_INFNAME_OPT, MYSQL_INFNAMEQ_OPT, MYSQL_INFTABLES_OPT,\r
1547     MYSQL_INFHOST_OPT, MYSQL_INFHOSTQ_OPT, MYSQL_INFLIST_OPT, MYSQL_INFO,\r
1548     MYSQL_INF_SERVERVERSION,MYSQL_INFO_SERVERVERSION_ID,MYSQL_INFO_SQLSTATE,MYSQL_INFO_STATE\r
1549   };\r
1550   \r
1551   /* We can't fully check the handle at this stage. */\r
1552   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_PLAIN,\r
1553                             "handle option")) == 0)\r
1554     return TCL_ERROR;\r
1555 \r
1556   if (Tcl_GetIndexFromObj(interp, objv[2], MysqlDbOpt, "option",\r
1557                           TCL_EXACT, &idx) != TCL_OK)\r
1558     return TCL_ERROR;\r
1559 \r
1560   /* First check the handle. Checking depends on the option. */\r
1561   switch (idx) {\r
1562   case MYSQL_INFNAMEQ_OPT:\r
1563     if ((handle = get_handle(interp,objc,objv,CL_CONN))!=NULL) {\r
1564       if (handle->database[0] == '\0')\r
1565         return TCL_OK ; /* Return empty string if no current db. */\r
1566     }\r
1567     break ;\r
1568   case MYSQL_INFNAME_OPT:\r
1569   case MYSQL_INFTABLES_OPT:\r
1570   case MYSQL_INFHOST_OPT:\r
1571   case MYSQL_INFLIST_OPT:\r
1572     /* !!! */\r
1573     handle = get_handle(interp,objc,objv,CL_CONN);\r
1574     break;\r
1575   case MYSQL_INFO:\r
1576   case MYSQL_INF_SERVERVERSION:\r
1577 #if (MYSQL_VERSION_ID >= 40107)\r
1578   case MYSQL_INFO_SERVERVERSION_ID:\r
1579   case MYSQL_INFO_SQLSTATE:\r
1580 #endif\r
1581   case MYSQL_INFO_STATE:\r
1582     break;\r
1583 \r
1584   case MYSQL_INFHOSTQ_OPT:\r
1585     if (handle->connection == 0)\r
1586       return TCL_OK ; /* Return empty string if not connected. */\r
1587     break;\r
1588   default: /* should never happen */\r
1589     return mysql_prim_confl(interp,objc,objv,"weirdness in Mysqltcl_Info") ;\r
1590   }\r
1591   \r
1592   if (handle == 0) return TCL_ERROR ;\r
1593 \r
1594   /* Handle OK, return the requested info. */\r
1595   switch (idx) {\r
1596   case MYSQL_INFNAME_OPT:\r
1597   case MYSQL_INFNAMEQ_OPT:\r
1598     Tcl_SetObjResult(interp, Tcl_NewStringObj(handle->database, -1));\r
1599     break ;\r
1600   case MYSQL_INFTABLES_OPT:\r
1601     if ((list = mysql_list_tables(handle->connection,(char*)NULL)) == NULL)\r
1602       return mysql_server_confl(interp,objc,objv,handle->connection);\r
1603     \r
1604     resList = Tcl_GetObjResult(interp);\r
1605     for (count = mysql_num_rows(list); count > 0; count--) {\r
1606       val = *(row = mysql_fetch_row(list)) ;\r
1607       Tcl_ListObjAppendElement(interp, resList, Tcl_NewStringObj((val == NULL)?"":val,-1));\r
1608     }\r
1609     mysql_free_result(list) ;\r
1610     break ;\r
1611   case MYSQL_INFHOST_OPT:\r
1612 \r
1613   case MYSQL_INFHOSTQ_OPT:\r
1614     Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_get_host_info(handle->connection), -1));\r
1615     break ;\r
1616   case MYSQL_INFLIST_OPT:\r
1617     if ((list = mysql_list_dbs(handle->connection,(char*)NULL)) == NULL)\r
1618       return mysql_server_confl(interp,objc,objv,handle->connection);\r
1619     \r
1620     resList = Tcl_GetObjResult(interp);\r
1621     for (count = mysql_num_rows(list); count > 0; count--) {\r
1622       val = *(row = mysql_fetch_row(list)) ;\r
1623       Tcl_ListObjAppendElement(interp, resList,\r
1624                                 Tcl_NewStringObj((val == NULL)?"":val,-1));\r
1625     }\r
1626     mysql_free_result(list) ;\r
1627     break ;\r
1628   case MYSQL_INFO:\r
1629     val = mysql_info(handle->connection);\r
1630     if (val!=NULL) {\r
1631       Tcl_SetObjResult(interp, Tcl_NewStringObj(val,-1));      \r
1632     }\r
1633     break;\r
1634   case MYSQL_INF_SERVERVERSION:\r
1635      Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_get_server_info(handle->connection),-1));\r
1636      break;\r
1637 #if (MYSQL_VERSION_ID >= 40107)\r
1638   case MYSQL_INFO_SERVERVERSION_ID:\r
1639          Tcl_SetObjResult(interp, Tcl_NewIntObj(mysql_get_server_version(handle->connection)));\r
1640          break;\r
1641   case MYSQL_INFO_SQLSTATE:\r
1642      Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_sqlstate(handle->connection),-1));\r
1643      break;\r
1644 #endif\r
1645   case MYSQL_INFO_STATE:\r
1646      Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_stat(handle->connection),-1));\r
1647      break;\r
1648   default: /* should never happen */\r
1649     return mysql_prim_confl(interp,objc,objv,"weirdness in Mysqltcl_Info") ;\r
1650   }\r
1651 \r
1652   return TCL_OK ;\r
1653 }\r
1654 \r
1655 /*\r
1656  *----------------------------------------------------------------------\r
1657  *\r
1658  * Mysqltcl_BaseInfo\r
1659  * Implements the mysqlinfo command:\r
1660  * usage: mysqlbaseinfo option\r
1661  *\r
1662  */\r
1663 \r
1664 static int Mysqltcl_BaseInfo(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1665 {\r
1666   int idx ;\r
1667   Tcl_Obj *resList;\r
1668   char **option;\r
1669   static CONST char* MysqlInfoOpt[] =\r
1670     {\r
1671       "connectparameters", "clientversion",\r
1672 #if (MYSQL_VERSION_ID >= 40107)\r
1673       "clientversionid",\r
1674 #endif\r
1675       NULL\r
1676     };\r
1677   enum baseoption {\r
1678     MYSQL_BINFO_CONNECT, MYSQL_BINFO_CLIENTVERSION,MYSQL_BINFO_CLIENTVERSIONID\r
1679   };\r
1680 \r
1681   if (objc <2) {\r
1682       Tcl_WrongNumArgs(interp, 1, objv, "connectparameters | clientversion");\r
1683 \r
1684       return TCL_ERROR;\r
1685   }  \r
1686   if (Tcl_GetIndexFromObj(interp, objv[1], MysqlInfoOpt, "option",\r
1687                           TCL_EXACT, &idx) != TCL_OK)\r
1688     return TCL_ERROR;\r
1689 \r
1690   /* First check the handle. Checking depends on the option. */\r
1691   switch (idx) {\r
1692   case MYSQL_BINFO_CONNECT:\r
1693     option = (char **)MysqlConnectOpt;\r
1694     resList = Tcl_NewListObj(0, NULL);\r
1695 \r
1696     while (*option!=NULL) {\r
1697       Tcl_ListObjAppendElement(interp, resList, Tcl_NewStringObj(*option,-1));\r
1698       option++;\r
1699     }\r
1700     Tcl_SetObjResult(interp, resList);\r
1701     break ;\r
1702   case MYSQL_BINFO_CLIENTVERSION:\r
1703     Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_get_client_info(),-1));\r
1704     break;\r
1705 #if (MYSQL_VERSION_ID >= 40107)\r
1706   case MYSQL_BINFO_CLIENTVERSIONID:\r
1707     Tcl_SetObjResult(interp, Tcl_NewIntObj(mysql_get_client_version()));\r
1708     break;\r
1709 #endif\r
1710   }\r
1711   return TCL_OK ;\r
1712 }\r
1713 \r
1714 \r
1715 /*\r
1716  *----------------------------------------------------------------------\r
1717  *\r
1718  * Mysqltcl_Result\r
1719 \r
1720  * Implements the mysqlresult command:\r
1721  * usage: mysqlresult handle option\r
1722  *\r
1723  */\r
1724 \r
1725 static int Mysqltcl_Result(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1726 {\r
1727   int idx ;\r
1728   MysqlTclHandle *handle;\r
1729   static CONST char* MysqlResultOpt[] =\r
1730     {\r
1731      "rows", "rows?", "cols", "cols?", "current", "current?", NULL\r
1732     };\r
1733   enum resultoption {\r
1734     MYSQL_RESROWS_OPT, MYSQL_RESROWSQ_OPT, MYSQL_RESCOLS_OPT, \r
1735     MYSQL_RESCOLSQ_OPT, MYSQL_RESCUR_OPT, MYSQL_RESCURQ_OPT\r
1736   };\r
1737   /* We can't fully check the handle at this stage. */\r
1738   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_PLAIN,\r
1739                             " handle option")) == 0)\r
1740 \r
1741     return TCL_ERROR;\r
1742 \r
1743   if (Tcl_GetIndexFromObj(interp, objv[2], MysqlResultOpt, "option",\r
1744                           TCL_EXACT, &idx) != TCL_OK)\r
1745     return TCL_ERROR;\r
1746 \r
1747   /* First check the handle. Checking depends on the option. */\r
1748   switch (idx) {\r
1749   case MYSQL_RESROWS_OPT:\r
1750   case MYSQL_RESCOLS_OPT:\r
1751   case MYSQL_RESCUR_OPT:\r
1752     handle = get_handle(interp,objc,objv,CL_RES) ;\r
1753     break ;\r
1754   case MYSQL_RESROWSQ_OPT:\r
1755   case MYSQL_RESCOLSQ_OPT:\r
1756   case MYSQL_RESCURQ_OPT:\r
1757     if ((handle = get_handle(interp,objc,objv,CL_RES))== NULL)\r
1758       return TCL_OK ; /* Return empty string if no pending result. */\r
1759     break ;\r
1760   default: /* should never happen */\r
1761     return mysql_prim_confl(interp,objc,objv,"weirdness in Mysqltcl_Result") ;\r
1762   }\r
1763   \r
1764   \r
1765   if (handle == 0)\r
1766     return TCL_ERROR ;\r
1767 \r
1768   /* Handle OK; return requested info. */\r
1769   switch (idx) {\r
1770   case MYSQL_RESROWS_OPT:\r
1771   case MYSQL_RESROWSQ_OPT:\r
1772     Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->res_count));\r
1773     break ;\r
1774   case MYSQL_RESCOLS_OPT:\r
1775   case MYSQL_RESCOLSQ_OPT:\r
1776     Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->col_count));\r
1777     break ;\r
1778   case MYSQL_RESCUR_OPT:\r
1779   case MYSQL_RESCURQ_OPT:\r
1780     Tcl_SetObjResult(interp,\r
1781                        Tcl_NewIntObj(mysql_num_rows(handle->result)\r
1782                                      - handle->res_count)) ;\r
1783     break ;\r
1784   default:\r
1785     return mysql_prim_confl(interp,objc,objv,"weirdness in Mysqltcl_Result");\r
1786   }\r
1787   return TCL_OK ;\r
1788 }\r
1789 \r
1790 \r
1791 /*\r
1792  *----------------------------------------------------------------------\r
1793  *\r
1794  * Mysqltcl_Col\r
1795 \r
1796  *    Implements the mysqlcol command:\r
1797  *    usage: mysqlcol handle table-name option ?option ...?\r
1798  *           mysqlcol handle -current option ?option ...?\r
1799  * '-current' can only be used if there is a pending result.\r
1800  *                      \r
1801  *    results:\r
1802  *      List of lists containing column attributes.\r
1803  *      If a single attribute is requested the result is a simple list.\r
1804  *\r
1805  * SIDE EFFECT: '-current' disturbs the field position of the result.\r
1806  */\r
1807 \r
1808 static int Mysqltcl_Col(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1809 {\r
1810   int coln ;\r
1811   int current_db ;\r
1812   MysqlTclHandle *handle;\r
1813   int idx ;\r
1814   int listObjc ;\r
1815   Tcl_Obj **listObjv, *colinfo, *resList, *resSubList;\r
1816   MYSQL_FIELD* fld ;\r
1817   MYSQL_RES* result ;\r
1818   char *argv ;\r
1819   \r
1820   /* This check is enough only without '-current'. */\r
1821   if ((handle = mysql_prologue(interp, objc, objv, 4, 99, CL_CONN,\r
1822                             "handle table-name option ?option ...?")) == 0)\r
1823     return TCL_ERROR;\r
1824 \r
1825   /* Fetch column info.\r
1826    * Two ways: explicit database and table names, or current.\r
1827    */\r
1828   argv=Tcl_GetStringFromObj(objv[2],NULL);\r
1829   current_db = strcmp(argv, "-current") == 0;\r
1830   \r
1831   if (current_db) {\r
1832     if ((handle = get_handle(interp,objc,objv,CL_RES)) == 0)\r
1833       return TCL_ERROR ;\r
1834     else\r
1835       result = handle->result ;\r
1836   } else {\r
1837     if ((result = mysql_list_fields(handle->connection, argv, (char*)NULL)) == NULL) {\r
1838       return mysql_server_confl(interp,objc,objv,handle->connection) ;\r
1839     }\r
1840   }\r
1841   /* Must examine the first specifier at this point. */\r
1842   if (Tcl_ListObjGetElements(interp, objv[3], &listObjc, &listObjv) != TCL_OK)\r
1843     return TCL_ERROR ;\r
1844   resList = Tcl_GetObjResult(interp);\r
1845   if (objc == 4 && listObjc == 1) {\r
1846       mysql_field_seek(result, 0) ;\r
1847       while ((fld = mysql_fetch_field(result)) != NULL)\r
1848         if ((colinfo = mysql_colinfo(interp,objc,objv,fld, objv[3])) != NULL) {\r
1849             Tcl_ListObjAppendElement(interp, resList, colinfo);\r
1850         } else {\r
1851             goto conflict;\r
1852             }\r
1853   } else if (objc == 4 && listObjc > 1) {\r
1854       mysql_field_seek(result, 0) ;\r
1855       while ((fld = mysql_fetch_field(result)) != NULL) {\r
1856         resSubList = Tcl_NewListObj(0, NULL);\r
1857         for (coln = 0; coln < listObjc; coln++)\r
1858             if ((colinfo = mysql_colinfo(interp,objc,objv,fld, listObjv[coln])) != NULL) {\r
1859                 Tcl_ListObjAppendElement(interp, resSubList, colinfo);\r
1860             } else {\r
1861 \r
1862                goto conflict; \r
1863             }\r
1864         Tcl_ListObjAppendElement(interp, resList, resSubList);\r
1865         }\r
1866   } else {\r
1867       for (idx = 3; idx < objc; idx++) {\r
1868         resSubList = Tcl_NewListObj(0, NULL);\r
1869         mysql_field_seek(result, 0) ;\r
1870         while ((fld = mysql_fetch_field(result)) != NULL)\r
1871         if ((colinfo = mysql_colinfo(interp,objc,objv,fld, objv[idx])) != NULL) {\r
1872 \r
1873             Tcl_ListObjAppendElement(interp, resSubList, colinfo);\r
1874         } else {\r
1875             goto conflict; \r
1876         }\r
1877         Tcl_ListObjAppendElement(interp, resList, resSubList);\r
1878       }\r
1879   }\r
1880   if (!current_db) mysql_free_result(result) ;\r
1881   return TCL_OK;\r
1882   \r
1883   conflict:\r
1884     if (!current_db) mysql_free_result(result) ;\r
1885     return TCL_ERROR;\r
1886 }\r
1887 \r
1888 \r
1889 /*\r
1890  *----------------------------------------------------------------------\r
1891  *\r
1892  * Mysqltcl_State\r
1893  *    Implements the mysqlstate command:\r
1894  *    usage: mysqlstate handle ?-numeric?\r
1895 \r
1896  *                      \r
1897  */\r
1898 \r
1899 static int Mysqltcl_State(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1900 {\r
1901   MysqlTclHandle *handle;\r
1902   int numeric=0 ;\r
1903   Tcl_Obj *res;\r
1904 \r
1905   if (objc!=2 && objc!=3) {\r
1906       Tcl_WrongNumArgs(interp, 1, objv, "handle ?-numeric");\r
1907       return TCL_ERROR;\r
1908   }\r
1909 \r
1910   if (objc==3) {\r
1911     if (strcmp(Tcl_GetStringFromObj(objv[2],NULL), "-numeric"))\r
1912       return mysql_prim_confl(interp,objc,objv,"last parameter should be -numeric");\r
1913     else\r
1914 \r
1915       numeric=1;\r
1916   }\r
1917   \r
1918   if (GetHandleFromObj(interp, objv[1], &handle) != TCL_OK)\r
1919     res = (numeric)?Tcl_NewIntObj(0):Tcl_NewStringObj("NOT_A_HANDLE",-1);\r
1920   else if (handle->connection == 0)\r
1921     res = (numeric)?Tcl_NewIntObj(1):Tcl_NewStringObj("UNCONNECTED",-1);\r
1922   else if (handle->database[0] == '\0')\r
1923     res = (numeric)?Tcl_NewIntObj(2):Tcl_NewStringObj("CONNECTED",-1);\r
1924   else if (handle->result == NULL)\r
1925     res = (numeric)?Tcl_NewIntObj(3):Tcl_NewStringObj("IN_USE",-1);\r
1926   else\r
1927     res = (numeric)?Tcl_NewIntObj(4):Tcl_NewStringObj("RESULT_PENDING",-1);\r
1928 \r
1929   Tcl_SetObjResult(interp, res);\r
1930   return TCL_OK ;\r
1931 }\r
1932 \r
1933 \r
1934 /*\r
1935  *----------------------------------------------------------------------\r
1936  *\r
1937  * Mysqltcl_InsertId\r
1938  *    Implements the mysqlstate command:\r
1939  *    usage: mysqlinsertid handle \r
1940  *    Returns the auto increment id of the last INSERT statement\r
1941  *                      \r
1942  */\r
1943 \r
1944 static int Mysqltcl_InsertId(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1945 {\r
1946 \r
1947   MysqlTclHandle *handle;\r
1948   \r
1949   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
1950                             "handle")) == 0)\r
1951     return TCL_ERROR;\r
1952 \r
1953   Tcl_SetObjResult(interp, Tcl_NewIntObj(mysql_insert_id(handle->connection)));\r
1954 \r
1955   return TCL_OK;\r
1956 }\r
1957 \r
1958 /*\r
1959  *----------------------------------------------------------------------\r
1960  *\r
1961  * Mysqltcl_Ping\r
1962  *    usage: mysqlping handle\r
1963  *    It can be used to check and refresh (reconnect after time out) the connection\r
1964  *    Returns 0 if connection is OK\r
1965  */\r
1966 \r
1967 \r
1968 static int Mysqltcl_Ping(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1969 {\r
1970   MysqlTclHandle *handle;\r
1971   \r
1972   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
1973                             "handle")) == 0)\r
1974     return TCL_ERROR;\r
1975 \r
1976   Tcl_SetObjResult(interp, Tcl_NewBooleanObj(mysql_ping(handle->connection)==0));\r
1977 \r
1978   return TCL_OK;\r
1979 }\r
1980 \r
1981 /*\r
1982  *----------------------------------------------------------------------\r
1983  *\r
1984  * Mysqltcl_ChangeUser\r
1985  *    usage: mysqlchangeuser handle user password database\r
1986  *    return TCL_ERROR if operation failed\r
1987  */\r
1988 \r
1989 static int Mysqltcl_ChangeUser(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
1990 {\r
1991   MysqlTclHandle *handle;\r
1992   int len;\r
1993   char *user,*password,*database=NULL;\r
1994   \r
1995   if ((handle = mysql_prologue(interp, objc, objv, 4, 5, CL_CONN,\r
1996                             "handle user password ?database?")) == 0)\r
1997     return TCL_ERROR;\r
1998 \r
1999   user = Tcl_GetStringFromObj(objv[2],NULL);\r
2000   password = Tcl_GetStringFromObj(objv[3],NULL);\r
2001   if (objc==5) {\r
2002     database = Tcl_GetStringFromObj(objv[4],&len);\r
2003     if (len >= MYSQL_NAME_LEN) {\r
2004        mysql_prim_confl(interp,objc,objv,"database name too long");\r
2005        return TCL_ERROR;\r
2006     }\r
2007   }\r
2008   if (mysql_change_user(handle->connection, user, password, database)!=0) {\r
2009       mysql_server_confl(interp,objc,objv,handle->connection);\r
2010       return TCL_ERROR;\r
2011   }\r
2012   if (database!=NULL) \r
2013           strcpy(handle->database, database);\r
2014   return TCL_OK;\r
2015 }\r
2016 /*\r
2017  *----------------------------------------------------------------------\r
2018  *\r
2019  * Mysqltcl_AutoCommit\r
2020  *    usage: mysql::autocommit bool\r
2021  *    set autocommit mode\r
2022  */\r
2023 \r
2024 static int Mysqltcl_AutoCommit(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2025 {\r
2026 #if (MYSQL_VERSION_ID < 40107)\r
2027   Tcl_AddErrorInfo(interp, FUNCTION_NOT_AVAILABLE);\r
2028   return TCL_ERROR;\r
2029 #else\r
2030   MysqlTclHandle *handle;\r
2031   int isAutocommit = 0;\r
2032 \r
2033   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
2034                             "handle bool")) == 0)\r
2035         return TCL_ERROR;\r
2036   if (Tcl_GetBooleanFromObj(interp,objv[2],&isAutocommit) != TCL_OK )\r
2037         return TCL_ERROR;\r
2038   if (mysql_autocommit(handle->connection, isAutocommit)!=0) {\r
2039         mysql_server_confl(interp,objc,objv,handle->connection);\r
2040   }\r
2041   return TCL_OK;\r
2042 #endif\r
2043 }\r
2044 /*\r
2045  *----------------------------------------------------------------------\r
2046  *\r
2047  * Mysqltcl_Commit\r
2048  *    usage: mysql::commit\r
2049  *    \r
2050  */\r
2051 \r
2052 static int Mysqltcl_Commit(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2053 {\r
2054 #if (MYSQL_VERSION_ID < 40107)\r
2055   Tcl_AddErrorInfo(interp, FUNCTION_NOT_AVAILABLE);\r
2056   return TCL_ERROR;\r
2057 #else\r
2058   MysqlTclHandle *handle;\r
2059 \r
2060   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
2061                             "handle")) == 0)\r
2062     return TCL_ERROR;\r
2063   if (mysql_commit(handle->connection)!=0) {\r
2064         mysql_server_confl(interp,objc,objv,handle->connection);\r
2065   }\r
2066   return TCL_OK;\r
2067 #endif\r
2068 }\r
2069 /*\r
2070  *----------------------------------------------------------------------\r
2071  *\r
2072  * Mysqltcl_Rollback\r
2073  *    usage: mysql::rollback\r
2074  *\r
2075  */\r
2076 \r
2077 static int Mysqltcl_Rollback(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2078 {\r
2079 #if (MYSQL_VERSION_ID < 40107)\r
2080   Tcl_AddErrorInfo(interp, FUNCTION_NOT_AVAILABLE);\r
2081   return TCL_ERROR;\r
2082 #else\r
2083   MysqlTclHandle *handle;\r
2084 \r
2085   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
2086                             "handle")) == 0)\r
2087     return TCL_ERROR;\r
2088   if (mysql_rollback(handle->connection)!=0) {\r
2089       mysql_server_confl(interp,objc,objv,handle->connection);\r
2090   }\r
2091   return TCL_OK;\r
2092 #endif\r
2093 }\r
2094 /*\r
2095  *----------------------------------------------------------------------\r
2096  *\r
2097  * Mysqltcl_MoreResult\r
2098  *    usage: mysql::moreresult handle\r
2099  *    return true if more results exists\r
2100  */\r
2101 \r
2102 static int Mysqltcl_MoreResult(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2103 {\r
2104 #if (MYSQL_VERSION_ID < 40107)\r
2105   Tcl_AddErrorInfo(interp, FUNCTION_NOT_AVAILABLE);\r
2106   return TCL_ERROR;\r
2107 #else\r
2108   MysqlTclHandle *handle;\r
2109   int boolResult = 0;\r
2110 \r
2111   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_RES,\r
2112                             "handle")) == 0)\r
2113     return TCL_ERROR;\r
2114   boolResult =  mysql_more_results(handle->connection);\r
2115   Tcl_SetObjResult(interp,Tcl_NewBooleanObj(boolResult));\r
2116   return TCL_OK;\r
2117 #endif\r
2118 }\r
2119 /*\r
2120 \r
2121  *----------------------------------------------------------------------\r
2122  *\r
2123  * Mysqltcl_NextResult\r
2124  *    usage: mysql::nextresult\r
2125  *\r
2126  *  return nummber of rows in result set. 0 if no next result\r
2127  */\r
2128 \r
2129 static int Mysqltcl_NextResult(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2130 {\r
2131 #if (MYSQL_VERSION_ID < 40107)\r
2132   Tcl_AddErrorInfo(interp, FUNCTION_NOT_AVAILABLE);\r
2133   return TCL_ERROR;\r
2134 #else\r
2135   MysqlTclHandle *handle;\r
2136   int result = 0;\r
2137 \r
2138   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_RES,\r
2139                             "handle")) == 0)\r
2140     return TCL_ERROR;\r
2141   if (handle->result != NULL) {\r
2142     mysql_free_result(handle->result) ;\r
2143     handle->result = NULL ;\r
2144   }\r
2145   result = mysql_next_result(handle->connection);\r
2146   if (result==-1) {\r
2147       Tcl_SetObjResult(interp, Tcl_NewIntObj(0));\r
2148       return TCL_OK;\r
2149   }\r
2150   if (result<0) {\r
2151       return mysql_server_confl(interp,objc,objv,handle->connection);\r
2152   }\r
2153   handle->result = mysql_store_result(handle->connection);\r
2154   if (handle->result == NULL) {\r
2155       Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));\r
2156   } else {\r
2157       handle->res_count = mysql_num_rows(handle->result);\r
2158       Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->res_count));\r
2159   }\r
2160   return TCL_OK;\r
2161 #endif\r
2162 }\r
2163 /*\r
2164  *----------------------------------------------------------------------\r
2165  *\r
2166  * Mysqltcl_WarningCount\r
2167  *    usage: mysql::warningcount\r
2168  *\r
2169  */\r
2170 \r
2171 static int Mysqltcl_WarningCount(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2172 {\r
2173 #if (MYSQL_VERSION_ID < 40107)\r
2174   Tcl_AddErrorInfo(interp, FUNCTION_NOT_AVAILABLE);\r
2175   return TCL_ERROR;\r
2176 #else\r
2177   MysqlTclHandle *handle;\r
2178   int count = 0;\r
2179 \r
2180   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
2181                             "handle")) == 0)\r
2182     return TCL_ERROR;\r
2183   count = mysql_warning_count(handle->connection);\r
2184   Tcl_SetObjResult(interp,Tcl_NewIntObj(count));\r
2185   return TCL_OK;\r
2186 #endif\r
2187 }\r
2188 /*\r
2189  *----------------------------------------------------------------------\r
2190  *\r
2191  * Mysqltcl_IsNull\r
2192  *    usage: mysql::isnull value\r
2193  *\r
2194  */\r
2195 \r
2196 static int Mysqltcl_IsNull(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2197 {\r
2198   int boolResult = 0;\r
2199   if (objc != 2) {\r
2200       Tcl_WrongNumArgs(interp, 1, objv, "value");\r
2201       return TCL_ERROR;\r
2202   }\r
2203   boolResult = objv[1]->typePtr == &mysqlNullType;\r
2204   Tcl_SetObjResult(interp,Tcl_NewBooleanObj(boolResult));\r
2205   return TCL_OK;\r
2206 \r
2207   return TCL_OK;\r
2208 }\r
2209 /*\r
2210  * Create new Mysql NullObject\r
2211  * (similar to Tcl API for example Tcl_NewIntObj)\r
2212  */\r
2213 static Tcl_Obj *Mysqltcl_NewNullObj(MysqltclState *mysqltclState) {\r
2214   Tcl_Obj *objPtr;\r
2215   objPtr = Tcl_NewObj();\r
2216   objPtr->bytes = NULL;\r
2217   objPtr->typePtr = &mysqlNullType;\r
2218   objPtr->internalRep.otherValuePtr = mysqltclState;\r
2219   return objPtr;\r
2220 }\r
2221 /*\r
2222  *----------------------------------------------------------------------\r
2223  *\r
2224  * Mysqltcl_NewNull\r
2225  *    usage: mysql::newnull\r
2226  *\r
2227  */\r
2228 \r
2229 static int Mysqltcl_NewNull(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2230 {\r
2231   if (objc != 1) {\r
2232       Tcl_WrongNumArgs(interp, 1, objv, "");\r
2233       return TCL_ERROR;\r
2234   }\r
2235   Tcl_SetObjResult(interp,Mysqltcl_NewNullObj((MysqltclState *)clientData));\r
2236   return TCL_OK;\r
2237 }\r
2238 /*\r
2239  *----------------------------------------------------------------------\r
2240  *\r
2241  * Mysqltcl_SetServerOption\r
2242  *    usage: mysql::setserveroption (-\r
2243  *\r
2244  */\r
2245 #if (MYSQL_VERSION_ID >= 40107)\r
2246 static CONST char* MysqlServerOpt[] =\r
2247     {\r
2248       "-multi_statment_on", "-multi_statment_off",NULL\r
2249     };\r
2250 #endif\r
2251  \r
2252 static int Mysqltcl_SetServerOption(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2253 {\r
2254 #if (MYSQL_VERSION_ID < 40107)\r
2255   Tcl_AddErrorInfo(interp, FUNCTION_NOT_AVAILABLE);\r
2256   return TCL_ERROR;\r
2257 #else\r
2258   MysqlTclHandle *handle;\r
2259   int idx;\r
2260   enum enum_mysql_set_option mysqlServerOption;\r
2261   \r
2262   enum serveroption {\r
2263     MYSQL_MSTATMENT_ON_SOPT, MYSQL_MSTATMENT_OFF_SOPT\r
2264   };\r
2265 \r
2266   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
2267                             "handle option")) == 0)\r
2268     return TCL_ERROR;\r
2269 \r
2270   if (Tcl_GetIndexFromObj(interp, objv[2], MysqlServerOpt, "option",\r
2271                           0, &idx) != TCL_OK)\r
2272       return TCL_ERROR;\r
2273 \r
2274   switch (idx) {\r
2275     case MYSQL_MSTATMENT_ON_SOPT:\r
2276       mysqlServerOption = MYSQL_OPTION_MULTI_STATEMENTS_ON;\r
2277       break;\r
2278     case MYSQL_MSTATMENT_OFF_SOPT:\r
2279       mysqlServerOption = MYSQL_OPTION_MULTI_STATEMENTS_OFF;\r
2280       break;\r
2281     default:\r
2282       return mysql_prim_confl(interp,objc,objv,"Weirdness in server options");\r
2283   }\r
2284   if (mysql_set_server_option(handle->connection,mysqlServerOption)!=0) {\r
2285         mysql_server_confl(interp,objc,objv,handle->connection);\r
2286   }\r
2287   return TCL_OK;\r
2288 #endif\r
2289 }\r
2290 /*\r
2291  *----------------------------------------------------------------------\r
2292  *\r
2293  * Mysqltcl_ShutDown\r
2294  *    usage: mysql::shutdown handle\r
2295  *\r
2296  */\r
2297 static int Mysqltcl_ShutDown(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2298 {\r
2299   MysqlTclHandle *handle;\r
2300 \r
2301   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
2302                             "handle")) == 0)\r
2303     return TCL_ERROR;\r
2304 #if (MYSQL_VERSION_ID >= 40107)\r
2305   if (mysql_shutdown(handle->connection,SHUTDOWN_DEFAULT)!=0) {\r
2306 #else\r
2307   if (mysql_shutdown(handle->connection)!=0) {\r
2308 #endif\r
2309         mysql_server_confl(interp,objc,objv,handle->connection);\r
2310   }\r
2311   return TCL_OK;\r
2312 }\r
2313 /*\r
2314  *----------------------------------------------------------------------\r
2315  *\r
2316  * Mysqltcl_Encoding\r
2317  *    usage: mysql::encoding handle ?encoding|binary?\r
2318  *\r
2319  */\r
2320 static int Mysqltcl_Encoding(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2321 {\r
2322   MysqltclState *statePtr = (MysqltclState *)clientData;\r
2323   Tcl_HashSearch search;\r
2324   Tcl_HashEntry *entryPtr;\r
2325   MysqlTclHandle *handle,*qhandle;\r
2326   char *encodingname;\r
2327   Tcl_Encoding encoding;\r
2328   \r
2329   if ((handle = mysql_prologue(interp, objc, objv, 2, 3, CL_CONN,\r
2330                             "handle")) == 0)\r
2331         return TCL_ERROR;\r
2332   if (objc==2) {\r
2333       if (handle->encoding == NULL)\r
2334          Tcl_SetObjResult(interp, Tcl_NewStringObj("binary",-1));\r
2335       else \r
2336          Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetEncodingName(handle->encoding),-1));\r
2337   } else {\r
2338       if (handle->type!=HT_CONNECTION) {\r
2339             Tcl_SetObjResult(interp, Tcl_NewStringObj("encoding set can be used only on connection handle",-1));\r
2340             return TCL_ERROR;\r
2341       }\r
2342       encodingname = Tcl_GetStringFromObj(objv[2],NULL);\r
2343       if (strcmp(encodingname, "binary") == 0) {\r
2344          encoding = NULL;       \r
2345       } else {\r
2346          encoding = Tcl_GetEncoding(interp, encodingname);\r
2347          if (encoding == NULL)\r
2348              return TCL_ERROR;\r
2349       }\r
2350       if (handle->encoding!=NULL)\r
2351           Tcl_FreeEncoding(handle->encoding);\r
2352       handle->encoding = encoding;\r
2353 \r
2354       /* change encoding of all subqueries */\r
2355       for (entryPtr=Tcl_FirstHashEntry(&statePtr->hash,&search);\r
2356                entryPtr!=NULL;\r
2357                 entryPtr=Tcl_NextHashEntry(&search)) {\r
2358             qhandle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);\r
2359             if (qhandle->type==HT_QUERY && handle->connection==qhandle->connection) {\r
2360                 qhandle->encoding = encoding;\r
2361             }\r
2362       }\r
2363 \r
2364   }\r
2365   return TCL_OK;\r
2366 }\r
2367 /*\r
2368  *----------------------------------------------------------------------\r
2369  *\r
2370  * Mysqltcl_Close --\r
2371  *    Implements the mysqlclose command:\r
2372  *    usage: mysqlclose ?handle?\r
2373  *                      \r
2374  *    results:\r
2375  *      null string\r
2376  */\r
2377 \r
2378 static int Mysqltcl_Close(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2379 \r
2380 {\r
2381   MysqltclState *statePtr = (MysqltclState *)clientData; \r
2382   MysqlTclHandle *handle,*thandle;\r
2383   Tcl_HashEntry *entryPtr;\r
2384   Tcl_HashEntry *qentries[16];\r
2385   Tcl_HashSearch search;\r
2386 \r
2387   int i,qfound = 0;\r
2388 \r
2389 \r
2390   /* If handle omitted, close all connections. */\r
2391   if (objc == 1) {\r
2392       Mysqltcl_CloseAll(clientData) ;\r
2393       return TCL_OK ;\r
2394   }\r
2395   \r
2396   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
2397                             "?handle?")) == 0)\r
2398     return TCL_ERROR;\r
2399 \r
2400 \r
2401   /* Search all queries and statements on this handle and close those */\r
2402   if (handle->type==HT_CONNECTION)  {\r
2403     while (1) {\r
2404       for (entryPtr=Tcl_FirstHashEntry(&statePtr->hash,&search); \r
2405            entryPtr!=NULL;\r
2406            entryPtr=Tcl_NextHashEntry(&search)) {\r
2407 \r
2408         thandle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);\r
2409         if (thandle->connection == handle->connection &&\r
2410             thandle->type!=HT_CONNECTION) {\r
2411           qentries[qfound++] = entryPtr;\r
2412         }\r
2413         if (qfound==16) break;\r
2414       }\r
2415       if (qfound>0) {\r
2416         for(i=0;i<qfound;i++) {\r
2417           entryPtr=qentries[i];\r
2418           thandle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);\r
2419           Tcl_DeleteHashEntry(entryPtr);\r
2420           closeHandle(thandle);\r
2421         }\r
2422       }\r
2423       if (qfound!=16) break;\r
2424       qfound = 0;\r
2425     }\r
2426   }\r
2427   entryPtr = Tcl_FindHashEntry(&statePtr->hash,Tcl_GetStringFromObj(objv[1],NULL));\r
2428   if (entryPtr) Tcl_DeleteHashEntry(entryPtr);\r
2429   closeHandle(handle);\r
2430   return TCL_OK;\r
2431 }\r
2432 \r
2433 #ifdef PREPARED_STATEMENT\r
2434 /*\r
2435  *----------------------------------------------------------------------\r
2436  *\r
2437  * Mysqltcl_Prepare --\r
2438  *    Implements the mysql::prepare command:\r
2439  *    usage: mysql::prepare handle statements\r
2440  *\r
2441  *    results:\r
2442  *          prepared statment handle\r
2443  */\r
2444 \r
2445 static int Mysqltcl_Prepare(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2446 {\r
2447   MysqltclState *statePtr = (MysqltclState *)clientData;\r
2448 \r
2449   MysqlTclHandle *handle;\r
2450   MysqlTclHandle *shandle;\r
2451   MYSQL_STMT *statement;\r
2452   char *query;\r
2453   int queryLen;\r
2454   int resultColumns;\r
2455   int paramCount;\r
2456 \r
2457   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
2458                             "handle sql-statement")) == 0)\r
2459     return TCL_ERROR;\r
2460 \r
2461   statement = mysql_stmt_init(handle->connection);\r
2462   if (statement==NULL) {\r
2463         return TCL_ERROR;\r
2464   }\r
2465   query = (char *)Tcl_GetByteArrayFromObj(objv[2], &queryLen);\r
2466   if (mysql_stmt_prepare(statement,query,queryLen)) {\r
2467 \r
2468         mysql_stmt_close(statement);\r
2469     return mysql_server_confl(interp,objc,objv,handle->connection);\r
2470   }\r
2471   if ((shandle = createHandleFrom(statePtr,handle,HT_STATEMENT)) == NULL) return TCL_ERROR;\r
2472   shandle->statement=statement;\r
2473   shandle->resultMetadata = mysql_stmt_result_metadata(statement);\r
2474   shandle->paramMetadata = mysql_stmt_param_metadata(statement);\r
2475   /* set result bind memory */\r
2476   resultColumns = mysql_stmt_field_count(statement);\r
2477   if (resultColumns>0) {\r
2478         shandle->bindResult = (MYSQL_BIND *)Tcl_Alloc(sizeof(MYSQL_BIND)*resultColumns);\r
2479     memset(shandle->bindResult,0,sizeof(MYSQL_BIND)*resultColumns);\r
2480   }\r
2481   paramCount = mysql_stmt_param_count(statement);\r
2482   if (resultColumns>0) {\r
2483         shandle->bindParam = (MYSQL_BIND *)Tcl_Alloc(sizeof(MYSQL_BIND)*paramCount);\r
2484     memset(shandle->bindParam,0,sizeof(MYSQL_BIND)*paramCount);\r
2485   }\r
2486   Tcl_SetObjResult(interp, Tcl_NewHandleObj(statePtr,shandle));\r
2487   return TCL_OK;\r
2488 }\r
2489 static int Mysqltcl_ParamMetaData(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2490 {\r
2491   MysqltclState *statePtr = (MysqltclState *)clientData;\r
2492   MysqlTclHandle *handle;\r
2493   MYSQL_RES *res;\r
2494   MYSQL_ROW row;\r
2495   Tcl_Obj *colinfo,*resObj;\r
2496   unsigned long *lengths;\r
2497   int i;\r
2498   int colCount;\r
2499   MYSQL_FIELD* fld;\r
2500 \r
2501   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
2502                             "statement-handle")) == 0)\r
2503     return TCL_ERROR;\r
2504   if(handle->type!=HT_STATEMENT)\r
2505         return TCL_ERROR;\r
2506 \r
2507   resObj = Tcl_GetObjResult(interp);\r
2508   printf("statement %p count %d\n",handle->statement,mysql_stmt_param_count(handle->statement));\r
2509   res = mysql_stmt_result_metadata(handle->statement);\r
2510   printf("res %p\n",res);\r
2511   if(res==NULL)\r
2512         return TCL_ERROR;\r
2513 \r
2514   mysql_field_seek(res, 0) ;\r
2515   while ((fld = mysql_fetch_field(res)) != NULL) {\r
2516         if ((colinfo = mysql_colinfo(interp,objc,objv,fld, objv[2])) != NULL) {\r
2517             Tcl_ListObjAppendElement(interp, resObj, colinfo);\r
2518         } else {\r
2519             goto conflict;\r
2520             }\r
2521   }\r
2522   conflict:\r
2523 \r
2524   mysql_free_result(res);\r
2525   return TCL_OK;\r
2526 }\r
2527 /*----------------------------------------------------------------------\r
2528  *\r
2529  * Mysqltcl_PSelect --\r
2530  *    Implements the mysql::pselect command:\r
2531  *    usage: mysql::pselect $statement_handle ?arguments...?\r
2532  *\r
2533  *    results:\r
2534  *          number of returned rows\r
2535  */\r
2536 \r
2537 static int Mysqltcl_PSelect(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2538 {\r
2539   MysqltclState *statePtr = (MysqltclState *)clientData;\r
2540   MysqlTclHandle *handle;\r
2541 \r
2542   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
2543                             "handle sql-statement")) == 0)\r
2544     return TCL_ERROR;\r
2545   if (handle->type!=HT_STATEMENT) {\r
2546         return TCL_ERROR;\r
2547   }\r
2548   mysql_stmt_reset(handle->statement);\r
2549   if (mysql_stmt_execute(handle->statement)) {\r
2550         return mysql_server_confl(interp,objc,objv,handle->connection);\r
2551   }\r
2552   mysql_stmt_bind_result(handle->statement, handle->bindResult);\r
2553   mysql_stmt_store_result(handle->statement);\r
2554   return TCL_OK;\r
2555 }\r
2556 /*----------------------------------------------------------------------\r
2557  *\r
2558  * Mysqltcl_PFetch --\r
2559  *    Implements the mysql::pfetch command:\r
2560  *    usage: mysql::pfetch $statement_handle\r
2561  *\r
2562  *    results:\r
2563  *          number of returned rows\r
2564  */\r
2565 \r
2566 static int Mysqltcl_PFetch(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2567 {\r
2568   MysqltclState *statePtr = (MysqltclState *)clientData;\r
2569   MysqlTclHandle *handle;\r
2570 \r
2571   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,\r
2572                             "prep-stat-handle")) == 0)\r
2573     return TCL_ERROR;\r
2574   if (handle->type!=HT_STATEMENT) {\r
2575         return TCL_ERROR;\r
2576   }\r
2577   \r
2578   return TCL_OK;\r
2579 }\r
2580 /*----------------------------------------------------------------------\r
2581  *\r
2582  * Mysqltcl_PExecute --\r
2583  *    Implements the mysql::pexecute command:\r
2584  *    usage: mysql::pexecute statement-handle ?arguments...?\r
2585  *\r
2586  *    results:\r
2587  *          number of effected rows\r
2588  */\r
2589 \r
2590 static int Mysqltcl_PExecute(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])\r
2591 {\r
2592   MysqltclState *statePtr = (MysqltclState *)clientData;\r
2593   MysqlTclHandle *handle;\r
2594 \r
2595   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,\r
2596                             "handle sql-statement")) == 0)\r
2597     return TCL_ERROR;\r
2598   if (handle->type!=HT_STATEMENT) {\r
2599         return TCL_ERROR;\r
2600   }\r
2601   mysql_stmt_reset(handle->statement);\r
2602 \r
2603   if (mysql_stmt_param_count(handle->statement)!=0) {\r
2604           Tcl_SetStringObj(Tcl_GetObjResult(interp),"works only for 0 params",-1);\r
2605           return TCL_ERROR;\r
2606   }\r
2607   if (mysql_stmt_execute(handle->statement))\r
2608   {\r
2609         Tcl_SetStringObj(Tcl_GetObjResult(interp),mysql_stmt_error(handle->statement),-1);\r
2610         return TCL_ERROR;\r
2611   }\r
2612   return TCL_OK;\r
2613 }\r
2614 #endif\r
2615 \r
2616 /*\r
2617  *----------------------------------------------------------------------\r
2618  * Mysqltcl_Init\r
2619  * Perform all initialization for the MYSQL to Tcl interface.\r
2620  * Adds additional commands to interp, creates message array, initializes\r
2621  * all handles.\r
2622  *\r
2623  * A call to Mysqltcl_Init should exist in Tcl_CreateInterp or\r
2624  * Tcl_CreateExtendedInterp.\r
2625 \r
2626  */\r
2627 \r
2628 \r
2629 #ifdef _WINDOWS\r
2630 __declspec( dllexport )\r
2631 #endif\r
2632 int Mysqltcl_Init(interp)\r
2633     Tcl_Interp *interp;\r
2634 {\r
2635   char nbuf[MYSQL_SMALL_SIZE];\r
2636   MysqltclState *statePtr;\r
2637  \r
2638   if (Tcl_InitStubs(interp, "8.1", 0) == NULL)\r
2639     return TCL_ERROR;\r
2640   if (Tcl_PkgRequire(interp, "Tcl", "8.1", 0) == NULL)\r
2641     return TCL_ERROR;\r
2642   if (Tcl_PkgProvide(interp, "mysqltcl" , PACKAGE_VERSION) != TCL_OK)\r
2643     return TCL_ERROR;\r
2644   /*\r
2645 \r
2646    * Initialize the new Tcl commands.\r
2647    * Deleting any command will close all connections.\r
2648    */\r
2649    statePtr = (MysqltclState*)Tcl_Alloc(sizeof(MysqltclState)); \r
2650    Tcl_InitHashTable(&statePtr->hash, TCL_STRING_KEYS);\r
2651    statePtr->handleNum = 0;\r
2652 \r
2653    Tcl_CreateObjCommand(interp,"mysqlconnect",Mysqltcl_Connect,(ClientData)statePtr, NULL);\r
2654    Tcl_CreateObjCommand(interp,"mysqluse", Mysqltcl_Use,(ClientData)statePtr, NULL);\r
2655    Tcl_CreateObjCommand(interp,"mysqlescape", Mysqltcl_Escape,(ClientData)statePtr, NULL);\r
2656    Tcl_CreateObjCommand(interp,"mysqlsel", Mysqltcl_Sel,(ClientData)statePtr, NULL);\r
2657    Tcl_CreateObjCommand(interp,"mysqlnext", Mysqltcl_Fetch,(ClientData)statePtr, NULL);\r
2658    Tcl_CreateObjCommand(interp,"mysqlseek", Mysqltcl_Seek,(ClientData)statePtr, NULL);\r
2659    Tcl_CreateObjCommand(interp,"mysqlmap", Mysqltcl_Map,(ClientData)statePtr, NULL);\r
2660    Tcl_CreateObjCommand(interp,"mysqlexec", Mysqltcl_Exec,(ClientData)statePtr, NULL);\r
2661    Tcl_CreateObjCommand(interp,"mysqlclose", Mysqltcl_Close,(ClientData)statePtr, NULL);\r
2662    Tcl_CreateObjCommand(interp,"mysqlinfo", Mysqltcl_Info,(ClientData)statePtr, NULL);\r
2663    Tcl_CreateObjCommand(interp,"mysqlresult", Mysqltcl_Result,(ClientData)statePtr, NULL);\r
2664    Tcl_CreateObjCommand(interp,"mysqlcol", Mysqltcl_Col,(ClientData)statePtr, NULL);\r
2665    Tcl_CreateObjCommand(interp,"mysqlstate", Mysqltcl_State,(ClientData)statePtr, NULL);\r
2666    Tcl_CreateObjCommand(interp,"mysqlinsertid", Mysqltcl_InsertId,(ClientData)statePtr, NULL);\r
2667    Tcl_CreateObjCommand(interp,"mysqlquery", Mysqltcl_Query,(ClientData)statePtr, NULL);\r
2668    Tcl_CreateObjCommand(interp,"mysqlendquery", Mysqltcl_EndQuery,(ClientData)statePtr, NULL);\r
2669    Tcl_CreateObjCommand(interp,"mysqlbaseinfo", Mysqltcl_BaseInfo,(ClientData)statePtr, NULL);\r
2670    Tcl_CreateObjCommand(interp,"mysqlping", Mysqltcl_Ping,(ClientData)statePtr, NULL);\r
2671    Tcl_CreateObjCommand(interp,"mysqlchangeuser", Mysqltcl_ChangeUser,(ClientData)statePtr, NULL);\r
2672    Tcl_CreateObjCommand(interp,"mysqlreceive", Mysqltcl_Receive,(ClientData)statePtr, NULL);\r
2673    \r
2674    Tcl_CreateObjCommand(interp,"::mysql::connect",Mysqltcl_Connect,(ClientData)statePtr, Mysqltcl_Kill);\r
2675    Tcl_CreateObjCommand(interp,"::mysql::use", Mysqltcl_Use,(ClientData)statePtr, NULL);\r
2676    Tcl_CreateObjCommand(interp,"::mysql::escape", Mysqltcl_Escape,(ClientData)statePtr, NULL);\r
2677    Tcl_CreateObjCommand(interp,"::mysql::sel", Mysqltcl_Sel,(ClientData)statePtr, NULL);\r
2678    Tcl_CreateObjCommand(interp,"::mysql::fetch", Mysqltcl_Fetch,(ClientData)statePtr, NULL);\r
2679    Tcl_CreateObjCommand(interp,"::mysql::seek", Mysqltcl_Seek,(ClientData)statePtr, NULL);\r
2680    Tcl_CreateObjCommand(interp,"::mysql::map", Mysqltcl_Map,(ClientData)statePtr, NULL);\r
2681    Tcl_CreateObjCommand(interp,"::mysql::exec", Mysqltcl_Exec,(ClientData)statePtr, NULL);\r
2682    Tcl_CreateObjCommand(interp,"::mysql::close", Mysqltcl_Close,(ClientData)statePtr, NULL);\r
2683    Tcl_CreateObjCommand(interp,"::mysql::info", Mysqltcl_Info,(ClientData)statePtr, NULL);\r
2684    Tcl_CreateObjCommand(interp,"::mysql::result", Mysqltcl_Result,(ClientData)statePtr, NULL);\r
2685    Tcl_CreateObjCommand(interp,"::mysql::col", Mysqltcl_Col,(ClientData)statePtr, NULL);\r
2686    Tcl_CreateObjCommand(interp,"::mysql::state", Mysqltcl_State,(ClientData)statePtr, NULL);\r
2687    Tcl_CreateObjCommand(interp,"::mysql::insertid", Mysqltcl_InsertId,(ClientData)statePtr, NULL);\r
2688    /* new in mysqltcl 2.0 */\r
2689    Tcl_CreateObjCommand(interp,"::mysql::query", Mysqltcl_Query,(ClientData)statePtr, NULL);\r
2690    Tcl_CreateObjCommand(interp,"::mysql::endquery", Mysqltcl_EndQuery,(ClientData)statePtr, NULL);\r
2691    Tcl_CreateObjCommand(interp,"::mysql::baseinfo", Mysqltcl_BaseInfo,(ClientData)statePtr, NULL);\r
2692    Tcl_CreateObjCommand(interp,"::mysql::ping", Mysqltcl_Ping,(ClientData)statePtr, NULL);\r
2693    Tcl_CreateObjCommand(interp,"::mysql::changeuser", Mysqltcl_ChangeUser,(ClientData)statePtr, NULL);\r
2694    Tcl_CreateObjCommand(interp,"::mysql::receive", Mysqltcl_Receive,(ClientData)statePtr, NULL);\r
2695    /* new in mysqltcl 3.0 */\r
2696    Tcl_CreateObjCommand(interp,"::mysql::autocommit", Mysqltcl_AutoCommit,(ClientData)statePtr, NULL);\r
2697    Tcl_CreateObjCommand(interp,"::mysql::commit", Mysqltcl_Commit,(ClientData)statePtr, NULL);\r
2698    Tcl_CreateObjCommand(interp,"::mysql::rollback", Mysqltcl_Rollback,(ClientData)statePtr, NULL);\r
2699    Tcl_CreateObjCommand(interp,"::mysql::nextresult", Mysqltcl_NextResult,(ClientData)statePtr, NULL);\r
2700    Tcl_CreateObjCommand(interp,"::mysql::moreresult", Mysqltcl_MoreResult,(ClientData)statePtr, NULL);\r
2701    Tcl_CreateObjCommand(interp,"::mysql::warningcount", Mysqltcl_WarningCount,(ClientData)statePtr, NULL);\r
2702    Tcl_CreateObjCommand(interp,"::mysql::isnull", Mysqltcl_IsNull,(ClientData)statePtr, NULL);\r
2703    Tcl_CreateObjCommand(interp,"::mysql::newnull", Mysqltcl_NewNull,(ClientData)statePtr, NULL);\r
2704    Tcl_CreateObjCommand(interp,"::mysql::setserveroption", Mysqltcl_SetServerOption,(ClientData)statePtr, NULL);\r
2705    Tcl_CreateObjCommand(interp,"::mysql::shutdown", Mysqltcl_ShutDown,(ClientData)statePtr, NULL);\r
2706    Tcl_CreateObjCommand(interp,"::mysql::encoding", Mysqltcl_Encoding,(ClientData)statePtr, NULL);\r
2707    /* prepared statements */\r
2708 \r
2709 #ifdef PREPARED_STATEMENT\r
2710    Tcl_CreateObjCommand(interp,"::mysql::prepare", Mysqltcl_Prepare,(ClientData)statePtr, NULL);\r
2711    // Tcl_CreateObjCommand(interp,"::mysql::parammetadata", Mysqltcl_ParamMetaData,(ClientData)statePtr, NULL);\r
2712    Tcl_CreateObjCommand(interp,"::mysql::pselect", Mysqltcl_PSelect,(ClientData)statePtr, NULL);\r
2713    Tcl_CreateObjCommand(interp,"::mysql::pselect", Mysqltcl_PFetch,(ClientData)statePtr, NULL);\r
2714    Tcl_CreateObjCommand(interp,"::mysql::pexecute", Mysqltcl_PExecute,(ClientData)statePtr, NULL);\r
2715 #endif\r
2716    \r
2717 \r
2718    \r
2719    /* Initialize mysqlstatus global array. */\r
2720    \r
2721    clear_msg(interp);\r
2722   \r
2723    /* Link the null value element to the corresponding C variable. */\r
2724    if ((statePtr->MysqlNullvalue = Tcl_Alloc (12)) == NULL) return TCL_ERROR;\r
2725    strcpy (statePtr->MysqlNullvalue, MYSQL_NULLV_INIT);\r
2726    sprintf (nbuf, "%s(%s)", MYSQL_STATUS_ARR, MYSQL_STATUS_NULLV);\r
2727 \r
2728    /* set null object in mysqltcl state */\r
2729    /* statePtr->nullObjPtr = Mysqltcl_NewNullObj(statePtr); */\r
2730    \r
2731    if (Tcl_LinkVar(interp,nbuf,(char *)&statePtr->MysqlNullvalue, TCL_LINK_STRING) != TCL_OK)\r
2732      return TCL_ERROR;\r
2733    \r
2734    /* Register the handle object type */\r
2735    Tcl_RegisterObjType(&mysqlHandleType);\r
2736    /* Register own null type object */\r
2737    Tcl_RegisterObjType(&mysqlNullType);\r
2738    \r
2739    /* A little sanity check.\r
2740     * If this message appears you must change the source code and recompile.\r
2741    */\r
2742    if (strlen(MysqlHandlePrefix) == MYSQL_HPREFIX_LEN)\r
2743      return TCL_OK;\r
2744    else {\r
2745      panic("*** mysqltcl (mysqltcl.c): handle prefix inconsistency!\n");\r
2746      return TCL_ERROR ;\r
2747    }\r
2748 }\r
2749 \r
2750 #ifdef _WINDOWS\r
2751 __declspec( dllexport )\r
2752 #endif\r
2753 int Mysqltcl_SafeInit(interp)\r
2754     Tcl_Interp *interp;\r
2755 {\r
2756   return Mysqltcl_Init(interp);\r
2757 }\r