2 * $Eid: mysqltcl.c,v 1.2 2002/02/15 18:52:08 artur Exp $
4 * MYSQL interface to Tcl
6 * Hakan Soderstrom, hs@soderstrom.se
11 * Copyright (c) 1994, 1995 Hakan Soderstrom and Tom Poindexter
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.
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.
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.
31 #define PACKAGE "mysqltcl"
32 #define VERSION "2.14"
44 /* A few macros for making the code more readable */
46 #define DECLARE_CMD(func) \
47 static int func _ANSI_ARGS_((ClientData clientData, \
48 Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
50 #define DEFINE_CMD(func) \
51 static int func(clientData, interp, objc, objv) \
52 ClientData clientData; \
55 Tcl_Obj *CONST objv[];
57 #define ADD_CMD(cmdName, cmdProc) \
58 Tcl_CreateObjCommand(interp, #cmdName, cmdProc, NULL, Mysqltcl_Kill)
60 /* Compile-time constants */
62 #define MYSQL_SMALL_SIZE TCL_RESULT_SIZE /* Smaller buffer size. */
63 #define MYSQL_NAME_LEN 80 /* Max. host, database name length. */
65 typedef struct MysqlTclHandle {
66 MYSQL * connection ; /* Connection handle, if connected; -1 otherwise. */
67 char host[MYSQL_NAME_LEN] ; /* Host name, if connected. */
68 char database[MYSQL_NAME_LEN] ; /* Db name, if selected; NULL otherwise. */
69 MYSQL_RES* result ; /* Stored result, if any; NULL otherwise. */
70 int res_count ; /* Count of unfetched rows in result. */
71 int col_count ; /* Column count in result, if any. */
76 /* one global Hash for mysql handles */
77 static Tcl_HashTable handleTable;
79 static char *MysqlHandlePrefix = "mysql";
80 /* Prefix string used to identify handles.
81 * The following must be strlen(MysqlHandlePrefix).
83 #define MYSQL_HPREFIX_LEN 5
85 /* Array for status info, and its elements. */
86 #define MYSQL_STATUS_ARR "mysqlstatus"
88 #define MYSQL_STATUS_CODE "code"
89 #define MYSQL_STATUS_CMD "command"
90 #define MYSQL_STATUS_MSG "message"
91 #define MYSQL_STATUS_NULLV "nullvalue"
93 /* C variable corresponding to mysqlstatus(nullvalue) */
94 static char *MysqlNullvalue = NULL ;
95 #define MYSQL_NULLV_INIT ""
97 /* Check Level for mysql_prologue */
103 /* Prototypes for all functions. */
105 DECLARE_CMD(Mysqltcl_Connect);
106 DECLARE_CMD(Mysqltcl_Use);
107 DECLARE_CMD(Mysqltcl_Escape);
108 DECLARE_CMD(Mysqltcl_Sel);
109 DECLARE_CMD(Mysqltcl_Next);
110 DECLARE_CMD(Mysqltcl_Seek);
111 DECLARE_CMD(Mysqltcl_Map);
112 DECLARE_CMD(Mysqltcl_Exec);
113 DECLARE_CMD(Mysqltcl_Close);
114 DECLARE_CMD(Mysqltcl_Info);
115 DECLARE_CMD(Mysqltcl_Result);
116 DECLARE_CMD(Mysqltcl_Col);
117 DECLARE_CMD(Mysqltcl_State);
118 DECLARE_CMD(Mysqltcl_InsertId);
119 DECLARE_CMD(Mysqltcl_Query);
121 static int MysqlHandleSet _ANSI_ARGS_((Tcl_Interp *interp,
123 static void MysqlHandleFree _ANSI_ARGS_((Tcl_Obj *objPtr));
126 /* handle object type
127 * This section defince funtions for Handling new Tcl_Obj type */
129 Tcl_ObjType mysqlHandleType = {
132 (Tcl_DupInternalRepProc *) NULL,
138 MysqlHandleSet(interp, objPtr)
139 Tcl_Interp *interp; /* Used for error reporting if not NULL. */
140 register Tcl_Obj *objPtr; /* The object to convert. */
142 Tcl_ObjType *oldTypePtr = objPtr->typePtr;
144 MysqlTclHandle *handle;
145 Tcl_HashEntry *entryPtr;
147 string=Tcl_GetStringFromObj(objPtr, NULL);
148 entryPtr = Tcl_FindHashEntry(&handleTable,string);
149 if (entryPtr == NULL) {
152 handle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);
158 if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
159 oldTypePtr->freeIntRepProc(objPtr);
162 objPtr->internalRep.otherValuePtr = (MysqlTclHandle *) handle;
163 objPtr->typePtr = &mysqlHandleType;
164 Tcl_Preserve((char *)handle);
165 // printf("p set obj handle %i %x\n",handle->isquery,handle);
170 MysqlHandleFree(Tcl_Obj *obj)
172 MysqlTclHandle *handle = (MysqlTclHandle *)obj->internalRep.otherValuePtr;
173 Tcl_Release((char *)handle);
174 // printf("r free obj handle %i %x\n",handle->isquery,handle);
178 GetHandleFromObj(interp, objPtr, handlePtr)
180 register Tcl_Obj *objPtr;
181 register MysqlTclHandle **handlePtr;
183 if (Tcl_ConvertToType (interp, objPtr, &mysqlHandleType) != TCL_OK)
185 *handlePtr = (MysqlTclHandle *)objPtr->internalRep.otherValuePtr;
190 Tcl_NewHandleObj(handle)
191 register MysqlTclHandle* handle;
193 register Tcl_Obj *objPtr;
194 char buffer[MYSQL_HPREFIX_LEN+TCL_DOUBLE_SPACE+1];
196 Tcl_HashEntry *entryPtr;
200 /* the string for "query" can not be longer as MysqlHandlePrefix see buf variable */
201 len=sprintf(buffer, "%s%d", (handle->isquery) ? "query" : MysqlHandlePrefix,handle->number);
202 objPtr->bytes = Tcl_Alloc((unsigned) len + 1);
203 strcpy(objPtr->bytes, buffer);
204 objPtr->length = len;
206 entryPtr=Tcl_CreateHashEntry(&handleTable,buffer,&newflag);
207 Tcl_SetHashValue(entryPtr,handle);
209 objPtr->internalRep.otherValuePtr = handle;
210 objPtr->typePtr = &mysqlHandleType;
212 Tcl_Preserve((char *)handle);
213 // printf("p new obj handle %i %x\n",handle->isquery,handle);
221 * Every command begins by calling 'mysql_prologue'.
222 * This function resets mysqlstatus(code) to zero; the other array elements
223 * retain their previous values.
224 * The function also saves objc/objv in global variables.
225 * After this the command processing proper begins.
227 * If there is a conflict, the message is taken from one of the following
229 * -- this code (mysql_prim_confl),
230 * -- the database server (mysql_server_confl),
231 * A complete message is put together from the above plus the name of the
232 * command where the conflict was detected.
233 * The complete message is returned as the Tcl result and is also stored in
234 * mysqlstatus(message).
235 * mysqlstatus(code) is set to "-1" for a primitive conflict or to mysql_errno
236 * for a server conflict
237 * In addition, the whole command where the conflict was detected is put
238 * together from the saved objc/objv and is copied into mysqlstatus(command).
242 *-----------------------------------------------------------
244 * Help procedure to set Tcl global array with mysqltcl internal
249 set_statusArr(Tcl_Interp *interp,char *elem_name,Tcl_Obj *tobj)
251 Tcl_SetVar2Ex (interp,MYSQL_STATUS_ARR,elem_name,tobj,TCL_GLOBAL_ONLY);
255 *----------------------------------------------------------------------
258 * Clears all error and message elements in the global array variable.
263 clear_msg(Tcl_Interp *interp)
265 set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(0));
266 set_statusArr(interp,MYSQL_STATUS_CMD,Tcl_NewObj());
267 set_statusArr(interp,MYSQL_STATUS_MSG,Tcl_NewObj());
271 *----------------------------------------------------------------------
273 * Reassembles the current command from the saved objv; copies it into
274 * mysqlstatus(command).
278 mysql_reassemble (Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[])
280 set_statusArr(interp,MYSQL_STATUS_CMD,Tcl_NewListObj(objc, objv));
285 *----------------------------------------------------------------------
287 * Conflict handling after a primitive conflict.
292 mysql_prim_confl (Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[],char *msg)
294 set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(-1));
296 Tcl_ResetResult (interp) ;
297 Tcl_AppendStringsToObj (Tcl_GetObjResult(interp),
298 Tcl_GetString(objv[0]), ": ", msg, (char*)NULL);
300 set_statusArr(interp,MYSQL_STATUS_MSG,Tcl_GetObjResult(interp));
302 mysql_reassemble (interp,objc,objv) ;
308 *----------------------------------------------------------------------
310 * Conflict handling after an mySQL conflict.
315 mysql_server_confl (Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[],MYSQL * connection)
317 char* mysql_errorMsg;
319 mysql_errorMsg = mysql_error(connection);
321 set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(mysql_errno(connection)));
323 Tcl_ResetResult (interp) ;
324 Tcl_AppendStringsToObj (Tcl_GetObjResult(interp),
325 Tcl_GetString(objv[0]), "/db server: ",
326 (mysql_errorMsg == NULL) ? "" : mysql_errorMsg,
329 set_statusArr(interp,MYSQL_STATUS_MSG,Tcl_GetObjResult(interp));
331 mysql_reassemble (interp,objc,objv) ;
335 static MysqlTclHandle *
336 get_handle (Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[],int check_level)
338 MysqlTclHandle *handle;
339 if (GetHandleFromObj(interp, objv[1], &handle) != TCL_OK) {
340 mysql_prim_confl (interp,objc,objv,"not mysqltcl handle") ;
343 if (check_level==CL_PLAIN) return handle;
344 if (handle->connection == 0) {
345 mysql_prim_confl (interp,objc,objv,"handle already closed (dangling pointer)") ;
348 if (check_level==CL_CONN) return handle;
349 if (check_level!=CL_RES) {
350 if (handle->database[0] == '\0') {
351 mysql_prim_confl (interp,objc,objv,"no current database") ;
354 if (check_level==CL_DB) return handle;
356 if (handle->result == NULL) {
357 mysql_prim_confl (interp,objc,objv,"no result pending") ;
363 /*----------------------------------------------------------------------
366 * This to method control how tcl data is transfered to mysql and
367 * how data is imported into tcl from mysql
369 static int mysql_QueryTclObj(MysqlTclHandle *handle,Tcl_Obj *obj)
375 query=Tcl_GetStringFromObj(obj, &queryLen);
376 Tcl_UtfToExternalDString(NULL, query, -1, &queryDS);
377 queryLen = Tcl_DStringLength(&queryDS);
378 result = mysql_real_query(handle->connection,Tcl_DStringValue(&queryDS),queryLen);
379 Tcl_DStringFree(&queryDS);
382 static Tcl_Obj *getRowCellAsObject(MYSQL_ROW row,int length)
386 obj = Tcl_NewByteArrayObj(*row,length);
388 obj = Tcl_NewStringObj(MysqlNullvalue,-1);
393 static MysqlTclHandle *createMysqlHandle()
395 static int HandleNum=0;
396 MysqlTclHandle *handle;
397 handle=(MysqlTclHandle *)Tcl_Alloc(sizeof(MysqlTclHandle));
399 panic("no memory for handle");
402 handle->connection = (MYSQL *)0 ;
403 handle->host[0] = '\0' ;
404 handle->database[0] = '\0' ;
405 handle->result = NULL ;
406 handle->res_count = 0 ;
407 handle->col_count = 0 ;
410 //printf("p create handle %i %x\n",handle->isquery,handle);
412 /* not MT-safe, static */
413 handle->number=HandleNum++;
417 static MysqlTclHandle *createQueryHandleFrom(MysqlTclHandle *handle)
420 MysqlTclHandle *qhandle;
421 qhandle = createMysqlHandle();
422 number = qhandle->number;
423 if (!qhandle) return qhandle;
424 memcpy(qhandle,handle,sizeof(MysqlTclHandle));
426 qhandle->number=number;
429 static void closeHandle(MysqlTclHandle *handle)
431 handle->connection = (MYSQL *)0;
432 // printf("r close handle %i %x\n",handle->isquery,handle);
433 Tcl_EventuallyFree((char *)handle,TCL_DYNAMIC);
437 *----------------------------------------------------------------------
440 * Does most of standard command prologue; required for all commands
441 * having conflict handling.
442 * 'req_min_args' must be the minimum number of arguments for the command,
443 * including the command word.
444 * 'req_max_args' must be the maximum number of arguments for the command,
445 * including the command word.
446 * 'usage_msg' must be a usage message, leaving out the command name.
447 * Checks the handle assumed to be present in objv[1] if 'check' is not NULL.
448 * RETURNS: Handle index or -1 on failure.
449 * SIDE EFFECT: Sets the Tcl result on failure.
452 static MysqlTclHandle *
453 mysql_prologue (interp, objc, objv, req_min_args, req_max_args, check_level, usage_msg)
456 Tcl_Obj *CONST objv[];
462 /* Check number of args. */
463 if (objc < req_min_args || objc > req_max_args) {
464 Tcl_WrongNumArgs(interp, 1, objv, usage_msg);
468 /* Reset mysqlstatus(code). */
469 set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(0));
472 * The function is assumed to set the status array on conflict.
474 return (get_handle(interp,objc,objv,check_level));
478 *----------------------------------------------------------------------
481 * Given an MYSQL_FIELD struct and a string keyword appends a piece of
482 * column info (one item) to the Tcl result.
483 * ASSUMES 'fld' is non-null.
484 * RETURNS 0 on success, 1 otherwise.
485 * SIDE EFFECT: Sets the result and status on failure.
489 mysql_colinfo (interp,objc,objv,fld,keyw)
492 Tcl_Obj *CONST objv[];
496 char buf[MYSQL_SMALL_SIZE];
499 static CONST char* MysqlColkey[] =
501 "table", "name", "type", "length", "prim_key", "non_null", "numeric", "decimals", NULL
504 MYSQL_COL_TABLE_K, MYSQL_COL_NAME_K, MYSQL_COL_TYPE_K, MYSQL_COL_LENGTH_K, MYSQL_COL_PRIMKEY_K,
505 MYSQL_COL_NONNULL_K, MYSQL_COL_NUMERIC_K, MYSQL_COL_DECIMALS_K};
507 if (Tcl_GetIndexFromObj(interp, keyw, (char **)MysqlColkey, "option",
508 TCL_EXACT, &idx) != TCL_OK)
513 case MYSQL_COL_TABLE_K:
514 return Tcl_NewStringObj(fld->table, -1) ;
515 case MYSQL_COL_NAME_K:
516 return Tcl_NewStringObj(fld->name, -1) ;
517 case MYSQL_COL_TYPE_K:
520 case FIELD_TYPE_DECIMAL:
521 return Tcl_NewStringObj("decimal", -1);
522 case FIELD_TYPE_TINY:
523 return Tcl_NewStringObj("tiny", -1);
524 case FIELD_TYPE_SHORT:
525 return Tcl_NewStringObj("short", -1);
526 case FIELD_TYPE_LONG:
527 return Tcl_NewStringObj("long", -1) ;
528 case FIELD_TYPE_FLOAT:
529 return Tcl_NewStringObj("float", -1);
530 case FIELD_TYPE_DOUBLE:
531 return Tcl_NewStringObj("double", -1);
532 case FIELD_TYPE_NULL:
533 return Tcl_NewStringObj("null", -1);
534 case FIELD_TYPE_TIMESTAMP:
535 return Tcl_NewStringObj("timestamp", -1);
536 case FIELD_TYPE_LONGLONG:
537 return Tcl_NewStringObj("long long", -1);
538 case FIELD_TYPE_INT24:
539 return Tcl_NewStringObj("int24", -1);
540 case FIELD_TYPE_DATE:
541 return Tcl_NewStringObj("date", -1);
542 case FIELD_TYPE_TIME:
543 return Tcl_NewStringObj("time", -1);
544 case FIELD_TYPE_DATETIME:
545 return Tcl_NewStringObj("date time", -1);
546 case FIELD_TYPE_YEAR:
547 return Tcl_NewStringObj("year", -1);
548 case FIELD_TYPE_NEWDATE:
549 return Tcl_NewStringObj("new date", -1);
550 case FIELD_TYPE_ENUM:
551 return Tcl_NewStringObj("enum", -1); /* fyll på¿¿? */
552 case FIELD_TYPE_SET: /* samma */
553 return Tcl_NewStringObj("set", -1);
554 case FIELD_TYPE_TINY_BLOB:
555 return Tcl_NewStringObj("tiny blob", -1);
556 case FIELD_TYPE_MEDIUM_BLOB:
557 return Tcl_NewStringObj("medium blob", -1);
558 case FIELD_TYPE_LONG_BLOB:
559 return Tcl_NewStringObj("long blob", -1);
560 case FIELD_TYPE_BLOB:
561 return Tcl_NewStringObj("blob", -1);
562 case FIELD_TYPE_VAR_STRING:
563 return Tcl_NewStringObj("var string", -1);
564 case FIELD_TYPE_STRING:
565 return Tcl_NewStringObj("string", -1) ;
567 sprintf (buf, "column '%s' has weird datatype", fld->name) ;
568 mysql_prim_confl (interp,objc,objv,buf) ;
572 case MYSQL_COL_LENGTH_K:
573 return Tcl_NewIntObj(fld->length) ;
574 case MYSQL_COL_PRIMKEY_K:
575 return Tcl_NewBooleanObj(IS_PRI_KEY(fld->flags)) ;
576 case MYSQL_COL_NONNULL_K:
577 return Tcl_NewBooleanObj(IS_NOT_NULL(fld->flags)) ;
578 case MYSQL_COL_NUMERIC_K:
579 return Tcl_NewBooleanObj(IS_NUM(fld->type));
580 case MYSQL_COL_DECIMALS_K:
581 return IS_NUM(fld->type)? Tcl_NewIntObj(fld->decimals): Tcl_NewIntObj(-1);
582 default: /* should never happen */
583 mysql_prim_confl (interp,objc,objv,"weirdness in mysql_colinfo") ;
590 *----------------------------------------------------------------------
592 * Close all connections.
597 Mysqltcl_Kill (clientData)
598 ClientData clientData;
600 Tcl_HashEntry *entryPtr;
601 Tcl_HashSearch search;
602 MysqlTclHandle *handle;
605 for (entryPtr=Tcl_FirstHashEntry(&handleTable,&search);
607 entryPtr=Tcl_NextHashEntry(&search)) {
609 handle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);
611 if (handle->connection == 0) continue;
613 if (handle->result != NULL)
614 mysql_free_result (handle->result) ;
616 mysql_close (handle->connection);
620 Tcl_DeleteHashTable(&handleTable);
621 Tcl_InitHashTable (&handleTable, TCL_STRING_KEYS);
629 *----------------------------------------------------------------------
632 * Implements the mysqlconnect command:
633 * usage: mysqlconnect ?option value ...?
636 * handle - a character string of newly open handle
637 * TCL_OK - connect successful
638 * TCL_ERROR - connect not successful - error message returned
641 DEFINE_CMD(Mysqltcl_Connect)
644 char *hostname = NULL;
646 char *password = NULL;
650 MysqlTclHandle *handle;
651 const char *groupname = "mysqltcl";
653 static CONST char* MysqlConnectOpt[] =
655 "-host", "-user", "-password", "-db", "-port", "-socket", NULL
658 MYSQL_CONNHOST_OPT, MYSQL_CONNUSER_OPT, MYSQL_CONNPASSWORD_OPT,
659 MYSQL_CONNDB_OPT, MYSQL_CONNPORT_OPT, MYSQL_CONNSOCKET_OPT
662 objc>(sizeof(MysqlConnectOpt)/sizeof(MysqlConnectOpt[0]-1)*2+1)) {
663 Tcl_WrongNumArgs(interp, 1, objv, "[-user xxx] [-db mysql] [-port 3306] [-host localhost] [-socket sock] [-password pass]");
667 for (i = 1; i < objc; i++) {
668 if (Tcl_GetIndexFromObj(interp, objv[i], (char **)MysqlConnectOpt, "option",
674 case MYSQL_CONNHOST_OPT:
675 hostname = Tcl_GetStringFromObj(objv[++i],NULL);
677 case MYSQL_CONNUSER_OPT:
678 user = Tcl_GetStringFromObj(objv[++i],NULL);
680 case MYSQL_CONNPASSWORD_OPT:
681 password = Tcl_GetStringFromObj(objv[++i],NULL);
683 case MYSQL_CONNDB_OPT:
684 db = Tcl_GetStringFromObj(objv[++i],NULL);
686 case MYSQL_CONNPORT_OPT:
687 if(Tcl_GetIntFromObj(interp, objv[++i], &port) != TCL_OK)
690 case MYSQL_CONNSOCKET_OPT:
691 socket = Tcl_GetStringFromObj(objv[++i],NULL);
694 return mysql_prim_confl(interp,objc,objv,"Weirdness in options");
698 handle = createMysqlHandle();
701 panic("no memory for handle");
705 handle->connection = mysql_init(NULL);
707 mysql_options(handle->connection,MYSQL_READ_DEFAULT_GROUP,groupname);
709 if (!mysql_real_connect (handle->connection, hostname, user,
710 password, db, port, socket, 0)) {
711 mysql_server_confl (interp,objc,objv,handle->connection);
712 mysql_close (handle->connection);
718 strncpy (handle->host, hostname, MYSQL_NAME_LEN) ;
719 handle->host[MYSQL_NAME_LEN - 1] = '\0' ;
721 strcpy (handle->host, "localhost");
725 strncpy (handle->database, db, MYSQL_NAME_LEN) ;
726 handle->database[MYSQL_NAME_LEN - 1] = '\0' ;
729 Tcl_SetObjResult(interp, Tcl_NewHandleObj(handle));
736 *----------------------------------------------------------------------
739 * Implements the mysqluse command:
740 * usage: mysqluse handle dbname
743 * Sets current database to dbname.
746 DEFINE_CMD(Mysqltcl_Use)
750 MysqlTclHandle *handle;
752 if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,
753 "handle dbname")) == 0)
756 db=Tcl_GetStringFromObj(objv[2], &len);
757 if (len >= MYSQL_NAME_LEN)
758 return mysql_prim_confl (interp,objc,objv,"database name too long") ;
759 if (mysql_select_db (handle->connection, db) < 0)
760 return mysql_server_confl (interp,objc,objv,handle->connection) ;
762 strcpy (handle->database, db) ;
769 *----------------------------------------------------------------------
772 * Implements the mysqlescape command:
773 * usage: mysqlescape string
776 * Escaped string for use in queries.
779 DEFINE_CMD(Mysqltcl_Escape)
782 char *inString, *outString;
785 Tcl_WrongNumArgs(interp, 2, objv, "string");
788 /* !!! here the real_escape command should be used
789 this need a additional parameter connection */
791 inString=Tcl_GetStringFromObj(objv[1], &len);
792 outString=Tcl_Alloc((len<<1) + 1);
793 len=mysql_escape_string(outString, inString, len);
794 Tcl_SetStringObj(Tcl_GetObjResult(interp), outString, len);
802 *----------------------------------------------------------------------
805 * Implements the mysqlsel command:
806 * usage: mysqlsel handle sel-query ?-list|-flatlist?
810 * SIDE EFFECT: Flushes any pending result, even in case of conflict.
811 * Stores new results.
814 DEFINE_CMD(Mysqltcl_Sel)
816 Tcl_Obj *res, *resList;
818 MysqlTclHandle *handle;
819 unsigned long *lengths;
820 static char* selOptions[] = {"-list", "-flatlist", NULL};
821 /* Warning !! no option number */
822 int i,selOption=2,colCount;
824 if ((handle = mysql_prologue(interp, objc, objv, 3, 4, CL_CONN,
825 "handle sel-query ?-list|-flatlist?")) == 0)
830 if (Tcl_GetIndexFromObj(interp, objv[3], (char **)selOptions, "option",
831 TCL_EXACT, &selOption) != TCL_OK)
835 /* Flush any previous result. */
836 if (handle->result != NULL) {
837 mysql_free_result (handle->result) ;
838 handle->result = NULL ;
841 if (mysql_QueryTclObj(handle,objv[2])) {
842 return mysql_server_confl (interp,objc,objv,handle->connection);
845 if ((handle->result = mysql_store_result (handle->connection)) == NULL) {
846 if (selOption==2) Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
848 colCount = handle->col_count = mysql_num_fields (handle->result) ;
849 res = Tcl_GetObjResult(interp);
850 handle->res_count = 0;
853 while ((row = mysql_fetch_row (handle->result)) != NULL) {
854 resList = Tcl_NewListObj(0, NULL);
855 lengths = mysql_fetch_lengths(handle->result);
856 for (i=0; i< colCount; i++, row++) {
857 Tcl_ListObjAppendElement (interp, resList,getRowCellAsObject(row,lengths[i]));
859 Tcl_ListObjAppendElement (interp, res, resList);
862 case 1: /* -flatlist */
863 while ((row = mysql_fetch_row (handle->result)) != NULL) {
864 lengths = mysql_fetch_lengths(handle->result);
865 for (i=0; i< colCount; i++, row++) {
866 Tcl_ListObjAppendElement (interp, res,getRowCellAsObject(row,lengths[i]));
870 case 2: /* No option */
871 handle->res_count = mysql_num_rows (handle->result);
872 Tcl_SetIntObj(res, handle->res_count);
880 * Works as mysqltclsel but return an $query handle that allow to build
881 * nested queries on simple handle
883 DEFINE_CMD(Mysqltcl_Query)
886 MysqlTclHandle *handle, *qhandle;
888 if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,
889 "handle sqlstatement")) == 0)
892 if (mysql_QueryTclObj(handle,objv[2])) {
893 return mysql_server_confl (interp,objc,objv,handle->connection);
896 if ((result = mysql_store_result (handle->connection)) == NULL) {
897 Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
900 if ((qhandle = createQueryHandleFrom(handle)) == NULL) return TCL_ERROR;
901 qhandle->result = result;
902 qhandle->col_count = mysql_num_fields (qhandle->result) ;
903 qhandle->res_count = mysql_num_rows (qhandle->result);
904 Tcl_SetObjResult(interp, Tcl_NewHandleObj(qhandle));
907 DEFINE_CMD(Mysqltcl_EndQuery)
909 Tcl_HashEntry *entryPtr;
910 MysqlTclHandle *handle;
912 if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,
916 if (handle->result != NULL) {
917 mysql_free_result (handle->result) ;
918 handle->result = NULL ;
920 if (handle->isquery) {
921 entryPtr = Tcl_FindHashEntry(&handleTable,Tcl_GetStringFromObj(objv[1],NULL));
923 Tcl_DeleteHashEntry(entryPtr);
931 *----------------------------------------------------------------------
934 * Implements the mysqlexec command:
935 * usage: mysqlexec handle sql-statement
938 * Number of affected rows on INSERT, UPDATE or DELETE, 0 otherwise.
940 * SIDE EFFECT: Flushes any pending result, even in case of conflict.
943 DEFINE_CMD(Mysqltcl_Exec)
945 MysqlTclHandle *handle;
948 if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,
949 "handle sql-statement")) == 0)
952 /* Flush any previous result. */
953 if (handle->result != NULL) {
954 mysql_free_result (handle->result) ;
955 handle->result = NULL ;
958 if (mysql_QueryTclObj(handle,objv[2]))
959 return mysql_server_confl (interp,objc,objv,handle->connection);
961 if ((affected=mysql_affected_rows(handle->connection)) < 0) affected=0;
962 Tcl_SetIntObj(Tcl_GetObjResult(interp),affected);
968 *----------------------------------------------------------------------
971 * Implements the mysqlnext command:
972 * usage: mysqlnext handle
975 * next row from pending results as tcl list, or null list.
978 DEFINE_CMD(Mysqltcl_Next)
980 MysqlTclHandle *handle;
984 unsigned long *lengths;
986 if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_RES,
991 if (handle->res_count == 0)
993 else if ((row = mysql_fetch_row (handle->result)) == NULL) {
994 handle->res_count = 0 ;
995 return mysql_prim_confl (interp,objc,objv,"result counter out of sync") ;
997 handle->res_count-- ;
999 lengths = mysql_fetch_lengths(handle->result);
1001 resList = Tcl_GetObjResult(interp);
1002 for (idx = 0 ; idx < handle->col_count ; idx++, row++) {
1003 Tcl_ListObjAppendElement (interp, resList,getRowCellAsObject(row,lengths[idx]));
1010 *----------------------------------------------------------------------
1013 * Implements the mysqlseek command:
1014 * usage: mysqlseek handle rownumber
1017 * number of remaining rows
1020 DEFINE_CMD(Mysqltcl_Seek)
1022 MysqlTclHandle *handle;
1026 if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_RES,
1027 " handle row-index")) == 0)
1030 if (Tcl_GetIntFromObj (interp, objv[2], &row) != TCL_OK)
1033 total = mysql_num_rows (handle->result);
1035 if (total + row < 0) {
1036 mysql_data_seek (handle->result, 0);
1037 handle->res_count = total;
1038 } else if (row < 0) {
1039 mysql_data_seek (handle->result, total + row);
1040 handle->res_count = -row;
1041 } else if (row >= total) {
1042 mysql_data_seek (handle->result, row);
1043 handle->res_count = 0;
1045 mysql_data_seek (handle->result, row);
1046 handle->res_count = total - row;
1049 Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->res_count)) ;
1055 *----------------------------------------------------------------------
1058 * Implements the mysqlmap command:
1059 * usage: mysqlmap handle binding-list script
1062 * SIDE EFFECT: For each row the column values are bound to the variables
1063 * in the binding list and the script is evaluated.
1064 * The variables are created in the current context.
1065 * NOTE: mysqlmap works very much like a 'foreach' construct.
1066 * The 'continue' and 'break' commands may be used with their usual effect.
1069 DEFINE_CMD(Mysqltcl_Map)
1073 MysqlTclHandle *handle;
1076 Tcl_Obj** listObjv ;
1079 unsigned long *lengths;
1082 if ((handle = mysql_prologue(interp, objc, objv, 4, 4, CL_RES,
1083 "handle binding-list script")) == 0)
1086 if (Tcl_ListObjGetElements (interp, objv[2], &listObjc, &listObjv) != TCL_OK)
1089 if (listObjc > handle->col_count)
1091 return mysql_prim_confl (interp,objc,objv,"too many variables in binding list") ;
1094 count = (listObjc < handle->col_count)?listObjc
1095 :handle->col_count ;
1097 val=(int*)Tcl_Alloc((count * sizeof (int)));
1098 for (idx=0; idx<count; idx++) {
1099 if (Tcl_GetStringFromObj(listObjv[idx],0)[0] != '-')
1105 while (handle->res_count > 0) {
1106 /* Get next row, decrement row counter. */
1107 if ((row = mysql_fetch_row (handle->result)) == NULL) {
1108 handle->res_count = 0 ;
1109 Tcl_Free((char *)val);
1110 return mysql_prim_confl (interp,objc,objv,"result counter out of sync") ;
1112 handle->res_count-- ;
1114 /* Bind variables to column values. */
1115 for (idx = 0; idx < count; idx++, row++) {
1116 lengths = mysql_fetch_lengths(handle->result);
1118 if (Tcl_ObjSetVar2 (interp,
1119 listObjv[idx], NULL,getRowCellAsObject(row,lengths[idx]),
1120 TCL_LEAVE_ERR_MSG) == NULL) {
1121 Tcl_Free((char *)val);
1127 /* Evaluate the script. */
1128 switch(code=Tcl_EvalObjEx(interp, objv[3],0)) {
1133 Tcl_Free((char *)val);
1136 Tcl_Free((char *)val);
1140 Tcl_Free((char *)val);
1146 *----------------------------------------------------------------------
1149 * Implements the mysqlinfo command:
1150 * usage: mysqlinfo handle option
1154 DEFINE_CMD(Mysqltcl_Info)
1157 MysqlTclHandle *handle;
1163 static CONST char* MysqlDbOpt[] =
1165 "dbname", "dbname?", "tables", "host", "host?", "databases","info", NULL
1168 MYSQL_INFNAME_OPT, MYSQL_INFNAMEQ_OPT, MYSQL_INFTABLES_OPT,
1169 MYSQL_INFHOST_OPT, MYSQL_INFHOSTQ_OPT, MYSQL_INFLIST_OPT, MYSQL_INFO
1172 /* We can't fully check the handle at this stage. */
1173 if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_PLAIN,
1174 "handle option")) == 0)
1177 if (Tcl_GetIndexFromObj(interp, objv[2], (char **)MysqlDbOpt, "option",
1178 TCL_EXACT, &idx) != TCL_OK)
1181 /* First check the handle. Checking depends on the option. */
1183 case MYSQL_INFNAMEQ_OPT:
1184 if ((handle = get_handle(interp,objc,objv,CL_CONN))!=NULL) {
1185 if (handle->database[0] == '\0')
1186 return TCL_OK ; /* Return empty string if no current db. */
1189 case MYSQL_INFNAME_OPT:
1190 case MYSQL_INFTABLES_OPT:
1191 case MYSQL_INFHOST_OPT:
1192 case MYSQL_INFLIST_OPT:
1194 handle = get_handle(interp,objc,objv,CL_CONN);
1196 case MYSQL_INFHOSTQ_OPT:
1197 if (handle->connection == 0)
1198 return TCL_OK ; /* Return empty string if not connected. */
1201 if (handle->connection == 0)
1202 return TCL_OK ; /* Return empty string if not connected. */
1204 default: /* should never happen */
1205 return mysql_prim_confl (interp,objc,objv,"weirdness in Mysqltcl_Info") ;
1208 if (handle == 0) return TCL_ERROR ;
1210 /* Handle OK, return the requested info. */
1212 case MYSQL_INFNAME_OPT:
1213 case MYSQL_INFNAMEQ_OPT:
1214 Tcl_SetObjResult(interp, Tcl_NewStringObj(handle->database, -1));
1216 case MYSQL_INFTABLES_OPT:
1217 if ((list = mysql_list_tables (handle->connection,(char*)NULL)) == NULL)
1218 return mysql_server_confl (interp,objc,objv,handle->connection);
1220 resList = Tcl_GetObjResult(interp);
1221 for (count = mysql_num_rows (list); count > 0; count--) {
1222 val = *(row = mysql_fetch_row (list)) ;
1223 Tcl_ListObjAppendElement (interp, resList, Tcl_NewStringObj((val == NULL)?"":val,-1));
1225 mysql_free_result (list) ;
1227 case MYSQL_INFHOST_OPT:
1228 case MYSQL_INFHOSTQ_OPT:
1229 Tcl_SetObjResult(interp, Tcl_NewStringObj(handle->host, -1));
1231 case MYSQL_INFLIST_OPT:
1232 if ((list = mysql_list_dbs (handle->connection,(char*)NULL)) == NULL)
1233 return mysql_server_confl (interp,objc,objv,handle->connection);
1235 resList = Tcl_GetObjResult(interp);
1236 for (count = mysql_num_rows (list); count > 0; count--) {
1237 val = *(row = mysql_fetch_row (list)) ;
1238 Tcl_ListObjAppendElement (interp, resList,
1239 Tcl_NewStringObj((val == NULL)?"":val,-1));
1241 mysql_free_result (list) ;
1244 val = mysql_info(handle->connection);
1246 Tcl_SetObjResult(interp, Tcl_NewStringObj(val,-1));
1249 default: /* should never happen */
1250 return mysql_prim_confl (interp,objc,objv,"weirdness in Mysqltcl_Info") ;
1257 *----------------------------------------------------------------------
1260 * Implements the mysqlresult command:
1261 * usage: mysqlresult handle option
1265 DEFINE_CMD(Mysqltcl_Result)
1268 MysqlTclHandle *handle;
1269 static CONST char* MysqlResultOpt[] =
1271 "rows", "rows?", "cols", "cols?", "current", "current?", NULL
1274 MYSQL_RESROWS_OPT, MYSQL_RESROWSQ_OPT, MYSQL_RESCOLS_OPT,
1275 MYSQL_RESCOLSQ_OPT, MYSQL_RESCUR_OPT, MYSQL_RESCURQ_OPT
1277 /* We can't fully check the handle at this stage. */
1278 if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_PLAIN,
1279 " handle option")) == 0)
1282 if (Tcl_GetIndexFromObj(interp, objv[2], (char **)MysqlResultOpt, "option",
1283 TCL_EXACT, &idx) != TCL_OK)
1286 /* First check the handle. Checking depends on the option. */
1288 case MYSQL_RESROWS_OPT:
1289 case MYSQL_RESCOLS_OPT:
1290 case MYSQL_RESCUR_OPT:
1291 handle = get_handle (interp,objc,objv,CL_RES) ;
1293 case MYSQL_RESROWSQ_OPT:
1294 case MYSQL_RESCOLSQ_OPT:
1295 case MYSQL_RESCURQ_OPT:
1296 if ((handle = get_handle (interp,objc,objv,CL_RES))== NULL)
1297 return TCL_OK ; /* Return empty string if no pending result. */
1299 default: /* should never happen */
1300 return mysql_prim_confl (interp,objc,objv,"weirdness in Mysqltcl_Result") ;
1307 /* Handle OK; return requested info. */
1309 case MYSQL_RESROWS_OPT:
1310 case MYSQL_RESROWSQ_OPT:
1311 Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->res_count));
1313 case MYSQL_RESCOLS_OPT:
1314 case MYSQL_RESCOLSQ_OPT:
1315 Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->col_count));
1317 case MYSQL_RESCUR_OPT:
1318 case MYSQL_RESCURQ_OPT:
1319 Tcl_SetObjResult(interp,
1320 Tcl_NewIntObj(mysql_num_rows (handle->result)
1321 - handle->res_count)) ;
1324 return mysql_prim_confl (interp,objc,objv,"weirdness in Mysqltcl_Result");
1331 *----------------------------------------------------------------------
1334 * Implements the mysqlcol command:
1335 * usage: mysqlcol handle table-name option ?option ...?
1336 * mysqlcol handle -current option ?option ...?
1337 * '-current' can only be used if there is a pending result.
1340 * List of lists containing column attributes.
1341 * If a single attribute is requested the result is a simple list.
1343 * SIDE EFFECT: '-current' disturbs the field position of the result.
1346 DEFINE_CMD(Mysqltcl_Col)
1350 MysqlTclHandle *handle;
1353 Tcl_Obj **listObjv, *colinfo, *resList, *resSubList;
1358 /* This check is enough only without '-current'. */
1359 if ((handle = mysql_prologue(interp, objc, objv, 4, 99, CL_CONN,
1360 "handle table-name option ?option ...?")) == 0)
1363 /* Fetch column info.
1364 * Two ways: explicit database and table names, or current.
1366 argv=Tcl_GetStringFromObj(objv[2],NULL);
1367 current_db = strcmp (argv, "-current") == 0;
1370 if ((handle = get_handle (interp,objc,objv,CL_RES)) == 0)
1373 result = handle->result ;
1375 if ((result = mysql_list_fields (handle->connection, argv, (char*)NULL)) == NULL) {
1376 return mysql_server_confl (interp,objc,objv,handle->connection) ;
1379 /* Must examine the first specifier at this point. */
1380 if (Tcl_ListObjGetElements (interp, objv[3], &listObjc, &listObjv) != TCL_OK)
1382 resList = Tcl_GetObjResult(interp);
1383 if (objc == 4 && listObjc == 1) {
1384 mysql_field_seek (result, 0) ;
1385 while ((fld = mysql_fetch_field (result)) != NULL)
1386 if ((colinfo = mysql_colinfo (interp,objc,objv,fld, objv[3])) != NULL) {
1387 Tcl_ListObjAppendElement (interp, resList, colinfo);
1391 } else if (objc == 4 && listObjc > 1) {
1392 mysql_field_seek (result, 0) ;
1393 while ((fld = mysql_fetch_field (result)) != NULL) {
1394 resSubList = Tcl_NewListObj(0, NULL);
1395 for (coln = 0; coln < listObjc; coln++)
1396 if ((colinfo = mysql_colinfo (interp,objc,objv,fld, listObjv[coln])) != NULL) {
1397 Tcl_ListObjAppendElement (interp, resSubList, colinfo);
1401 Tcl_ListObjAppendElement (interp, resList, resSubList);
1404 for (idx = 3; idx < objc; idx++) {
1405 resSubList = Tcl_NewListObj(0, NULL);
1406 mysql_field_seek (result, 0) ;
1407 while ((fld = mysql_fetch_field (result)) != NULL)
1408 if ((colinfo = mysql_colinfo (interp,objc,objv,fld, objv[idx])) != NULL) {
1409 Tcl_ListObjAppendElement (interp, resSubList, colinfo);
1413 Tcl_ListObjAppendElement (interp, resList, resSubList);
1416 if (!current_db) mysql_free_result (result) ;
1420 if (!current_db) mysql_free_result (result) ;
1426 *----------------------------------------------------------------------
1429 * Implements the mysqlstate command:
1430 * usage: mysqlstate handle ?-numeric?
1434 DEFINE_CMD(Mysqltcl_State)
1436 MysqlTclHandle *handle;
1440 if (mysql_prologue(interp, objc, objv, 2, 3, NULL, "handle ?-numeric?") == 0)
1444 if (strcmp (Tcl_GetStringFromObj(objv[2],NULL), "-numeric"))
1445 return mysql_prim_confl (interp,objc,objv,"last parameter should be -numeric") ;
1450 if (GetHandleFromObj(NULL, objv[1], &handle) != TCL_OK)
1451 res = (numeric)?Tcl_NewIntObj(0):Tcl_NewStringObj("NOT_A_HANDLE",-1) ;
1452 else if (handle->connection == 0)
1453 res = (numeric)?Tcl_NewIntObj(1):Tcl_NewStringObj("UNCONNECTED",-1) ;
1454 else if (handle->database[0] == '\0')
1455 res = (numeric)?Tcl_NewIntObj(2):Tcl_NewStringObj("CONNECTED",-1) ;
1456 else if (handle->result == NULL)
1457 res = (numeric)?Tcl_NewIntObj(3):Tcl_NewStringObj("IN_USE",-1) ;
1459 res = (numeric)?Tcl_NewIntObj(4):Tcl_NewStringObj("RESULT_PENDING",-1) ;
1461 Tcl_SetObjResult(interp, res);
1467 *----------------------------------------------------------------------
1470 * Implements the mysqlstate command:
1471 * usage: mysqlinsertid handle
1472 * Returns the auto increment id of the last INSERT statement
1476 DEFINE_CMD(Mysqltcl_InsertId)
1478 MysqlTclHandle *handle;
1480 if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,
1484 Tcl_SetObjResult(interp, Tcl_NewIntObj(mysql_insert_id(handle->connection)));
1491 *----------------------------------------------------------------------
1494 * Implements the mysqlclose command:
1495 * usage: mysqlclose ?handle?
1501 DEFINE_CMD(Mysqltcl_Close)
1503 MysqlTclHandle *handle,*thandle;
1504 Tcl_HashEntry *entryPtr;
1505 Tcl_HashEntry *qentries[16];
1506 Tcl_HashSearch search;
1510 /* If handle omitted, close all connections. */
1512 Mysqltcl_Kill ((ClientData)NULL) ;
1516 if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,
1520 if (handle->result != NULL)
1521 mysql_free_result (handle->result) ;
1523 /* Search all queries on this handle and close those */
1524 if (!handle->isquery) {
1525 mysql_close(handle->connection);
1527 for (entryPtr=Tcl_FirstHashEntry(&handleTable,&search);
1529 entryPtr=Tcl_NextHashEntry(&search)) {
1531 thandle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);
1532 if (thandle->connection == handle->connection &&
1534 qentries[qfound++] = entryPtr;
1536 if (qfound==16) break;
1539 for(i=0;i<qfound;i++) {
1540 entryPtr=qentries[i];
1541 thandle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);
1542 Tcl_DeleteHashEntry(entryPtr);
1543 if (thandle->result != NULL)
1544 mysql_free_result (thandle->result);
1545 closeHandle(thandle);
1548 if (qfound!=16) break;
1552 entryPtr = Tcl_FindHashEntry(&handleTable,Tcl_GetStringFromObj(objv[1],NULL));
1553 if (entryPtr) Tcl_DeleteHashEntry(entryPtr);
1554 closeHandle(handle);
1559 *----------------------------------------------------------------------
1561 * Perform all initialization for the MYSQL to Tcl interface.
1562 * Adds additional commands to interp, creates message array, initializes
1565 * A call to Mysqltcl_Init should exist in Tcl_CreateInterp or
1566 * Tcl_CreateExtendedInterp.
1570 __declspec( dllexport )
1572 int Mysqltcl_Init (interp)
1575 char nbuf[MYSQL_SMALL_SIZE];
1577 if (Tcl_InitStubs(interp, "8.1", 0) == NULL)
1579 if (Tcl_PkgRequire(interp, "Tcl", "8.1", 0) == NULL)
1581 if (Tcl_PkgProvide(interp, "mysqltcl" , VERSION) != TCL_OK)
1584 * Initialize the new Tcl commands.
1585 * Deleting any command will close all connections.
1587 ADD_CMD(mysqlconnect, Mysqltcl_Connect);
1588 ADD_CMD(mysqluse, Mysqltcl_Use);
1589 ADD_CMD(mysqlescape, Mysqltcl_Escape);
1590 ADD_CMD(mysqlsel, Mysqltcl_Sel);
1591 ADD_CMD(mysqlnext, Mysqltcl_Next);
1592 ADD_CMD(mysqlseek, Mysqltcl_Seek);
1593 ADD_CMD(mysqlmap, Mysqltcl_Map);
1594 ADD_CMD(mysqlexec, Mysqltcl_Exec);
1595 ADD_CMD(mysqlclose, Mysqltcl_Close);
1596 ADD_CMD(mysqlinfo, Mysqltcl_Info);
1597 ADD_CMD(mysqlresult, Mysqltcl_Result);
1598 ADD_CMD(mysqlcol, Mysqltcl_Col);
1599 ADD_CMD(mysqlstate, Mysqltcl_State);
1600 ADD_CMD(mysqlinsertid, Mysqltcl_InsertId);
1601 ADD_CMD(mysqlquery, Mysqltcl_Query);
1602 ADD_CMD(mysqlendquery, Mysqltcl_EndQuery);
1604 /* Initialize mysqlstatus global array. */
1608 /* Initialize HashTable for mysql handles */
1609 Tcl_InitHashTable (&handleTable, TCL_STRING_KEYS);
1611 /* Link the null value element to the corresponding C variable. */
1612 if ((MysqlNullvalue = (char*)Tcl_Alloc (12)) == NULL) return TCL_ERROR ;
1613 strcpy (MysqlNullvalue, MYSQL_NULLV_INIT);
1614 sprintf (nbuf, "%s(%s)", MYSQL_STATUS_ARR, MYSQL_STATUS_NULLV) ;
1616 if (Tcl_LinkVar (interp,nbuf,(char *)&MysqlNullvalue, TCL_LINK_STRING) != TCL_OK)
1619 /* Register the handle object type */
1620 Tcl_RegisterObjType(&mysqlHandleType);
1622 /* A little sanity check.
1623 * If this message appears you must change the source code and recompile.
1625 if (strlen (MysqlHandlePrefix) == MYSQL_HPREFIX_LEN)
1628 panic("*** mysqltcl (mysqltcl.c): handle prefix inconsistency!\n");