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.145 2006/01/05 15:50:07 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",
    "exists",             "function",          "last_insert_rowid",
    "nullvalue",          "onecolumn",         "profile",
    "progress",           "rekey",             "rollback_hook",

    "timeout",            "total_changes",     "trace",
    "transaction",        "update_hook",       "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_EXISTS,            DB_FUNCTION,         DB_LAST_INSERT_ROWID,
    DB_NULLVALUE,         DB_ONECOLUMN,        DB_PROFILE,
    DB_PROGRESS,          DB_REKEY,            DB_ROLLBACK_HOOK,

    DB_TIMEOUT,           DB_TOTAL_CHANGES,    DB_TRACE,
    DB_TRANSACTION,       DB_UPDATE_HOOK,      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;
  }

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



















































  
  /*
  **     $db total_changes
  **
  ** Return the number of rows that were modified, inserted, or deleted 
  ** since the database handle was created.
  */

**    May you share freely, never taking more than you give.
**
*************************************************************************
** Code for testing the printf() interface to SQLite.  This code
** is not included in the SQLite library.  It is used for automated
** testing of the SQLite library.
**
** $Id: test1.c,v 1.180 2006/01/05 15:50:07 drh Exp $
*/
#include "sqliteInt.h"
#include "tcl.h"
#include "os.h"
#include <stdlib.h>
#include <string.h>

  pVar = Tcl_GetVar2Ex(interp, Tcl_GetString(objv[1]), 0, TCL_LEAVE_ERR_MSG);
  if( pVar==0 ) return TCL_ERROR;
  if( pVar->typePtr ){
    Tcl_SetObjResult(interp, Tcl_NewStringObj(pVar->typePtr->name, -1));
  }
  return TCL_OK;
}

/*
** Usage:  sqlite3_release_memory ?N?
**
** Attempt to release memory currently held but not actually required.
** The integer N is the number of bytes we are trying to release.  The 
** return value is the amount of memory actually released.
*/
static int test_release_memory(
  void * clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
#ifndef SQLITE_OMIT_MEMORY_MANAGEMENT
  int N;
  int amt;
  if( objc!=1 && objc!=2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "?N?");
    return TCL_ERROR;
  }
  if( objc==2 ){
    if( Tcl_GetIntFromObj(interp, objv[1], &N) ) return TCL_ERROR;
  }else{
    N = -1;
  }
  amt = sqlite3_release_memory(N);
  Tcl_SetObjResult(interp, Tcl_NewIntObj(amt));
#endif
  return TCL_OK;
}

/*
** Usage:  sqlite3_soft_heap_limit ?N?
**
** Query or set the soft heap limit for the current thread.  The
** limit is only changed if the N is present.  The previous limit
** is returned.
*/
static int test_soft_heap_limit(
  void * clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
#ifndef SQLITE_OMIT_MEMORY_MANAGEMENT
  int amt;
  if( objc!=1 && objc!=2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "?N?");
    return TCL_ERROR;
  }
  amt = sqlite3Tsd()->nSoftHeapLimit;
  if( objc==2 ){
    int N;
    if( Tcl_GetIntFromObj(interp, objv[1], &N) ) return TCL_ERROR;
    sqlite3_soft_heap_limit(N);
  }
  Tcl_SetObjResult(interp, Tcl_NewIntObj(amt));
#endif
  return TCL_OK;
}

/*
** This routine sets entries in the global ::sqlite_options() array variable
** according to the compile-time configuration of the database.  Test
** procedures use this to determine when tests should be omitted.
*/
static void set_options(Tcl_Interp *interp){

#endif

#ifdef SQLITE_OMIT_MEMORYDB
  Tcl_SetVar2(interp, "sqlite_options", "memorydb", "0", TCL_GLOBAL_ONLY);
#else
  Tcl_SetVar2(interp, "sqlite_options", "memorydb", "1", TCL_GLOBAL_ONLY);
#endif

#ifdef SQLITE_OMIT_MEMORY_MANAGEMENT
  Tcl_SetVar2(interp, "sqlite_options", "memorymanage", "0", TCL_GLOBAL_ONLY);
#else
  Tcl_SetVar2(interp, "sqlite_options", "memorymanage", "1", TCL_GLOBAL_ONLY);
#endif

#ifdef SQLITE_OMIT_OR_OPTIMIZATION
  Tcl_SetVar2(interp, "sqlite_options", "or_opt", "0", TCL_GLOBAL_ONLY);
#else
  Tcl_SetVar2(interp, "sqlite_options", "or_opt", "1", TCL_GLOBAL_ONLY);
#endif

     { "sqlite3_prepare16",             test_prepare16     ,0 },
     { "sqlite3_finalize",              test_finalize      ,0 },
     { "sqlite3_reset",                 test_reset         ,0 },
     { "sqlite3_expired",               test_expired       ,0 },
     { "sqlite3_transfer_bindings",     test_transfer_bind ,0 },
     { "sqlite3_changes",               test_changes       ,0 },
     { "sqlite3_step",                  test_step          ,0 },

     { "sqlite3_release_memory",        test_release_memory,  0},
     { "sqlite3_soft_heap_limit",       test_soft_heap_limit, 0},

     /* sqlite3_column_*() API */
     { "sqlite3_column_count",          test_column_count  ,0 },
     { "sqlite3_data_count",            test_data_count    ,0 },
     { "sqlite3_column_type",           test_column_type   ,0 },
     { "sqlite3_column_blob",           test_column_blob   ,0 },
     { "sqlite3_column_double",         test_column_double ,0 },

#    May you share freely, never taking more than you give.
#
#***********************************************************************
#
# This file contains test cases focused on the two memory-management APIs, 
# sqlite3_soft_heap_limit() and sqlite3_release_memory().
#
# $Id: malloc5.test,v 1.4 2006/01/05 15:50:07 drh Exp $

#---------------------------------------------------------------------------
# NOTES ON EXPECTED BEHAVIOUR
#
#---------------------------------------------------------------------------

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

# Only run these tests if memory debugging is turned on.
if {[info command sqlite_malloc_stat]==""} {
   puts "Skipping malloc tests: not compiled with -DSQLITE_MEMDEBUG..."
   finish_test
   return
}

do_test malloc5-1.1 {
  # Simplest possible test. Call sqlite3_release_memory when there is exactly
  # one unused page in a single pager cache. This test case set's the 
  # value of the ::pgalloc variable, which is used in subsequent tests.
  #
  # Note: Even though executing this statement on an empty database 
  # modifies 2 pages (the root of sqlite_master and the new root page), 
  # the sqlite_master root (page 1) is never freed because the btree layer
  # retains a reference to it for the entire transaction. 
  execsql {
    BEGIN;
    CREATE TABLE abc(a, b, c);
  }
  set ::pgalloc [sqlite3_release_memory]
  expr $::pgalloc > 0
} {1}
do_test malloc5-1.2 {
  # Test that the transaction started in the above test is still active.
  # Because the page freed had been written to, freeing it required a
  # journal sync and exclusive lock on the database file. Test the file
  # appears to be locked.
  sqlite3 db2 test.db
  catchsql {
    SELECT * FROM abc;
  } db2
} {1 {database is locked}}
do_test malloc5-1.3 {
  # Again call [sqlite3_release_memory] when there is exactly one unused page 
  # in the cache. The same amount of memory is required, but no journal-sync
  # or exclusive lock should be established.
  execsql {
    COMMIT;
    BEGIN;
    SELECT * FROM abc;
  }
  sqlite3_release_memory
} $::pgalloc
do_test malloc5-1.4 {
  # Database should not be locked this time.
  catchsql {
    SELECT * FROM abc;
  } db2
} {0 {}}
do_test malloc5-1.5 {
  # Manipulate the cache so that it contains two unused pages. One requires 
  # a journal-sync to free, the other does not.
  execsql {
    SELECT * FROM abc;
    CREATE TABLE def(d, e, f);
  }
  sqlite3_release_memory 500
} $::pgalloc
do_test malloc5-1.6 {
  # Database should not be locked this time. The above test case only
  # requested 500 bytes of memory, which can be obtained by freeing the page
  # that does not require an fsync().
  catchsql {
    SELECT * FROM abc;
  } db2
} {0 {}}
do_test malloc5-1.7 {
  # Release another 500 bytes of memory. This time we require a sync(), 
  # so the database file will be locked afterwards.
  sqlite3_release_memory 500
} $::pgalloc
do_test malloc5-1.8 {
  catchsql {
    SELECT * FROM abc;
  } db2
} {1 {database is locked}}
do_test malloc5-1.9 {

  set nRelease 0
  execsql { 
    BEGIN;
    SELECT * FROM def;
  }
  set data [list]
  db eval {SELECT * FROM abc} {
    incr nRelease [sqlite3_release_memory]
    lappend data $a $b $c
  }
  execsql {
    COMMIT;
  }
  list $nRelease $data
} [list $pgalloc [list 1 2 3 4 5 6]]

    SELECT * FROM abc;
  }
  execsql {
    SELECT * FROM sqlite_master;
    BEGIN;
    SELECT * FROM def;
  } db2
  sqlite3_release_memory
} [expr $::pgalloc * 2]
do_test malloc5-3.2 {
  concat \
    [execsql {SELECT * FROM abc; COMMIT}] \
    [execsql {SELECT * FROM def; COMMIT} db2]
} {1 2 3 4 5 6 7 8 9 10 11 12}

# and tests to see that this limit is not exceeded at any point during 
# transaction execution.
#
# Before executing malloc5-4.* we save the value of the current soft heap 
# limit in variable ::soft_limit. The original value is restored after 
# running the tests.
#
set ::soft_limit [sqlite3_soft_heap_limit -1]
do_test malloc5-4.1 {
  execsql {BEGIN;}
  execsql {DELETE FROM abc;}
  for {set i 0} {$i < 10000} {incr i} {
    execsql "INSERT INTO abc VALUES($i, $i, '[string repeat X 100]');"
  }
  execsql {COMMIT;}
  set ::nMaxBytes [sqlite_malloc_outstanding -maxbytes]
  expr $::nMaxBytes > 1000000
} {1}
do_test malloc5-4.2 {
  sqlite3_release_memory
  sqlite_malloc_outstanding -clearmaxbytes
  sqlite3_soft_heap_limit 100000
  execsql {BEGIN;}
  for {set i 0} {$i < 10000} {incr i} {
    execsql "INSERT INTO abc VALUES($i, $i, '[string repeat X 100]');"
  }
  execsql {COMMIT;}
  set ::nMaxBytes [sqlite_malloc_outstanding -maxbytes]
  expr $::nMaxBytes <= 100000
} {1}
do_test malloc5-4.3 {
  # Check that the content of table abc is at least roughly as expected.
  execsql {
    SELECT count(*), sum(a), sum(b) FROM abc;
  }
} [list 20000 [expr int(20000.0 * 4999.5)] [expr int(20000.0 * 4999.5)]]

# Restore the soft heap limit.
sqlite3_soft_heap_limit $::soft_limit

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.49 2006/01/05 15:50:07 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, exists, function, last_insert_rowid, nullvalue, onecolumn, profile, progress, rekey, rollback_hook, timeout, total_changes, trace, transaction, update_hook, 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"
    }

  if {[regexp {\(([0-9.]+)\)} $date all vers]} {
    set label [string map {. _} $vers]
    puts "<A NAME=\"version_$label\">"
  }
  puts "<DT><B>$date</B></DT>"
  puts "<DD><P><UL>$desc</UL></P></DD>"
}

chng {2006 January ? (3.3.0)} {
<li>CHECK constraints</li>
<li>IF EXISTS and IF NOT EXISTS clauses on CREATE/DROP TABLE/INDEX.</li>
<li>DESC indices</li>
<li>More efficient encoding of boolean values resulting in smaller database
files</li>
<li>More aggressive SQLITE_OMIT_FLOATING_POINT<li>
<li>Separate INTEGER and REAL affinity</li>
<li>Add a virtual function layer for the OS interface</li>
<li>"exists" method added to the TCL interface</li>
<li>Improved response to out-of-memory errors</li>
<li>Database cached shared between connections in the same thread</li>
}

chng {2005 December 19 (3.2.8)} {
<li>Fix an obscure bug that can cause database corruption under the
following unusual circumstances: A large INSERT or UPDATE statement which 
is part of an even larger transaction fails due to a uniqueness contraint
but the containing transaction commits.</li>
}

#
# Run this Tcl script to generate the tclsqlite.html file.
#
set rcsid {$Id: tclsqlite.tcl,v 1.16 2006/01/05 15:50:07 drh 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 {

 collate
 collation_needed
 commit_hook
 complete
 copy
 errorcode
 eval
 exists
 function
 last_insert_rowid
 nullvalue
 onecolumn
 progress
 timeout
 total_changes

database.  This callback can do whatever is desired.  Presumably, the
callback will do some other useful work for a short while (such as service
GUI events) then return
so that the lock can be tried again.  The callback procedure should
return "0" if it wants SQLite to try again to open the database and
should return "1" if it wants SQLite to abandon the current operation.
}

##############################################################################
METHOD exists {

<p>The "exists" method is similar to "onecolumn" and "eval" in that
it executes SQL statements.  The difference is that the "exists" method
always returns a boolean value which is TRUE if a query in the SQL
statement it executes returns one or more rows and FALSE if the SQL
returns an empty set.</p>

<p>The "exists" method is often used to test for the existance of
rows in a table.  For example:</p>

<blockquote><b>
if {[db exists {SELECT 1 FROM table1 WHERE user=$user}]} {<br>
&nbsp;&nbsp;&nbsp;# Processing if $user exists<br>
} else {<br>
&nbsp;&nbsp;&nbsp;# Processing if $user does not exist<br>
}
</b></blockquote>
}


##############################################################################
METHOD last_insert_rowid {

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