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.129 2005/08/02 12:21:09 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>

    "authorizer",         "busy",              "cache",
    "changes",            "close",             "collate",
    "collation_needed",   "commit_hook",       "complete",
    "copy",               "errorcode",         "eval",
    "function",           "last_insert_rowid", "nullvalue",
    "onecolumn",          "progress",          "rekey",
    "timeout",            "total_changes",     "trace",
    "transaction",        "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_NULLVALUE,
    DB_ONECOLUMN,         DB_PROGRESS,         DB_REKEY,
    DB_TIMEOUT,           DB_TOTAL_CHANGES,    DB_TRACE,
    DB_TRANSACTION,       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_trace(pDb->db, DbTraceHandler, pDb);
      }else{
        sqlite3_trace(pDb->db, 0, 0);
      }
    }
    break;
  }

  /*    $db transaction [-deferred|-immediate|-exclusive] SCRIPT
  **
  ** Start a new transaction (if we are not already in the midst of a
  ** transaction) and execute the TCL script SCRIPT.  After SCRIPT
  ** completes, either commit the transaction or roll it back if SCRIPT
  ** throws an exception.  Or if no new transation was started, do nothing.
  ** pass the exception on up the stack.
  **
  ** This command was inspired by Dave Thomas's talk on Ruby at the
  ** 2005 O'Reilly Open Source Convention (OSCON).
  */
  case DB_TRANSACTION: {
    int inTrans;
    Tcl_Obj *pScript;
    const char *zBegin = "BEGIN";
    if( objc!=3 && objc!=4 ){
      Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT");
      return TCL_ERROR;
    }
    if( objc==3 ){
      pScript = objv[2];
    } else {
      static const char *TTYPE_strs[] = {
        "deferred",   "exclusive",  "immediate"
      };
      enum TTYPE_enum {
        TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
      };
      int ttype;
      if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction_type",
                              0, &ttype) ){
        return TCL_ERROR;
      }
      switch( (enum TTYPE_enum)ttype ){
        case TTYPE_DEFERRED:    /* no-op */;                 break;
        case TTYPE_EXCLUSIVE:   zBegin = "BEGIN EXCLUSIVE";  break;
        case TTYPE_IMMEDIATE:   zBegin = "BEGIN IMMEDIATE";  break;
      }
      pScript = objv[3];
    }
    inTrans = !sqlite3_get_autocommit(pDb->db);
    if( !inTrans ){
      sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
    }
    rc = Tcl_EvalObjEx(interp, pScript, 0);
    if( !inTrans ){
      const char *zEnd;
      if( rc==TCL_ERROR ){
        zEnd = "ROLLBACK";
      } else {
        zEnd = "COMMIT";
      }
      sqlite3_exec(pDb->db, zEnd, 0, 0, 0);
    }
    break;
  }

  /*    $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR?
  **
  ** Copy data into table from filename, optionally using SEPARATOR
  ** as column separators.  If a column contains a null string, or the
  ** value of NULLINDICATOR, a NULL is inserted for the column.
  ** conflict-algorithm is one of the sqlite conflict algorithms:

# 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.42 2005/08/02 12:21:10 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, nullvalue, onecolumn, progress, rekey, timeout, total_changes, trace, transaction, 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"
    }