/*** 2001 September 15**** The author disclaims copyright to this source code.  In place of** a legal notice, here is a blessing:****    May you do good and not evil.**    May you find forgiveness for yourself and forgive others.**    May you share freely, never taking more than you give.***************************************************************************** A TCL Interface to SQLite**** $Id: tclsqlite.c,v 1.59.2.1 2004/06/19 11:57:40 drh Exp $*/#ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */#include "sqliteInt.h"#include "tcl.h"#include <stdlib.h>#include <string.h>#include <assert.h>/*** If TCL uses UTF-8 and SQLite is configured to use iso8859, then we** have to do a translation when going between the two.  Set the ** UTF_TRANSLATION_NEEDED macro to indicate that we need to do** this translation.  */#if defined(TCL_UTF_MAX) && !defined(SQLITE_UTF8)# define UTF_TRANSLATION_NEEDED 1#endif/*** New SQL functions can be created as TCL scripts.  Each such function** is described by an instance of the following structure.*/typedef struct SqlFunc SqlFunc;struct SqlFunc {  Tcl_Interp *interp;   /* The TCL interpret to execute the function */  char *zScript;        /* The script to be run */  SqlFunc *pNext;       /* Next function on the list of them all */};/*** There is one instance of this structure for each SQLite database** that has been opened by the SQLite TCL interface.*/typedef struct SqliteDb SqliteDb;struct SqliteDb {  sqlite *db;           /* The "real" database structure */  Tcl_Interp *interp;   /* The interpreter used for this database */  char *zBusy;          /* The busy callback routine */  char *zCommit;        /* The commit hook callback routine */  char *zTrace;         /* The trace callback routine */  char *zProgress;      /* The progress callback routine */  char *zAuth;          /* The authorization callback routine */  SqlFunc *pFunc;       /* List of SQL functions */  int rc;               /* Return code of most recent sqlite_exec() */};/*** An instance of this structure passes information thru the sqlite** logic from the original TCL command into the callback routine.*/typedef struct CallbackData CallbackData;struct CallbackData {  Tcl_Interp *interp;       /* The TCL interpreter */  char *zArray;             /* The array into which data is written */  Tcl_Obj *pCode;           /* The code to execute for each row */  int once;                 /* Set for first callback only */  int tcl_rc;               /* Return code from TCL script */  int nColName;             /* Number of entries in the azColName[] array */  char **azColName;         /* Column names translated to UTF-8 */};#ifdef UTF_TRANSLATION_NEEDED/*** Called for each row of the result.**** This version is used when TCL expects UTF-8 data but the database** uses the ISO8859 format.  A translation must occur from ISO8859 into** UTF-8.*/static int DbEvalCallback(  void *clientData,      /* An instance of CallbackData */  int nCol,              /* Number of columns in the result */  char ** azCol,         /* Data for each column */  char ** azN            /* Name for each column */){  CallbackData *cbData = (CallbackData*)clientData;  int i, rc;  Tcl_DString dCol;  Tcl_DStringInit(&dCol);  if( cbData->azColName==0 ){    assert( cbData->once );    cbData->once = 0;    if( cbData->zArray[0] ){      Tcl_SetVar2(cbData->interp, cbData->zArray, "*", "", 0);    }    cbData->azColName = malloc( nCol*sizeof(char*) );    if( cbData->azColName==0 ){ return 1; }    cbData->nColName = nCol;    for(i=0; i<nCol; i++){      Tcl_ExternalToUtfDString(NULL, azN[i], -1, &dCol);      cbData->azColName[i] = malloc( Tcl_DStringLength(&dCol) + 1 );      if( cbData->azColName[i] ){        strcpy(cbData->azColName[i], Tcl_DStringValue(&dCol));      }else{        return 1;      }      if( cbData->zArray[0] ){        Tcl_SetVar2(cbData->interp, cbData->zArray, "*",             Tcl_DStringValue(&dCol), TCL_LIST_ELEMENT|TCL_APPEND_VALUE);        if( azN[nCol]!=0 ){          Tcl_DString dType;          Tcl_DStringInit(&dType);          Tcl_DStringAppend(&dType, "typeof:", -1);          Tcl_DStringAppend(&dType, Tcl_DStringValue(&dCol), -1);          Tcl_DStringFree(&dCol);          Tcl_ExternalToUtfDString(NULL, azN[i+nCol], -1, &dCol);          Tcl_SetVar2(cbData->interp, cbData->zArray,                Tcl_DStringValue(&dType), Tcl_DStringValue(&dCol),               TCL_LIST_ELEMENT|TCL_APPEND_VALUE);          Tcl_DStringFree(&dType);        }      }            Tcl_DStringFree(&dCol);    }  }  if( azCol!=0 ){    if( cbData->zArray[0] ){      for(i=0; i<nCol; i++){        char *z = azCol[i];        if( z==0 ) z = "";        Tcl_DStringInit(&dCol);        Tcl_ExternalToUtfDString(NULL, z, -1, &dCol);        Tcl_SetVar2(cbData->interp, cbData->zArray, cbData->azColName[i],               Tcl_DStringValue(&dCol), 0);        Tcl_DStringFree(&dCol);      }    }else{      for(i=0; i<nCol; i++){        char *z = azCol[i];        if( z==0 ) z = "";        Tcl_DStringInit(&dCol);        Tcl_ExternalToUtfDString(NULL, z, -1, &dCol);        Tcl_SetVar(cbData->interp, cbData->azColName[i],                   Tcl_DStringValue(&dCol), 0);        Tcl_DStringFree(&dCol);      }    }  }  rc = Tcl_EvalObj(cbData->interp, cbData->pCode);  if( rc==TCL_CONTINUE ) rc = TCL_OK;  cbData->tcl_rc = rc;  return rc!=TCL_OK;}#endif /* UTF_TRANSLATION_NEEDED */#ifndef UTF_TRANSLATION_NEEDED/*** Called for each row of the result.**** This version is used when either of the following is true:****    (1) This version of TCL uses UTF-8 and the data in the**        SQLite database is already in the UTF-8 format.****    (2) This version of TCL uses ISO8859 and the data in the**        SQLite database is already in the ISO8859 format.*/static int DbEvalCallback(  void *clientData,      /* An instance of CallbackData */  int nCol,              /* Number of columns in the result */  char ** azCol,         /* Data for each column */  char ** azN            /* Name for each column */){  CallbackData *cbData = (CallbackData*)clientData;  int i, rc;  if( azCol==0 || (cbData->once && cbData->zArray[0]) ){    Tcl_SetVar2(cbData->interp, cbData->zArray, "*", "", 0);    for(i=0; i<nCol; i++){      Tcl_SetVar2(cbData->interp, cbData->zArray, "*", azN[i],         TCL_LIST_ELEMENT|TCL_APPEND_VALUE);      if( azN[nCol] ){        char *z = sqlite_mprintf("typeof:%s", azN[i]);        Tcl_SetVar2(cbData->interp, cbData->zArray, z, azN[i+nCol],           TCL_LIST_ELEMENT|TCL_APPEND_VALUE);        sqlite_freemem(z);      }    }    cbData->once = 0;  }  if( azCol!=0 ){    if( cbData->zArray[0] ){      for(i=0; i<nCol; i++){        char *z = azCol[i];        if( z==0 ) z = "";        Tcl_SetVar2(cbData->interp, cbData->zArray, azN[i], z, 0);      }    }else{      for(i=0; i<nCol; i++){        char *z = azCol[i];        if( z==0 ) z = "";        Tcl_SetVar(cbData->interp, azN[i], z, 0);      }    }  }  rc = Tcl_EvalObj(cbData->interp, cbData->pCode);  if( rc==TCL_CONTINUE ) rc = TCL_OK;  cbData->tcl_rc = rc;  return rc!=TCL_OK;}#endif/*** This is an alternative callback for database queries.  Instead** of invoking a TCL script to handle the result, this callback just** appends each column of the result to a list.  After the query** is complete, the list is returned.*/static int DbEvalCallback2(  void *clientData,      /* An instance of CallbackData */  int nCol,              /* Number of columns in the result */  char ** azCol,         /* Data for each column */  char ** azN            /* Name for each column */){  Tcl_Obj *pList = (Tcl_Obj*)clientData;  int i;  if( azCol==0 ) return 0;  for(i=0; i<nCol; i++){    Tcl_Obj *pElem;    if( azCol[i] && *azCol[i] ){#ifdef UTF_TRANSLATION_NEEDED      Tcl_DString dCol;      Tcl_DStringInit(&dCol);      Tcl_ExternalToUtfDString(NULL, azCol[i], -1, &dCol);      pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);      Tcl_DStringFree(&dCol);#else      pElem = Tcl_NewStringObj(azCol[i], -1);#endif    }else{      pElem = Tcl_NewObj();    }    Tcl_ListObjAppendElement(0, pList, pElem);  }  return 0;}/*** This is a second alternative callback for database queries.  A the** first column of the first row of the result is made the TCL result.*/static int DbEvalCallback3(  void *clientData,      /* An instance of CallbackData */  int nCol,              /* Number of columns in the result */  char ** azCol,         /* Data for each column */  char ** azN            /* Name for each column */){  Tcl_Interp *interp = (Tcl_Interp*)clientData;  Tcl_Obj *pElem;  if( azCol==0 ) return 1;  if( nCol==0 ) return 1;#ifdef UTF_TRANSLATION_NEEDED  {    Tcl_DString dCol;    Tcl_DStringInit(&dCol);    Tcl_ExternalToUtfDString(NULL, azCol[0], -1, &dCol);    pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);    Tcl_DStringFree(&dCol);  }#else  pElem = Tcl_NewStringObj(azCol[0], -1);#endif  Tcl_SetObjResult(interp, pElem);  return 1;}/*** Called when the command is deleted.*/static void DbDeleteCmd(void *db){  SqliteDb *pDb = (SqliteDb*)db;  sqlite_close(pDb->db);  while( pDb->pFunc ){    SqlFunc *pFunc = pDb->pFunc;    pDb->pFunc = pFunc->pNext;    Tcl_Free((char*)pFunc);  }  if( pDb->zBusy ){    Tcl_Free(pDb->zBusy);  }  if( pDb->zTrace ){    Tcl_Free(pDb->zTrace);  }  if( pDb->zAuth ){    Tcl_Free(pDb->zAuth);  }  Tcl_Free((char*)pDb);}/*** This routine is called when a database file is locked while trying** to execute SQL.*/static int DbBusyHandler(void *cd, const char *zTable, int nTries){  SqliteDb *pDb = (SqliteDb*)cd;  int rc;  char zVal[30];  char *zCmd;  Tcl_DString cmd;  Tcl_DStringInit(&cmd);  Tcl_DStringAppend(&cmd, pDb->zBusy, -1);  Tcl_DStringAppendElement(&cmd, zTable);  sprintf(zVal, " %d", nTries);  Tcl_DStringAppend(&cmd, zVal, -1);  zCmd = Tcl_DStringValue(&cmd);  rc = Tcl_Eval(pDb->interp, zCmd);  Tcl_DStringFree(&cmd);  if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){    return 0;  }  return 1;}/*** This routine is invoked as the 'progress callback' for the database.*/static int DbProgressHandler(void *cd){  SqliteDb *pDb = (SqliteDb*)cd;  int rc;  assert( pDb->zProgress );  rc = Tcl_Eval(pDb->interp, pDb->zProgress);  if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){    return 1;  }  return 0;}/*** This routine is called by the SQLite trace handler whenever a new** block of SQL is executed.  The TCL script in pDb->zTrace is executed.*/static void DbTraceHandler(void *cd, const char *zSql){  SqliteDb *pDb = (SqliteDb*)cd;  Tcl_DString str;  Tcl_DStringInit(&str);  Tcl_DStringAppend(&str, pDb->zTrace, -1);  Tcl_DStringAppendElement(&str, zSql);  Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));  Tcl_DStringFree(&str);  Tcl_ResetResult(pDb->interp);}/*** This routine is called when a transaction is committed.  The** TCL script in pDb->zCommit is executed.  If it returns non-zero or** if it throws an exception, the transaction is rolled back instead** of being committed.*/static int DbCommitHandler(void *cd){  SqliteDb *pDb = (SqliteDb*)cd;  int rc;  rc = Tcl_Eval(pDb->interp, pDb->zCommit);  if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){    return 1;  }  return 0;}/*** This routine is called to evaluate an SQL function implemented** using TCL script.*/static void tclSqlFunc(sqlite_func *context, int argc, const char **argv){  SqlFunc *p = sqlite_user_data(context);  Tcl_DString cmd;  int i;  int rc;  Tcl_DStringInit(&cmd);  Tcl_DStringAppend(&cmd, p->zScript, -1);  for(i=0; i<argc; i++){    Tcl_DStringAppendElement(&cmd, argv[i] ? argv[i] : "");  }  rc = Tcl_Eval(p->interp, Tcl_DStringValue(&cmd));  if( rc ){    sqlite_set_result_error(context, Tcl_GetStringResult(p->interp), -1);   }else{    sqlite_set_result_string(context, Tcl_GetStringResult(p->interp), -1);  }}#ifndef SQLITE_OMIT_AUTHORIZATION/*** This is the authentication function.  It appends the authentication** type code and the two arguments to zCmd[] then invokes the result** on the interpreter.  The reply is examined to determine if the** authentication fails or succeeds.*/static int auth_callback(  void *pArg,  int code,  const char *zArg1,  const char *zArg2,  const char *zArg3,  const char *zArg4){  char *zCode;  Tcl_DString str;  int rc;  const char *zReply;  SqliteDb *pDb = (SqliteDb*)pArg;  switch( code ){    case SQLITE_COPY              : zCode="SQLITE_COPY"; break;    case SQLITE_CREATE_INDEX      : zCode="SQLITE_CREATE_INDEX"; break;    case SQLITE_CREATE_TABLE      : zCode="SQLITE_CREATE_TABLE"; break;    case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;    case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;    case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;    case SQLITE_CREATE_TEMP_VIEW  : zCode="SQLITE_CREATE_TEMP_VIEW"; break;    case SQLITE_CREATE_TRIGGER    : zCode="SQLITE_CREATE_TRIGGER"; break;    case SQLITE_CREATE_VIEW       : zCode="SQLITE_CREATE_VIEW"; break;    case SQLITE_DELETE            : zCode="SQLITE_DELETE"; break;    case SQLITE_DROP_INDEX        : zCode="SQLITE_DROP_INDEX"; break;