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.121 2005/04/03 23:54:44 danielk1977 Exp $
*/
#ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */

#include "sqliteInt.h"
#include "hash.h"
#include "tcl.h"
#include <stdlib.h>

  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 */
  char *zNull;          /* Text to substitute for an SQL NULL value */
  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 */

  }
  if( pDb->zTrace ){
    Tcl_Free(pDb->zTrace);
  }
  if( pDb->zAuth ){
    Tcl_Free(pDb->zAuth);
  }
  if( pDb->zNull ){
    Tcl_Free(pDb->zNull);
  }
  Tcl_Free((char*)pDb);
}

/*
** This routine is called when a database file is locked while trying
** to execute SQL.
*/

  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", "nullvalue",
    "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_NULLVALUE,
    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;
  }

              }
              break;
            }
            case SQLITE_FLOAT: {
              double r = sqlite3_column_double(pStmt, i);
              pVal = Tcl_NewDoubleObj(r);
              break;
            }
            case SQLITE_NULL: {
              pVal = dbTextToObj(pDb->zNull);
              break;
            }
            default: {
              pVal = dbTextToObj(sqlite3_column_text(pStmt, i));
              break;
            }
          }
  

      return TCL_ERROR;
    }
    if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
    sqlite3_busy_timeout(pDb->db, ms);
    break;
  }

  /*
  **     $db nullvalue ?STRING?
  **
  ** Change text used when a NULL comes back from the database. If ?STRING?
  ** is not present, then the current string used for NULL is returned.
  ** If STRING is present, then STRING is returned.
  **
  */
  case DB_NULLVALUE: {
    if( objc!=2 && objc!=3 ){
      Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE");
      return TCL_ERROR;
    }
    if( objc==3 ){
      int len;
      char *zNull = Tcl_GetStringFromObj(objv[2], &len);
      if( pDb->zNull ){
        Tcl_Free(pDb->zNull);
      }
      if( zNull && len>0 ){
        pDb->zNull = Tcl_Alloc( len + 1 );
        strncpy(pDb->zNull, zNull, len);
        pDb->zNull[len] = '\0';
      }else{
        pDb->zNull = 0;
      }
    }
    Tcl_SetObjResult(interp, dbTextToObj(pDb->zNull));
    break;
  }
  
  /*
  **     $db total_changes
  **
  ** Return the number of rows that were modified, inserted, or deleted 
  ** since the database handle was created.
  */
  case DB_TOTAL_CHANGES: {

# 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.39 2005/04/03 23:54:45 danielk1977 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, 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"
    }

  return_test 0
} {}

do_test tcl-7.1 {
  db version
  expr 0
} {0}

# modify and reset the NULL representation
#
do_test tcl-8.1 {
  db nullvalue NaN
  execsql {INSERT INTO t1 VALUES(30,NULL)}
  db eval {SELECT * FROM t1 WHERE b IS NULL}
} {30 NaN}
do_test tcl-8.2 {
  db nullvalue NULL
  db nullvalue
} {NULL}
do_test tcl-8.3 {
  db nullvalue {}
  db eval {SELECT * FROM t1 WHERE b IS NULL}
} {30 {}}

finish_test

#
# Run this Tcl script to generate the tclsqlite.html file.
#
set rcsid {$Id: tclsqlite.tcl,v 1.13 2005/04/03 23:54:45 danielk1977 Exp $}
source common.tcl
header {The Tcl interface to the SQLite library}
proc METHOD {name text} {
  puts "<a name=\"$name\">\n<h3>The \"$name\" method</h3>\n"
  puts $text
}
puts {

<p>
The name of the database is just the name of a disk file in which
the database is stored.
</p>

<p>
Once an SQLite database is open, it can be controlled using 
methods of the <i>dbcmd</i>.  There are currently 19 methods
defined:</p>

<p>
<ul>
}
foreach m [lsort {
 authorizer
 busy
 changes
 close
 collate
 collation_needed
 commit_hook
 complete
 copy
 errorcode
 eval
 function
 last_insert_rowid
 nullvalue
 onecolumn
 progress
 timeout
 total_changes
 trace
}] {
 puts "<li><a href=\"#$m\">$m</a></li>"

</p>

<blockquote><b>
db function hex {format 0x%X}
</b></blockquote>

}

##############################################################################
METHOD nullvalue {

<p>
The "nullvalue" method changes the representation for NULL returned
as result of the "eval" method.</p>

<blockquote><b>
db1 nullvalue NULL
</b></blockquote>

<p>The "nullvalue" method is useful to differ between NULL and empty
column values as Tcl lacks a NULL representation.  The default
representation for NULL values is an empty string.</p>
}



##############################################################################
METHOD onecolumn {

<p>The "onecolumn" method works like "eval" in that it evaluates the
SQL query statement given as its argument.  The difference is that
"onecolumn" returns a single element which is the first column of the