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 }