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