]> git.sven.stormbind.net Git - sven/mysqltcl.git/blob - mysqltcl_2.14.c
Imported Upstream version 3.05
[sven/mysqltcl.git] / mysqltcl_2.14.c
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 #ifdef _WINDOWS
30    #include <windows.h>
31    #define PACKAGE "mysqltcl"
32    #define VERSION "2.14"
33 #endif
34
35 #include <tcl.h>
36 #include <mysql.h>
37
38 #include <errno.h>
39 #include <string.h>
40 #include <ctype.h>
41 #include <stdlib.h>
42
43
44 /* A few macros for making the code more readable */
45
46 #define DECLARE_CMD(func) \
47 static int func _ANSI_ARGS_((ClientData clientData, \
48                    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
49
50 #define DEFINE_CMD(func) \
51 static int func(clientData, interp, objc, objv) \
52     ClientData clientData; \
53     Tcl_Interp *interp; \
54     int objc; \
55     Tcl_Obj *CONST objv[];
56
57 #define ADD_CMD(cmdName, cmdProc) \
58 Tcl_CreateObjCommand(interp, #cmdName, cmdProc, NULL, Mysqltcl_Kill)
59
60 /* Compile-time constants */
61
62 #define MYSQL_SMALL_SIZE  TCL_RESULT_SIZE /* Smaller buffer size. */
63 #define MYSQL_NAME_LEN     80    /* Max. host, database name length. */
64
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. */
72   int number;
73   int isquery;
74 } MysqlTclHandle;
75
76 /* one global Hash for mysql handles */
77 static Tcl_HashTable handleTable;
78
79 static char *MysqlHandlePrefix = "mysql";
80 /* Prefix string used to identify handles.
81  * The following must be strlen(MysqlHandlePrefix).
82  */
83 #define MYSQL_HPREFIX_LEN 5
84
85 /* Array for status info, and its elements. */
86 #define MYSQL_STATUS_ARR "mysqlstatus"
87
88 #define MYSQL_STATUS_CODE "code"
89 #define MYSQL_STATUS_CMD  "command"
90 #define MYSQL_STATUS_MSG  "message"
91 #define MYSQL_STATUS_NULLV  "nullvalue"
92
93 /* C variable corresponding to mysqlstatus(nullvalue) */
94 static char *MysqlNullvalue = NULL ;
95 #define MYSQL_NULLV_INIT ""
96
97 /* Check Level for mysql_prologue */
98 #define CL_PLAIN 0
99 #define CL_CONN  1
100 #define CL_DB    2
101 #define CL_RES 3
102
103 /* Prototypes for all functions. */
104
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);
120
121 static int MysqlHandleSet _ANSI_ARGS_((Tcl_Interp *interp,
122            Tcl_Obj *objPtr));
123 static void MysqlHandleFree _ANSI_ARGS_((Tcl_Obj *objPtr));
124
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
137 static int
138 MysqlHandleSet(interp, objPtr)
139     Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
140     register Tcl_Obj *objPtr;   /* The object to convert. */
141 {
142     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
143     char *string;
144     MysqlTclHandle *handle;
145     Tcl_HashEntry *entryPtr;
146
147     string=Tcl_GetStringFromObj(objPtr, NULL);  
148     entryPtr = Tcl_FindHashEntry(&handleTable,string);
149     if (entryPtr == NULL) {
150       handle=0;
151     } else {
152       handle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);
153     }
154     if (!handle) {
155         if (interp != NULL)
156           return TCL_ERROR;
157     }
158     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
159         oldTypePtr->freeIntRepProc(objPtr);
160     }
161     
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);
166
167     return TCL_OK;
168 }
169 static void
170 MysqlHandleFree(Tcl_Obj *obj)
171 {
172   MysqlTclHandle *handle = (MysqlTclHandle *)obj->internalRep.otherValuePtr;
173   Tcl_Release((char *)handle);
174   // printf("r free obj handle %i %x\n",handle->isquery,handle);
175 }
176
177 static int
178 GetHandleFromObj(interp, objPtr, handlePtr)
179     Tcl_Interp *interp;
180     register Tcl_Obj *objPtr;
181     register MysqlTclHandle **handlePtr;
182 {
183     if (Tcl_ConvertToType (interp, objPtr, &mysqlHandleType) != TCL_OK)
184         return TCL_ERROR;
185     *handlePtr = (MysqlTclHandle *)objPtr->internalRep.otherValuePtr;
186     return TCL_OK;
187 }
188
189 static Tcl_Obj *
190 Tcl_NewHandleObj(handle)
191     register MysqlTclHandle* handle;
192 {
193     register Tcl_Obj *objPtr;
194     char buffer[MYSQL_HPREFIX_LEN+TCL_DOUBLE_SPACE+1];
195     register int len;
196     Tcl_HashEntry *entryPtr;
197     int newflag;
198
199     objPtr=Tcl_NewObj();
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;
205     
206     entryPtr=Tcl_CreateHashEntry(&handleTable,buffer,&newflag);
207     Tcl_SetHashValue(entryPtr,handle);     
208   
209     objPtr->internalRep.otherValuePtr = handle;
210     objPtr->typePtr = &mysqlHandleType;
211
212     Tcl_Preserve((char *)handle);  
213     // printf("p new obj handle %i %x\n",handle->isquery,handle);
214
215     return objPtr;
216 }
217
218
219 /* CONFLICT HANDLING
220  *
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.
226  *
227  * If there is a conflict, the message is taken from one of the following
228  * sources,
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).
239  */
240
241 /*
242  *-----------------------------------------------------------
243  * set_statusArr
244  * Help procedure to set Tcl global array with mysqltcl internal
245  * informations
246  */
247
248 static void 
249 set_statusArr(Tcl_Interp *interp,char *elem_name,Tcl_Obj *tobj)
250 {
251   Tcl_SetVar2Ex (interp,MYSQL_STATUS_ARR,elem_name,tobj,TCL_GLOBAL_ONLY); 
252 }
253
254 /*
255  *----------------------------------------------------------------------
256  * clear_msg
257  *
258  * Clears all error and message elements in the global array variable.
259  *
260  */
261
262 static void
263 clear_msg(Tcl_Interp *interp)
264 {
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());
268 }
269
270 /*
271  *----------------------------------------------------------------------
272  * mysql_reassemble
273  * Reassembles the current command from the saved objv; copies it into
274  * mysqlstatus(command).
275  */
276
277 static void
278 mysql_reassemble (Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[])
279 {
280    set_statusArr(interp,MYSQL_STATUS_CMD,Tcl_NewListObj(objc, objv));
281 }
282
283
284 /*
285  *----------------------------------------------------------------------
286  * mysql_prim_confl
287  * Conflict handling after a primitive conflict.
288  *
289  */
290
291 static int
292 mysql_prim_confl (Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[],char *msg)
293 {
294   set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(-1));
295
296   Tcl_ResetResult (interp) ;
297   Tcl_AppendStringsToObj (Tcl_GetObjResult(interp),
298                           Tcl_GetString(objv[0]), ": ", msg, (char*)NULL);
299
300   set_statusArr(interp,MYSQL_STATUS_MSG,Tcl_GetObjResult(interp));
301
302   mysql_reassemble (interp,objc,objv) ;
303   return TCL_ERROR ;
304 }
305
306
307 /*
308  *----------------------------------------------------------------------
309  * mysql_server_confl
310  * Conflict handling after an mySQL conflict.
311  *
312  */
313
314 static int
315 mysql_server_confl (Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[],MYSQL * connection)
316 {
317   char* mysql_errorMsg;
318
319   mysql_errorMsg = mysql_error(connection);
320
321   set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(mysql_errno(connection)));
322
323   Tcl_ResetResult (interp) ;
324   Tcl_AppendStringsToObj (Tcl_GetObjResult(interp),
325                           Tcl_GetString(objv[0]), "/db server: ",
326                           (mysql_errorMsg == NULL) ? "" : mysql_errorMsg,
327                           (char*)NULL) ;
328
329   set_statusArr(interp,MYSQL_STATUS_MSG,Tcl_GetObjResult(interp));
330
331   mysql_reassemble (interp,objc,objv) ;
332   return TCL_ERROR ;
333 }
334
335 static  MysqlTclHandle *
336 get_handle (Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[],int check_level) 
337 {
338   MysqlTclHandle *handle;
339   if (GetHandleFromObj(interp, objv[1], &handle) != TCL_OK) {
340     mysql_prim_confl (interp,objc,objv,"not mysqltcl handle") ;
341     return NULL;
342   }
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)") ;
346       return NULL;
347   }
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") ;
352       return NULL;
353     }
354     if (check_level==CL_DB) return handle;
355   }
356   if (handle->result == NULL) {
357       mysql_prim_confl (interp,objc,objv,"no result pending") ;
358       return NULL;
359   }
360   return handle;
361 }
362
363 /*----------------------------------------------------------------------
364  * mysql_QueryTclObj
365  * getRowCellAsObject
366  * This to method control how tcl data is transfered to mysql and
367  * how data is imported into tcl from mysql
368  */
369 static int mysql_QueryTclObj(MysqlTclHandle *handle,Tcl_Obj *obj)
370 {
371   char *query;
372   int result,queryLen;
373   Tcl_DString queryDS;
374
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);
380   return result;
381
382 static Tcl_Obj *getRowCellAsObject(MYSQL_ROW row,int length) 
383 {
384   Tcl_Obj *obj;
385   if (*row) {
386     obj = Tcl_NewByteArrayObj(*row,length);
387   } else {
388     obj = Tcl_NewStringObj(MysqlNullvalue,-1);
389   } 
390   return obj;
391 }
392  
393 static MysqlTclHandle *createMysqlHandle() 
394 {
395   static int HandleNum=0;
396   MysqlTclHandle *handle;
397   handle=(MysqlTclHandle *)Tcl_Alloc(sizeof(MysqlTclHandle));
398   if (handle == 0) {
399     panic("no memory for handle");
400     return handle;
401   }
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 ;
408   handle->isquery = 0;
409
410   //printf("p create handle %i %x\n",handle->isquery,handle);
411
412   /* not MT-safe, static  */
413   handle->number=HandleNum++;
414   return handle;
415 }
416
417 static MysqlTclHandle *createQueryHandleFrom(MysqlTclHandle *handle)
418 {
419   int number;
420   MysqlTclHandle *qhandle;
421   qhandle = createMysqlHandle();
422   number = qhandle->number;
423   if (!qhandle) return qhandle;
424   memcpy(qhandle,handle,sizeof(MysqlTclHandle));
425   qhandle->isquery=1;
426   qhandle->number=number;
427   return qhandle;
428 }
429 static void closeHandle(MysqlTclHandle *handle)
430 {
431   handle->connection = (MYSQL *)0;
432   // printf("r close handle %i %x\n",handle->isquery,handle);
433   Tcl_EventuallyFree((char *)handle,TCL_DYNAMIC);
434 }
435
436 /*
437  *----------------------------------------------------------------------
438  * mysql_prologue
439  *
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.
450  */
451
452 static MysqlTclHandle *
453 mysql_prologue (interp, objc, objv, req_min_args, req_max_args, check_level, usage_msg)
454      Tcl_Interp *interp;
455      int         objc;
456      Tcl_Obj *CONST objv[];
457      int         req_min_args;
458      int         req_max_args;
459      int check_level;
460      char *usage_msg;
461 {
462   /* Check number of args. */
463   if (objc < req_min_args || objc > req_max_args) {
464       Tcl_WrongNumArgs(interp, 1, objv, usage_msg);
465       return NULL;
466   }
467
468   /* Reset mysqlstatus(code). */
469   set_statusArr(interp,MYSQL_STATUS_CODE,Tcl_NewIntObj(0));
470
471   /* Check the handle.
472    * The function is assumed to set the status array on conflict.
473    */
474   return (get_handle(interp,objc,objv,check_level));
475 }
476
477 /*
478  *----------------------------------------------------------------------
479  * mysql_colinfo
480  *
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.
486  */
487
488 static Tcl_Obj *
489 mysql_colinfo (interp,objc,objv,fld,keyw)
490      Tcl_Interp *interp;
491      int         objc;
492      Tcl_Obj *CONST objv[];
493      MYSQL_FIELD* fld ;
494      Tcl_Obj * keyw ;
495 {
496   char buf[MYSQL_SMALL_SIZE];
497   int idx ;
498
499   static CONST char* MysqlColkey[] =
500     {
501       "table", "name", "type", "length", "prim_key", "non_null", "numeric", "decimals", NULL
502     };
503   enum coloptions {
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};
506
507   if (Tcl_GetIndexFromObj(interp, keyw, (char **)MysqlColkey, "option",
508                           TCL_EXACT, &idx) != TCL_OK)
509     return NULL;
510
511   switch (idx)
512     {
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:
518       switch (fld->type)
519         {
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) ;
566         default:
567           sprintf (buf, "column '%s' has weird datatype", fld->name) ;
568           mysql_prim_confl (interp,objc,objv,buf) ;
569           return NULL ;
570         }
571       break ;
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") ;
584       return NULL ;
585     }
586 }
587
588
589 /*
590  *----------------------------------------------------------------------
591  * Mysqltcl_Kill
592  * Close all connections.
593  *
594  */
595
596 static void
597 Mysqltcl_Kill (clientData)
598     ClientData clientData;
599 {
600   Tcl_HashEntry *entryPtr;
601   Tcl_HashSearch search;
602   MysqlTclHandle *handle;
603   int wasdeleted=0;
604
605   for (entryPtr=Tcl_FirstHashEntry(&handleTable,&search); 
606        entryPtr!=NULL;
607        entryPtr=Tcl_NextHashEntry(&search)) {
608     wasdeleted=1;
609     handle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);
610
611     if (handle->connection == 0) continue;
612
613     if (handle->result != NULL)
614       mysql_free_result (handle->result) ;
615
616     mysql_close (handle->connection);
617     closeHandle(handle);
618   }
619   if (wasdeleted) {
620     Tcl_DeleteHashTable(&handleTable);
621     Tcl_InitHashTable (&handleTable, TCL_STRING_KEYS);
622   }
623 }
624
625
626
627
628 /*
629  *----------------------------------------------------------------------
630  *
631  * Mysqltcl_Connect
632  * Implements the mysqlconnect command:
633  * usage: mysqlconnect ?option value ...?
634  *                      
635  * Results:
636  *      handle - a character string of newly open handle
637  *      TCL_OK - connect successful
638  *      TCL_ERROR - connect not successful - error message returned
639  */
640
641 DEFINE_CMD(Mysqltcl_Connect)
642 {
643   int        i, idx;
644   char *hostname = NULL;
645   char *user = NULL;
646   char *password = NULL;
647   char *db = NULL;
648   int port = 0;
649   char *socket = NULL;
650   MysqlTclHandle *handle;
651   const char *groupname = "mysqltcl";
652
653   static CONST char* MysqlConnectOpt[] =
654     {
655       "-host", "-user", "-password", "-db", "-port", "-socket", NULL
656     };
657   enum connectoption {
658     MYSQL_CONNHOST_OPT, MYSQL_CONNUSER_OPT, MYSQL_CONNPASSWORD_OPT, 
659     MYSQL_CONNDB_OPT, MYSQL_CONNPORT_OPT, MYSQL_CONNSOCKET_OPT
660   };
661   if (!(objc & 1) || 
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]");
664         return TCL_ERROR;
665   }
666               
667   for (i = 1; i < objc; i++) {
668     if (Tcl_GetIndexFromObj(interp, objv[i], (char **)MysqlConnectOpt, "option",
669                           0, &idx) != TCL_OK)
670     return TCL_ERROR;
671     
672     switch (idx)
673         {
674         case MYSQL_CONNHOST_OPT:
675             hostname = Tcl_GetStringFromObj(objv[++i],NULL);
676             break;
677         case MYSQL_CONNUSER_OPT:
678             user = Tcl_GetStringFromObj(objv[++i],NULL);
679             break;
680         case MYSQL_CONNPASSWORD_OPT:
681             password = Tcl_GetStringFromObj(objv[++i],NULL);
682             break;
683         case MYSQL_CONNDB_OPT:
684             db = Tcl_GetStringFromObj(objv[++i],NULL);
685             break;
686         case MYSQL_CONNPORT_OPT:
687             if(Tcl_GetIntFromObj(interp, objv[++i], &port) != TCL_OK)
688                 return TCL_ERROR;
689             break;
690         case MYSQL_CONNSOCKET_OPT:
691             socket = Tcl_GetStringFromObj(objv[++i],NULL);
692             break;
693         default:
694                 return mysql_prim_confl(interp,objc,objv,"Weirdness in options");            
695         }
696   }
697
698   handle = createMysqlHandle();
699
700   if (handle == 0) {
701     panic("no memory for handle");
702     return TCL_ERROR;
703   }
704
705   handle->connection = mysql_init(NULL);
706
707   mysql_options(handle->connection,MYSQL_READ_DEFAULT_GROUP,groupname);
708
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);
713       closeHandle(handle);
714       return TCL_ERROR;
715   }
716
717   if (hostname) {
718     strncpy (handle->host, hostname, MYSQL_NAME_LEN) ;
719     handle->host[MYSQL_NAME_LEN - 1] = '\0' ;
720   } else {
721     strcpy (handle->host, "localhost");
722   }
723
724   if (db) {
725     strncpy (handle->database, db, MYSQL_NAME_LEN) ;
726     handle->database[MYSQL_NAME_LEN - 1] = '\0' ;
727   }
728
729   Tcl_SetObjResult(interp, Tcl_NewHandleObj(handle));
730
731   return TCL_OK;
732 }
733
734
735 /*
736  *----------------------------------------------------------------------
737  *
738  * Mysqltcl_Use
739  *    Implements the mysqluse command:
740  *    usage: mysqluse handle dbname
741  *                      
742  *    results:
743  *      Sets current database to dbname.
744  */
745
746 DEFINE_CMD(Mysqltcl_Use)
747 {
748   int len;
749   char *db;
750   MysqlTclHandle *handle;  
751
752   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,
753                             "handle dbname")) == 0)
754     return TCL_ERROR;
755
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) ;
761
762   strcpy (handle->database, db) ;
763   return TCL_OK;
764 }
765
766
767
768 /*
769  *----------------------------------------------------------------------
770  *
771  * Mysqltcl_Escape
772  *    Implements the mysqlescape command:
773  *    usage: mysqlescape string
774  *                      
775  *    results:
776  *      Escaped string for use in queries.
777  */
778
779 DEFINE_CMD(Mysqltcl_Escape)
780 {
781   int len;
782   char *inString, *outString;
783   
784   if (objc != 2) {
785       Tcl_WrongNumArgs(interp, 2, objv, "string");
786       return TCL_ERROR;
787   }
788   /* !!! here the real_escape command should be used 
789      this need a additional parameter connection */
790
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);
795   Tcl_Free(outString);
796   return TCL_OK;
797 }
798
799
800
801 /*
802  *----------------------------------------------------------------------
803  *
804  * Mysqltcl_Sel
805  *    Implements the mysqlsel command:
806  *    usage: mysqlsel handle sel-query ?-list|-flatlist?
807  *                      
808  *    results:
809  *
810  *    SIDE EFFECT: Flushes any pending result, even in case of conflict.
811  *    Stores new results.
812  */
813
814 DEFINE_CMD(Mysqltcl_Sel)
815 {
816   Tcl_Obj *res, *resList;
817   MYSQL_ROW row;
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;
823   
824   if ((handle = mysql_prologue(interp, objc, objv, 3, 4, CL_CONN,
825                             "handle sel-query ?-list|-flatlist?")) == 0)
826     return TCL_ERROR;
827
828
829   if (objc==4) {
830     if (Tcl_GetIndexFromObj(interp, objv[3], (char **)selOptions, "option",
831                             TCL_EXACT, &selOption) != TCL_OK)
832       return TCL_ERROR;
833   }
834        
835   /* Flush any previous result. */
836   if (handle->result != NULL) {
837     mysql_free_result (handle->result) ;
838     handle->result = NULL ;
839   }
840
841   if (mysql_QueryTclObj(handle,objv[2])) {
842     return mysql_server_confl (interp,objc,objv,handle->connection);
843   }
844
845   if ((handle->result = mysql_store_result (handle->connection)) == NULL) {
846     if (selOption==2) Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
847   } else {
848     colCount = handle->col_count = mysql_num_fields (handle->result) ;
849     res = Tcl_GetObjResult(interp);
850     handle->res_count = 0;
851     switch (selOption) {
852     case 0: /* -list */
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]));
858         }
859         Tcl_ListObjAppendElement (interp, res, resList);
860       }  
861       break;
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]));
867         }
868       }  
869       break;
870     case 2: /* No option */
871       handle->res_count = mysql_num_rows (handle->result);
872       Tcl_SetIntObj(res, handle->res_count);
873       break;
874     }
875   }
876   return TCL_OK;
877 }
878 /*
879  * Mysqltcl_Query
880  * Works as mysqltclsel but return an $query handle that allow to build
881  * nested queries on simple handle
882  */
883 DEFINE_CMD(Mysqltcl_Query)
884 {
885   MYSQL_RES *result;
886   MysqlTclHandle *handle, *qhandle;
887   
888   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,
889                             "handle sqlstatement")) == 0)
890     return TCL_ERROR;
891        
892   if (mysql_QueryTclObj(handle,objv[2])) {
893     return mysql_server_confl (interp,objc,objv,handle->connection);
894   }
895
896   if ((result = mysql_store_result (handle->connection)) == NULL) {
897     Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
898     return TCL_OK;
899   } 
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));
905   return TCL_OK;
906 }
907 DEFINE_CMD(Mysqltcl_EndQuery)
908 {
909   Tcl_HashEntry *entryPtr;
910   MysqlTclHandle *handle;
911   
912   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,
913                             "queryhanle")) == 0)
914     return TCL_ERROR;
915
916   if (handle->result != NULL) {
917     mysql_free_result (handle->result) ;
918     handle->result = NULL ;
919   }
920   if (handle->isquery) {
921     entryPtr = Tcl_FindHashEntry(&handleTable,Tcl_GetStringFromObj(objv[1],NULL));
922     if (entryPtr) {
923       Tcl_DeleteHashEntry(entryPtr);
924     }
925     closeHandle(handle);
926   }
927   return TCL_OK;
928 }
929
930 /*
931  *----------------------------------------------------------------------
932  *
933  * Mysqltcl_Exec
934  * Implements the mysqlexec command:
935  * usage: mysqlexec handle sql-statement
936  *                      
937  * Results:
938  * Number of affected rows on INSERT, UPDATE or DELETE, 0 otherwise.
939  *
940  * SIDE EFFECT: Flushes any pending result, even in case of conflict.
941  */
942
943 DEFINE_CMD(Mysqltcl_Exec)
944 {
945   MysqlTclHandle *handle;
946   int affected;
947
948   if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN,
949                             "handle sql-statement")) == 0)
950     return TCL_ERROR;
951
952   /* Flush any previous result. */
953   if (handle->result != NULL) {
954       mysql_free_result (handle->result) ;
955       handle->result = NULL ;
956   }
957
958   if (mysql_QueryTclObj(handle,objv[2]))
959     return mysql_server_confl (interp,objc,objv,handle->connection);
960
961   if ((affected=mysql_affected_rows(handle->connection)) < 0) affected=0;
962   Tcl_SetIntObj(Tcl_GetObjResult(interp),affected);  
963   return TCL_OK ;
964 }
965
966
967 /*
968  *----------------------------------------------------------------------
969  *
970  * Mysqltcl_Next
971  *    Implements the mysqlnext command:
972  *    usage: mysqlnext handle
973  *                      
974  *    results:
975  *      next row from pending results as tcl list, or null list.
976  */
977
978 DEFINE_CMD(Mysqltcl_Next)
979 {
980   MysqlTclHandle *handle;
981   int idx ;
982   MYSQL_ROW row ;
983   Tcl_Obj *resList;
984   unsigned long *lengths;
985
986   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_RES,
987                             "handle")) == 0)
988     return TCL_ERROR;
989
990   
991   if (handle->res_count == 0)
992     return TCL_OK ;
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") ;
996   } else
997     handle->res_count-- ;
998   
999   lengths = mysql_fetch_lengths(handle->result);
1000
1001   resList = Tcl_GetObjResult(interp);
1002   for (idx = 0 ; idx < handle->col_count ; idx++, row++) {
1003     Tcl_ListObjAppendElement (interp, resList,getRowCellAsObject(row,lengths[idx]));
1004   }
1005   return TCL_OK;
1006 }
1007
1008
1009 /*
1010  *----------------------------------------------------------------------
1011  *
1012  * Mysqltcl_Seek
1013  *    Implements the mysqlseek command:
1014  *    usage: mysqlseek handle rownumber
1015  *                      
1016  *    results:
1017  *      number of remaining rows
1018  */
1019
1020 DEFINE_CMD(Mysqltcl_Seek)
1021 {
1022     MysqlTclHandle *handle;
1023     int row;
1024     int total;
1025    
1026     if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_RES,
1027                               " handle row-index")) == 0)
1028       return TCL_ERROR;
1029
1030     if (Tcl_GetIntFromObj (interp, objv[2], &row) != TCL_OK)
1031       return TCL_ERROR;
1032     
1033     total = mysql_num_rows (handle->result);
1034     
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;
1044     } else {
1045       mysql_data_seek (handle->result, row);
1046       handle->res_count = total - row;
1047     }
1048
1049     Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->res_count)) ;
1050     return TCL_OK;
1051 }
1052
1053
1054 /*
1055  *----------------------------------------------------------------------
1056  *
1057  * Mysqltcl_Map
1058  * Implements the mysqlmap command:
1059  * usage: mysqlmap handle binding-list script
1060  *                      
1061  * Results:
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.
1067  */
1068
1069 DEFINE_CMD(Mysqltcl_Map)
1070 {
1071   int code ;
1072   int count ;
1073   MysqlTclHandle *handle;
1074   int idx ;
1075   int listObjc ;
1076   Tcl_Obj** listObjv ;
1077   MYSQL_ROW row ;
1078   int *val;
1079   unsigned long *lengths;
1080   
1081   
1082   if ((handle = mysql_prologue(interp, objc, objv, 4, 4, CL_RES,
1083                             "handle binding-list script")) == 0)
1084     return TCL_ERROR;
1085
1086   if (Tcl_ListObjGetElements (interp, objv[2], &listObjc, &listObjv) != TCL_OK)
1087     return TCL_ERROR ;
1088   
1089   if (listObjc > handle->col_count)
1090     {
1091       return mysql_prim_confl (interp,objc,objv,"too many variables in binding list") ;
1092     }
1093   else
1094     count = (listObjc < handle->col_count)?listObjc
1095       :handle->col_count ;
1096   
1097   val=(int*)Tcl_Alloc((count * sizeof (int)));
1098   for (idx=0; idx<count; idx++) {
1099     if (Tcl_GetStringFromObj(listObjv[idx],0)[0] != '-')
1100         val[idx]=1;
1101     else
1102         val[idx]=0;
1103   }
1104   
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") ;
1111     } else
1112       handle->res_count-- ;
1113       
1114     /* Bind variables to column values. */
1115     for (idx = 0; idx < count; idx++, row++) {
1116       lengths = mysql_fetch_lengths(handle->result);
1117       if (val[idx]) {
1118         if (Tcl_ObjSetVar2 (interp, 
1119                             listObjv[idx], NULL,getRowCellAsObject(row,lengths[idx]),
1120                             TCL_LEAVE_ERR_MSG) == NULL) {
1121           Tcl_Free((char *)val);
1122           return TCL_ERROR ;
1123         }
1124       }
1125     }
1126
1127     /* Evaluate the script. */
1128     switch(code=Tcl_EvalObjEx(interp, objv[3],0)) {
1129     case TCL_CONTINUE:
1130     case TCL_OK:
1131       break ;
1132     case TCL_BREAK:
1133       Tcl_Free((char *)val);
1134       return TCL_OK ;
1135     default:
1136       Tcl_Free((char *)val);
1137       return code ;
1138     }
1139   }
1140   Tcl_Free((char *)val);
1141   return TCL_OK ;
1142 }
1143
1144
1145 /*
1146  *----------------------------------------------------------------------
1147  *
1148  * Mysqltcl_Info
1149  * Implements the mysqlinfo command:
1150  * usage: mysqlinfo handle option
1151  *
1152  */
1153
1154 DEFINE_CMD(Mysqltcl_Info)
1155 {
1156   int count ;
1157   MysqlTclHandle *handle;
1158   int idx ;
1159   MYSQL_RES* list ;
1160   MYSQL_ROW row ;
1161   char* val ;
1162   Tcl_Obj *resList;
1163   static CONST char* MysqlDbOpt[] =
1164     {
1165       "dbname", "dbname?", "tables", "host", "host?", "databases","info", NULL
1166     };
1167   enum dboption {
1168     MYSQL_INFNAME_OPT, MYSQL_INFNAMEQ_OPT, MYSQL_INFTABLES_OPT,
1169     MYSQL_INFHOST_OPT, MYSQL_INFHOSTQ_OPT, MYSQL_INFLIST_OPT, MYSQL_INFO
1170   };
1171   
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)
1175     return TCL_ERROR;
1176
1177   if (Tcl_GetIndexFromObj(interp, objv[2], (char **)MysqlDbOpt, "option",
1178                           TCL_EXACT, &idx) != TCL_OK)
1179     return TCL_ERROR;
1180
1181   /* First check the handle. Checking depends on the option. */
1182   switch (idx) {
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. */
1187     }
1188     break ;
1189   case MYSQL_INFNAME_OPT:
1190   case MYSQL_INFTABLES_OPT:
1191   case MYSQL_INFHOST_OPT:
1192   case MYSQL_INFLIST_OPT:
1193     /* !!! */
1194     handle = get_handle(interp,objc,objv,CL_CONN);
1195     break ;
1196   case MYSQL_INFHOSTQ_OPT:
1197     if (handle->connection == 0)
1198       return TCL_OK ; /* Return empty string if not connected. */
1199     break ;
1200   case MYSQL_INFO:
1201     if (handle->connection == 0)
1202       return TCL_OK ; /* Return empty string if not connected. */
1203     break;
1204   default: /* should never happen */
1205     return mysql_prim_confl (interp,objc,objv,"weirdness in Mysqltcl_Info") ;
1206   }
1207   
1208   if (handle == 0) return TCL_ERROR ;
1209
1210   /* Handle OK, return the requested info. */
1211   switch (idx) {
1212   case MYSQL_INFNAME_OPT:
1213   case MYSQL_INFNAMEQ_OPT:
1214     Tcl_SetObjResult(interp, Tcl_NewStringObj(handle->database, -1));
1215     break ;
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);
1219     
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));
1224     }
1225     mysql_free_result (list) ;
1226     break ;
1227   case MYSQL_INFHOST_OPT:
1228   case MYSQL_INFHOSTQ_OPT:
1229     Tcl_SetObjResult(interp, Tcl_NewStringObj(handle->host, -1));
1230     break ;
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);
1234     
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));
1240     }
1241     mysql_free_result (list) ;
1242     break ;
1243   case MYSQL_INFO:
1244     val = mysql_info(handle->connection);
1245     if (val!=NULL) {
1246       Tcl_SetObjResult(interp, Tcl_NewStringObj(val,-1));      
1247     }
1248     break;
1249   default: /* should never happen */
1250     return mysql_prim_confl (interp,objc,objv,"weirdness in Mysqltcl_Info") ;
1251   }
1252   return TCL_OK ;
1253 }
1254
1255
1256 /*
1257  *----------------------------------------------------------------------
1258  *
1259  * Mysqltcl_Result
1260  * Implements the mysqlresult command:
1261  * usage: mysqlresult handle option
1262  *
1263  */
1264
1265 DEFINE_CMD(Mysqltcl_Result)
1266 {
1267   int idx ;
1268   MysqlTclHandle *handle;
1269   static CONST char* MysqlResultOpt[] =
1270     {
1271      "rows", "rows?", "cols", "cols?", "current", "current?", NULL
1272     };
1273   enum resultoption {
1274     MYSQL_RESROWS_OPT, MYSQL_RESROWSQ_OPT, MYSQL_RESCOLS_OPT, 
1275     MYSQL_RESCOLSQ_OPT, MYSQL_RESCUR_OPT, MYSQL_RESCURQ_OPT
1276   };
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)
1280     return TCL_ERROR;
1281
1282   if (Tcl_GetIndexFromObj(interp, objv[2], (char **)MysqlResultOpt, "option",
1283                           TCL_EXACT, &idx) != TCL_OK)
1284     return TCL_ERROR;
1285
1286   /* First check the handle. Checking depends on the option. */
1287   switch (idx) {
1288   case MYSQL_RESROWS_OPT:
1289   case MYSQL_RESCOLS_OPT:
1290   case MYSQL_RESCUR_OPT:
1291     handle = get_handle (interp,objc,objv,CL_RES) ;
1292     break ;
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. */
1298     break ;
1299   default: /* should never happen */
1300     return mysql_prim_confl (interp,objc,objv,"weirdness in Mysqltcl_Result") ;
1301   }
1302   
1303   
1304   if (handle == 0)
1305     return TCL_ERROR ;
1306
1307   /* Handle OK; return requested info. */
1308   switch (idx) {
1309   case MYSQL_RESROWS_OPT:
1310   case MYSQL_RESROWSQ_OPT:
1311     Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->res_count));
1312     break ;
1313   case MYSQL_RESCOLS_OPT:
1314   case MYSQL_RESCOLSQ_OPT:
1315     Tcl_SetObjResult(interp, Tcl_NewIntObj(handle->col_count));
1316     break ;
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)) ;
1322     break ;
1323   default:
1324     return mysql_prim_confl (interp,objc,objv,"weirdness in Mysqltcl_Result");
1325   }
1326   return TCL_OK ;
1327 }
1328
1329
1330 /*
1331  *----------------------------------------------------------------------
1332  *
1333  * Mysqltcl_Col
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.
1338  *                      
1339  *    results:
1340  *      List of lists containing column attributes.
1341  *      If a single attribute is requested the result is a simple list.
1342  *
1343  * SIDE EFFECT: '-current' disturbs the field position of the result.
1344  */
1345
1346 DEFINE_CMD(Mysqltcl_Col)
1347 {
1348   int coln ;
1349   int current_db ;
1350   MysqlTclHandle *handle;
1351   int idx ;
1352   int listObjc ;
1353   Tcl_Obj **listObjv, *colinfo, *resList, *resSubList;
1354   MYSQL_FIELD* fld ;
1355   MYSQL_RES* result ;
1356   char *argv ;
1357   
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)
1361     return TCL_ERROR;
1362
1363   /* Fetch column info.
1364    * Two ways: explicit database and table names, or current.
1365    */
1366   argv=Tcl_GetStringFromObj(objv[2],NULL);
1367   current_db = strcmp (argv, "-current") == 0;
1368   
1369   if (current_db) {
1370     if ((handle = get_handle (interp,objc,objv,CL_RES)) == 0)
1371       return TCL_ERROR ;
1372     else
1373       result = handle->result ;
1374   } else {
1375     if ((result = mysql_list_fields (handle->connection, argv, (char*)NULL)) == NULL) {
1376       return mysql_server_confl (interp,objc,objv,handle->connection) ;
1377     }
1378   }
1379   /* Must examine the first specifier at this point. */
1380   if (Tcl_ListObjGetElements (interp, objv[3], &listObjc, &listObjv) != TCL_OK)
1381     return TCL_ERROR ;
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);
1388         } else {
1389             goto conflict;
1390             }
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);
1398             } else {
1399                goto conflict; 
1400             }
1401         Tcl_ListObjAppendElement (interp, resList, resSubList);
1402         }
1403   } else {
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);
1410         } else {
1411             goto conflict; 
1412         }
1413         Tcl_ListObjAppendElement (interp, resList, resSubList);
1414       }
1415   }
1416   if (!current_db) mysql_free_result (result) ;
1417   return TCL_OK;
1418   
1419   conflict:
1420     if (!current_db) mysql_free_result (result) ;
1421     return TCL_ERROR;
1422 }
1423
1424
1425 /*
1426  *----------------------------------------------------------------------
1427  *
1428  * Mysqltcl_State
1429  *    Implements the mysqlstate command:
1430  *    usage: mysqlstate handle ?-numeric?
1431  *                      
1432  */
1433
1434 DEFINE_CMD(Mysqltcl_State)
1435 {
1436   MysqlTclHandle *handle;
1437   int numeric=0 ;
1438   Tcl_Obj *res;
1439   
1440   if (mysql_prologue(interp, objc, objv, 2, 3, NULL, "handle ?-numeric?") == 0)
1441     return TCL_ERROR;
1442
1443   if (objc==3) {
1444     if (strcmp (Tcl_GetStringFromObj(objv[2],NULL), "-numeric"))
1445       return mysql_prim_confl (interp,objc,objv,"last parameter should be -numeric") ;
1446     else
1447       numeric=1;
1448   }
1449   
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) ;
1458   else
1459     res = (numeric)?Tcl_NewIntObj(4):Tcl_NewStringObj("RESULT_PENDING",-1) ;
1460
1461   Tcl_SetObjResult(interp, res);
1462   return TCL_OK ;
1463 }
1464
1465
1466 /*
1467  *----------------------------------------------------------------------
1468  *
1469  * Mysqltcl_InsertId
1470  *    Implements the mysqlstate command:
1471  *    usage: mysqlinsertid handle 
1472  *    Returns the auto increment id of the last INSERT statement
1473  *                      
1474  */
1475
1476 DEFINE_CMD(Mysqltcl_InsertId)
1477 {
1478   MysqlTclHandle *handle;
1479   
1480   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,
1481                             "handle")) == 0)
1482     return TCL_ERROR;
1483
1484   Tcl_SetObjResult(interp, Tcl_NewIntObj(mysql_insert_id(handle->connection)));
1485
1486   return TCL_OK;
1487 }
1488
1489
1490 /*
1491  *----------------------------------------------------------------------
1492  *
1493  * Mysqltcl_Close --
1494  *    Implements the mysqlclose command:
1495  *    usage: mysqlclose ?handle?
1496  *                      
1497  *    results:
1498  *      null string
1499  */
1500
1501 DEFINE_CMD(Mysqltcl_Close)
1502 {
1503   MysqlTclHandle *handle,*thandle;
1504   Tcl_HashEntry *entryPtr;
1505   Tcl_HashEntry *qentries[16];
1506   Tcl_HashSearch search;
1507
1508   int i,qfound = 0;
1509
1510   /* If handle omitted, close all connections. */
1511   if (objc == 1) {
1512       Mysqltcl_Kill ((ClientData)NULL) ;
1513       return TCL_OK ;
1514   }
1515   
1516   if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN,
1517                             "?handle?")) == 0)
1518     return TCL_ERROR;
1519
1520   if (handle->result != NULL)
1521     mysql_free_result (handle->result) ;
1522
1523   /* Search all queries on this handle and close those */
1524   if (!handle->isquery)  {
1525     mysql_close(handle->connection);
1526     while (1) {
1527       for (entryPtr=Tcl_FirstHashEntry(&handleTable,&search); 
1528            entryPtr!=NULL;
1529            entryPtr=Tcl_NextHashEntry(&search)) {
1530
1531         thandle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr);
1532         if (thandle->connection == handle->connection &&
1533             thandle->isquery) {
1534           qentries[qfound++] = entryPtr;
1535         }
1536         if (qfound==16) break;
1537       }
1538       if (qfound>0) {
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);
1546         }
1547       }
1548       if (qfound!=16) break;
1549       qfound = 0;
1550     }
1551   }
1552   entryPtr = Tcl_FindHashEntry(&handleTable,Tcl_GetStringFromObj(objv[1],NULL));
1553   if (entryPtr) Tcl_DeleteHashEntry(entryPtr);
1554   closeHandle(handle);
1555   return TCL_OK;
1556 }
1557
1558 /*
1559  *----------------------------------------------------------------------
1560  * Mysqltcl_Init
1561  * Perform all initialization for the MYSQL to Tcl interface.
1562  * Adds additional commands to interp, creates message array, initializes
1563  * all handles.
1564  *
1565  * A call to Mysqltcl_Init should exist in Tcl_CreateInterp or
1566  * Tcl_CreateExtendedInterp.
1567  */
1568
1569 #ifdef _WINDOWS
1570 __declspec( dllexport )
1571 #endif
1572 int Mysqltcl_Init (interp)
1573     Tcl_Interp *interp;
1574 {
1575   char nbuf[MYSQL_SMALL_SIZE];
1576  
1577   if (Tcl_InitStubs(interp, "8.1", 0) == NULL)
1578     return TCL_ERROR;
1579   if (Tcl_PkgRequire(interp, "Tcl", "8.1", 0) == NULL)
1580     return TCL_ERROR;
1581   if (Tcl_PkgProvide(interp, "mysqltcl" , VERSION) != TCL_OK)
1582     return TCL_ERROR;
1583   /*
1584    * Initialize the new Tcl commands.
1585    * Deleting any command will close all connections.
1586    */
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);
1603
1604   /* Initialize mysqlstatus global array. */
1605
1606   clear_msg(interp);
1607   
1608   /* Initialize HashTable for mysql handles */
1609   Tcl_InitHashTable (&handleTable, TCL_STRING_KEYS);
1610
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) ;
1615
1616   if (Tcl_LinkVar (interp,nbuf,(char *)&MysqlNullvalue, TCL_LINK_STRING) != TCL_OK)
1617     return TCL_ERROR;
1618
1619   /* Register the handle object type */
1620   Tcl_RegisterObjType(&mysqlHandleType);
1621
1622   /* A little sanity check.
1623    * If this message appears you must change the source code and recompile.
1624    */
1625   if (strlen (MysqlHandlePrefix) == MYSQL_HPREFIX_LEN)
1626     return TCL_OK;
1627   else {
1628     panic("*** mysqltcl (mysqltcl.c): handle prefix inconsistency!\n");
1629     return TCL_ERROR ;
1630   }
1631 }