SQLite

  const char *zSchema,
  void *aData,
  sqlite3_int64 sz,
  sqlite3_int64 szMax,
  unsigned int mFlags
){
  MemFile *p = memdbFromDbSchema(db, zSchema);
  int rc;
  if( p==0 ){
    rc = SQLITE_ERROR;
  }else if( p->eLock!=SQLITE_LOCK_NONE || p->nMmap>0 ){
    rc = SQLITE_BUSY;
  }else{
    if( p->mFlags & SQLITE_MEMDB_FREEONCLOSE ) sqlite3_free(p->aData);
    p->aData = aData;
    p->sz = sz;
    p->szMax = szMax;
    p->mFlags = mFlags;
    rc = SQLITE_OK;
  }
  if( rc!=SQLITE_OK && (mFlags & SQLITE_MEMDB_FREEONCLOSE)!=0 ){
    sqlite3_free(aData);
  }
  return SQLITE_OK;
}

/* 
** This routine is called when the extension is loaded.
** Register the new VFS.
*/

    "complete",           "copy",              "enable_load_extension",
    "errorcode",          "eval",              "exists",
    "function",           "incrblob",          "interrupt",
    "last_insert_rowid",  "memdb",             "nullvalue",
    "onecolumn",          "preupdate",         "profile",
    "progress",           "rekey",             "restore",
    "rollback_hook",      "status",            "timeout",
    "total_changes",      "trace",             "trace_v2",
    "transaction",        "unlock_notify",     "update_hook",
    "version",            "wal_hook",          0
  };
  enum DB_enum {
    DB_AUTHORIZER,        DB_BACKUP,           DB_BUSY,
    DB_CACHE,             DB_CHANGES,          DB_CLOSE,
    DB_COLLATE,           DB_COLLATION_NEEDED, DB_COMMIT_HOOK,

        Tcl_AppendResult(interp, "out of memory", (char*)0);
        rc = TCL_ERROR;
      }else{
        memcpy(pData, pBA, len);
        xrc = sqlite3_memdb_config(pDb->db, zSchema, pData, len, len,
                  SQLITE_MEMDB_FREEONCLOSE|SQLITE_MEMDB_RESIZEABLE);
        if( xrc ){

          Tcl_AppendResult(interp, "unable to set MEMDB content", (char*)0);
          rc = TCL_ERROR;
        }
      }
    }else{
      Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
      rc = TCL_ERROR;

  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *const*objv
){
  return Tcl_NRCallObjProc(interp, DbObjCmd, cd, objc, objv);
}
#endif /* SQLITE_TCL_NRE */

/*
** Issue the usage message when the "sqlite3" command arguments are
** incorrect.
*/
static int sqliteCmdUsage(
  Tcl_Interp *interp,
  Tcl_Obj *const*objv
){
  Tcl_WrongNumArgs(interp, 1, objv,
    "HANDLE ?FILENAME? ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?"
    " ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN? ?-uri BOOLEAN?"
#if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
    " ?-key CODECKEY?"
#endif
  );
  return TCL_ERROR;
}

/*
**   sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN?
**                           ?-create BOOLEAN? ?-nomutex BOOLEAN?
**
** This is the main Tcl command.  When the "sqlite" Tcl command is
** invoked, this routine runs to process that command.

  int objc,
  Tcl_Obj *const*objv
){
  SqliteDb *p;
  const char *zArg;
  char *zErrMsg;
  int i;
  const char *zFile = 0;
  const char *zVfs = 0;
  int flags;
  Tcl_DString translatedFilename;
#if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
  void *pKey = 0;
  int nKey = 0;
#endif
  int rc;
#ifdef SQLITE_ENABLE_MEMDB
  Tcl_Obj *pDbObj = 0;
#endif

  /* In normal use, each TCL interpreter runs in a single thread.  So
  ** by default, we can turn off mutexing on SQLite database connections.
  ** However, for testing purposes it is useful to have mutexes turned
  ** on.  So, by default, mutexes default off.  But if compiled with
  ** SQLITE_TCL_DEFAULT_FULLMUTEX then mutexes default on.
  */
#ifdef SQLITE_TCL_DEFAULT_FULLMUTEX
  flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_FULLMUTEX;
#else

#if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
      Tcl_AppendResult(interp,"1",(char*)0);
#else
      Tcl_AppendResult(interp,"0",(char*)0);
#endif
      return TCL_OK;
    }
    if( zArg[0]=='-' ) return sqliteCmdUsage(interp, objv);
  }
  for(i=2; i<objc; i++){
    zArg = Tcl_GetString(objv[i]);
    if( zArg[0]!='-' ){
      if( zFile!=0 ) return sqliteCmdUsage(interp, objv);
      zFile = zArg;
      continue;
    }
    if( i==objc-1 ) return sqliteCmdUsage(interp, objv);
    i++;
    if( strcmp(zArg,"-key")==0 ){
#if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
      pKey = Tcl_GetByteArrayFromObj(objv[i], &nKey);
#endif
    }else if( strcmp(zArg, "-vfs")==0 ){
      zVfs = Tcl_GetString(objv[i]);
    }else if( strcmp(zArg, "-readonly")==0 ){
      int b;
      if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
      if( b ){
        flags &= ~(SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE);
        flags |= SQLITE_OPEN_READONLY;
      }else{
        flags &= ~SQLITE_OPEN_READONLY;
        flags |= SQLITE_OPEN_READWRITE;
      }
    }else if( strcmp(zArg, "-create")==0 ){
      int b;
      if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
      if( b && (flags & SQLITE_OPEN_READONLY)==0 ){
        flags |= SQLITE_OPEN_CREATE;
      }else{
        flags &= ~SQLITE_OPEN_CREATE;
      }
    }else if( strcmp(zArg, "-nomutex")==0 ){
      int b;
      if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
      if( b ){
        flags |= SQLITE_OPEN_NOMUTEX;
        flags &= ~SQLITE_OPEN_FULLMUTEX;
      }else{
        flags &= ~SQLITE_OPEN_NOMUTEX;
      }
    }else if( strcmp(zArg, "-fullmutex")==0 ){
      int b;
      if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
      if( b ){
        flags |= SQLITE_OPEN_FULLMUTEX;
        flags &= ~SQLITE_OPEN_NOMUTEX;
      }else{
        flags &= ~SQLITE_OPEN_FULLMUTEX;
      }
    }else if( strcmp(zArg, "-uri")==0 ){
      int b;
      if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
      if( b ){
        flags |= SQLITE_OPEN_URI;
      }else{
        flags &= ~SQLITE_OPEN_URI;
      }
#ifdef SQLITE_ENABLE_MEMDB
    }else if( strcmp(zArg, "-memdb")==0 ){
      pDbObj = objv[i];
#endif
    }else{
      Tcl_AppendResult(interp, "unknown option: ", zArg, (char*)0);
      return TCL_ERROR;
    }
  }










  zErrMsg = 0;
  p = (SqliteDb*)Tcl_Alloc( sizeof(*p) );
  memset(p, 0, sizeof(*p));
#ifdef SQLITE_ENABLE_MEMDB
  if( pDbObj ){
    rc = sqlite3_open_v2("x", &p->db, flags, "memdb");
    if( rc==SQLITE_OK ){
      int len;
      unsigned char *aData = Tcl_GetByteArrayFromObj(pDbObj, &len);
      unsigned char *a = sqlite3_malloc64( len );
      memcpy(a, aData, len);
      sqlite3_memdb_config(p->db, "main", a, len, sqlite3_msize(a),
           SQLITE_MEMDB_FREEONCLOSE | SQLITE_MEMDB_RESIZEABLE);
    }
  }else
#endif
  {
    if( zFile==0 ) zFile = ":memory:";
    zFile = Tcl_TranslateFileName(interp, zFile, &translatedFilename);
    rc = sqlite3_open_v2(zFile, &p->db, flags, zVfs);
    Tcl_DStringFree(&translatedFilename);
  }
  if( p->db ){
    if( SQLITE_OK!=sqlite3_errcode(p->db) ){
      zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db));
      sqlite3_close(p->db);
      p->db = 0;
    }
  }else{

  expr {[string length $::db1]==$::sz1}
} 1

# Create a new MEMDB and initialize it to the content of $::db1
# Verify that the content is the same.
#
db close
sqlite3 db -memdb $db1

do_execsql_test 110 {
  SELECT * FROM t1;
} {1 2}


finish_test

# $Id: tclsqlite.test,v 1.73 2009/03/16 13:19:36 danielk1977 Exp $

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

# Check the error messages generated by tclsqlite
#
set r "sqlite_orig HANDLE ?FILENAME? ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN? ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN? ?-uri BOOLEAN?"
if {[sqlite3 -has-codec]} {
  append r " ?-key CODECKEY?"
}
do_test tcl-1.1 {
  set v [catch {sqlite3 -bogus} msg]
  regsub {really_sqlite3} $msg {sqlite3} 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, backup, busy, cache, changes, close, collate, collation_needed, commit_hook, complete, copy, enable_load_extension, errorcode, eval, exists, function, incrblob, interrupt, last_insert_rowid, memdb, nullvalue, onecolumn, preupdate, profile, progress, rekey, restore, rollback_hook, status, timeout, total_changes, trace, trace_v2, transaction, unlock_notify, update_hook, version, or wal_hook}}
do_test tcl-1.2.1 {
  set v [catch {db cache bogus} msg]
  lappend v $msg
} {1 {bad option "bogus": must be flush or size}}
do_test tcl-1.2.2 {
  set v [catch {db cache} msg]
  lappend v $msg