SQLite

/*
** 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.116 2005/01/24 00:28:43 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>

#define NUM_PREPARED_STMTS 0
#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)

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

/*
** 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_Free((char*)pFunc);
  }
  while( pDb->pCollate ){

  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_DString cmd;
  int i;
  int rc;

  Tcl_DStringInit(&cmd);
  Tcl_DStringAppend(&cmd, p->zScript, -1);

** subroutine to be invoked.
*/
static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
  SqliteDb *pDb = (SqliteDb*)cd;
  int choice;
  int rc = TCL_OK;
  static const char *DB_strs[] = {
    "authorizer",         "busy",              "cache",
    "changes",            "close",             "collate",
    "collation_needed",   "commit_hook",       "complete",
    "copy",               "errorcode",         "eval",
    "function",           "last_insert_rowid", "onecolumn",
    "progress",           "rekey",             "timeout",
    "total_changes",      "trace",             "version",
    0                    
  };
  enum DB_enum {
    DB_AUTHORIZER,        DB_BUSY,             DB_CACHE,
    DB_CHANGES,           DB_CLOSE,            DB_COLLATE,
    DB_COLLATION_NEEDED,  DB_COMMIT_HOOK,      DB_COMPLETE,
    DB_COPY,              DB_ERRORCODE,        DB_EVAL,
    DB_FUNCTION,          DB_LAST_INSERT_ROWID,DB_ONECOLUMN,
    DB_PROGRESS,          DB_REKEY,            DB_TIMEOUT,
    DB_TOTAL_CHANGES,     DB_TRACE,            DB_VERSION
  };
  /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */

  if( objc<2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
    return TCL_ERROR;
  }

        sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb);
      }else{
        sqlite3_busy_handler(pDb->db, 0, 0);
      }
    }
    break;
  }

  /*     $db cache flush
  **     $db cache size n
  **
  ** Flush the prepared statement cache, or set the maximum number of
  ** cached statements.
  */
  case DB_CACHE: {
    char *subCmd;
    int n;

    if( objc<=2 ){
      Tcl_WrongNumArgs(interp, 1, objv, "cache option ?arg?");
      return TCL_ERROR;
    }
    subCmd = Tcl_GetStringFromObj( objv[2], 0 );
    if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){
      if( objc!=3 ){
        Tcl_WrongNumArgs(interp, 2, objv, "flush");
        return TCL_ERROR;
      }else{
        flushStmtCache( pDb );
      }
    }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){
      if( objc!=4 ){
        Tcl_WrongNumArgs(interp, 2, objv, "size n");
        return TCL_ERROR;
      }else{
        if( TCL_ERROR==Tcl_GetIntFromObj(interp, objv[3], &n) ){
          Tcl_AppendResult( interp, "cannot convert \"", 
               Tcl_GetStringFromObj(objv[3],0), "\" to integer", 0);
          return TCL_ERROR;
        }else{
          if( n<0 ){
            flushStmtCache( pDb );
            n = 0;
          }else if( n>MAX_PREPARED_STMTS ){
            n = MAX_PREPARED_STMTS;
          }
          pDb->maxStmt = n;
        }
      }
    }else{
      Tcl_AppendResult( interp, "bad option \"", 
          Tcl_GetStringFromObj(objv[0],0), "\": must be flush or size", 0);
      return TCL_ERROR;
    }
    break;
  }

  /*     $db changes
  **
  ** Return the number of rows that were modified, inserted, or deleted by
  ** the most recent INSERT, UPDATE or DELETE statement, not including 
  ** any changes made by trigger programs.
  */

    sqlite3_stmt *pStmt;   /* Compiled SQL statment */
    Tcl_Obj *pArray;       /* Name of array into which results are written */
    Tcl_Obj *pScript;      /* Script to run for each result set */
    Tcl_Obj **apParm;      /* Parameters that need a Tcl_DecrRefCount() */
    int nParm;             /* Number of entries used in apParm[] */
    Tcl_Obj *aParm[10];    /* Static space for apParm[] in the common case */
    Tcl_Obj *pRet;         /* Value to be returned */
    SqlPreparedStmt *pPreStmt;  /* Pointer to a prepared statement */
    int rc2;

    if( choice==DB_ONECOLUMN ){
      if( objc!=3 ){
        Tcl_WrongNumArgs(interp, 2, objv, "SQL");
        return TCL_ERROR;
      }
      pRet = 0;

      if( Tcl_GetString(pArray)[0]==0 ) pArray = 0;
      pScript = objv[4];
    }

    Tcl_IncrRefCount(objv[2]);
    zSql = Tcl_GetStringFromObj(objv[2], 0);
    while( rc==TCL_OK && zSql[0] ){
      int i;                     /* Loop counter */
      int nVar;                  /* Number of bind parameters in the pStmt */
      int nCol;                  /* Number of columns in the result set */
      Tcl_Obj **apColName = 0;   /* Array of column names */
      int len;                   /* String length of zSql */
  
      /* Try to find a SQL statement that has already been compiled and
      ** which matches the next sequence of SQL.
      */
      pStmt = 0;
      pPreStmt = pDb->stmtList;
      len = strlen(zSql);
      if( pPreStmt && sqlite3_expired(pPreStmt->pStmt) ){
        flushStmtCache(pDb);
        pPreStmt = 0;
      }
      for(; pPreStmt; pPreStmt=pPreStmt->pNext){
        int n = pPreStmt->nSql;
        if( len>=n 
            && memcmp(pPreStmt->zSql, zSql, n)==0
            && (zSql[n]==0 || zSql[n-1]==';')
        ){
          pStmt = pPreStmt->pStmt;
          zLeft = &zSql[pPreStmt->nSql];

          /* When a prepared statement is found, unlink it from the
          ** cache list.  It will later be added back to the beginning
          ** of the cache list in order to implement LRU replacement.
          */
          if( pPreStmt->pPrev ){
            pPreStmt->pPrev->pNext = pPreStmt->pNext;
          }else{
            pDb->stmtList = pPreStmt->pNext;
          }
          if( pPreStmt->pNext ){
            pPreStmt->pNext->pPrev = pPreStmt->pPrev;
          }else{
            pDb->stmtLast = pPreStmt->pPrev;
          }
          pDb->nStmt--;
          break;
        }
      }
  
      /* If no prepared statement was found.  Compile the SQL text
      */
      if( pStmt==0 ){
        if( SQLITE_OK!=sqlite3_prepare(pDb->db, zSql, -1, &pStmt, &zLeft) ){
          Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
          rc = TCL_ERROR;
          break;
        }
        if( pStmt==0 ){
          if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){
            /* A compile-time error in the statement
            */
            Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
            rc = TCL_ERROR;
            break;
          }else{
            /* The statement was a no-op.  Continue to the next statement
            ** in the SQL string.
            */
            zSql = zLeft;
            continue;
          }
        }
        assert( pPreStmt==0 );
      }

      /* Bind values to parameters that begin with $ or :
      */  
      nVar = sqlite3_bind_parameter_count(pStmt);
      nParm = 0;
      if( nVar>sizeof(aParm)/sizeof(aParm[0]) ){
        apParm = (Tcl_Obj**)Tcl_Alloc(nVar*sizeof(apParm[0]));
      }else{
        apParm = aParm;
      }

              sqlite3_bind_double(pStmt, i, r);
            }else{
              data = Tcl_GetStringFromObj(pVar, &n);
              sqlite3_bind_text(pStmt, i, data, n, SQLITE_STATIC);
              Tcl_IncrRefCount(pVar);
              apParm[nParm++] = pVar;
            }
          }else{
            sqlite3_bind_null( pStmt, i );
          }
        }
      }

      /* Compute column names */
      nCol = sqlite3_column_count(pStmt);
      if( pScript ){

      for(i=0; i<nParm; i++){
        Tcl_DecrRefCount(apParm[i]);
      }
      if( apParm!=aParm ){
        Tcl_Free((char*)apParm);
      }

      /* Reset the statement.  If the result code is SQLITE_SCHEMA, then
      ** flush the statement cache and try the statement again.
      */
      rc2 = sqlite3_reset(pStmt);
      if( SQLITE_SCHEMA==rc2 ){
        /* After a schema change, flush the cache and try to run the
        ** statement again
        */
        flushStmtCache( pDb );
        sqlite3_finalize(pStmt);
        if( pPreStmt ) Tcl_Free((char*)pPreStmt);
        continue;

      }else if( SQLITE_OK!=rc2 ){
        /* If a run-time error occurs, report the error and stop reading
        ** the SQL
        */
        Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
        sqlite3_finalize(pStmt);
        rc = TCL_ERROR;
        if( pPreStmt ) Tcl_Free((char*)pPreStmt);
        break;
      }else if( pDb->maxStmt<=0 ){
        /* If the cache is turned off, deallocated the statement */
        if( pPreStmt ) Tcl_Free((char*)pPreStmt);
        sqlite3_finalize(pStmt);
      }else{
        /* Everything worked and the cache is operational.
        ** Create a new SqlPreparedStmt structure if we need one.
        ** (If we already have one we can just reuse it.)
        */
        if( pPreStmt==0 ){
          len = zLeft - zSql;
          pPreStmt = (SqlPreparedStmt*)Tcl_Alloc( sizeof(*pPreStmt) + len );
          if( pPreStmt==0 ) return TCL_ERROR;
          pPreStmt->pStmt = pStmt;
          pPreStmt->nSql = len;
          memcpy(pPreStmt->zSql, zSql, len);
          pPreStmt->zSql[len] = 0;
        }

        /* Add the prepared statement to the beginning of the cache list
        */
        pPreStmt->pNext = pDb->stmtList;
        pPreStmt->pPrev = 0;
        if( pDb->stmtList ){
         pDb->stmtList->pPrev = pPreStmt;
        }
        pDb->stmtList = pPreStmt;
        if( pDb->stmtLast==0 ){
          assert( pDb->nStmt==0 );
          pDb->stmtLast = pPreStmt;
        }else{
          assert( pDb->nStmt>0 );
        }
        pDb->nStmt++;
   
        /* If we have too many statement in cache, remove the surplus from the
        ** end of the cache list.
        */
        while( pDb->nStmt>pDb->maxStmt ){
          sqlite3_finalize(pDb->stmtLast->pStmt);
          pDb->stmtLast = pDb->stmtLast->pPrev;
          Tcl_Free((char*)pDb->stmtLast->pNext);
          pDb->stmtLast->pNext = 0;
          pDb->nStmt--;
        }
      }

      /* Proceed to the next statement */
      zSql = zLeft;
    }
    Tcl_DecrRefCount(objv[2]);

    if( pRet ){
      if( rc==TCL_OK ){
        Tcl_SetObjResult(interp, pRet);

    pFunc->interp = interp;
    pFunc->pNext = pDb->pFunc;
    pFunc->zScript = (char*)&pFunc[1];
    pDb->pFunc = pFunc;
    strcpy(pFunc->zScript, zScript);
    rc = sqlite3_create_function(pDb->db, zName, -1, SQLITE_UTF8,
        pFunc, tclSqlFunc, 0, 0);
    if( rc!=SQLITE_OK ){
       rc = TCL_ERROR;
    }else{
      /* Must flush any cached statements */
      flushStmtCache( pDb );
    }
    break;
  }

  /*
  **     $db last_insert_rowid 
  **
  ** Return an integer which is the ROWID for the most recent insert.

#endif
  if( p->db==0 ){
    Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
    Tcl_Free((char*)p);
    free(zErrMsg);
    return TCL_ERROR;
  }
  p->maxStmt = NUM_PREPARED_STMTS;
  zArg = Tcl_GetStringFromObj(objv[1], 0);
  Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd);

  /* The return value is the value of the sqlite* pointer
  */
  sprintf(zBuf, "%p", p->db);
  if( strncmp(zBuf,"0x",2) ){

  /* If the VM did not run to completion or if it encountered an
  ** error, then it might not have been halted properly.  So halt
  ** it now.
  */
  sqlite3VdbeHalt(p);

  /* If the VDBE has be run even partially, then transfer the error code
  ** and error message from the VDBE into the main database structure.  But
  ** if the VDBE has just been set to run but has not actually executed any
  ** instructions yet, leave the main database error information unchanged.
  */
  if( p->pc>=0 ){
    if( p->zErrMsg ){
      sqlite3Error(p->db, p->rc, "%s", p->zErrMsg);
      sqliteFree(p->zErrMsg);
      p->zErrMsg = 0;
    }else if( p->rc ){
      sqlite3Error(p->db, p->rc, 0);
    }else{
      sqlite3Error(p->db, SQLITE_OK, 0);
    }
  }

  /* Reclaim all memory used by the VDBE
  */
  Cleanup(p);

  /* Save profiling information from this VDBE run.

# This file implements regression tests for TCL interface to the
# SQLite library. 
#
# Actually, all tests are based on the TCL interface, so the main
# interface is pretty well tested.  This file contains some addition
# tests for fringe issues that the main test suite does not cover.
#
# $Id: tclsqlite.test,v 1.37 2005/01/24 00:28:43 drh Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl

# Check the error messages generated by tclsqlite
#
if {[sqlite3 -has-codec]} {
  set r "sqlite_orig HANDLE FILENAME ?-key CODEC-KEY?"
} else {
  set r "sqlite3 HANDLE FILENAME ?MODE?"
}
do_test tcl-1.1 {
  set v [catch {sqlite3 bogus} msg]
  lappend v $msg
} [list 1 "wrong # args: should be \"$r\""]
do_test tcl-1.2 {
  set v [catch {db bogus} msg]
  lappend v $msg
} {1 {bad option "bogus": must be authorizer, busy, cache, changes, close, collate, collation_needed, commit_hook, complete, copy, errorcode, eval, function, last_insert_rowid, onecolumn, progress, rekey, timeout, total_changes, trace, or version}}
do_test tcl-1.3 {
  execsql {CREATE TABLE t1(a int, b int)}
  execsql {INSERT INTO t1 VALUES(10,20)}
  set v [catch {
    db eval {SELECT * FROM t1} data {
      error "The error message"
    }