SQLite

#
LIBREADLINE = @TARGET_READLINE_LIBS@

# Object files for the SQLite library.
#
LIBOBJ = build.o dbbe.o delete.o expr.o insert.o \
         main.o parse.o select.o tokenize.o update.o \
         util.o vdbe.o where.o tclsqlite.o

# All of the source code files.
#
SRC = \
  $(TOP)/src/build.c \
  $(TOP)/src/dbbe.c \
  $(TOP)/src/dbbe.h \

select.o:	$(TOP)/src/select.c $(HDR)
	$(TCC) $(GDBM_FLAGS) -c $(TOP)/src/select.c

update.o:	$(TOP)/src/update.c $(HDR)
	$(TCC) $(GDBM_FLAGS) -c $(TOP)/src/update.c

tclsqlite.o:	$(TOP)/src/tclsqlite.c $(HDR)
	$(TCC) $(GDBM_FLAGS) $(TCL_FLAGS) -c $(TOP)/src/tclsqlite.c

gdbmdump:	$(TOP)/tool/gdbmdump.c
	$(TCC) $(GDBM_FLAGS) -o gdbmdump $(TOP)/tool/gdbmdump.c $(LIBGDBM)

tclsqlite:	$(TOP)/src/tclsqlite.c libsqlite.a
	$(TCC) $(TCL_FLAGS) -DTCLSH=1 -o tclsqlite \
		$(TOP)/src/tclsqlite.c libsqlite.a $(LIBGDBM) $(LIBTCL)

else
  ac_n= ac_c='\c' ac_t=
fi



# The following RCS revision string applies to configure.in
# $Revision: 1.7 $

#########
# Make sure we are not building in a subdirectory of the source tree.
#

temp=`echo $srcdir | grep '[^./]'`

    if test "$found" = "yes"; then
      TARGET_TCL_INC="-I$dir/include"
      break
    fi
  done
fi
if test "$found" = "no"; then
  TARGET_TCL_INC="-DNO_TCL=1"
fi


##########
# Figure out what C libraries are required to compile programs
# that use GDBM.
#
if test "$config_TARGET_GDBM_LIBS" != ""; then
  TARGET_GDBM_LIBS="$config_TARGET_GDBM_LIBS"
else
  CC=$TARGET_CC
  LIBS=""
  
echo $ac_n "checking for library containing gdbm_open""... $ac_c" 1>&6
echo "configure:1394: checking for library containing gdbm_open" >&5
if eval "test \"`echo '$''{'ac_cv_search_gdbm_open'+set}'`\" = set"; then
  echo $ac_n "(cached) $ac_c" 1>&6
else
  ac_func_search_save_LIBS="$LIBS"
ac_cv_search_gdbm_open="no"
cat > conftest.$ac_ext <<EOF
#line 1401 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error.  */
/* We use char because int might match the return type of a gcc2
    builtin and then its argument prototype would still apply.  */
char gdbm_open();

int main() {
gdbm_open()
; return 0; }
EOF
if { (eval echo configure:1412: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
  rm -rf conftest*
  ac_cv_search_gdbm_open="none required"
else
  echo "configure: failed program was:" >&5
  cat conftest.$ac_ext >&5
fi
rm -f conftest*
test "$ac_cv_search_gdbm_open" = "no" && for i in gdbm; do
LIBS="-l$i  $ac_func_search_save_LIBS"
cat > conftest.$ac_ext <<EOF
#line 1423 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error.  */
/* We use char because int might match the return type of a gcc2
    builtin and then its argument prototype would still apply.  */
char gdbm_open();

int main() {
gdbm_open()
; return 0; }
EOF
if { (eval echo configure:1434: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
  rm -rf conftest*
  ac_cv_search_gdbm_open="-l$i"
break
else
  echo "configure: failed program was:" >&5
  cat conftest.$ac_ext >&5
fi

fi


##########
# Figure out where to get the GDBM header files.
#
echo $ac_n "checking GDBM header files""... $ac_c" 1>&6
echo "configure:1462: checking GDBM header files" >&5
found=no
if test "$config_TARGET_GDBM_INC" != ""; then
  TARGET_GDBM_INC=$config_TARGET_GDBM_INC
  found=yes
fi
if test "$found" = "yes"; then
  echo "$ac_t""$TARGET_GDBM_INC" 1>&6
else
  echo "$ac_t""not specified: still searching..." 1>&6
  ac_safe=`echo "gdbm.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for gdbm.h""... $ac_c" 1>&6
echo "configure:1474: checking for gdbm.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
  echo $ac_n "(cached) $ac_c" 1>&6
else
  cat > conftest.$ac_ext <<EOF
#line 1479 "configure"
#include "confdefs.h"
#include <gdbm.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:1484: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
  rm -rf conftest*
  eval "ac_cv_header_$ac_safe=yes"
else
  echo "$ac_err" >&5
  echo "configure: failed program was:" >&5

fi
if test "$found" = "no"; then
  for dir in /usr/local /usr/pkg /usr/contrib; do
    
ac_safe=`echo "$dir/include/gdbm.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $dir/include/gdbm.h""... $ac_c" 1>&6
echo "configure:1511: checking for $dir/include/gdbm.h" >&5
if eval "test \"`echo '$''{'ac_cv_file_$ac_safe'+set}'`\" = set"; then
  echo $ac_n "(cached) $ac_c" 1>&6
else
  if test "$cross_compiling" = yes; then
    { echo "configure: error: Cannot check for file existence when cross compiling" 1>&2; exit 1; }
else
  if test -r $dir/include/gdbm.h; then

if test "$config_TARGET_READLINE_LIBS" != ""; then
  TARGET_READLINE_LIBS="$config_TARGET_READLINE_LIBS"
else
  CC=$TARGET_CC
  LIBS=""
  
echo $ac_n "checking for library containing readline""... $ac_c" 1>&6
echo "configure:1552: checking for library containing readline" >&5
if eval "test \"`echo '$''{'ac_cv_search_readline'+set}'`\" = set"; then
  echo $ac_n "(cached) $ac_c" 1>&6
else
  ac_func_search_save_LIBS="$LIBS"
ac_cv_search_readline="no"
cat > conftest.$ac_ext <<EOF
#line 1559 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error.  */
/* We use char because int might match the return type of a gcc2
    builtin and then its argument prototype would still apply.  */
char readline();

int main() {
readline()
; return 0; }
EOF
if { (eval echo configure:1570: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
  rm -rf conftest*
  ac_cv_search_readline="none required"
else
  echo "configure: failed program was:" >&5
  cat conftest.$ac_ext >&5
fi
rm -f conftest*
test "$ac_cv_search_readline" = "no" && for i in readline; do
LIBS="-l$i  $ac_func_search_save_LIBS"
cat > conftest.$ac_ext <<EOF
#line 1581 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error.  */
/* We use char because int might match the return type of a gcc2
    builtin and then its argument prototype would still apply.  */
char readline();

int main() {
readline()
; return 0; }
EOF
if { (eval echo configure:1592: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
  rm -rf conftest*
  ac_cv_search_readline="-l$i"
break
else
  echo "configure: failed program was:" >&5
  cat conftest.$ac_ext >&5
fi

fi


##########
# Figure out where to get the READLINE header files.
#
echo $ac_n "checking readline header files""... $ac_c" 1>&6
echo "configure:1620: checking readline header files" >&5
found=no
if test "$config_TARGET_READLINE_INC" != ""; then
  TARGET_READLINE_INC=$config_TARGET_READLINE_INC
  found=yes
fi
if test "$found" = "yes"; then
  echo "$ac_t""$TARGET_READLINE_INC" 1>&6
else
  echo "$ac_t""not specified: still searching..." 1>&6
  ac_safe=`echo "readline.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for readline.h""... $ac_c" 1>&6
echo "configure:1632: checking for readline.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
  echo $ac_n "(cached) $ac_c" 1>&6
else
  cat > conftest.$ac_ext <<EOF
#line 1637 "configure"
#include "confdefs.h"
#include <readline.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:1642: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
  rm -rf conftest*
  eval "ac_cv_header_$ac_safe=yes"
else
  echo "$ac_err" >&5
  echo "configure: failed program was:" >&5

fi
if test "$found" = "no"; then
  for dir in /usr /usr/local /usr/local/readline /usr/contrib; do
    
ac_safe=`echo "$dir/include/readline.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $dir/include/readline.h""... $ac_c" 1>&6
echo "configure:1669: checking for $dir/include/readline.h" >&5
if eval "test \"`echo '$''{'ac_cv_file_$ac_safe'+set}'`\" = set"; then
  echo $ac_n "(cached) $ac_c" 1>&6
else
  if test "$cross_compiling" = yes; then
    { echo "configure: error: Cannot check for file existence when cross compiling" 1>&2; exit 1; }
else
  if test -r $dir/include/readline.h; then

    if test "$found" = "yes"; then
      TARGET_READLINE_INC="-I$dir/include"
      break
    fi
    
ac_safe=`echo "$dir/include/readline/readline.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $dir/include/readline/readline.h""... $ac_c" 1>&6
echo "configure:1698: checking for $dir/include/readline/readline.h" >&5
if eval "test \"`echo '$''{'ac_cv_file_$ac_safe'+set}'`\" = set"; then
  echo $ac_n "(cached) $ac_c" 1>&6
else
  if test "$cross_compiling" = yes; then
    { echo "configure: error: Cannot check for file existence when cross compiling" 1>&2; exit 1; }
else
  if test -r $dir/include/readline/readline.h; then

#########
# Figure out whether or not we have a "usleep()" function.
#
echo $ac_n "checking for usleep""... $ac_c" 1>&6
echo "configure:1742: checking for usleep" >&5
if eval "test \"`echo '$''{'ac_cv_func_usleep'+set}'`\" = set"; then
  echo $ac_n "(cached) $ac_c" 1>&6
else
  cat > conftest.$ac_ext <<EOF
#line 1747 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
    which can conflict with char usleep(); below.  */
#include <assert.h>
/* Override any gcc2 internal prototype to avoid an error.  */
/* We use char because int might match the return type of a gcc2
    builtin and then its argument prototype would still apply.  */

choke me
#else
usleep();
#endif

; return 0; }
EOF
if { (eval echo configure:1770: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
  rm -rf conftest*
  eval "ac_cv_func_usleep=yes"
else
  echo "configure: failed program was:" >&5
  cat conftest.$ac_ext >&5
  rm -rf conftest*
  eval "ac_cv_func_usleep=no"

# the corresponding code.
#
AC_INIT(src/sqlite.h.in)

dnl Put the RCS revision string after AC_INIT so that it will also
dnl show in in configure.
# The following RCS revision string applies to configure.in
# $Revision: 1.7 $

#########
# Make sure we are not building in a subdirectory of the source tree.
#
changequote(<<<,>>>)
temp=`echo $srcdir | grep '[^./]'`
changequote([,])

  for dir in /usr/local /usr/X11* /usr/pkg /usr/contrib /usr; do
    AC_CHECK_FILE($dir/include/tcl.h, found=yes)
    if test "$found" = "yes"; then
      TARGET_TCL_INC="-I$dir/include"
      break
    fi
  done
fi
if test "$found" = "no"; then
  TARGET_TCL_INC="-DNO_TCL=1"
fi
AC_SUBST(TARGET_TCL_INC)

##########
# Figure out what C libraries are required to compile programs
# that use GDBM.
#

** Author contact information:
**   drh@hwaci.com
**   http://www.hwaci.com/drh/
**
*************************************************************************
** A TCL Interface to SQLite
**
** $Id: tclsqlite.c,v 1.9 2000/09/21 13:01:37 drh Exp $
*/
#ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */

#include "sqlite.h"
#include <tcl.h>
#include <stdlib.h>
#include <string.h>

/*
** 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 {
  sqlite *db;           /* The "real" database structure */
  Tcl_Interp *interp;   /* The interpreter used for this database */
  char *zBusy;          /* The busy callback routine */
};

/*
** An instance of this structure passes information thru the sqlite
** logic from the original TCL command into the callback routine.
*/
typedef struct CallbackData CallbackData;
struct CallbackData {
  Tcl_Interp *interp;       /* The TCL interpreter */
  char *zArray;             /* The array into which data is written */
  Tcl_Obj *pCode;           /* The code to execute for each row */
  int once;                 /* Set only for the first invocation of callback */
};

/*
** Called for each row of the result.
*/
static int DbEvalCallback(

    for(i=0; i<nCol; i++){
      char *z = azCol[i];
      if( z==0 ) z = "";
      Tcl_SetVar(cbData->interp, azN[i], z, 0);
    }
  }
  cbData->once = 0;
  rc = Tcl_EvalObj(cbData->interp, cbData->pCode);
  return rc;
}

/*
** This is an alternative callback for database queries.  Instead
** of invoking a TCL script to handle the result, this callback just
** appends each column of the result to a list.  After the query
** is complete, the list is returned.
*/
static int DbEvalCallback2(
  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_Obj *pList = (Tcl_Obj*)clientData;
  int i;
  for(i=0; i<nCol; i++){
    Tcl_Obj *pElem;
    if( azCol[i] && *azCol[i] ){
      pElem = Tcl_NewStringObj(azCol[i], -1);
    }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);

**       sqlite db1  "my_database"
**       db1 close
**
** The first command opens a connection to the "my_database" database
** and calls that connection "db1".  The second command causes this
** subroutine to be invoked.
*/
static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){


  SqliteDb *pDb = (SqliteDb*)cd;
  int choice;
  static char *DB_optStrs[] = {
     "busy",   "close",  "complete",  "eval",  "timeout"
  };
  enum DB_opts {
     DB_BUSY,  DB_CLOSE, DB_COMPLETE, DB_EVAL, DB_TIMEOUT
  };

  if( objc<2 ){

    Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
    return TCL_ERROR;
  }

  if( Tcl_GetIndexFromObj(interp, objv[1], DB_optStrs, "option", 0, &choice) ){
    return TCL_ERROR;
  }

  switch( (enum DB_opts)choice ){

  /*    $db busy ?CALLBACK?
  **
  ** Invoke the given callback if an SQL statement attempts to open
  ** a locked database file.
  */
  case DB_BUSY: {
    if( objc>3 ){

      Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
      return TCL_ERROR;
    }else if( objc==2 ){
      if( pDb->zBusy ){
        Tcl_AppendResult(interp, pDb->zBusy, 0);
      }
    }else{
      char *zBusy;
      int len;
      if( pDb->zBusy ){
        Tcl_Free(pDb->zBusy);

      }
      zBusy = Tcl_GetStringFromObj(objv[2], &len);
      if( zBusy && len>0 ){
        pDb->zBusy = Tcl_Alloc( len + 1 );

        strcpy(pDb->zBusy, zBusy);
      }else{
        pDb->zBusy = 0;
      }
      if( pDb->zBusy ){
        pDb->interp = interp;
        sqlite_busy_handler(pDb->db, DbBusyHandler, pDb);
      }else{
        sqlite_busy_handler(pDb->db, 0, 0);
      }
    }
    break;
  }

  /*    $db close
  **
  ** Shutdown the database
  */
  case DB_CLOSE: {
    Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0));
    break;
  }

  /*    $db complete SQL
  **
  ** Return TRUE if SQL is a complete SQL statement.  Return FALSE if
  ** additional lines of input are needed.  This is similar to the
  ** built-in "info complete" command of Tcl.
  */
  case DB_COMPLETE: {
    Tcl_Obj *pResult;
    int isComplete;
    if( objc!=3 ){
      Tcl_WrongNumArgs(interp, 2, objv, "SQL");

      return TCL_ERROR;
    }
    isComplete = sqlite_complete( Tcl_GetStringFromObj(objv[2], 0) );
    pResult = Tcl_GetObjResult(interp);
    Tcl_SetBooleanObj(pResult, isComplete);
    break;
  }
   
  /*
  **    $db eval $sql ?array {  ...code... }?
  **
  ** The SQL statement in $sql is evaluated.  For each row, the values are
  ** placed in elements of the array named "array" and ...code... is executed.
  ** If "array" and "code" are omitted, then no callback is every invoked.
  ** If "array" is an empty string, then the values are placed in variables
  ** that have the same name as the fields extracted by the query.
  */
  case DB_EVAL: {
    CallbackData cbData;
    char *zErrMsg;
    char *zSql;
    int rc;

    if( objc!=5 && objc!=3 ){

      Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME CODE?");
      return TCL_ERROR;
    }
    pDb->interp = interp;
    zSql = Tcl_GetStringFromObj(objv[2], 0);
    Tcl_IncrRefCount(objv[2]);
    if( objc==5 ){
      cbData.interp = interp;
      cbData.once = 1;
      cbData.zArray = Tcl_GetStringFromObj(objv[3], 0);
      cbData.pCode = objv[4];
      zErrMsg = 0;
      Tcl_IncrRefCount(objv[3]);
      Tcl_IncrRefCount(objv[4]);
      rc = sqlite_exec(pDb->db, zSql, DbEvalCallback, &cbData, &zErrMsg);
      Tcl_DecrRefCount(objv[4]);
      Tcl_DecrRefCount(objv[3]);
    }else{
      Tcl_Obj *pList = Tcl_NewObj();
      rc = sqlite_exec(pDb->db, zSql, DbEvalCallback2, pList, &zErrMsg);
      Tcl_SetObjResult(interp, pList);
    }
    if( zErrMsg ){
      Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
      free(zErrMsg);
    }
    Tcl_DecrRefCount(objv[2]);
    return rc;

  }

  /*
  **     $db timeout MILLESECONDS
  **
  ** Delay for the number of milliseconds specified when a file is locked.
  */
  case DB_TIMEOUT: {
    int ms;
    if( objc!=3 ){

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

    break;






  }
  } /* End of the SWITCH statement */
  return TCL_OK;
}

/*
**   sqlite DBNAME FILENAME ?MODE?
**
** This is the main Tcl command.  When the "sqlite" Tcl command is

  p->db = sqlite_open(argv[2], mode, &zErrMsg);
  if( p->db==0 ){
    Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
    Tcl_Free((char*)p);
    free(zErrMsg);
    return TCL_ERROR;
  }
  Tcl_CreateObjCommand(interp, argv[1], DbObjCmd, (char*)p, DbDeleteCmd);
  return TCL_OK;
}

/*
** Initialize this module.
**
** This Tcl module contains only a single new Tcl command named "sqlite".

    }
  }else{
    Tcl_GlobalEval(interp, zMainloop);
  }
  return 0;
}
#endif /* TCLSH */

#endif /* !defined(NO_TCL) */

#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
#***********************************************************************
# This file implements some common TCL routines used for regression
# testing the SQLite library
#
# $Id: tester.tcl,v 1.6 2000/09/21 13:01:37 drh Exp $

# Create a test database
#
file delete -force testdb
file mkdir testdb
sqlite db testdb

  puts "$nErr errors out of $nTest tests"
  exit $nErr
}

# A procedure to execute SQL
#
proc execsql {sql} {

  return [db eval $sql]





}

# Another procedure to execute SQL.  This one includes the field
# names in the returned list.
#
proc execsql2 {sql} {
  set result {}

}


proc chng {date desc} {
  puts "<DT><B>$date</B></DT>"
  puts "<DD><P><UL>$desc</UL></P></DD>"
}

chng {2000 Sep 21 (Not Released)} {
<li>Change the tclsqlite "eval" method to return a list of results if
    no callback script is specified.</li>
<li>Change tclsqlite.c to use the Tcl_Obj interface</li>
<li>Add tclsqlite.c to the libsqlite.a library</li>
}

chng {2000 Sep 13 (Version 1.0.5)} {
<li>Changed the print format for floating point values from "%g" to "%.15g".
    </li>
<li>Changed the comparison function so that numbers in exponential notation
    (ex: 1.234e+05) sort in numerical order.</li>
}