2.8.5

2.8.6

**    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.49 2003/06/06 19:00:42 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>
................................................................................
    }else{
      pElem = Tcl_NewObj();
    }
    Tcl_ListObjAppendElement(0, pList, pElem);
  }
  return 0;
}






























/*
** Called when the command is deleted.
*/
static void DbDeleteCmd(void *db){
  SqliteDb *pDb = (SqliteDb*)db;
  sqlite_close(pDb->db);
................................................................................
static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
  SqliteDb *pDb = (SqliteDb*)cd;
  int choice;
  static const char *DB_strs[] = {
    "authorizer",         "busy",              "changes",
    "close",              "complete",          "errorcode",
    "eval",               "function",          "last_insert_rowid",
    "timeout",            "trace",             0

  };
  enum DB_enum {
    DB_AUTHORIZER,        DB_BUSY,             DB_CHANGES,
    DB_CLOSE,             DB_COMPLETE,         DB_ERRORCODE,
    DB_EVAL,              DB_FUNCTION,         DB_LAST_INSERT_ROWID,
    DB_TIMEOUT,           DB_TRACE,            
  };

  if( objc<2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
    return TCL_ERROR;
  }
  if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
................................................................................
      return TCL_ERROR;
    }
    rowid = sqlite_last_insert_rowid(pDb->db);
    pResult = Tcl_GetObjResult(interp);
    Tcl_SetIntObj(pResult, rowid);
    break;
  }





























  /*
  **     $db timeout MILLESECONDS
  **
  ** Delay for the number of milliseconds specified when a file is locked.
  */
  case DB_TIMEOUT: {

**    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.50 2003/08/19 14:31:02 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>
................................................................................
    }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);
................................................................................
static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
  SqliteDb *pDb = (SqliteDb*)cd;
  int choice;
  static const char *DB_strs[] = {
    "authorizer",         "busy",              "changes",
    "close",              "complete",          "errorcode",
    "eval",               "function",          "last_insert_rowid",
    "onecolumn",          "timeout",            "trace",
    0
  };
  enum DB_enum {
    DB_AUTHORIZER,        DB_BUSY,             DB_CHANGES,
    DB_CLOSE,             DB_COMPLETE,         DB_ERRORCODE,
    DB_EVAL,              DB_FUNCTION,         DB_LAST_INSERT_ROWID,
    DB_ONECOLUMN,         DB_TIMEOUT,          DB_TRACE,            
  };

  if( objc<2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
    return TCL_ERROR;
  }
  if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
................................................................................
      return TCL_ERROR;
    }
    rowid = sqlite_last_insert_rowid(pDb->db);
    pResult = Tcl_GetObjResult(interp);
    Tcl_SetIntObj(pResult, rowid);
    break;
  }

  /*
  **     $db onecolumn SQL
  **
  ** Return a single column from a single row of the given SQL query.
  */
  case DB_ONECOLUMN: {
    int rc;
    char *zSql;
    char *zErrMsg = 0;
    if( objc!=3 ){
      Tcl_WrongNumArgs(interp, 2, objv, "SQL");
      return TCL_ERROR;
    }
    zSql = Tcl_GetStringFromObj(objv[2], 0);
    rc = sqlite_exec(pDb->db, zSql, DbEvalCallback3, interp, &zErrMsg);
    if( rc==SQLITE_ABORT ){
      /* Do nothing.  This is normal. */
    }else if( zErrMsg ){
      Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
      free(zErrMsg);
      rc = TCL_ERROR;
    }else if( rc!=SQLITE_OK ){
      Tcl_AppendResult(interp, sqlite_error_string(rc), 0);
      rc = TCL_ERROR;
    }
    break;
  }

  /*
  **     $db timeout MILLESECONDS
  **
  ** Delay for the number of milliseconds specified when a file is locked.
  */
  case DB_TIMEOUT: {

# 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.13 2003/04/23 12:25:25 drh Exp $

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

# Check the error messages generated by tclsqlite
#
do_test tcl-1.1 {
  set v [catch {sqlite bogus} msg]
  lappend v $msg
} {1 {wrong # args: should be "sqlite HANDLE FILENAME ?MODE?"}}
do_test tcl-1.2 {
  set v [catch {db bogus} msg]
  lappend v $msg
} {1 {bad option "bogus": must be authorizer, busy, changes, close, complete, errorcode, eval, function, last_insert_rowid, timeout, or trace}}
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"
    }
................................................................................
  do_test tcl-2.2 {
    execsql "INSERT INTO t\251x VALUES(1,2.3)"
    db eval "SELECT * FROM t\251x" result break
    set result(*)
  } "a b\306"
}




















finish_test

# 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.14 2003/08/19 14:31:02 drh Exp $

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

# Check the error messages generated by tclsqlite
#
do_test tcl-1.1 {
  set v [catch {sqlite bogus} msg]
  lappend v $msg
} {1 {wrong # args: should be "sqlite HANDLE FILENAME ?MODE?"}}
do_test tcl-1.2 {
  set v [catch {db bogus} msg]
  lappend v $msg
} {1 {bad option "bogus": must be authorizer, busy, changes, close, complete, errorcode, eval, function, last_insert_rowid, onecolumn, timeout, or trace}}
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"
    }
................................................................................
  do_test tcl-2.2 {
    execsql "INSERT INTO t\251x VALUES(1,2.3)"
    db eval "SELECT * FROM t\251x" result break
    set result(*)
  } "a b\306"
}

# Test the onecolumn method
#
do_test tcl-3.1 {
  execsql {
    INSERT INTO t1 SELECT a*2, b*2 FROM t1;
    INSERT INTO t1 SELECT a*2+1, b*2+1 FROM t1;
    INSERT INTO t1 SELECT a*2+3, b*2+3 FROM t1;
  }
  db onecolumn {SELECT * FROM t1 ORDER BY a}
} {10}
do_test tcl-3.2 {
  db onecolumn {SELECT * FROM t1 WHERE a<0}
} {}
do_test tcl-3.3 {
  set rc [catch {db onecolumn} errmsg]
  lappend rc $errmsg
} {1 {wrong # args: should be "db onecolumn SQL"}}


finish_test

#
# Run this Tcl script to generate the tclsqlite.html file.
#
set rcsid {$Id: tclsqlite.tcl,v 1.7 2002/04/12 10:09:00 drh Exp $}

puts {<html>
<head>
  <title>The Tcl interface to the SQLite library</title>
</head>
<body bgcolor=white>
<h1 align=center>
................................................................................
<ul>
<li> busy
<li> changes
<li> close
<li> complete
<li> eval
<li> last_insert_rowid

<li> timeout
</ul>
</p>

<p>We will explain all of these methods, though not in that order.
We will be begin with the "close" method.</p>

................................................................................
should return "1" if it wants SQLite to abandon the current operation.

<h2>The "last_insert_rowid" method</h2>

<p>The "last_insert_rowid" method returns an integer which is the ROWID
of the most recently inserted database row.</p>












<h2>The "changes" method</h2>

<p>The "changes" method returns an integer which is the number of rows
in the database that were inserted, deleted, and/or modified by the most
recent "eval" method.</p>

}

#
# Run this Tcl script to generate the tclsqlite.html file.
#
set rcsid {$Id: tclsqlite.tcl,v 1.8 2003/08/19 14:31:02 drh Exp $}

puts {<html>
<head>
  <title>The Tcl interface to the SQLite library</title>
</head>
<body bgcolor=white>
<h1 align=center>
................................................................................
<ul>
<li> busy
<li> changes
<li> close
<li> complete
<li> eval
<li> last_insert_rowid
<li> onecolumn
<li> timeout
</ul>
</p>

<p>We will explain all of these methods, though not in that order.
We will be begin with the "close" method.</p>

................................................................................
should return "1" if it wants SQLite to abandon the current operation.

<h2>The "last_insert_rowid" method</h2>

<p>The "last_insert_rowid" method returns an integer which is the ROWID
of the most recently inserted database row.</p>

<h2>The "onecolumn" method</h2>

<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
first row of the query result.</p>

<p>This is a convenience method.  It saves the user from having to
do a "<tt>[lindex&nbsp;...&nbsp;0]</tt>" on the results of an "eval"
in order to extract a single column result.</p>

<h2>The "changes" method</h2>

<p>The "changes" method returns an integer which is the number of rows
in the database that were inserted, deleted, and/or modified by the most
recent "eval" method.</p>

}