/*

** 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.173 2006/09/02 14:17:00 drh Exp $

*/

#ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */

#include "sqliteInt.h"

#include "hash.h"

#include "tcl.h"

#include <stdlib.h>

#include <string.h>

#include <assert.h>

#include <ctype.h>

/*

 * Windows needs to know which symbols to export.  Unix does not.

 * BUILD_sqlite should be undefined for Unix.

 */

#ifdef BUILD_sqlite

#undef TCL_STORAGE_CLASS

#define TCL_STORAGE_CLASS DLLEXPORT

#endif /* BUILD_sqlite */

#define NUM_PREPARED_STMTS 10

#define MAX_PREPARED_STMTS 100

/*

** 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 */

  Tcl_Obj *pScript;     /* The Tcl_Obj representation of the script */

  int useEvalObjv;      /* True if it is safe to use Tcl_EvalObjv */

  char *zName;          /* Name of this function */

  SqlFunc *pNext;       /* Next function on the list of them all */

};

/*

** New collation sequences function can be created as TCL scripts.  Each such

** function is described by an instance of the following structure.

*/

typedef struct SqlCollate SqlCollate;

struct SqlCollate {

  Tcl_Interp *interp;   /* The TCL interpret to execute the function */

  char *zScript;        /* The script to be run */

  SqlCollate *pNext;    /* Next function on the list of them all */

};

/*

** Prepared statements are cached for faster execution.  Each prepared

** statement is described by an instance of the following structure.

*/

typedef struct SqlPreparedStmt SqlPreparedStmt;

struct SqlPreparedStmt {

  SqlPreparedStmt *pNext;  /* Next in linked list */

  SqlPreparedStmt *pPrev;  /* Previous on the list */

  sqlite3_stmt *pStmt;     /* The prepared statement */

  int nSql;                /* chars in zSql[] */

  char zSql[1];            /* Text of the SQL statement */

};

/*

** 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 {

  sqlite3 *db;               /* The "real" database structure. MUST BE FIRST */

  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 *zProfile;            /* The profile callback routine */

  char *zProgress;           /* The progress callback routine */

  char *zAuth;               /* The authorization callback routine */

  char *zNull;               /* Text to substitute for an SQL NULL value */

  SqlFunc *pFunc;            /* List of SQL functions */

  Tcl_Obj *pUpdateHook;      /* Update hook script (if any) */

  Tcl_Obj *pRollbackHook;    /* Rollback hook script (if any) */

  SqlCollate *pCollate;      /* List of SQL collation functions */

  int rc;                    /* Return code of most recent sqlite3_exec() */

  Tcl_Obj *pCollateNeeded;   /* Collation needed script */

  SqlPreparedStmt *stmtList; /* List of prepared statements*/

  SqlPreparedStmt *stmtLast; /* Last statement in the list */

  int maxStmt;               /* The next maximum number of stmtList */

  int nStmt;                 /* Number of statements in stmtList */

};

/*

** Look at the script prefix in pCmd.  We will be executing this script

** after first appending one or more arguments.  This routine analyzes

** the script to see if it is safe to use Tcl_EvalObjv() on the script

** rather than the more general Tcl_EvalEx().  Tcl_EvalObjv() is much

** faster.

**

** Scripts that are safe to use with Tcl_EvalObjv() consists of a

** command name followed by zero or more arguments with no [...] or $

** or {...} or ; to be seen anywhere.  Most callback scripts consist

** of just a single procedure name and they meet this requirement.

*/

static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){

  /* We could try to do something with Tcl_Parse().  But we will instead

  ** just do a search for forbidden characters.  If any of the forbidden

  ** characters appear in pCmd, we will report the string as unsafe.

  */

  const char *z;

  int n;

  z = Tcl_GetStringFromObj(pCmd, &n);

  while( n-- > 0 ){

    int c = *(z++);

    if( c=='$' || c=='[' || c==';' ) return 0;

  }

  return 1;

}

/*

** Find an SqlFunc structure with the given name.  Or create a new

** one if an existing one cannot be found.  Return a pointer to the

** structure.

*/

static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){

  SqlFunc *p, *pNew;

  int i;

  pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + strlen(zName) + 1 );

  pNew->zName = (char*)&pNew[1];

  for(i=0; zName[i]; i++){ pNew->zName[i] = tolower(zName[i]); }

  pNew->zName[i] = 0;

  for(p=pDb->pFunc; p; p=p->pNext){ 

    if( strcmp(p->zName, pNew->zName)==0 ){

      Tcl_Free((char*)pNew);

      return p;

    }

  }

  pNew->interp = pDb->interp;

  pNew->pScript = 0;

  pNew->pNext = pDb->pFunc;

  pDb->pFunc = pNew;

  return pNew;

}

/*

** Finalize and free a list of prepared statements

*/

static void flushStmtCache( SqliteDb *pDb ){

  SqlPreparedStmt *pPreStmt;

  while(  pDb->stmtList ){

    sqlite3_finalize( pDb->stmtList->pStmt );

    pPreStmt = pDb->stmtList;

    pDb->stmtList = pDb->stmtList->pNext;

    Tcl_Free( (char*)pPreStmt );

  }

  pDb->nStmt = 0;

  pDb->stmtLast = 0;

}

/*

** TCL calls this procedure when an sqlite3 database command is

** deleted.

*/

static void DbDeleteCmd(void *db){

  SqliteDb *pDb = (SqliteDb*)db;

  flushStmtCache(pDb);

  sqlite3_close(pDb->db);

  while( pDb->pFunc ){

    SqlFunc *pFunc = pDb->pFunc;

    pDb->pFunc = pFunc->pNext;

    Tcl_DecrRefCount(pFunc->pScript);

    Tcl_Free((char*)pFunc);

  }

  while( pDb->pCollate ){

    SqlCollate *pCollate = pDb->pCollate;

    pDb->pCollate = pCollate->pNext;

    Tcl_Free((char*)pCollate);

  }

  if( pDb->zBusy ){

    Tcl_Free(pDb->zBusy);

  }

  if( pDb->zTrace ){

    Tcl_Free(pDb->zTrace);

  }

  if( pDb->zProfile ){

    Tcl_Free(pDb->zProfile);

  }

  if( pDb->zAuth ){

    Tcl_Free(pDb->zAuth);

  }

  if( pDb->zNull ){

    Tcl_Free(pDb->zNull);

  }

  if( pDb->pUpdateHook ){

    Tcl_DecrRefCount(pDb->pUpdateHook);

  }

  if( pDb->pRollbackHook ){

    Tcl_DecrRefCount(pDb->pRollbackHook);

  }

  if( pDb->pCollateNeeded ){

    Tcl_DecrRefCount(pDb->pCollateNeeded);

  }

  Tcl_Free((char*)pDb);

}

/*

** This routine is called when a database file is locked while trying

** to execute SQL.

*/

static int DbBusyHandler(void *cd, int nTries){

  SqliteDb *pDb = (SqliteDb*)cd;

  int rc;

  char zVal[30];

  sprintf(zVal, "%d", nTries);

  rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0);

  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;

}

#ifndef SQLITE_OMIT_TRACE

/*

** 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);

}

#endif

#ifndef SQLITE_OMIT_TRACE

/*

** This routine is called by the SQLite profile handler after a statement

** SQL has executed.  The TCL script in pDb->zProfile is evaluated.

*/

static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){

  SqliteDb *pDb = (SqliteDb*)cd;

  Tcl_DString str;

  char zTm[100];

  sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm);

  Tcl_DStringInit(&str);

  Tcl_DStringAppend(&str, pDb->zProfile, -1);

  Tcl_DStringAppendElement(&str, zSql);

  Tcl_DStringAppendElement(&str, zTm);

  Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));

  Tcl_DStringFree(&str);

  Tcl_ResetResult(pDb->interp);

}

#endif

/*

** 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;

}

static void DbRollbackHandler(void *clientData){

  SqliteDb *pDb = (SqliteDb*)clientData;

  assert(pDb->pRollbackHook);

  if( TCL_OK!=Tcl_EvalObjEx(pDb->interp, pDb->pRollbackHook, 0) ){

    Tcl_BackgroundError(pDb->interp);

  }

}

static void DbUpdateHandler(

  void *p, 

  int op,

  const char *zDb, 

  const char *zTbl, 

  sqlite_int64 rowid

){

  SqliteDb *pDb = (SqliteDb *)p;

  Tcl_Obj *pCmd;

  assert( pDb->pUpdateHook );

  assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );

  pCmd = Tcl_DuplicateObj(pDb->pUpdateHook);

  Tcl_IncrRefCount(pCmd);

  Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(

    ( (op==SQLITE_INSERT)?"INSERT":(op==SQLITE_UPDATE)?"UPDATE":"DELETE"), -1));

  Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));

  Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));

  Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(rowid));

  Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);

}

static void tclCollateNeeded(

  void *pCtx,

  sqlite3 *db,

  int enc,

  const char *zName

){

  SqliteDb *pDb = (SqliteDb *)pCtx;

  Tcl_Obj *pScript = Tcl_DuplicateObj(pDb->pCollateNeeded);

  Tcl_IncrRefCount(pScript);

  Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(zName, -1));

  Tcl_EvalObjEx(pDb->interp, pScript, 0);

  Tcl_DecrRefCount(pScript);

}

/*

** This routine is called to evaluate an SQL collation function implemented

** using TCL script.

*/

static int tclSqlCollate(

  void *pCtx,

  int nA,

  const void *zA,

  int nB,

  const void *zB

){

  SqlCollate *p = (SqlCollate *)pCtx;

  Tcl_Obj *pCmd;

  pCmd = Tcl_NewStringObj(p->zScript, -1);

  Tcl_IncrRefCount(pCmd);

  Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA));

  Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB));

  Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);

  Tcl_DecrRefCount(pCmd);

  return (atoi(Tcl_GetStringResult(p->interp)));

}

/*

** This routine is called to evaluate an SQL function implemented

** using TCL script.

*/

static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){

  SqlFunc *p = sqlite3_user_data(context);

  Tcl_Obj *pCmd;

  int i;

  int rc;

  if( argc==0 ){

    /* If there are no arguments to the function, call Tcl_EvalObjEx on the

    ** script object directly.  This allows the TCL compiler to generate

    ** bytecode for the command on the first invocation and thus make

    ** subsequent invocations much faster. */

    pCmd = p->pScript;

    Tcl_IncrRefCount(pCmd);

    rc = Tcl_EvalObjEx(p->interp, pCmd, 0);

    Tcl_DecrRefCount(pCmd);

  }else{

    /* If there are arguments to the function, make a shallow copy of the

    ** script object, lappend the arguments, then evaluate the copy.

    **

    ** By "shallow" copy, we mean a only the outer list Tcl_Obj is duplicated.

    ** The new Tcl_Obj contains pointers to the original list elements. 

    ** That way, when Tcl_EvalObjv() is run and shimmers the first element

    ** of the list to tclCmdNameType, that alternate representation will

    ** be preserved and reused on the next invocation.

    */

    Tcl_Obj **aArg;

    int nArg;

    if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){

      sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 

      return;

    }     

    pCmd = Tcl_NewListObj(nArg, aArg);

    Tcl_IncrRefCount(pCmd);

    for(i=0; i<argc; i++){

      sqlite3_value *pIn = argv[i];

      Tcl_Obj *pVal;

      /* Set pVal to contain the i'th column of this row. */

      switch( sqlite3_value_type(pIn) ){

        case SQLITE_BLOB: {

          int bytes = sqlite3_value_bytes(pIn);

          pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes);

          break;

        }

        case SQLITE_INTEGER: {

          sqlite_int64 v = sqlite3_value_int64(pIn);

          if( v>=-2147483647 && v<=2147483647 ){

            pVal = Tcl_NewIntObj(v);

          }else{

            pVal = Tcl_NewWideIntObj(v);

          }

          break;

        }

        case SQLITE_FLOAT: {

          double r = sqlite3_value_double(pIn);

          pVal = Tcl_NewDoubleObj(r);

          break;

        }

        case SQLITE_NULL: {

          pVal = Tcl_NewStringObj("", 0);

          break;

        }

        default: {

          int bytes = sqlite3_value_bytes(pIn);

          pVal = Tcl_NewStringObj((char *)sqlite3_value_text(pIn), bytes);

          break;

        }

      }

      rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal);

      if( rc ){

        Tcl_DecrRefCount(pCmd);

        sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 

        return;

      }

    }

    if( !p->useEvalObjv ){

      /* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd

      ** is a list without a string representation.  To prevent this from

      ** happening, make sure pCmd has a valid string representation */

      Tcl_GetString(pCmd);

    }

    rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);

    Tcl_DecrRefCount(pCmd);

  }

  if( rc && rc!=TCL_RETURN ){

    sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 

  }else{

    Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);

    int n;

    u8 *data;

    char *zType = pVar->typePtr ? pVar->typePtr->name : "";

    char c = zType[0];

    if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){

      /* Only return a BLOB type if the Tcl variable is a bytearray and

      ** has no string representation. */

      data = Tcl_GetByteArrayFromObj(pVar, &n);

      sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);

    }else if( (c=='b' && strcmp(zType,"boolean")==0) ||

          (c=='i' && strcmp(zType,"int")==0) ){

      Tcl_GetIntFromObj(0, pVar, &n);

      sqlite3_result_int(context, n);

    }else if( c=='d' && strcmp(zType,"double")==0 ){

      double r;

      Tcl_GetDoubleFromObj(0, pVar, &r);

      sqlite3_result_double(context, r);

    }else if( c=='w' && strcmp(zType,"wideInt")==0 ){

      Tcl_WideInt v;

      Tcl_GetWideIntFromObj(0, pVar, &v);

      sqlite3_result_int64(context, v);

    }else{

      data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);

      sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT);

    }

  }

}

#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;