os/persistentdata/persistentstorage/sqlite3api/TEST/SRC/tclsqlite.c
author sl@SLION-WIN7.fritz.box
Fri, 15 Jun 2012 03:10:57 +0200
changeset 0 bde4ae8d615e
permissions -rw-r--r--
First public contribution.
sl@0
     1
/*
sl@0
     2
** 2001 September 15
sl@0
     3
**
sl@0
     4
** Portions Copyright (c) 2008 Nokia Corporation and/or its subsidiaries. All rights reserved.
sl@0
     5
**
sl@0
     6
** The author disclaims copyright to this source code.  In place of
sl@0
     7
** a legal notice, here is a blessing:
sl@0
     8
**
sl@0
     9
**    May you do good and not evil.
sl@0
    10
**    May you find forgiveness for yourself and forgive others.
sl@0
    11
**    May you share freely, never taking more than you give.
sl@0
    12
**
sl@0
    13
*************************************************************************
sl@0
    14
** A TCL Interface to SQLite.  Append this file to sqlite3.c and
sl@0
    15
** compile the whole thing to build a TCL-enabled version of SQLite.
sl@0
    16
**
sl@0
    17
** $Id: tclsqlite.c,v 1.226 2008/09/23 10:12:15 drh Exp $
sl@0
    18
*/
sl@0
    19
#include "tcl.h"
sl@0
    20
#include <errno.h>
sl@0
    21
sl@0
    22
/*
sl@0
    23
** Some additional include files are needed if this file is not
sl@0
    24
** appended to the amalgamation.
sl@0
    25
*/
sl@0
    26
#ifndef SQLITE_AMALGAMATION
sl@0
    27
# include "sqliteInt.h"
sl@0
    28
# include <stdlib.h>
sl@0
    29
# include <string.h>
sl@0
    30
# include <assert.h>
sl@0
    31
# include <ctype.h>
sl@0
    32
#endif
sl@0
    33
sl@0
    34
#ifdef __SYMBIAN32__
sl@0
    35
int CopyTestFiles(void);
sl@0
    36
int DeleteTestFiles(void);
sl@0
    37
int PrintText(void*, Tcl_Interp*, int objc, Tcl_Obj* const* objv);
sl@0
    38
void PrintS(const char* aText);
sl@0
    39
#endif 
sl@0
    40
sl@0
    41
/*
sl@0
    42
 * Windows needs to know which symbols to export.  Unix does not.
sl@0
    43
 * BUILD_sqlite should be undefined for Unix.
sl@0
    44
 */
sl@0
    45
#ifdef BUILD_sqlite
sl@0
    46
#undef TCL_STORAGE_CLASS
sl@0
    47
#define TCL_STORAGE_CLASS DLLEXPORT
sl@0
    48
#endif /* BUILD_sqlite */
sl@0
    49
sl@0
    50
#define NUM_PREPARED_STMTS 10
sl@0
    51
#define MAX_PREPARED_STMTS 100
sl@0
    52
sl@0
    53
/*
sl@0
    54
** If TCL uses UTF-8 and SQLite is configured to use iso8859, then we
sl@0
    55
** have to do a translation when going between the two.  Set the 
sl@0
    56
** UTF_TRANSLATION_NEEDED macro to indicate that we need to do
sl@0
    57
** this translation.  
sl@0
    58
*/
sl@0
    59
#if defined(TCL_UTF_MAX) && !defined(SQLITE_UTF8)
sl@0
    60
# define UTF_TRANSLATION_NEEDED 1
sl@0
    61
#endif
sl@0
    62
sl@0
    63
/*
sl@0
    64
** New SQL functions can be created as TCL scripts.  Each such function
sl@0
    65
** is described by an instance of the following structure.
sl@0
    66
*/
sl@0
    67
typedef struct SqlFunc SqlFunc;
sl@0
    68
struct SqlFunc {
sl@0
    69
  Tcl_Interp *interp;   /* The TCL interpret to execute the function */
sl@0
    70
  Tcl_Obj *pScript;     /* The Tcl_Obj representation of the script */
sl@0
    71
  int useEvalObjv;      /* True if it is safe to use Tcl_EvalObjv */
sl@0
    72
  char *zName;          /* Name of this function */
sl@0
    73
  SqlFunc *pNext;       /* Next function on the list of them all */
sl@0
    74
};
sl@0
    75
sl@0
    76
/*
sl@0
    77
** New collation sequences function can be created as TCL scripts.  Each such
sl@0
    78
** function is described by an instance of the following structure.
sl@0
    79
*/
sl@0
    80
typedef struct SqlCollate SqlCollate;
sl@0
    81
struct SqlCollate {
sl@0
    82
  Tcl_Interp *interp;   /* The TCL interpret to execute the function */
sl@0
    83
  char *zScript;        /* The script to be run */
sl@0
    84
  SqlCollate *pNext;    /* Next function on the list of them all */
sl@0
    85
};
sl@0
    86
sl@0
    87
/*
sl@0
    88
** Prepared statements are cached for faster execution.  Each prepared
sl@0
    89
** statement is described by an instance of the following structure.
sl@0
    90
*/
sl@0
    91
typedef struct SqlPreparedStmt SqlPreparedStmt;
sl@0
    92
struct SqlPreparedStmt {
sl@0
    93
  SqlPreparedStmt *pNext;  /* Next in linked list */
sl@0
    94
  SqlPreparedStmt *pPrev;  /* Previous on the list */
sl@0
    95
  sqlite3_stmt *pStmt;     /* The prepared statement */
sl@0
    96
  int nSql;                /* chars in zSql[] */
sl@0
    97
  const char *zSql;        /* Text of the SQL statement */
sl@0
    98
};
sl@0
    99
sl@0
   100
typedef struct IncrblobChannel IncrblobChannel;
sl@0
   101
sl@0
   102
/*
sl@0
   103
** There is one instance of this structure for each SQLite database
sl@0
   104
** that has been opened by the SQLite TCL interface.
sl@0
   105
*/
sl@0
   106
typedef struct SqliteDb SqliteDb;
sl@0
   107
struct SqliteDb {
sl@0
   108
  sqlite3 *db;               /* The "real" database structure. MUST BE FIRST */
sl@0
   109
  Tcl_Interp *interp;        /* The interpreter used for this database */
sl@0
   110
  char *zBusy;               /* The busy callback routine */
sl@0
   111
  char *zCommit;             /* The commit hook callback routine */
sl@0
   112
  char *zTrace;              /* The trace callback routine */
sl@0
   113
  char *zProfile;            /* The profile callback routine */
sl@0
   114
  char *zProgress;           /* The progress callback routine */
sl@0
   115
  char *zAuth;               /* The authorization callback routine */
sl@0
   116
  int disableAuth;           /* Disable the authorizer if it exists */
sl@0
   117
  char *zNull;               /* Text to substitute for an SQL NULL value */
sl@0
   118
  SqlFunc *pFunc;            /* List of SQL functions */
sl@0
   119
  Tcl_Obj *pUpdateHook;      /* Update hook script (if any) */
sl@0
   120
  Tcl_Obj *pRollbackHook;    /* Rollback hook script (if any) */
sl@0
   121
  SqlCollate *pCollate;      /* List of SQL collation functions */
sl@0
   122
  int rc;                    /* Return code of most recent sqlite3_exec() */
sl@0
   123
  Tcl_Obj *pCollateNeeded;   /* Collation needed script */
sl@0
   124
  SqlPreparedStmt *stmtList; /* List of prepared statements*/
sl@0
   125
  SqlPreparedStmt *stmtLast; /* Last statement in the list */
sl@0
   126
  int maxStmt;               /* The next maximum number of stmtList */
sl@0
   127
  int nStmt;                 /* Number of statements in stmtList */
sl@0
   128
  IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */
sl@0
   129
};
sl@0
   130
sl@0
   131
struct IncrblobChannel {
sl@0
   132
  sqlite3_blob *pBlob;      /* sqlite3 blob handle */
sl@0
   133
  SqliteDb *pDb;            /* Associated database connection */
sl@0
   134
  int iSeek;                /* Current seek offset */
sl@0
   135
  Tcl_Channel channel;      /* Channel identifier */
sl@0
   136
  IncrblobChannel *pNext;   /* Linked list of all open incrblob channels */
sl@0
   137
  IncrblobChannel *pPrev;   /* Linked list of all open incrblob channels */
sl@0
   138
};
sl@0
   139
sl@0
   140
#ifndef SQLITE_OMIT_INCRBLOB
sl@0
   141
/*
sl@0
   142
** Close all incrblob channels opened using database connection pDb.
sl@0
   143
** This is called when shutting down the database connection.
sl@0
   144
*/
sl@0
   145
static void closeIncrblobChannels(SqliteDb *pDb){
sl@0
   146
  IncrblobChannel *p;
sl@0
   147
  IncrblobChannel *pNext;
sl@0
   148
sl@0
   149
  for(p=pDb->pIncrblob; p; p=pNext){
sl@0
   150
    pNext = p->pNext;
sl@0
   151
sl@0
   152
    /* Note: Calling unregister here call Tcl_Close on the incrblob channel, 
sl@0
   153
    ** which deletes the IncrblobChannel structure at *p. So do not
sl@0
   154
    ** call Tcl_Free() here.
sl@0
   155
    */
sl@0
   156
    Tcl_UnregisterChannel(pDb->interp, p->channel);
sl@0
   157
  }
sl@0
   158
}
sl@0
   159
sl@0
   160
/*
sl@0
   161
** Close an incremental blob channel.
sl@0
   162
*/
sl@0
   163
static int incrblobClose(ClientData instanceData, Tcl_Interp *interp){
sl@0
   164
  IncrblobChannel *p = (IncrblobChannel *)instanceData;
sl@0
   165
  int rc = sqlite3_blob_close(p->pBlob);
sl@0
   166
  sqlite3 *db = p->pDb->db;
sl@0
   167
sl@0
   168
  /* Remove the channel from the SqliteDb.pIncrblob list. */
sl@0
   169
  if( p->pNext ){
sl@0
   170
    p->pNext->pPrev = p->pPrev;
sl@0
   171
  }
sl@0
   172
  if( p->pPrev ){
sl@0
   173
    p->pPrev->pNext = p->pNext;
sl@0
   174
  }
sl@0
   175
  if( p->pDb->pIncrblob==p ){
sl@0
   176
    p->pDb->pIncrblob = p->pNext;
sl@0
   177
  }
sl@0
   178
sl@0
   179
  /* Free the IncrblobChannel structure */
sl@0
   180
  Tcl_Free((char *)p);
sl@0
   181
sl@0
   182
  if( rc!=SQLITE_OK ){
sl@0
   183
    Tcl_SetResult(interp, (char *)sqlite3_errmsg(db), TCL_VOLATILE);
sl@0
   184
    return TCL_ERROR;
sl@0
   185
  }
sl@0
   186
  return TCL_OK;
sl@0
   187
}
sl@0
   188
sl@0
   189
/*
sl@0
   190
** Read data from an incremental blob channel.
sl@0
   191
*/
sl@0
   192
static int incrblobInput(
sl@0
   193
  ClientData instanceData, 
sl@0
   194
  char *buf, 
sl@0
   195
  int bufSize,
sl@0
   196
  int *errorCodePtr
sl@0
   197
){
sl@0
   198
  IncrblobChannel *p = (IncrblobChannel *)instanceData;
sl@0
   199
  int nRead = bufSize;         /* Number of bytes to read */
sl@0
   200
  int nBlob;                   /* Total size of the blob */
sl@0
   201
  int rc;                      /* sqlite error code */
sl@0
   202
sl@0
   203
  nBlob = sqlite3_blob_bytes(p->pBlob);
sl@0
   204
  if( (p->iSeek+nRead)>nBlob ){
sl@0
   205
    nRead = nBlob-p->iSeek;
sl@0
   206
  }
sl@0
   207
  if( nRead<=0 ){
sl@0
   208
    return 0;
sl@0
   209
  }
sl@0
   210
sl@0
   211
  rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek);
sl@0
   212
  if( rc!=SQLITE_OK ){
sl@0
   213
    *errorCodePtr = rc;
sl@0
   214
    return -1;
sl@0
   215
  }
sl@0
   216
sl@0
   217
  p->iSeek += nRead;
sl@0
   218
  return nRead;
sl@0
   219
}
sl@0
   220
sl@0
   221
/*
sl@0
   222
** Write data to an incremental blob channel.
sl@0
   223
*/
sl@0
   224
static int incrblobOutput(
sl@0
   225
  ClientData instanceData, 
sl@0
   226
  CONST char *buf, 
sl@0
   227
  int toWrite,
sl@0
   228
  int *errorCodePtr
sl@0
   229
){
sl@0
   230
  IncrblobChannel *p = (IncrblobChannel *)instanceData;
sl@0
   231
  int nWrite = toWrite;        /* Number of bytes to write */
sl@0
   232
  int nBlob;                   /* Total size of the blob */
sl@0
   233
  int rc;                      /* sqlite error code */
sl@0
   234
sl@0
   235
  nBlob = sqlite3_blob_bytes(p->pBlob);
sl@0
   236
  if( (p->iSeek+nWrite)>nBlob ){
sl@0
   237
    *errorCodePtr = EINVAL;
sl@0
   238
    return -1;
sl@0
   239
  }
sl@0
   240
  if( nWrite<=0 ){
sl@0
   241
    return 0;
sl@0
   242
  }
sl@0
   243
sl@0
   244
  rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek);
sl@0
   245
  if( rc!=SQLITE_OK ){
sl@0
   246
    *errorCodePtr = EIO;
sl@0
   247
    return -1;
sl@0
   248
  }
sl@0
   249
sl@0
   250
  p->iSeek += nWrite;
sl@0
   251
  return nWrite;
sl@0
   252
}
sl@0
   253
sl@0
   254
/*
sl@0
   255
** Seek an incremental blob channel.
sl@0
   256
*/
sl@0
   257
static int incrblobSeek(
sl@0
   258
  ClientData instanceData, 
sl@0
   259
  long offset,
sl@0
   260
  int seekMode,
sl@0
   261
  int *errorCodePtr
sl@0
   262
){
sl@0
   263
  IncrblobChannel *p = (IncrblobChannel *)instanceData;
sl@0
   264
sl@0
   265
  switch( seekMode ){
sl@0
   266
    case SEEK_SET:
sl@0
   267
      p->iSeek = offset;
sl@0
   268
      break;
sl@0
   269
    case SEEK_CUR:
sl@0
   270
      p->iSeek += offset;
sl@0
   271
      break;
sl@0
   272
    case SEEK_END:
sl@0
   273
      p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset;
sl@0
   274
      break;
sl@0
   275
sl@0
   276
    default: assert(0); /* Bad seekMode */ 
sl@0
   277
  }
sl@0
   278
sl@0
   279
  return p->iSeek;
sl@0
   280
}
sl@0
   281
sl@0
   282
sl@0
   283
static void incrblobWatch(ClientData instanceData, int mode){ 
sl@0
   284
  /* NO-OP */ 
sl@0
   285
}
sl@0
   286
static int incrblobHandle(ClientData instanceData, int dir, ClientData *hPtr){
sl@0
   287
  return TCL_ERROR;
sl@0
   288
}
sl@0
   289
sl@0
   290
static Tcl_ChannelType IncrblobChannelType = {
sl@0
   291
  "incrblob",                        /* typeName                             */
sl@0
   292
  TCL_CHANNEL_VERSION_2,             /* version                              */
sl@0
   293
  incrblobClose,                     /* closeProc                            */
sl@0
   294
  incrblobInput,                     /* inputProc                            */
sl@0
   295
  incrblobOutput,                    /* outputProc                           */
sl@0
   296
  incrblobSeek,                      /* seekProc                             */
sl@0
   297
  0,                                 /* setOptionProc                        */
sl@0
   298
  0,                                 /* getOptionProc                        */
sl@0
   299
  incrblobWatch,                     /* watchProc (this is a no-op)          */
sl@0
   300
  incrblobHandle,                    /* getHandleProc (always returns error) */
sl@0
   301
  0,                                 /* close2Proc                           */
sl@0
   302
  0,                                 /* blockModeProc                        */
sl@0
   303
  0,                                 /* flushProc                            */
sl@0
   304
  0,                                 /* handlerProc                          */
sl@0
   305
  0,                                 /* wideSeekProc                         */
sl@0
   306
};
sl@0
   307
sl@0
   308
/*
sl@0
   309
** Create a new incrblob channel.
sl@0
   310
*/
sl@0
   311
static int createIncrblobChannel(
sl@0
   312
  Tcl_Interp *interp, 
sl@0
   313
  SqliteDb *pDb, 
sl@0
   314
  const char *zDb,
sl@0
   315
  const char *zTable, 
sl@0
   316
  const char *zColumn, 
sl@0
   317
  sqlite_int64 iRow,
sl@0
   318
  int isReadonly
sl@0
   319
){
sl@0
   320
  IncrblobChannel *p;
sl@0
   321
  sqlite3 *db = pDb->db;
sl@0
   322
  sqlite3_blob *pBlob;
sl@0
   323
  int rc;
sl@0
   324
  int flags = TCL_READABLE|(isReadonly ? 0 : TCL_WRITABLE);
sl@0
   325
sl@0
   326
  /* This variable is used to name the channels: "incrblob_[incr count]" */
sl@0
   327
  static int count = 0;
sl@0
   328
  char zChannel[64];
sl@0
   329
sl@0
   330
  rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob);
sl@0
   331
  if( rc!=SQLITE_OK ){
sl@0
   332
    Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
sl@0
   333
    return TCL_ERROR;
sl@0
   334
  }
sl@0
   335
sl@0
   336
  p = (IncrblobChannel *)Tcl_Alloc(sizeof(IncrblobChannel));
sl@0
   337
  p->iSeek = 0;
sl@0
   338
  p->pBlob = pBlob;
sl@0
   339
sl@0
   340
  sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count);
sl@0
   341
  p->channel = Tcl_CreateChannel(&IncrblobChannelType, zChannel, p, flags);
sl@0
   342
  Tcl_RegisterChannel(interp, p->channel);
sl@0
   343
sl@0
   344
  /* Link the new channel into the SqliteDb.pIncrblob list. */
sl@0
   345
  p->pNext = pDb->pIncrblob;
sl@0
   346
  p->pPrev = 0;
sl@0
   347
  if( p->pNext ){
sl@0
   348
    p->pNext->pPrev = p;
sl@0
   349
  }
sl@0
   350
  pDb->pIncrblob = p;
sl@0
   351
  p->pDb = pDb;
sl@0
   352
sl@0
   353
  Tcl_SetResult(interp, (char *)Tcl_GetChannelName(p->channel), TCL_VOLATILE);
sl@0
   354
  return TCL_OK;
sl@0
   355
}
sl@0
   356
#else  /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */
sl@0
   357
  #define closeIncrblobChannels(pDb)
sl@0
   358
#endif
sl@0
   359
sl@0
   360
/*
sl@0
   361
** Look at the script prefix in pCmd.  We will be executing this script
sl@0
   362
** after first appending one or more arguments.  This routine analyzes
sl@0
   363
** the script to see if it is safe to use Tcl_EvalObjv() on the script
sl@0
   364
** rather than the more general Tcl_EvalEx().  Tcl_EvalObjv() is much
sl@0
   365
** faster.
sl@0
   366
**
sl@0
   367
** Scripts that are safe to use with Tcl_EvalObjv() consists of a
sl@0
   368
** command name followed by zero or more arguments with no [...] or $
sl@0
   369
** or {...} or ; to be seen anywhere.  Most callback scripts consist
sl@0
   370
** of just a single procedure name and they meet this requirement.
sl@0
   371
*/
sl@0
   372
static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){
sl@0
   373
  /* We could try to do something with Tcl_Parse().  But we will instead
sl@0
   374
  ** just do a search for forbidden characters.  If any of the forbidden
sl@0
   375
  ** characters appear in pCmd, we will report the string as unsafe.
sl@0
   376
  */
sl@0
   377
  const char *z;
sl@0
   378
  int n;
sl@0
   379
  z = Tcl_GetStringFromObj(pCmd, &n);
sl@0
   380
  while( n-- > 0 ){
sl@0
   381
    int c = *(z++);
sl@0
   382
    if( c=='$' || c=='[' || c==';' ) return 0;
sl@0
   383
  }
sl@0
   384
  return 1;
sl@0
   385
}
sl@0
   386
sl@0
   387
/*
sl@0
   388
** Find an SqlFunc structure with the given name.  Or create a new
sl@0
   389
** one if an existing one cannot be found.  Return a pointer to the
sl@0
   390
** structure.
sl@0
   391
*/
sl@0
   392
static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){
sl@0
   393
  SqlFunc *p, *pNew;
sl@0
   394
  int i;
sl@0
   395
  pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + strlen(zName) + 1 );
sl@0
   396
  pNew->zName = (char*)&pNew[1];
sl@0
   397
  for(i=0; zName[i]; i++){ pNew->zName[i] = tolower(zName[i]); }
sl@0
   398
  pNew->zName[i] = 0;
sl@0
   399
  for(p=pDb->pFunc; p; p=p->pNext){ 
sl@0
   400
    if( strcmp(p->zName, pNew->zName)==0 ){
sl@0
   401
      Tcl_Free((char*)pNew);
sl@0
   402
      return p;
sl@0
   403
    }
sl@0
   404
  }
sl@0
   405
  pNew->interp = pDb->interp;
sl@0
   406
  pNew->pScript = 0;
sl@0
   407
  pNew->pNext = pDb->pFunc;
sl@0
   408
  pDb->pFunc = pNew;
sl@0
   409
  return pNew;
sl@0
   410
}
sl@0
   411
sl@0
   412
/*
sl@0
   413
** Finalize and free a list of prepared statements
sl@0
   414
*/
sl@0
   415
static void flushStmtCache( SqliteDb *pDb ){
sl@0
   416
  SqlPreparedStmt *pPreStmt;
sl@0
   417
sl@0
   418
  while(  pDb->stmtList ){
sl@0
   419
    sqlite3_finalize( pDb->stmtList->pStmt );
sl@0
   420
    pPreStmt = pDb->stmtList;
sl@0
   421
    pDb->stmtList = pDb->stmtList->pNext;
sl@0
   422
    Tcl_Free( (char*)pPreStmt );
sl@0
   423
  }
sl@0
   424
  pDb->nStmt = 0;
sl@0
   425
  pDb->stmtLast = 0;
sl@0
   426
}
sl@0
   427
sl@0
   428
/*
sl@0
   429
** TCL calls this procedure when an sqlite3 database command is
sl@0
   430
** deleted.
sl@0
   431
*/
sl@0
   432
static void DbDeleteCmd(void *db){
sl@0
   433
  SqliteDb *pDb = (SqliteDb*)db;
sl@0
   434
  flushStmtCache(pDb);
sl@0
   435
  closeIncrblobChannels(pDb);
sl@0
   436
  sqlite3_close(pDb->db);
sl@0
   437
  while( pDb->pFunc ){
sl@0
   438
    SqlFunc *pFunc = pDb->pFunc;
sl@0
   439
    pDb->pFunc = pFunc->pNext;
sl@0
   440
    Tcl_DecrRefCount(pFunc->pScript);
sl@0
   441
    Tcl_Free((char*)pFunc);
sl@0
   442
  }
sl@0
   443
  while( pDb->pCollate ){
sl@0
   444
    SqlCollate *pCollate = pDb->pCollate;
sl@0
   445
    pDb->pCollate = pCollate->pNext;
sl@0
   446
    Tcl_Free((char*)pCollate);
sl@0
   447
  }
sl@0
   448
  if( pDb->zBusy ){
sl@0
   449
    Tcl_Free(pDb->zBusy);
sl@0
   450
  }
sl@0
   451
  if( pDb->zTrace ){
sl@0
   452
    Tcl_Free(pDb->zTrace);
sl@0
   453
  }
sl@0
   454
  if( pDb->zProfile ){
sl@0
   455
    Tcl_Free(pDb->zProfile);
sl@0
   456
  }
sl@0
   457
  if( pDb->zAuth ){
sl@0
   458
    Tcl_Free(pDb->zAuth);
sl@0
   459
  }
sl@0
   460
  if( pDb->zNull ){
sl@0
   461
    Tcl_Free(pDb->zNull);
sl@0
   462
  }
sl@0
   463
  if( pDb->pUpdateHook ){
sl@0
   464
    Tcl_DecrRefCount(pDb->pUpdateHook);
sl@0
   465
  }
sl@0
   466
  if( pDb->pRollbackHook ){
sl@0
   467
    Tcl_DecrRefCount(pDb->pRollbackHook);
sl@0
   468
  }
sl@0
   469
  if( pDb->pCollateNeeded ){
sl@0
   470
    Tcl_DecrRefCount(pDb->pCollateNeeded);
sl@0
   471
  }
sl@0
   472
  Tcl_Free((char*)pDb);
sl@0
   473
}
sl@0
   474
sl@0
   475
/*
sl@0
   476
** This routine is called when a database file is locked while trying
sl@0
   477
** to execute SQL.
sl@0
   478
*/
sl@0
   479
static int DbBusyHandler(void *cd, int nTries){
sl@0
   480
  SqliteDb *pDb = (SqliteDb*)cd;
sl@0
   481
  int rc;
sl@0
   482
  char zVal[30];
sl@0
   483
sl@0
   484
  sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries);
sl@0
   485
  rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0);
sl@0
   486
  if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
sl@0
   487
    return 0;
sl@0
   488
  }
sl@0
   489
  return 1;
sl@0
   490
}
sl@0
   491
sl@0
   492
#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
sl@0
   493
/*
sl@0
   494
** This routine is invoked as the 'progress callback' for the database.
sl@0
   495
*/
sl@0
   496
static int DbProgressHandler(void *cd){
sl@0
   497
  SqliteDb *pDb = (SqliteDb*)cd;
sl@0
   498
  int rc;
sl@0
   499
sl@0
   500
  assert( pDb->zProgress );
sl@0
   501
  rc = Tcl_Eval(pDb->interp, pDb->zProgress);
sl@0
   502
  if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
sl@0
   503
    return 1;
sl@0
   504
  }
sl@0
   505
  return 0;
sl@0
   506
}
sl@0
   507
#endif
sl@0
   508
sl@0
   509
#ifndef SQLITE_OMIT_TRACE
sl@0
   510
/*
sl@0
   511
** This routine is called by the SQLite trace handler whenever a new
sl@0
   512
** block of SQL is executed.  The TCL script in pDb->zTrace is executed.
sl@0
   513
*/
sl@0
   514
static void DbTraceHandler(void *cd, const char *zSql){
sl@0
   515
  SqliteDb *pDb = (SqliteDb*)cd;
sl@0
   516
  Tcl_DString str;
sl@0
   517
sl@0
   518
  Tcl_DStringInit(&str);
sl@0
   519
  Tcl_DStringAppend(&str, pDb->zTrace, -1);
sl@0
   520
  Tcl_DStringAppendElement(&str, zSql);
sl@0
   521
  Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
sl@0
   522
  Tcl_DStringFree(&str);
sl@0
   523
  Tcl_ResetResult(pDb->interp);
sl@0
   524
}
sl@0
   525
#endif
sl@0
   526
sl@0
   527
#ifndef SQLITE_OMIT_TRACE
sl@0
   528
/*
sl@0
   529
** This routine is called by the SQLite profile handler after a statement
sl@0
   530
** SQL has executed.  The TCL script in pDb->zProfile is evaluated.
sl@0
   531
*/
sl@0
   532
static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){
sl@0
   533
  SqliteDb *pDb = (SqliteDb*)cd;
sl@0
   534
  Tcl_DString str;
sl@0
   535
  char zTm[100];
sl@0
   536
sl@0
   537
  sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm);
sl@0
   538
  Tcl_DStringInit(&str);
sl@0
   539
  Tcl_DStringAppend(&str, pDb->zProfile, -1);
sl@0
   540
  Tcl_DStringAppendElement(&str, zSql);
sl@0
   541
  Tcl_DStringAppendElement(&str, zTm);
sl@0
   542
  Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
sl@0
   543
  Tcl_DStringFree(&str);
sl@0
   544
  Tcl_ResetResult(pDb->interp);
sl@0
   545
}
sl@0
   546
#endif
sl@0
   547
sl@0
   548
/*
sl@0
   549
** This routine is called when a transaction is committed.  The
sl@0
   550
** TCL script in pDb->zCommit is executed.  If it returns non-zero or
sl@0
   551
** if it throws an exception, the transaction is rolled back instead
sl@0
   552
** of being committed.
sl@0
   553
*/
sl@0
   554
static int DbCommitHandler(void *cd){
sl@0
   555
  SqliteDb *pDb = (SqliteDb*)cd;
sl@0
   556
  int rc;
sl@0
   557
sl@0
   558
  rc = Tcl_Eval(pDb->interp, pDb->zCommit);
sl@0
   559
  if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
sl@0
   560
    return 1;
sl@0
   561
  }
sl@0
   562
  return 0;
sl@0
   563
}
sl@0
   564
sl@0
   565
static void DbRollbackHandler(void *clientData){
sl@0
   566
  SqliteDb *pDb = (SqliteDb*)clientData;
sl@0
   567
  assert(pDb->pRollbackHook);
sl@0
   568
  if( TCL_OK!=Tcl_EvalObjEx(pDb->interp, pDb->pRollbackHook, 0) ){
sl@0
   569
    Tcl_BackgroundError(pDb->interp);
sl@0
   570
  }
sl@0
   571
}
sl@0
   572
sl@0
   573
static void DbUpdateHandler(
sl@0
   574
  void *p, 
sl@0
   575
  int op,
sl@0
   576
  const char *zDb, 
sl@0
   577
  const char *zTbl, 
sl@0
   578
  sqlite_int64 rowid
sl@0
   579
){
sl@0
   580
  SqliteDb *pDb = (SqliteDb *)p;
sl@0
   581
  Tcl_Obj *pCmd;
sl@0
   582
sl@0
   583
  assert( pDb->pUpdateHook );
sl@0
   584
  assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );
sl@0
   585
sl@0
   586
  pCmd = Tcl_DuplicateObj(pDb->pUpdateHook);
sl@0
   587
  Tcl_IncrRefCount(pCmd);
sl@0
   588
  Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(
sl@0
   589
    ( (op==SQLITE_INSERT)?"INSERT":(op==SQLITE_UPDATE)?"UPDATE":"DELETE"), -1));
sl@0
   590
  Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));
sl@0
   591
  Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));
sl@0
   592
  Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(rowid));
sl@0
   593
  Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
sl@0
   594
}
sl@0
   595
sl@0
   596
static void tclCollateNeeded(
sl@0
   597
  void *pCtx,
sl@0
   598
  sqlite3 *db,
sl@0
   599
  int enc,
sl@0
   600
  const char *zName
sl@0
   601
){
sl@0
   602
  SqliteDb *pDb = (SqliteDb *)pCtx;
sl@0
   603
  Tcl_Obj *pScript = Tcl_DuplicateObj(pDb->pCollateNeeded);
sl@0
   604
  Tcl_IncrRefCount(pScript);
sl@0
   605
  Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(zName, -1));
sl@0
   606
  Tcl_EvalObjEx(pDb->interp, pScript, 0);
sl@0
   607
  Tcl_DecrRefCount(pScript);
sl@0
   608
}
sl@0
   609
sl@0
   610
/*
sl@0
   611
** This routine is called to evaluate an SQL collation function implemented
sl@0
   612
** using TCL script.
sl@0
   613
*/
sl@0
   614
static int tclSqlCollate(
sl@0
   615
  void *pCtx,
sl@0
   616
  int nA,
sl@0
   617
  const void *zA,
sl@0
   618
  int nB,
sl@0
   619
  const void *zB
sl@0
   620
){
sl@0
   621
  SqlCollate *p = (SqlCollate *)pCtx;
sl@0
   622
  Tcl_Obj *pCmd;
sl@0
   623
sl@0
   624
  pCmd = Tcl_NewStringObj(p->zScript, -1);
sl@0
   625
  Tcl_IncrRefCount(pCmd);
sl@0
   626
  Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA));
sl@0
   627
  Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB));
sl@0
   628
  Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
sl@0
   629
  Tcl_DecrRefCount(pCmd);
sl@0
   630
  return (atoi(Tcl_GetStringResult(p->interp)));
sl@0
   631
}
sl@0
   632
sl@0
   633
/*
sl@0
   634
** This routine is called to evaluate an SQL function implemented
sl@0
   635
** using TCL script.
sl@0
   636
*/
sl@0
   637
static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){
sl@0
   638
  SqlFunc *p = sqlite3_user_data(context);
sl@0
   639
  Tcl_Obj *pCmd;
sl@0
   640
  int i;
sl@0
   641
  int rc;
sl@0
   642
sl@0
   643
  if( argc==0 ){
sl@0
   644
    /* If there are no arguments to the function, call Tcl_EvalObjEx on the
sl@0
   645
    ** script object directly.  This allows the TCL compiler to generate
sl@0
   646
    ** bytecode for the command on the first invocation and thus make
sl@0
   647
    ** subsequent invocations much faster. */
sl@0
   648
    pCmd = p->pScript;
sl@0
   649
    Tcl_IncrRefCount(pCmd);
sl@0
   650
    rc = Tcl_EvalObjEx(p->interp, pCmd, 0);
sl@0
   651
    Tcl_DecrRefCount(pCmd);
sl@0
   652
  }else{
sl@0
   653
    /* If there are arguments to the function, make a shallow copy of the
sl@0
   654
    ** script object, lappend the arguments, then evaluate the copy.
sl@0
   655
    **
sl@0
   656
    ** By "shallow" copy, we mean a only the outer list Tcl_Obj is duplicated.
sl@0
   657
    ** The new Tcl_Obj contains pointers to the original list elements. 
sl@0
   658
    ** That way, when Tcl_EvalObjv() is run and shimmers the first element
sl@0
   659
    ** of the list to tclCmdNameType, that alternate representation will
sl@0
   660
    ** be preserved and reused on the next invocation.
sl@0
   661
    */
sl@0
   662
    Tcl_Obj **aArg;
sl@0
   663
    int nArg;
sl@0
   664
    if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){
sl@0
   665
      sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 
sl@0
   666
      return;
sl@0
   667
    }     
sl@0
   668
    pCmd = Tcl_NewListObj(nArg, aArg);
sl@0
   669
    Tcl_IncrRefCount(pCmd);
sl@0
   670
    for(i=0; i<argc; i++){
sl@0
   671
      sqlite3_value *pIn = argv[i];
sl@0
   672
      Tcl_Obj *pVal;
sl@0
   673
            
sl@0
   674
      /* Set pVal to contain the i'th column of this row. */
sl@0
   675
      switch( sqlite3_value_type(pIn) ){
sl@0
   676
        case SQLITE_BLOB: {
sl@0
   677
          int bytes = sqlite3_value_bytes(pIn);
sl@0
   678
          pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes);
sl@0
   679
          break;
sl@0
   680
        }
sl@0
   681
        case SQLITE_INTEGER: {
sl@0
   682
          sqlite_int64 v = sqlite3_value_int64(pIn);
sl@0
   683
          if( v>=-2147483647 && v<=2147483647 ){
sl@0
   684
            pVal = Tcl_NewIntObj(v);
sl@0
   685
          }else{
sl@0
   686
            pVal = Tcl_NewWideIntObj(v);
sl@0
   687
          }
sl@0
   688
          break;
sl@0
   689
        }
sl@0
   690
        case SQLITE_FLOAT: {
sl@0
   691
          double r = sqlite3_value_double(pIn);
sl@0
   692
          pVal = Tcl_NewDoubleObj(r);
sl@0
   693
          break;
sl@0
   694
        }
sl@0
   695
        case SQLITE_NULL: {
sl@0
   696
          pVal = Tcl_NewStringObj("", 0);
sl@0
   697
          break;
sl@0
   698
        }
sl@0
   699
        default: {
sl@0
   700
          int bytes = sqlite3_value_bytes(pIn);
sl@0
   701
          pVal = Tcl_NewStringObj((char *)sqlite3_value_text(pIn), bytes);
sl@0
   702
          break;
sl@0
   703
        }
sl@0
   704
      }
sl@0
   705
      rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal);
sl@0
   706
      if( rc ){
sl@0
   707
        Tcl_DecrRefCount(pCmd);
sl@0
   708
        sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 
sl@0
   709
        return;
sl@0
   710
      }
sl@0
   711
    }
sl@0
   712
    if( !p->useEvalObjv ){
sl@0
   713
      /* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd
sl@0
   714
      ** is a list without a string representation.  To prevent this from
sl@0
   715
      ** happening, make sure pCmd has a valid string representation */
sl@0
   716
      Tcl_GetString(pCmd);
sl@0
   717
    }
sl@0
   718
    rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
sl@0
   719
    Tcl_DecrRefCount(pCmd);
sl@0
   720
  }
sl@0
   721
sl@0
   722
  if( rc && rc!=TCL_RETURN ){
sl@0
   723
    sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 
sl@0
   724
  }else{
sl@0
   725
    Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);
sl@0
   726
    int n;
sl@0
   727
    u8 *data;
sl@0
   728
    char *zType = pVar->typePtr ? pVar->typePtr->name : "";
sl@0
   729
    char c = zType[0];
sl@0
   730
    if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
sl@0
   731
      /* Only return a BLOB type if the Tcl variable is a bytearray and
sl@0
   732
      ** has no string representation. */
sl@0
   733
      data = Tcl_GetByteArrayFromObj(pVar, &n);
sl@0
   734
      sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
sl@0
   735
    }else if( c=='b' && strcmp(zType,"boolean")==0 ){
sl@0
   736
      Tcl_GetIntFromObj(0, pVar, &n);
sl@0
   737
      sqlite3_result_int(context, n);
sl@0
   738
    }else if( c=='d' && strcmp(zType,"double")==0 ){
sl@0
   739
      double r;
sl@0
   740
      Tcl_GetDoubleFromObj(0, pVar, &r);
sl@0
   741
      sqlite3_result_double(context, r);
sl@0
   742
    }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
sl@0
   743
          (c=='i' && strcmp(zType,"int")==0) ){
sl@0
   744
      Tcl_WideInt v;
sl@0
   745
      Tcl_GetWideIntFromObj(0, pVar, &v);
sl@0
   746
      sqlite3_result_int64(context, v);
sl@0
   747
    }else{
sl@0
   748
      data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
sl@0
   749
      sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT);
sl@0
   750
    }
sl@0
   751
  }
sl@0
   752
}
sl@0
   753
sl@0
   754
#ifndef SQLITE_OMIT_AUTHORIZATION
sl@0
   755
/*
sl@0
   756
** This is the authentication function.  It appends the authentication
sl@0
   757
** type code and the two arguments to zCmd[] then invokes the result
sl@0
   758
** on the interpreter.  The reply is examined to determine if the
sl@0
   759
** authentication fails or succeeds.
sl@0
   760
*/
sl@0
   761
static int auth_callback(
sl@0
   762
  void *pArg,
sl@0
   763
  int code,
sl@0
   764
  const char *zArg1,
sl@0
   765
  const char *zArg2,
sl@0
   766
  const char *zArg3,
sl@0
   767
  const char *zArg4
sl@0
   768
){
sl@0
   769
  char *zCode;
sl@0
   770
  Tcl_DString str;
sl@0
   771
  int rc;
sl@0
   772
  const char *zReply;
sl@0
   773
  SqliteDb *pDb = (SqliteDb*)pArg;
sl@0
   774
  if( pDb->disableAuth ) return SQLITE_OK;
sl@0
   775
sl@0
   776
  switch( code ){
sl@0
   777
    case SQLITE_COPY              : zCode="SQLITE_COPY"; break;
sl@0
   778
    case SQLITE_CREATE_INDEX      : zCode="SQLITE_CREATE_INDEX"; break;
sl@0
   779
    case SQLITE_CREATE_TABLE      : zCode="SQLITE_CREATE_TABLE"; break;
sl@0
   780
    case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;
sl@0
   781
    case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;
sl@0
   782
    case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;
sl@0
   783
    case SQLITE_CREATE_TEMP_VIEW  : zCode="SQLITE_CREATE_TEMP_VIEW"; break;
sl@0
   784
    case SQLITE_CREATE_TRIGGER    : zCode="SQLITE_CREATE_TRIGGER"; break;
sl@0
   785
    case SQLITE_CREATE_VIEW       : zCode="SQLITE_CREATE_VIEW"; break;
sl@0
   786
    case SQLITE_DELETE            : zCode="SQLITE_DELETE"; break;
sl@0
   787
    case SQLITE_DROP_INDEX        : zCode="SQLITE_DROP_INDEX"; break;
sl@0
   788
    case SQLITE_DROP_TABLE        : zCode="SQLITE_DROP_TABLE"; break;
sl@0
   789
    case SQLITE_DROP_TEMP_INDEX   : zCode="SQLITE_DROP_TEMP_INDEX"; break;
sl@0
   790
    case SQLITE_DROP_TEMP_TABLE   : zCode="SQLITE_DROP_TEMP_TABLE"; break;
sl@0
   791
    case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break;
sl@0
   792
    case SQLITE_DROP_TEMP_VIEW    : zCode="SQLITE_DROP_TEMP_VIEW"; break;
sl@0
   793
    case SQLITE_DROP_TRIGGER      : zCode="SQLITE_DROP_TRIGGER"; break;
sl@0
   794
    case SQLITE_DROP_VIEW         : zCode="SQLITE_DROP_VIEW"; break;
sl@0
   795
    case SQLITE_INSERT            : zCode="SQLITE_INSERT"; break;
sl@0
   796
    case SQLITE_PRAGMA            : zCode="SQLITE_PRAGMA"; break;
sl@0
   797
    case SQLITE_READ              : zCode="SQLITE_READ"; break;
sl@0
   798
    case SQLITE_SELECT            : zCode="SQLITE_SELECT"; break;
sl@0
   799
    case SQLITE_TRANSACTION       : zCode="SQLITE_TRANSACTION"; break;
sl@0
   800
    case SQLITE_UPDATE            : zCode="SQLITE_UPDATE"; break;
sl@0
   801
    case SQLITE_ATTACH            : zCode="SQLITE_ATTACH"; break;
sl@0
   802
    case SQLITE_DETACH            : zCode="SQLITE_DETACH"; break;
sl@0
   803
    case SQLITE_ALTER_TABLE       : zCode="SQLITE_ALTER_TABLE"; break;
sl@0
   804
    case SQLITE_REINDEX           : zCode="SQLITE_REINDEX"; break;
sl@0
   805
    case SQLITE_ANALYZE           : zCode="SQLITE_ANALYZE"; break;
sl@0
   806
    case SQLITE_CREATE_VTABLE     : zCode="SQLITE_CREATE_VTABLE"; break;
sl@0
   807
    case SQLITE_DROP_VTABLE       : zCode="SQLITE_DROP_VTABLE"; break;
sl@0
   808
    case SQLITE_FUNCTION          : zCode="SQLITE_FUNCTION"; break;
sl@0
   809
    default                       : zCode="????"; break;
sl@0
   810
  }
sl@0
   811
  Tcl_DStringInit(&str);
sl@0
   812
  Tcl_DStringAppend(&str, pDb->zAuth, -1);
sl@0
   813
  Tcl_DStringAppendElement(&str, zCode);
sl@0
   814
  Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : "");
sl@0
   815
  Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : "");
sl@0
   816
  Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : "");
sl@0
   817
  Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : "");
sl@0
   818
  rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str));
sl@0
   819
  Tcl_DStringFree(&str);
sl@0
   820
  zReply = Tcl_GetStringResult(pDb->interp);
sl@0
   821
  if( strcmp(zReply,"SQLITE_OK")==0 ){
sl@0
   822
    rc = SQLITE_OK;
sl@0
   823
  }else if( strcmp(zReply,"SQLITE_DENY")==0 ){
sl@0
   824
    rc = SQLITE_DENY;
sl@0
   825
  }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){
sl@0
   826
    rc = SQLITE_IGNORE;
sl@0
   827
  }else{
sl@0
   828
    rc = 999;
sl@0
   829
  }
sl@0
   830
  return rc;
sl@0
   831
}
sl@0
   832
#endif /* SQLITE_OMIT_AUTHORIZATION */
sl@0
   833
sl@0
   834
/*
sl@0
   835
** zText is a pointer to text obtained via an sqlite3_result_text()
sl@0
   836
** or similar interface. This routine returns a Tcl string object, 
sl@0
   837
** reference count set to 0, containing the text. If a translation
sl@0
   838
** between iso8859 and UTF-8 is required, it is preformed.
sl@0
   839
*/
sl@0
   840
static Tcl_Obj *dbTextToObj(char const *zText){
sl@0
   841
  Tcl_Obj *pVal;
sl@0
   842
#ifdef UTF_TRANSLATION_NEEDED
sl@0
   843
  Tcl_DString dCol;
sl@0
   844
  Tcl_DStringInit(&dCol);
sl@0
   845
  Tcl_ExternalToUtfDString(NULL, zText, -1, &dCol);
sl@0
   846
  pVal = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
sl@0
   847
  Tcl_DStringFree(&dCol);
sl@0
   848
#else
sl@0
   849
  pVal = Tcl_NewStringObj(zText, -1);
sl@0
   850
#endif
sl@0
   851
  return pVal;
sl@0
   852
}
sl@0
   853
sl@0
   854
/*
sl@0
   855
** This routine reads a line of text from FILE in, stores
sl@0
   856
** the text in memory obtained from malloc() and returns a pointer
sl@0
   857
** to the text.  NULL is returned at end of file, or if malloc()
sl@0
   858
** fails.
sl@0
   859
**
sl@0
   860
** The interface is like "readline" but no command-line editing
sl@0
   861
** is done.
sl@0
   862
**
sl@0
   863
** copied from shell.c from '.import' command
sl@0
   864
*/
sl@0
   865
static char *local_getline(char *zPrompt, FILE *in){
sl@0
   866
  char *zLine;
sl@0
   867
  int nLine;
sl@0
   868
  int n;
sl@0
   869
  int eol;
sl@0
   870
sl@0
   871
  nLine = 100;
sl@0
   872
  zLine = malloc( nLine );
sl@0
   873
  if( zLine==0 ) return 0;
sl@0
   874
  n = 0;
sl@0
   875
  eol = 0;
sl@0
   876
  while( !eol ){
sl@0
   877
    if( n+100>nLine ){
sl@0
   878
      nLine = nLine*2 + 100;
sl@0
   879
      zLine = realloc(zLine, nLine);
sl@0
   880
      if( zLine==0 ) return 0;
sl@0
   881
    }
sl@0
   882
    if( fgets(&zLine[n], nLine - n, in)==0 ){
sl@0
   883
      if( n==0 ){
sl@0
   884
        free(zLine);
sl@0
   885
        return 0;
sl@0
   886
      }
sl@0
   887
      zLine[n] = 0;
sl@0
   888
      eol = 1;
sl@0
   889
      break;
sl@0
   890
    }
sl@0
   891
    while( zLine[n] ){ n++; }
sl@0
   892
    if( n>0 && zLine[n-1]=='\n' ){
sl@0
   893
      n--;
sl@0
   894
      zLine[n] = 0;
sl@0
   895
      eol = 1;
sl@0
   896
    }
sl@0
   897
  }
sl@0
   898
  zLine = realloc( zLine, n+1 );
sl@0
   899
  return zLine;
sl@0
   900
}
sl@0
   901
sl@0
   902
sl@0
   903
/*
sl@0
   904
** Figure out the column names for the data returned by the statement
sl@0
   905
** passed as the second argument.
sl@0
   906
**
sl@0
   907
** If parameter papColName is not NULL, then *papColName is set to point
sl@0
   908
** at an array allocated using Tcl_Alloc(). It is the callers responsibility
sl@0
   909
** to free this array using Tcl_Free(), and to decrement the reference
sl@0
   910
** count of each Tcl_Obj* member of the array.
sl@0
   911
**
sl@0
   912
** The return value of this function is the number of columns of data
sl@0
   913
** returned by pStmt (and hence the size of the *papColName array).
sl@0
   914
**
sl@0
   915
** If pArray is not NULL, then it contains the name of a Tcl array
sl@0
   916
** variable. The "*" member of this array is set to a list containing
sl@0
   917
** the names of the columns returned by the statement, in order from
sl@0
   918
** left to right. e.g. if the names of the returned columns are a, b and
sl@0
   919
** c, it does the equivalent of the tcl command:
sl@0
   920
**
sl@0
   921
**     set ${pArray}(*) {a b c}
sl@0
   922
*/
sl@0
   923
static int
sl@0
   924
computeColumnNames(
sl@0
   925
  Tcl_Interp *interp, 
sl@0
   926
  sqlite3_stmt *pStmt,              /* SQL statement */
sl@0
   927
  Tcl_Obj ***papColName,            /* OUT: Array of column names */
sl@0
   928
  Tcl_Obj *pArray                   /* Name of array variable (may be null) */
sl@0
   929
){
sl@0
   930
  int nCol;
sl@0
   931
sl@0
   932
  /* Compute column names */
sl@0
   933
  nCol = sqlite3_column_count(pStmt);
sl@0
   934
  if( papColName ){
sl@0
   935
    int i;
sl@0
   936
    Tcl_Obj **apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol );
sl@0
   937
    for(i=0; i<nCol; i++){
sl@0
   938
      apColName[i] = dbTextToObj(sqlite3_column_name(pStmt,i));
sl@0
   939
      Tcl_IncrRefCount(apColName[i]);
sl@0
   940
    }
sl@0
   941
sl@0
   942
    /* If results are being stored in an array variable, then create
sl@0
   943
    ** the array(*) entry for that array
sl@0
   944
    */
sl@0
   945
    if( pArray ){
sl@0
   946
      Tcl_Obj *pColList = Tcl_NewObj();
sl@0
   947
      Tcl_Obj *pStar = Tcl_NewStringObj("*", -1);
sl@0
   948
      Tcl_IncrRefCount(pColList);
sl@0
   949
      for(i=0; i<nCol; i++){
sl@0
   950
        Tcl_ListObjAppendElement(interp, pColList, apColName[i]);
sl@0
   951
      }
sl@0
   952
      Tcl_IncrRefCount(pStar);
sl@0
   953
      Tcl_ObjSetVar2(interp, pArray, pStar, pColList,0);
sl@0
   954
      Tcl_DecrRefCount(pColList);
sl@0
   955
      Tcl_DecrRefCount(pStar);
sl@0
   956
    }
sl@0
   957
    *papColName = apColName;
sl@0
   958
  }
sl@0
   959
sl@0
   960
  return nCol;
sl@0
   961
}
sl@0
   962
sl@0
   963
/*
sl@0
   964
** The "sqlite" command below creates a new Tcl command for each
sl@0
   965
** connection it opens to an SQLite database.  This routine is invoked
sl@0
   966
** whenever one of those connection-specific commands is executed
sl@0
   967
** in Tcl.  For example, if you run Tcl code like this:
sl@0
   968
**
sl@0
   969
**       sqlite3 db1  "my_database"
sl@0
   970
**       db1 close
sl@0
   971
**
sl@0
   972
** The first command opens a connection to the "my_database" database
sl@0
   973
** and calls that connection "db1".  The second command causes this
sl@0
   974
** subroutine to be invoked.
sl@0
   975
*/
sl@0
   976
static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
sl@0
   977
  SqliteDb *pDb = (SqliteDb*)cd;
sl@0
   978
  int choice;
sl@0
   979
  int rc = TCL_OK;
sl@0
   980
  static const char *DB_strs[] = {
sl@0
   981
    "authorizer",         "busy",              "cache",
sl@0
   982
    "changes",            "close",             "collate",
sl@0
   983
    "collation_needed",   "commit_hook",       "complete",
sl@0
   984
    "copy",               "enable_load_extension","errorcode",
sl@0
   985
    "eval",               "exists",            "function",
sl@0
   986
    "incrblob",           "interrupt",         "last_insert_rowid",
sl@0
   987
    "nullvalue",          "onecolumn",         "profile",
sl@0
   988
    "progress",           "rekey",             "rollback_hook",
sl@0
   989
    "timeout",            "total_changes",     "trace",
sl@0
   990
    "transaction",        "update_hook",       "version",
sl@0
   991
    0                    
sl@0
   992
  };
sl@0
   993
  enum DB_enum {
sl@0
   994
    DB_AUTHORIZER,        DB_BUSY,             DB_CACHE,
sl@0
   995
    DB_CHANGES,           DB_CLOSE,            DB_COLLATE,
sl@0
   996
    DB_COLLATION_NEEDED,  DB_COMMIT_HOOK,      DB_COMPLETE,
sl@0
   997
    DB_COPY,              DB_ENABLE_LOAD_EXTENSION,DB_ERRORCODE,
sl@0
   998
    DB_EVAL,              DB_EXISTS,           DB_FUNCTION,
sl@0
   999
    DB_INCRBLOB,          DB_INTERRUPT,        DB_LAST_INSERT_ROWID,
sl@0
  1000
    DB_NULLVALUE,         DB_ONECOLUMN,        DB_PROFILE,
sl@0
  1001
    DB_PROGRESS,          DB_REKEY,            DB_ROLLBACK_HOOK,
sl@0
  1002
    DB_TIMEOUT,           DB_TOTAL_CHANGES,    DB_TRACE,
sl@0
  1003
    DB_TRANSACTION,       DB_UPDATE_HOOK,      DB_VERSION
sl@0
  1004
  };
sl@0
  1005
  /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */
sl@0
  1006
sl@0
  1007
  if( objc<2 ){
sl@0
  1008
    Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
sl@0
  1009
    return TCL_ERROR;
sl@0
  1010
  }
sl@0
  1011
  if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
sl@0
  1012
    return TCL_ERROR;
sl@0
  1013
  }
sl@0
  1014
sl@0
  1015
  switch( (enum DB_enum)choice ){
sl@0
  1016
sl@0
  1017
  /*    $db authorizer ?CALLBACK?
sl@0
  1018
  **
sl@0
  1019
  ** Invoke the given callback to authorize each SQL operation as it is
sl@0
  1020
  ** compiled.  5 arguments are appended to the callback before it is
sl@0
  1021
  ** invoked:
sl@0
  1022
  **
sl@0
  1023
  **   (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...)
sl@0
  1024
  **   (2) First descriptive name (depends on authorization type)
sl@0
  1025
  **   (3) Second descriptive name
sl@0
  1026
  **   (4) Name of the database (ex: "main", "temp")
sl@0
  1027
  **   (5) Name of trigger that is doing the access
sl@0
  1028
  **
sl@0
  1029
  ** The callback should return on of the following strings: SQLITE_OK,
sl@0
  1030
  ** SQLITE_IGNORE, or SQLITE_DENY.  Any other return value is an error.
sl@0
  1031
  **
sl@0
  1032
  ** If this method is invoked with no arguments, the current authorization
sl@0
  1033
  ** callback string is returned.
sl@0
  1034
  */
sl@0
  1035
  case DB_AUTHORIZER: {
sl@0
  1036
#ifdef SQLITE_OMIT_AUTHORIZATION
sl@0
  1037
    Tcl_AppendResult(interp, "authorization not available in this build", 0);
sl@0
  1038
    return TCL_ERROR;
sl@0
  1039
#else
sl@0
  1040
    if( objc>3 ){
sl@0
  1041
      Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
sl@0
  1042
      return TCL_ERROR;
sl@0
  1043
    }else if( objc==2 ){
sl@0
  1044
      if( pDb->zAuth ){
sl@0
  1045
        Tcl_AppendResult(interp, pDb->zAuth, 0);
sl@0
  1046
      }
sl@0
  1047
    }else{
sl@0
  1048
      char *zAuth;
sl@0
  1049
      int len;
sl@0
  1050
      if( pDb->zAuth ){
sl@0
  1051
        Tcl_Free(pDb->zAuth);
sl@0
  1052
      }
sl@0
  1053
      zAuth = Tcl_GetStringFromObj(objv[2], &len);
sl@0
  1054
      if( zAuth && len>0 ){
sl@0
  1055
        pDb->zAuth = Tcl_Alloc( len + 1 );
sl@0
  1056
        memcpy(pDb->zAuth, zAuth, len+1);
sl@0
  1057
      }else{
sl@0
  1058
        pDb->zAuth = 0;
sl@0
  1059
      }
sl@0
  1060
      if( pDb->zAuth ){
sl@0
  1061
        pDb->interp = interp;
sl@0
  1062
        sqlite3_set_authorizer(pDb->db, auth_callback, pDb);
sl@0
  1063
      }else{
sl@0
  1064
        sqlite3_set_authorizer(pDb->db, 0, 0);
sl@0
  1065
      }
sl@0
  1066
    }
sl@0
  1067
#endif
sl@0
  1068
    break;
sl@0
  1069
  }
sl@0
  1070
sl@0
  1071
  /*    $db busy ?CALLBACK?
sl@0
  1072
  **
sl@0
  1073
  ** Invoke the given callback if an SQL statement attempts to open
sl@0
  1074
  ** a locked database file.
sl@0
  1075
  */
sl@0
  1076
  case DB_BUSY: {
sl@0
  1077
    if( objc>3 ){
sl@0
  1078
      Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
sl@0
  1079
      return TCL_ERROR;
sl@0
  1080
    }else if( objc==2 ){
sl@0
  1081
      if( pDb->zBusy ){
sl@0
  1082
        Tcl_AppendResult(interp, pDb->zBusy, 0);
sl@0
  1083
      }
sl@0
  1084
    }else{
sl@0
  1085
      char *zBusy;
sl@0
  1086
      int len;
sl@0
  1087
      if( pDb->zBusy ){
sl@0
  1088
        Tcl_Free(pDb->zBusy);
sl@0
  1089
      }
sl@0
  1090
      zBusy = Tcl_GetStringFromObj(objv[2], &len);
sl@0
  1091
      if( zBusy && len>0 ){
sl@0
  1092
        pDb->zBusy = Tcl_Alloc( len + 1 );
sl@0
  1093
        memcpy(pDb->zBusy, zBusy, len+1);
sl@0
  1094
      }else{
sl@0
  1095
        pDb->zBusy = 0;
sl@0
  1096
      }
sl@0
  1097
      if( pDb->zBusy ){
sl@0
  1098
        pDb->interp = interp;
sl@0
  1099
        sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb);
sl@0
  1100
      }else{
sl@0
  1101
        sqlite3_busy_handler(pDb->db, 0, 0);
sl@0
  1102
      }
sl@0
  1103
    }
sl@0
  1104
    break;
sl@0
  1105
  }
sl@0
  1106
sl@0
  1107
  /*     $db cache flush
sl@0
  1108
  **     $db cache size n
sl@0
  1109
  **
sl@0
  1110
  ** Flush the prepared statement cache, or set the maximum number of
sl@0
  1111
  ** cached statements.
sl@0
  1112
  */
sl@0
  1113
  case DB_CACHE: {
sl@0
  1114
    char *subCmd;
sl@0
  1115
    int n;
sl@0
  1116
sl@0
  1117
    if( objc<=2 ){
sl@0
  1118
      Tcl_WrongNumArgs(interp, 1, objv, "cache option ?arg?");
sl@0
  1119
      return TCL_ERROR;
sl@0
  1120
    }
sl@0
  1121
    subCmd = Tcl_GetStringFromObj( objv[2], 0 );
sl@0
  1122
    if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){
sl@0
  1123
      if( objc!=3 ){
sl@0
  1124
        Tcl_WrongNumArgs(interp, 2, objv, "flush");
sl@0
  1125
        return TCL_ERROR;
sl@0
  1126
      }else{
sl@0
  1127
        flushStmtCache( pDb );
sl@0
  1128
      }
sl@0
  1129
    }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){
sl@0
  1130
      if( objc!=4 ){
sl@0
  1131
        Tcl_WrongNumArgs(interp, 2, objv, "size n");
sl@0
  1132
        return TCL_ERROR;
sl@0
  1133
      }else{
sl@0
  1134
        if( TCL_ERROR==Tcl_GetIntFromObj(interp, objv[3], &n) ){
sl@0
  1135
          Tcl_AppendResult( interp, "cannot convert \"", 
sl@0
  1136
               Tcl_GetStringFromObj(objv[3],0), "\" to integer", 0);
sl@0
  1137
          return TCL_ERROR;
sl@0
  1138
        }else{
sl@0
  1139
          if( n<0 ){
sl@0
  1140
            flushStmtCache( pDb );
sl@0
  1141
            n = 0;
sl@0
  1142
          }else if( n>MAX_PREPARED_STMTS ){
sl@0
  1143
            n = MAX_PREPARED_STMTS;
sl@0
  1144
          }
sl@0
  1145
          pDb->maxStmt = n;
sl@0
  1146
        }
sl@0
  1147
      }
sl@0
  1148
    }else{
sl@0
  1149
      Tcl_AppendResult( interp, "bad option \"", 
sl@0
  1150
          Tcl_GetStringFromObj(objv[2],0), "\": must be flush or size", 0);
sl@0
  1151
      return TCL_ERROR;
sl@0
  1152
    }
sl@0
  1153
    break;
sl@0
  1154
  }
sl@0
  1155
sl@0
  1156
  /*     $db changes
sl@0
  1157
  **
sl@0
  1158
  ** Return the number of rows that were modified, inserted, or deleted by
sl@0
  1159
  ** the most recent INSERT, UPDATE or DELETE statement, not including 
sl@0
  1160
  ** any changes made by trigger programs.
sl@0
  1161
  */
sl@0
  1162
  case DB_CHANGES: {
sl@0
  1163
    Tcl_Obj *pResult;
sl@0
  1164
    if( objc!=2 ){
sl@0
  1165
      Tcl_WrongNumArgs(interp, 2, objv, "");
sl@0
  1166
      return TCL_ERROR;
sl@0
  1167
    }
sl@0
  1168
    pResult = Tcl_GetObjResult(interp);
sl@0
  1169
    Tcl_SetIntObj(pResult, sqlite3_changes(pDb->db));
sl@0
  1170
    break;
sl@0
  1171
  }
sl@0
  1172
sl@0
  1173
  /*    $db close
sl@0
  1174
  **
sl@0
  1175
  ** Shutdown the database
sl@0
  1176
  */
sl@0
  1177
  case DB_CLOSE: {
sl@0
  1178
    Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0));
sl@0
  1179
    break;
sl@0
  1180
  }
sl@0
  1181
sl@0
  1182
  /*
sl@0
  1183
  **     $db collate NAME SCRIPT
sl@0
  1184
  **
sl@0
  1185
  ** Create a new SQL collation function called NAME.  Whenever
sl@0
  1186
  ** that function is called, invoke SCRIPT to evaluate the function.
sl@0
  1187
  */
sl@0
  1188
  case DB_COLLATE: {
sl@0
  1189
    SqlCollate *pCollate;
sl@0
  1190
    char *zName;
sl@0
  1191
    char *zScript;
sl@0
  1192
    int nScript;
sl@0
  1193
    if( objc!=4 ){
sl@0
  1194
      Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
sl@0
  1195
      return TCL_ERROR;
sl@0
  1196
    }
sl@0
  1197
    zName = Tcl_GetStringFromObj(objv[2], 0);
sl@0
  1198
    zScript = Tcl_GetStringFromObj(objv[3], &nScript);
sl@0
  1199
    pCollate = (SqlCollate*)Tcl_Alloc( sizeof(*pCollate) + nScript + 1 );
sl@0
  1200
    if( pCollate==0 ) return TCL_ERROR;
sl@0
  1201
    pCollate->interp = interp;
sl@0
  1202
    pCollate->pNext = pDb->pCollate;
sl@0
  1203
    pCollate->zScript = (char*)&pCollate[1];
sl@0
  1204
    pDb->pCollate = pCollate;
sl@0
  1205
    memcpy(pCollate->zScript, zScript, nScript+1);
sl@0
  1206
    if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8, 
sl@0
  1207
        pCollate, tclSqlCollate) ){
sl@0
  1208
      Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
sl@0
  1209
      return TCL_ERROR;
sl@0
  1210
    }
sl@0
  1211
    break;
sl@0
  1212
  }
sl@0
  1213
sl@0
  1214
  /*
sl@0
  1215
  **     $db collation_needed SCRIPT
sl@0
  1216
  **
sl@0
  1217
  ** Create a new SQL collation function called NAME.  Whenever
sl@0
  1218
  ** that function is called, invoke SCRIPT to evaluate the function.
sl@0
  1219
  */
sl@0
  1220
  case DB_COLLATION_NEEDED: {
sl@0
  1221
    if( objc!=3 ){
sl@0
  1222
      Tcl_WrongNumArgs(interp, 2, objv, "SCRIPT");
sl@0
  1223
      return TCL_ERROR;
sl@0
  1224
    }
sl@0
  1225
    if( pDb->pCollateNeeded ){
sl@0
  1226
      Tcl_DecrRefCount(pDb->pCollateNeeded);
sl@0
  1227
    }
sl@0
  1228
    pDb->pCollateNeeded = Tcl_DuplicateObj(objv[2]);
sl@0
  1229
    Tcl_IncrRefCount(pDb->pCollateNeeded);
sl@0
  1230
    sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded);
sl@0
  1231
    break;
sl@0
  1232
  }
sl@0
  1233
sl@0
  1234
  /*    $db commit_hook ?CALLBACK?
sl@0
  1235
  **
sl@0
  1236
  ** Invoke the given callback just before committing every SQL transaction.
sl@0
  1237
  ** If the callback throws an exception or returns non-zero, then the
sl@0
  1238
  ** transaction is aborted.  If CALLBACK is an empty string, the callback
sl@0
  1239
  ** is disabled.
sl@0
  1240
  */
sl@0
  1241
  case DB_COMMIT_HOOK: {
sl@0
  1242
    if( objc>3 ){
sl@0
  1243
      Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
sl@0
  1244
      return TCL_ERROR;
sl@0
  1245
    }else if( objc==2 ){
sl@0
  1246
      if( pDb->zCommit ){
sl@0
  1247
        Tcl_AppendResult(interp, pDb->zCommit, 0);
sl@0
  1248
      }
sl@0
  1249
    }else{
sl@0
  1250
      char *zCommit;
sl@0
  1251
      int len;
sl@0
  1252
      if( pDb->zCommit ){
sl@0
  1253
        Tcl_Free(pDb->zCommit);
sl@0
  1254
      }
sl@0
  1255
      zCommit = Tcl_GetStringFromObj(objv[2], &len);
sl@0
  1256
      if( zCommit && len>0 ){
sl@0
  1257
        pDb->zCommit = Tcl_Alloc( len + 1 );
sl@0
  1258
        memcpy(pDb->zCommit, zCommit, len+1);
sl@0
  1259
      }else{
sl@0
  1260
        pDb->zCommit = 0;
sl@0
  1261
      }
sl@0
  1262
      if( pDb->zCommit ){
sl@0
  1263
        pDb->interp = interp;
sl@0
  1264
        sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb);
sl@0
  1265
      }else{
sl@0
  1266
        sqlite3_commit_hook(pDb->db, 0, 0);
sl@0
  1267
      }
sl@0
  1268
    }
sl@0
  1269
    break;
sl@0
  1270
  }
sl@0
  1271
sl@0
  1272
  /*    $db complete SQL
sl@0
  1273
  **
sl@0
  1274
  ** Return TRUE if SQL is a complete SQL statement.  Return FALSE if
sl@0
  1275
  ** additional lines of input are needed.  This is similar to the
sl@0
  1276
  ** built-in "info complete" command of Tcl.
sl@0
  1277
  */
sl@0
  1278
  case DB_COMPLETE: {
sl@0
  1279
#ifndef SQLITE_OMIT_COMPLETE
sl@0
  1280
    Tcl_Obj *pResult;
sl@0
  1281
    int isComplete;
sl@0
  1282
    if( objc!=3 ){
sl@0
  1283
      Tcl_WrongNumArgs(interp, 2, objv, "SQL");
sl@0
  1284
      return TCL_ERROR;
sl@0
  1285
    }
sl@0
  1286
    isComplete = sqlite3_complete( Tcl_GetStringFromObj(objv[2], 0) );
sl@0
  1287
    pResult = Tcl_GetObjResult(interp);
sl@0
  1288
    Tcl_SetBooleanObj(pResult, isComplete);
sl@0
  1289
#endif
sl@0
  1290
    break;
sl@0
  1291
  }
sl@0
  1292
sl@0
  1293
  /*    $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR?
sl@0
  1294
  **
sl@0
  1295
  ** Copy data into table from filename, optionally using SEPARATOR
sl@0
  1296
  ** as column separators.  If a column contains a null string, or the
sl@0
  1297
  ** value of NULLINDICATOR, a NULL is inserted for the column.
sl@0
  1298
  ** conflict-algorithm is one of the sqlite conflict algorithms:
sl@0
  1299
  **    rollback, abort, fail, ignore, replace
sl@0
  1300
  ** On success, return the number of lines processed, not necessarily same
sl@0
  1301
  ** as 'db changes' due to conflict-algorithm selected.
sl@0
  1302
  **
sl@0
  1303
  ** This code is basically an implementation/enhancement of
sl@0
  1304
  ** the sqlite3 shell.c ".import" command.
sl@0
  1305
  **
sl@0
  1306
  ** This command usage is equivalent to the sqlite2.x COPY statement,
sl@0
  1307
  ** which imports file data into a table using the PostgreSQL COPY file format:
sl@0
  1308
  **   $db copy $conflit_algo $table_name $filename \t \\N
sl@0
  1309
  */
sl@0
  1310
  case DB_COPY: {
sl@0
  1311
    char *zTable;               /* Insert data into this table */
sl@0
  1312
    char *zFile;                /* The file from which to extract data */
sl@0
  1313
    char *zConflict;            /* The conflict algorithm to use */
sl@0
  1314
    sqlite3_stmt *pStmt;        /* A statement */
sl@0
  1315
    int nCol;                   /* Number of columns in the table */
sl@0
  1316
    int nByte;                  /* Number of bytes in an SQL string */
sl@0
  1317
    int i, j;                   /* Loop counters */
sl@0
  1318
    int nSep;                   /* Number of bytes in zSep[] */
sl@0
  1319
    int nNull;                  /* Number of bytes in zNull[] */
sl@0
  1320
    char *zSql;                 /* An SQL statement */
sl@0
  1321
    char *zLine;                /* A single line of input from the file */
sl@0
  1322
    char **azCol;               /* zLine[] broken up into columns */
sl@0
  1323
    char *zCommit;              /* How to commit changes */
sl@0
  1324
    FILE *in;                   /* The input file */
sl@0
  1325
    int lineno = 0;             /* Line number of input file */
sl@0
  1326
    char zLineNum[80];          /* Line number print buffer */
sl@0
  1327
    Tcl_Obj *pResult;           /* interp result */
sl@0
  1328
sl@0
  1329
    char *zSep;
sl@0
  1330
    char *zNull;
sl@0
  1331
    if( objc<5 || objc>7 ){
sl@0
  1332
      Tcl_WrongNumArgs(interp, 2, objv, 
sl@0
  1333
         "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?");
sl@0
  1334
      return TCL_ERROR;
sl@0
  1335
    }
sl@0
  1336
    if( objc>=6 ){
sl@0
  1337
      zSep = Tcl_GetStringFromObj(objv[5], 0);
sl@0
  1338
    }else{
sl@0
  1339
      zSep = "\t";
sl@0
  1340
    }
sl@0
  1341
    if( objc>=7 ){
sl@0
  1342
      zNull = Tcl_GetStringFromObj(objv[6], 0);
sl@0
  1343
    }else{
sl@0
  1344
      zNull = "";
sl@0
  1345
    }
sl@0
  1346
    zConflict = Tcl_GetStringFromObj(objv[2], 0);
sl@0
  1347
    zTable = Tcl_GetStringFromObj(objv[3], 0);
sl@0
  1348
    zFile = Tcl_GetStringFromObj(objv[4], 0);
sl@0
  1349
    nSep = strlen(zSep);
sl@0
  1350
    nNull = strlen(zNull);
sl@0
  1351
    if( nSep==0 ){
sl@0
  1352
      Tcl_AppendResult(interp,"Error: non-null separator required for copy",0);
sl@0
  1353
      return TCL_ERROR;
sl@0
  1354
    }
sl@0
  1355
    if(strcmp(zConflict, "rollback") != 0 &&
sl@0
  1356
       strcmp(zConflict, "abort"   ) != 0 &&
sl@0
  1357
       strcmp(zConflict, "fail"    ) != 0 &&
sl@0
  1358
       strcmp(zConflict, "ignore"  ) != 0 &&
sl@0
  1359
       strcmp(zConflict, "replace" ) != 0 ) {
sl@0
  1360
      Tcl_AppendResult(interp, "Error: \"", zConflict, 
sl@0
  1361
            "\", conflict-algorithm must be one of: rollback, "
sl@0
  1362
            "abort, fail, ignore, or replace", 0);
sl@0
  1363
      return TCL_ERROR;
sl@0
  1364
    }
sl@0
  1365
    zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable);
sl@0
  1366
    if( zSql==0 ){
sl@0
  1367
      Tcl_AppendResult(interp, "Error: no such table: ", zTable, 0);
sl@0
  1368
      return TCL_ERROR;
sl@0
  1369
    }
sl@0
  1370
    nByte = strlen(zSql);
sl@0
  1371
    rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
sl@0
  1372
    sqlite3_free(zSql);
sl@0
  1373
    if( rc ){
sl@0
  1374
      Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0);
sl@0
  1375
      nCol = 0;
sl@0
  1376
    }else{
sl@0
  1377
      nCol = sqlite3_column_count(pStmt);
sl@0
  1378
    }
sl@0
  1379
    sqlite3_finalize(pStmt);
sl@0
  1380
    if( nCol==0 ) {
sl@0
  1381
      return TCL_ERROR;
sl@0
  1382
    }
sl@0
  1383
    zSql = malloc( nByte + 50 + nCol*2 );
sl@0
  1384
    if( zSql==0 ) {
sl@0
  1385
      Tcl_AppendResult(interp, "Error: can't malloc()", 0);
sl@0
  1386
      return TCL_ERROR;
sl@0
  1387
    }
sl@0
  1388
    sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?",
sl@0
  1389
         zConflict, zTable);
sl@0
  1390
    j = strlen(zSql);
sl@0
  1391
    for(i=1; i<nCol; i++){
sl@0
  1392
      zSql[j++] = ',';
sl@0
  1393
      zSql[j++] = '?';
sl@0
  1394
    }
sl@0
  1395
    zSql[j++] = ')';
sl@0
  1396
    zSql[j] = 0;
sl@0
  1397
    rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
sl@0
  1398
    free(zSql);
sl@0
  1399
    if( rc ){
sl@0
  1400
      Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0);
sl@0
  1401
      sqlite3_finalize(pStmt);
sl@0
  1402
      return TCL_ERROR;
sl@0
  1403
    }
sl@0
  1404
    in = fopen(zFile, "rb");
sl@0
  1405
    if( in==0 ){
sl@0
  1406
      Tcl_AppendResult(interp, "Error: cannot open file: ", zFile, NULL);
sl@0
  1407
      sqlite3_finalize(pStmt);
sl@0
  1408
      return TCL_ERROR;
sl@0
  1409
    }
sl@0
  1410
    azCol = malloc( sizeof(azCol[0])*(nCol+1) );
sl@0
  1411
    if( azCol==0 ) {
sl@0
  1412
      Tcl_AppendResult(interp, "Error: can't malloc()", 0);
sl@0
  1413
      fclose(in);
sl@0
  1414
      return TCL_ERROR;
sl@0
  1415
    }
sl@0
  1416
    (void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0);
sl@0
  1417
    zCommit = "COMMIT";
sl@0
  1418
    while( (zLine = local_getline(0, in))!=0 ){
sl@0
  1419
      char *z;
sl@0
  1420
      i = 0;
sl@0
  1421
      lineno++;
sl@0
  1422
      azCol[0] = zLine;
sl@0
  1423
      for(i=0, z=zLine; *z; z++){
sl@0
  1424
        if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){
sl@0
  1425
          *z = 0;
sl@0
  1426
          i++;
sl@0
  1427
          if( i<nCol ){
sl@0
  1428
            azCol[i] = &z[nSep];
sl@0
  1429
            z += nSep-1;
sl@0
  1430
          }
sl@0
  1431
        }
sl@0
  1432
      }
sl@0
  1433
      if( i+1!=nCol ){
sl@0
  1434
        char *zErr;
sl@0
  1435
        int nErr = strlen(zFile) + 200;
sl@0
  1436
        zErr = malloc(nErr);
sl@0
  1437
        if( zErr ){
sl@0
  1438
          sqlite3_snprintf(nErr, zErr,
sl@0
  1439
             "Error: %s line %d: expected %d columns of data but found %d",
sl@0
  1440
             zFile, lineno, nCol, i+1);
sl@0
  1441
          Tcl_AppendResult(interp, zErr, 0);
sl@0
  1442
          free(zErr);
sl@0
  1443
        }
sl@0
  1444
        zCommit = "ROLLBACK";
sl@0
  1445
        break;
sl@0
  1446
      }
sl@0
  1447
      for(i=0; i<nCol; i++){
sl@0
  1448
        /* check for null data, if so, bind as null */
sl@0
  1449
        if ((nNull>0 && strcmp(azCol[i], zNull)==0) || strlen(azCol[i])==0) {
sl@0
  1450
          sqlite3_bind_null(pStmt, i+1);
sl@0
  1451
        }else{
sl@0
  1452
          sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC);
sl@0
  1453
        }
sl@0
  1454
      }
sl@0
  1455
      sqlite3_step(pStmt);
sl@0
  1456
      rc = sqlite3_reset(pStmt);
sl@0
  1457
      free(zLine);
sl@0
  1458
      if( rc!=SQLITE_OK ){
sl@0
  1459
        Tcl_AppendResult(interp,"Error: ", sqlite3_errmsg(pDb->db), 0);
sl@0
  1460
        zCommit = "ROLLBACK";
sl@0
  1461
        break;
sl@0
  1462
      }
sl@0
  1463
    }
sl@0
  1464
    free(azCol);
sl@0
  1465
    fclose(in);
sl@0
  1466
    sqlite3_finalize(pStmt);
sl@0
  1467
    (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0);
sl@0
  1468
sl@0
  1469
    if( zCommit[0] == 'C' ){
sl@0
  1470
      /* success, set result as number of lines processed */
sl@0
  1471
      pResult = Tcl_GetObjResult(interp);
sl@0
  1472
      Tcl_SetIntObj(pResult, lineno);
sl@0
  1473
      rc = TCL_OK;
sl@0
  1474
    }else{
sl@0
  1475
      /* failure, append lineno where failed */
sl@0
  1476
      sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno);
sl@0
  1477
      Tcl_AppendResult(interp,", failed while processing line: ",zLineNum,0);
sl@0
  1478
      rc = TCL_ERROR;
sl@0
  1479
    }
sl@0
  1480
    break;
sl@0
  1481
  }
sl@0
  1482
sl@0
  1483
  /*
sl@0
  1484
  **    $db enable_load_extension BOOLEAN
sl@0
  1485
  **
sl@0
  1486
  ** Turn the extension loading feature on or off.  It if off by
sl@0
  1487
  ** default.
sl@0
  1488
  */
sl@0
  1489
  case DB_ENABLE_LOAD_EXTENSION: {
sl@0
  1490
#ifndef SQLITE_OMIT_LOAD_EXTENSION
sl@0
  1491
    int onoff;
sl@0
  1492
    if( objc!=3 ){
sl@0
  1493
      Tcl_WrongNumArgs(interp, 2, objv, "BOOLEAN");
sl@0
  1494
      return TCL_ERROR;
sl@0
  1495
    }
sl@0
  1496
    if( Tcl_GetBooleanFromObj(interp, objv[2], &onoff) ){
sl@0
  1497
      return TCL_ERROR;
sl@0
  1498
    }
sl@0
  1499
    sqlite3_enable_load_extension(pDb->db, onoff);
sl@0
  1500
    break;
sl@0
  1501
#else
sl@0
  1502
    Tcl_AppendResult(interp, "extension loading is turned off at compile-time",
sl@0
  1503
                     0);
sl@0
  1504
    return TCL_ERROR;
sl@0
  1505
#endif
sl@0
  1506
  }
sl@0
  1507
sl@0
  1508
  /*
sl@0
  1509
  **    $db errorcode
sl@0
  1510
  **
sl@0
  1511
  ** Return the numeric error code that was returned by the most recent
sl@0
  1512
  ** call to sqlite3_exec().
sl@0
  1513
  */
sl@0
  1514
  case DB_ERRORCODE: {
sl@0
  1515
    Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db)));
sl@0
  1516
    break;
sl@0
  1517
  }
sl@0
  1518
   
sl@0
  1519
  /*
sl@0
  1520
  **    $db eval $sql ?array? ?{  ...code... }?
sl@0
  1521
  **    $db onecolumn $sql
sl@0
  1522
  **
sl@0
  1523
  ** The SQL statement in $sql is evaluated.  For each row, the values are
sl@0
  1524
  ** placed in elements of the array named "array" and ...code... is executed.
sl@0
  1525
  ** If "array" and "code" are omitted, then no callback is every invoked.
sl@0
  1526
  ** If "array" is an empty string, then the values are placed in variables
sl@0
  1527
  ** that have the same name as the fields extracted by the query.
sl@0
  1528
  **
sl@0
  1529
  ** The onecolumn method is the equivalent of:
sl@0
  1530
  **     lindex [$db eval $sql] 0
sl@0
  1531
  */
sl@0
  1532
  case DB_ONECOLUMN:
sl@0
  1533
  case DB_EVAL:
sl@0
  1534
  case DB_EXISTS: {
sl@0
  1535
    char const *zSql;      /* Next SQL statement to execute */
sl@0
  1536
    char const *zLeft;     /* What is left after first stmt in zSql */
sl@0
  1537
    sqlite3_stmt *pStmt;   /* Compiled SQL statment */
sl@0
  1538
    Tcl_Obj *pArray;       /* Name of array into which results are written */
sl@0
  1539
    Tcl_Obj *pScript;      /* Script to run for each result set */
sl@0
  1540
    Tcl_Obj **apParm;      /* Parameters that need a Tcl_DecrRefCount() */
sl@0
  1541
    int nParm;             /* Number of entries used in apParm[] */
sl@0
  1542
    Tcl_Obj *aParm[10];    /* Static space for apParm[] in the common case */
sl@0
  1543
    Tcl_Obj *pRet;         /* Value to be returned */
sl@0
  1544
    SqlPreparedStmt *pPreStmt;  /* Pointer to a prepared statement */
sl@0
  1545
    int rc2;
sl@0
  1546
sl@0
  1547
    if( choice==DB_EVAL ){
sl@0
  1548
      if( objc<3 || objc>5 ){
sl@0
  1549
        Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?");
sl@0
  1550
        return TCL_ERROR;
sl@0
  1551
      }
sl@0
  1552
      pRet = Tcl_NewObj();
sl@0
  1553
      Tcl_IncrRefCount(pRet);
sl@0
  1554
    }else{
sl@0
  1555
      if( objc!=3 ){
sl@0
  1556
        Tcl_WrongNumArgs(interp, 2, objv, "SQL");
sl@0
  1557
        return TCL_ERROR;
sl@0
  1558
      }
sl@0
  1559
      if( choice==DB_EXISTS ){
sl@0
  1560
        pRet = Tcl_NewBooleanObj(0);
sl@0
  1561
        Tcl_IncrRefCount(pRet);
sl@0
  1562
      }else{
sl@0
  1563
        pRet = 0;
sl@0
  1564
      }
sl@0
  1565
    }
sl@0
  1566
    if( objc==3 ){
sl@0
  1567
      pArray = pScript = 0;
sl@0
  1568
    }else if( objc==4 ){
sl@0
  1569
      pArray = 0;
sl@0
  1570
      pScript = objv[3];
sl@0
  1571
    }else{
sl@0
  1572
      pArray = objv[3];
sl@0
  1573
      if( Tcl_GetString(pArray)[0]==0 ) pArray = 0;
sl@0
  1574
      pScript = objv[4];
sl@0
  1575
    }
sl@0
  1576
sl@0
  1577
    Tcl_IncrRefCount(objv[2]);
sl@0
  1578
    zSql = Tcl_GetStringFromObj(objv[2], 0);
sl@0
  1579
    while( rc==TCL_OK && zSql[0] ){
sl@0
  1580
      int i;                     /* Loop counter */
sl@0
  1581
      int nVar;                  /* Number of bind parameters in the pStmt */
sl@0
  1582
      int nCol = -1;             /* Number of columns in the result set */
sl@0
  1583
      Tcl_Obj **apColName = 0;   /* Array of column names */
sl@0
  1584
      int len;                   /* String length of zSql */
sl@0
  1585
  
sl@0
  1586
      /* Try to find a SQL statement that has already been compiled and
sl@0
  1587
      ** which matches the next sequence of SQL.
sl@0
  1588
      */
sl@0
  1589
      pStmt = 0;
sl@0
  1590
      len = strlen(zSql);
sl@0
  1591
      for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){
sl@0
  1592
        int n = pPreStmt->nSql;
sl@0
  1593
        if( len>=n 
sl@0
  1594
            && memcmp(pPreStmt->zSql, zSql, n)==0
sl@0
  1595
            && (zSql[n]==0 || zSql[n-1]==';')
sl@0
  1596
        ){
sl@0
  1597
          pStmt = pPreStmt->pStmt;
sl@0
  1598
          zLeft = &zSql[pPreStmt->nSql];
sl@0
  1599
sl@0
  1600
          /* When a prepared statement is found, unlink it from the
sl@0
  1601
          ** cache list.  It will later be added back to the beginning
sl@0
  1602
          ** of the cache list in order to implement LRU replacement.
sl@0
  1603
          */
sl@0
  1604
          if( pPreStmt->pPrev ){
sl@0
  1605
            pPreStmt->pPrev->pNext = pPreStmt->pNext;
sl@0
  1606
          }else{
sl@0
  1607
            pDb->stmtList = pPreStmt->pNext;
sl@0
  1608
          }
sl@0
  1609
          if( pPreStmt->pNext ){
sl@0
  1610
            pPreStmt->pNext->pPrev = pPreStmt->pPrev;
sl@0
  1611
          }else{
sl@0
  1612
            pDb->stmtLast = pPreStmt->pPrev;
sl@0
  1613
          }
sl@0
  1614
          pDb->nStmt--;
sl@0
  1615
          break;
sl@0
  1616
        }
sl@0
  1617
      }
sl@0
  1618
  
sl@0
  1619
      /* If no prepared statement was found.  Compile the SQL text
sl@0
  1620
      */
sl@0
  1621
      if( pStmt==0 ){
sl@0
  1622
        if( SQLITE_OK!=sqlite3_prepare_v2(pDb->db, zSql, -1, &pStmt, &zLeft) ){
sl@0
  1623
          Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
sl@0
  1624
          rc = TCL_ERROR;
sl@0
  1625
          break;
sl@0
  1626
        }
sl@0
  1627
        if( pStmt==0 ){
sl@0
  1628
          if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){
sl@0
  1629
            /* A compile-time error in the statement
sl@0
  1630
            */
sl@0
  1631
            Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
sl@0
  1632
            rc = TCL_ERROR;
sl@0
  1633
            break;
sl@0
  1634
          }else{
sl@0
  1635
            /* The statement was a no-op.  Continue to the next statement
sl@0
  1636
            ** in the SQL string.
sl@0
  1637
            */
sl@0
  1638
            zSql = zLeft;
sl@0
  1639
            continue;
sl@0
  1640
          }
sl@0
  1641
        }
sl@0
  1642
        assert( pPreStmt==0 );
sl@0
  1643
      }
sl@0
  1644
sl@0
  1645
      /* Bind values to parameters that begin with $ or :
sl@0
  1646
      */  
sl@0
  1647
      nVar = sqlite3_bind_parameter_count(pStmt);
sl@0
  1648
      nParm = 0;
sl@0
  1649
      if( nVar>sizeof(aParm)/sizeof(aParm[0]) ){
sl@0
  1650
        apParm = (Tcl_Obj**)Tcl_Alloc(nVar*sizeof(apParm[0]));
sl@0
  1651
      }else{
sl@0
  1652
        apParm = aParm;
sl@0
  1653
      }
sl@0
  1654
      for(i=1; i<=nVar; i++){
sl@0
  1655
        const char *zVar = sqlite3_bind_parameter_name(pStmt, i);
sl@0
  1656
        if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){
sl@0
  1657
          Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0);
sl@0
  1658
          if( pVar ){
sl@0
  1659
            int n;
sl@0
  1660
            u8 *data;
sl@0
  1661
            char *zType = pVar->typePtr ? pVar->typePtr->name : "";
sl@0
  1662
            char c = zType[0];
sl@0
  1663
            if( zVar[0]=='@' ||
sl@0
  1664
               (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){
sl@0
  1665
              /* Load a BLOB type if the Tcl variable is a bytearray and
sl@0
  1666
              ** it has no string representation or the host
sl@0
  1667
              ** parameter name begins with "@". */
sl@0
  1668
              data = Tcl_GetByteArrayFromObj(pVar, &n);
sl@0
  1669
              sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC);
sl@0
  1670
              Tcl_IncrRefCount(pVar);
sl@0
  1671
              apParm[nParm++] = pVar;
sl@0
  1672
            }else if( c=='b' && strcmp(zType,"boolean")==0 ){
sl@0
  1673
              Tcl_GetIntFromObj(interp, pVar, &n);
sl@0
  1674
              sqlite3_bind_int(pStmt, i, n);
sl@0
  1675
            }else if( c=='d' && strcmp(zType,"double")==0 ){
sl@0
  1676
              double r;
sl@0
  1677
              Tcl_GetDoubleFromObj(interp, pVar, &r);
sl@0
  1678
              sqlite3_bind_double(pStmt, i, r);
sl@0
  1679
            }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
sl@0
  1680
                  (c=='i' && strcmp(zType,"int")==0) ){
sl@0
  1681
              Tcl_WideInt v;
sl@0
  1682
              Tcl_GetWideIntFromObj(interp, pVar, &v);
sl@0
  1683
              sqlite3_bind_int64(pStmt, i, v);
sl@0
  1684
            }else{
sl@0
  1685
              data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
sl@0
  1686
              sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC);
sl@0
  1687
              Tcl_IncrRefCount(pVar);
sl@0
  1688
              apParm[nParm++] = pVar;
sl@0
  1689
            }
sl@0
  1690
          }else{
sl@0
  1691
            sqlite3_bind_null( pStmt, i );
sl@0
  1692
          }
sl@0
  1693
        }
sl@0
  1694
      }
sl@0
  1695
sl@0
  1696
      /* Execute the SQL
sl@0
  1697
      */
sl@0
  1698
      while( rc==TCL_OK && pStmt && SQLITE_ROW==sqlite3_step(pStmt) ){
sl@0
  1699
sl@0
  1700
	/* Compute column names. This must be done after the first successful
sl@0
  1701
	** call to sqlite3_step(), in case the query is recompiled and the
sl@0
  1702
        ** number or names of the returned columns changes. 
sl@0
  1703
        */
sl@0
  1704
        assert(!pArray||pScript);
sl@0
  1705
        if (nCol < 0) {
sl@0
  1706
          Tcl_Obj ***ap = (pScript?&apColName:0);
sl@0
  1707
          nCol = computeColumnNames(interp, pStmt, ap, pArray);
sl@0
  1708
        }
sl@0
  1709
sl@0
  1710
        for(i=0; i<nCol; i++){
sl@0
  1711
          Tcl_Obj *pVal;
sl@0
  1712
          
sl@0
  1713
          /* Set pVal to contain the i'th column of this row. */
sl@0
  1714
          switch( sqlite3_column_type(pStmt, i) ){
sl@0
  1715
            case SQLITE_BLOB: {
sl@0
  1716
              int bytes = sqlite3_column_bytes(pStmt, i);
sl@0
  1717
              const char *zBlob = sqlite3_column_blob(pStmt, i);
sl@0
  1718
              if( !zBlob ) bytes = 0;
sl@0
  1719
              pVal = Tcl_NewByteArrayObj((u8*)zBlob, bytes);
sl@0
  1720
              break;
sl@0
  1721
            }
sl@0
  1722
            case SQLITE_INTEGER: {
sl@0
  1723
              sqlite_int64 v = sqlite3_column_int64(pStmt, i);
sl@0
  1724
              if( v>=-2147483647 && v<=2147483647 ){
sl@0
  1725
                pVal = Tcl_NewIntObj(v);
sl@0
  1726
              }else{
sl@0
  1727
                pVal = Tcl_NewWideIntObj(v);
sl@0
  1728
              }
sl@0
  1729
              break;
sl@0
  1730
            }
sl@0
  1731
            case SQLITE_FLOAT: {
sl@0
  1732
              double r = sqlite3_column_double(pStmt, i);
sl@0
  1733
              pVal = Tcl_NewDoubleObj(r);
sl@0
  1734
              break;
sl@0
  1735
            }
sl@0
  1736
            case SQLITE_NULL: {
sl@0
  1737
              pVal = dbTextToObj(pDb->zNull);
sl@0
  1738
              break;
sl@0
  1739
            }
sl@0
  1740
            default: {
sl@0
  1741
              pVal = dbTextToObj((char *)sqlite3_column_text(pStmt, i));
sl@0
  1742
              break;
sl@0
  1743
            }
sl@0
  1744
          }
sl@0
  1745
  
sl@0
  1746
          if( pScript ){
sl@0
  1747
            if( pArray==0 ){
sl@0
  1748
              Tcl_ObjSetVar2(interp, apColName[i], 0, pVal, 0);
sl@0
  1749
            }else{
sl@0
  1750
              Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0);
sl@0
  1751
            }
sl@0
  1752
          }else if( choice==DB_ONECOLUMN ){
sl@0
  1753
            assert( pRet==0 );
sl@0
  1754
            if( pRet==0 ){
sl@0
  1755
              pRet = pVal;
sl@0
  1756
              Tcl_IncrRefCount(pRet);
sl@0
  1757
            }
sl@0
  1758
            rc = TCL_BREAK;
sl@0
  1759
            i = nCol;
sl@0
  1760
          }else if( choice==DB_EXISTS ){
sl@0
  1761
            Tcl_DecrRefCount(pRet);
sl@0
  1762
            pRet = Tcl_NewBooleanObj(1);
sl@0
  1763
            Tcl_IncrRefCount(pRet);
sl@0
  1764
            rc = TCL_BREAK;
sl@0
  1765
            i = nCol;
sl@0
  1766
          }else{
sl@0
  1767
            Tcl_ListObjAppendElement(interp, pRet, pVal);
sl@0
  1768
          }
sl@0
  1769
        }
sl@0
  1770
  
sl@0
  1771
        if( pScript ){
sl@0
  1772
          rc = Tcl_EvalObjEx(interp, pScript, 0);
sl@0
  1773
          if( rc==TCL_CONTINUE ){
sl@0
  1774
            rc = TCL_OK;
sl@0
  1775
          }
sl@0
  1776
        }
sl@0
  1777
      }
sl@0
  1778
      if( rc==TCL_BREAK ){
sl@0
  1779
        rc = TCL_OK;
sl@0
  1780
      }
sl@0
  1781
sl@0
  1782
      /* Free the column name objects */
sl@0
  1783
      if( pScript ){
sl@0
  1784
        /* If the query returned no rows, but an array variable was 
sl@0
  1785
        ** specified, call computeColumnNames() now to populate the 
sl@0
  1786
        ** arrayname(*) variable.
sl@0
  1787
        */
sl@0
  1788
        if (pArray && nCol < 0) {
sl@0
  1789
          Tcl_Obj ***ap = (pScript?&apColName:0);
sl@0
  1790
          nCol = computeColumnNames(interp, pStmt, ap, pArray);
sl@0
  1791
        }
sl@0
  1792
        for(i=0; i<nCol; i++){
sl@0
  1793
          Tcl_DecrRefCount(apColName[i]);
sl@0
  1794
        }
sl@0
  1795
        Tcl_Free((char*)apColName);
sl@0
  1796
      }
sl@0
  1797
sl@0
  1798
      /* Free the bound string and blob parameters */
sl@0
  1799
      for(i=0; i<nParm; i++){
sl@0
  1800
        Tcl_DecrRefCount(apParm[i]);
sl@0
  1801
      }
sl@0
  1802
      if( apParm!=aParm ){
sl@0
  1803
        Tcl_Free((char*)apParm);
sl@0
  1804
      }
sl@0
  1805
sl@0
  1806
      /* Reset the statement.  If the result code is SQLITE_SCHEMA, then
sl@0
  1807
      ** flush the statement cache and try the statement again.
sl@0
  1808
      */
sl@0
  1809
      rc2 = sqlite3_reset(pStmt);
sl@0
  1810
      if( SQLITE_OK!=rc2 ){
sl@0
  1811
        /* If a run-time error occurs, report the error and stop reading
sl@0
  1812
        ** the SQL
sl@0
  1813
        */
sl@0
  1814
        Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
sl@0
  1815
        sqlite3_finalize(pStmt);
sl@0
  1816
        rc = TCL_ERROR;
sl@0
  1817
        if( pPreStmt ) Tcl_Free((char*)pPreStmt);
sl@0
  1818
        break;
sl@0
  1819
      }else if( pDb->maxStmt<=0 ){
sl@0
  1820
        /* If the cache is turned off, deallocated the statement */
sl@0
  1821
        if( pPreStmt ) Tcl_Free((char*)pPreStmt);
sl@0
  1822
        sqlite3_finalize(pStmt);
sl@0
  1823
      }else{
sl@0
  1824
        /* Everything worked and the cache is operational.
sl@0
  1825
        ** Create a new SqlPreparedStmt structure if we need one.
sl@0
  1826
        ** (If we already have one we can just reuse it.)
sl@0
  1827
        */
sl@0
  1828
        if( pPreStmt==0 ){
sl@0
  1829
          len = zLeft - zSql;
sl@0
  1830
          pPreStmt = (SqlPreparedStmt*)Tcl_Alloc( sizeof(*pPreStmt) );
sl@0
  1831
          if( pPreStmt==0 ) return TCL_ERROR;
sl@0
  1832
          pPreStmt->pStmt = pStmt;
sl@0
  1833
          pPreStmt->nSql = len;
sl@0
  1834
          pPreStmt->zSql = sqlite3_sql(pStmt);
sl@0
  1835
          assert( strlen(pPreStmt->zSql)==len );
sl@0
  1836
          assert( 0==memcmp(pPreStmt->zSql, zSql, len) );
sl@0
  1837
        }
sl@0
  1838
sl@0
  1839
        /* Add the prepared statement to the beginning of the cache list
sl@0
  1840
        */
sl@0
  1841
        pPreStmt->pNext = pDb->stmtList;
sl@0
  1842
        pPreStmt->pPrev = 0;
sl@0
  1843
        if( pDb->stmtList ){
sl@0
  1844
         pDb->stmtList->pPrev = pPreStmt;
sl@0
  1845
        }
sl@0
  1846
        pDb->stmtList = pPreStmt;
sl@0
  1847
        if( pDb->stmtLast==0 ){
sl@0
  1848
          assert( pDb->nStmt==0 );
sl@0
  1849
          pDb->stmtLast = pPreStmt;
sl@0
  1850
        }else{
sl@0
  1851
          assert( pDb->nStmt>0 );
sl@0
  1852
        }
sl@0
  1853
        pDb->nStmt++;
sl@0
  1854
   
sl@0
  1855
        /* If we have too many statement in cache, remove the surplus from the
sl@0
  1856
        ** end of the cache list.
sl@0
  1857
        */
sl@0
  1858
        while( pDb->nStmt>pDb->maxStmt ){
sl@0
  1859
          sqlite3_finalize(pDb->stmtLast->pStmt);
sl@0
  1860
          pDb->stmtLast = pDb->stmtLast->pPrev;
sl@0
  1861
          Tcl_Free((char*)pDb->stmtLast->pNext);
sl@0
  1862
          pDb->stmtLast->pNext = 0;
sl@0
  1863
          pDb->nStmt--;
sl@0
  1864
        }
sl@0
  1865
      }
sl@0
  1866
sl@0
  1867
      /* Proceed to the next statement */
sl@0
  1868
      zSql = zLeft;
sl@0
  1869
    }
sl@0
  1870
    Tcl_DecrRefCount(objv[2]);
sl@0
  1871
sl@0
  1872
    if( pRet ){
sl@0
  1873
      if( rc==TCL_OK ){
sl@0
  1874
        Tcl_SetObjResult(interp, pRet);
sl@0
  1875
      }
sl@0
  1876
      Tcl_DecrRefCount(pRet);
sl@0
  1877
    }else if( rc==TCL_OK ){
sl@0
  1878
      Tcl_ResetResult(interp);
sl@0
  1879
    }
sl@0
  1880
    break;
sl@0
  1881
  }
sl@0
  1882
sl@0
  1883
  /*
sl@0
  1884
  **     $db function NAME [-argcount N] SCRIPT
sl@0
  1885
  **
sl@0
  1886
  ** Create a new SQL function called NAME.  Whenever that function is
sl@0
  1887
  ** called, invoke SCRIPT to evaluate the function.
sl@0
  1888
  */
sl@0
  1889
  case DB_FUNCTION: {
sl@0
  1890
    SqlFunc *pFunc;
sl@0
  1891
    Tcl_Obj *pScript;
sl@0
  1892
    char *zName;
sl@0
  1893
    int nArg = -1;
sl@0
  1894
    if( objc==6 ){
sl@0
  1895
      const char *z = Tcl_GetString(objv[3]);
sl@0
  1896
      int n = strlen(z);
sl@0
  1897
      if( n>2 && strncmp(z, "-argcount",n)==0 ){
sl@0
  1898
        if( Tcl_GetIntFromObj(interp, objv[4], &nArg) ) return TCL_ERROR;
sl@0
  1899
        if( nArg<0 ){
sl@0
  1900
          Tcl_AppendResult(interp, "number of arguments must be non-negative",
sl@0
  1901
                           (char*)0);
sl@0
  1902
          return TCL_ERROR;
sl@0
  1903
        }
sl@0
  1904
      }
sl@0
  1905
      pScript = objv[5];
sl@0
  1906
    }else if( objc!=4 ){
sl@0
  1907
      Tcl_WrongNumArgs(interp, 2, objv, "NAME [-argcount N] SCRIPT");
sl@0
  1908
      return TCL_ERROR;
sl@0
  1909
    }else{
sl@0
  1910
      pScript = objv[3];
sl@0
  1911
    }
sl@0
  1912
    zName = Tcl_GetStringFromObj(objv[2], 0);
sl@0
  1913
    pFunc = findSqlFunc(pDb, zName);
sl@0
  1914
    if( pFunc==0 ) return TCL_ERROR;
sl@0
  1915
    if( pFunc->pScript ){
sl@0
  1916
      Tcl_DecrRefCount(pFunc->pScript);
sl@0
  1917
    }
sl@0
  1918
    pFunc->pScript = pScript;
sl@0
  1919
    Tcl_IncrRefCount(pScript);
sl@0
  1920
    pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
sl@0
  1921
    rc = sqlite3_create_function(pDb->db, zName, nArg, SQLITE_UTF8,
sl@0
  1922
        pFunc, tclSqlFunc, 0, 0);
sl@0
  1923
    if( rc!=SQLITE_OK ){
sl@0
  1924
      rc = TCL_ERROR;
sl@0
  1925
      Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
sl@0
  1926
    }
sl@0
  1927
    break;
sl@0
  1928
  }
sl@0
  1929
sl@0
  1930
  /*
sl@0
  1931
  **     $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID
sl@0
  1932
  */
sl@0
  1933
  case DB_INCRBLOB: {
sl@0
  1934
#ifdef SQLITE_OMIT_INCRBLOB
sl@0
  1935
    Tcl_AppendResult(interp, "incrblob not available in this build", 0);
sl@0
  1936
    return TCL_ERROR;
sl@0
  1937
#else
sl@0
  1938
    int isReadonly = 0;
sl@0
  1939
    const char *zDb = "main";
sl@0
  1940
    const char *zTable;
sl@0
  1941
    const char *zColumn;
sl@0
  1942
    sqlite_int64 iRow;
sl@0
  1943
sl@0
  1944
    /* Check for the -readonly option */
sl@0
  1945
    if( objc>3 && strcmp(Tcl_GetString(objv[2]), "-readonly")==0 ){
sl@0
  1946
      isReadonly = 1;
sl@0
  1947
    }
sl@0
  1948
sl@0
  1949
    if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){
sl@0
  1950
      Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID");
sl@0
  1951
      return TCL_ERROR;
sl@0
  1952
    }
sl@0
  1953
sl@0
  1954
    if( objc==(6+isReadonly) ){
sl@0
  1955
      zDb = Tcl_GetString(objv[2]);
sl@0
  1956
    }
sl@0
  1957
    zTable = Tcl_GetString(objv[objc-3]);
sl@0
  1958
    zColumn = Tcl_GetString(objv[objc-2]);
sl@0
  1959
    rc = Tcl_GetWideIntFromObj(interp, objv[objc-1], &iRow);
sl@0
  1960
sl@0
  1961
    if( rc==TCL_OK ){
sl@0
  1962
      rc = createIncrblobChannel(
sl@0
  1963
          interp, pDb, zDb, zTable, zColumn, iRow, isReadonly
sl@0
  1964
      );
sl@0
  1965
    }
sl@0
  1966
#endif
sl@0
  1967
    break;
sl@0
  1968
  }
sl@0
  1969
sl@0
  1970
  /*
sl@0
  1971
  **     $db interrupt
sl@0
  1972
  **
sl@0
  1973
  ** Interrupt the execution of the inner-most SQL interpreter.  This
sl@0
  1974
  ** causes the SQL statement to return an error of SQLITE_INTERRUPT.
sl@0
  1975
  */
sl@0
  1976
  case DB_INTERRUPT: {
sl@0
  1977
    sqlite3_interrupt(pDb->db);
sl@0
  1978
    break;
sl@0
  1979
  }
sl@0
  1980
sl@0
  1981
  /*
sl@0
  1982
  **     $db nullvalue ?STRING?
sl@0
  1983
  **
sl@0
  1984
  ** Change text used when a NULL comes back from the database. If ?STRING?
sl@0
  1985
  ** is not present, then the current string used for NULL is returned.
sl@0
  1986
  ** If STRING is present, then STRING is returned.
sl@0
  1987
  **
sl@0
  1988
  */
sl@0
  1989
  case DB_NULLVALUE: {
sl@0
  1990
    if( objc!=2 && objc!=3 ){
sl@0
  1991
      Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE");
sl@0
  1992
      return TCL_ERROR;
sl@0
  1993
    }
sl@0
  1994
    if( objc==3 ){
sl@0
  1995
      int len;
sl@0
  1996
      char *zNull = Tcl_GetStringFromObj(objv[2], &len);
sl@0
  1997
      if( pDb->zNull ){
sl@0
  1998
        Tcl_Free(pDb->zNull);
sl@0
  1999
      }
sl@0
  2000
      if( zNull && len>0 ){
sl@0
  2001
        pDb->zNull = Tcl_Alloc( len + 1 );
sl@0
  2002
        strncpy(pDb->zNull, zNull, len);
sl@0
  2003
        pDb->zNull[len] = '\0';
sl@0
  2004
      }else{
sl@0
  2005
        pDb->zNull = 0;
sl@0
  2006
      }
sl@0
  2007
    }
sl@0
  2008
    Tcl_SetObjResult(interp, dbTextToObj(pDb->zNull));
sl@0
  2009
    break;
sl@0
  2010
  }
sl@0
  2011
sl@0
  2012
  /*
sl@0
  2013
  **     $db last_insert_rowid 
sl@0
  2014
  **
sl@0
  2015
  ** Return an integer which is the ROWID for the most recent insert.
sl@0
  2016
  */
sl@0
  2017
  case DB_LAST_INSERT_ROWID: {
sl@0
  2018
    Tcl_Obj *pResult;
sl@0
  2019
    Tcl_WideInt rowid;
sl@0
  2020
    if( objc!=2 ){
sl@0
  2021
      Tcl_WrongNumArgs(interp, 2, objv, "");
sl@0
  2022
      return TCL_ERROR;
sl@0
  2023
    }
sl@0
  2024
    rowid = sqlite3_last_insert_rowid(pDb->db);
sl@0
  2025
    pResult = Tcl_GetObjResult(interp);
sl@0
  2026
    Tcl_SetWideIntObj(pResult, rowid);
sl@0
  2027
    break;
sl@0
  2028
  }
sl@0
  2029
sl@0
  2030
  /*
sl@0
  2031
  ** The DB_ONECOLUMN method is implemented together with DB_EVAL.
sl@0
  2032
  */
sl@0
  2033
sl@0
  2034
  /*    $db progress ?N CALLBACK?
sl@0
  2035
  ** 
sl@0
  2036
  ** Invoke the given callback every N virtual machine opcodes while executing
sl@0
  2037
  ** queries.
sl@0
  2038
  */
sl@0
  2039
  case DB_PROGRESS: {
sl@0
  2040
    if( objc==2 ){
sl@0
  2041
      if( pDb->zProgress ){
sl@0
  2042
        Tcl_AppendResult(interp, pDb->zProgress, 0);
sl@0
  2043
      }
sl@0
  2044
    }else if( objc==4 ){
sl@0
  2045
      char *zProgress;
sl@0
  2046
      int len;
sl@0
  2047
      int N;
sl@0
  2048
      if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
sl@0
  2049
        return TCL_ERROR;
sl@0
  2050
      };
sl@0
  2051
      if( pDb->zProgress ){
sl@0
  2052
        Tcl_Free(pDb->zProgress);
sl@0
  2053
      }
sl@0
  2054
      zProgress = Tcl_GetStringFromObj(objv[3], &len);
sl@0
  2055
      if( zProgress && len>0 ){
sl@0
  2056
        pDb->zProgress = Tcl_Alloc( len + 1 );
sl@0
  2057
        memcpy(pDb->zProgress, zProgress, len+1);
sl@0
  2058
      }else{
sl@0
  2059
        pDb->zProgress = 0;
sl@0
  2060
      }
sl@0
  2061
#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
sl@0
  2062
      if( pDb->zProgress ){
sl@0
  2063
        pDb->interp = interp;
sl@0
  2064
        sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
sl@0
  2065
      }else{
sl@0
  2066
        sqlite3_progress_handler(pDb->db, 0, 0, 0);
sl@0
  2067
      }
sl@0
  2068
#endif
sl@0
  2069
    }else{
sl@0
  2070
      Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
sl@0
  2071
      return TCL_ERROR;
sl@0
  2072
    }
sl@0
  2073
    break;
sl@0
  2074
  }
sl@0
  2075
sl@0
  2076
  /*    $db profile ?CALLBACK?
sl@0
  2077
  **
sl@0
  2078
  ** Make arrangements to invoke the CALLBACK routine after each SQL statement
sl@0
  2079
  ** that has run.  The text of the SQL and the amount of elapse time are
sl@0
  2080
  ** appended to CALLBACK before the script is run.
sl@0
  2081
  */
sl@0
  2082
  case DB_PROFILE: {
sl@0
  2083
    if( objc>3 ){
sl@0
  2084
      Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
sl@0
  2085
      return TCL_ERROR;
sl@0
  2086
    }else if( objc==2 ){
sl@0
  2087
      if( pDb->zProfile ){
sl@0
  2088
        Tcl_AppendResult(interp, pDb->zProfile, 0);
sl@0
  2089
      }
sl@0
  2090
    }else{
sl@0
  2091
      char *zProfile;
sl@0
  2092
      int len;
sl@0
  2093
      if( pDb->zProfile ){
sl@0
  2094
        Tcl_Free(pDb->zProfile);
sl@0
  2095
      }
sl@0
  2096
      zProfile = Tcl_GetStringFromObj(objv[2], &len);
sl@0
  2097
      if( zProfile && len>0 ){
sl@0
  2098
        pDb->zProfile = Tcl_Alloc( len + 1 );
sl@0
  2099
        memcpy(pDb->zProfile, zProfile, len+1);
sl@0
  2100
      }else{
sl@0
  2101
        pDb->zProfile = 0;
sl@0
  2102
      }
sl@0
  2103
#ifndef SQLITE_OMIT_TRACE
sl@0
  2104
      if( pDb->zProfile ){
sl@0
  2105
        pDb->interp = interp;
sl@0
  2106
        sqlite3_profile(pDb->db, DbProfileHandler, pDb);
sl@0
  2107
      }else{
sl@0
  2108
        sqlite3_profile(pDb->db, 0, 0);
sl@0
  2109
      }
sl@0
  2110
#endif
sl@0
  2111
    }
sl@0
  2112
    break;
sl@0
  2113
  }
sl@0
  2114
sl@0
  2115
  /*
sl@0
  2116
  **     $db rekey KEY
sl@0
  2117
  **
sl@0
  2118
  ** Change the encryption key on the currently open database.
sl@0
  2119
  */
sl@0
  2120
  case DB_REKEY: {
sl@0
  2121
    int nKey;
sl@0
  2122
    void *pKey;
sl@0
  2123
    if( objc!=3 ){
sl@0
  2124
      Tcl_WrongNumArgs(interp, 2, objv, "KEY");
sl@0
  2125
      return TCL_ERROR;
sl@0
  2126
    }
sl@0
  2127
    pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey);
sl@0
  2128
#ifdef SQLITE_HAS_CODEC
sl@0
  2129
    rc = sqlite3_rekey(pDb->db, pKey, nKey);
sl@0
  2130
    if( rc ){
sl@0
  2131
      Tcl_AppendResult(interp, sqlite3ErrStr(rc), 0);
sl@0
  2132
      rc = TCL_ERROR;
sl@0
  2133
    }
sl@0
  2134
#endif
sl@0
  2135
    break;
sl@0
  2136
  }
sl@0
  2137
sl@0
  2138
  /*
sl@0
  2139
  **     $db timeout MILLESECONDS
sl@0
  2140
  **
sl@0
  2141
  ** Delay for the number of milliseconds specified when a file is locked.
sl@0
  2142
  */
sl@0
  2143
  case DB_TIMEOUT: {
sl@0
  2144
    int ms;
sl@0
  2145
    if( objc!=3 ){
sl@0
  2146
      Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
sl@0
  2147
      return TCL_ERROR;
sl@0
  2148
    }
sl@0
  2149
    if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
sl@0
  2150
    sqlite3_busy_timeout(pDb->db, ms);
sl@0
  2151
    break;
sl@0
  2152
  }
sl@0
  2153
  
sl@0
  2154
  /*
sl@0
  2155
  **     $db total_changes
sl@0
  2156
  **
sl@0
  2157
  ** Return the number of rows that were modified, inserted, or deleted 
sl@0
  2158
  ** since the database handle was created.
sl@0
  2159
  */
sl@0
  2160
  case DB_TOTAL_CHANGES: {
sl@0
  2161
    Tcl_Obj *pResult;
sl@0
  2162
    if( objc!=2 ){
sl@0
  2163
      Tcl_WrongNumArgs(interp, 2, objv, "");
sl@0
  2164
      return TCL_ERROR;
sl@0
  2165
    }
sl@0
  2166
    pResult = Tcl_GetObjResult(interp);
sl@0
  2167
    Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db));
sl@0
  2168
    break;
sl@0
  2169
  }
sl@0
  2170
sl@0
  2171
  /*    $db trace ?CALLBACK?
sl@0
  2172
  **
sl@0
  2173
  ** Make arrangements to invoke the CALLBACK routine for each SQL statement
sl@0
  2174
  ** that is executed.  The text of the SQL is appended to CALLBACK before
sl@0
  2175
  ** it is executed.
sl@0
  2176
  */
sl@0
  2177
  case DB_TRACE: {
sl@0
  2178
    if( objc>3 ){
sl@0
  2179
      Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
sl@0
  2180
      return TCL_ERROR;
sl@0
  2181
    }else if( objc==2 ){
sl@0
  2182
      if( pDb->zTrace ){
sl@0
  2183
        Tcl_AppendResult(interp, pDb->zTrace, 0);
sl@0
  2184
      }
sl@0
  2185
    }else{
sl@0
  2186
      char *zTrace;
sl@0
  2187
      int len;
sl@0
  2188
      if( pDb->zTrace ){
sl@0
  2189
        Tcl_Free(pDb->zTrace);
sl@0
  2190
      }
sl@0
  2191
      zTrace = Tcl_GetStringFromObj(objv[2], &len);
sl@0
  2192
      if( zTrace && len>0 ){
sl@0
  2193
        pDb->zTrace = Tcl_Alloc( len + 1 );
sl@0
  2194
        memcpy(pDb->zTrace, zTrace, len+1);
sl@0
  2195
      }else{
sl@0
  2196
        pDb->zTrace = 0;
sl@0
  2197
      }
sl@0
  2198
#ifndef SQLITE_OMIT_TRACE
sl@0
  2199
      if( pDb->zTrace ){
sl@0
  2200
        pDb->interp = interp;
sl@0
  2201
        sqlite3_trace(pDb->db, DbTraceHandler, pDb);
sl@0
  2202
      }else{
sl@0
  2203
        sqlite3_trace(pDb->db, 0, 0);
sl@0
  2204
      }
sl@0
  2205
#endif
sl@0
  2206
    }
sl@0
  2207
    break;
sl@0
  2208
  }
sl@0
  2209
sl@0
  2210
  /*    $db transaction [-deferred|-immediate|-exclusive] SCRIPT
sl@0
  2211
  **
sl@0
  2212
  ** Start a new transaction (if we are not already in the midst of a
sl@0
  2213
  ** transaction) and execute the TCL script SCRIPT.  After SCRIPT
sl@0
  2214
  ** completes, either commit the transaction or roll it back if SCRIPT
sl@0
  2215
  ** throws an exception.  Or if no new transation was started, do nothing.
sl@0
  2216
  ** pass the exception on up the stack.
sl@0
  2217
  **
sl@0
  2218
  ** This command was inspired by Dave Thomas's talk on Ruby at the
sl@0
  2219
  ** 2005 O'Reilly Open Source Convention (OSCON).
sl@0
  2220
  */
sl@0
  2221
  case DB_TRANSACTION: {
sl@0
  2222
    int inTrans;
sl@0
  2223
    Tcl_Obj *pScript;
sl@0
  2224
    const char *zBegin = "BEGIN";
sl@0
  2225
    if( objc!=3 && objc!=4 ){
sl@0
  2226
      Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT");
sl@0
  2227
      return TCL_ERROR;
sl@0
  2228
    }
sl@0
  2229
    if( objc==3 ){
sl@0
  2230
      pScript = objv[2];
sl@0
  2231
    } else {
sl@0
  2232
      static const char *TTYPE_strs[] = {
sl@0
  2233
        "deferred",   "exclusive",  "immediate", 0
sl@0
  2234
      };
sl@0
  2235
      enum TTYPE_enum {
sl@0
  2236
        TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
sl@0
  2237
      };
sl@0
  2238
      int ttype;
sl@0
  2239
      if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type",
sl@0
  2240
                              0, &ttype) ){
sl@0
  2241
        return TCL_ERROR;
sl@0
  2242
      }
sl@0
  2243
      switch( (enum TTYPE_enum)ttype ){
sl@0
  2244
        case TTYPE_DEFERRED:    /* no-op */;                 break;
sl@0
  2245
        case TTYPE_EXCLUSIVE:   zBegin = "BEGIN EXCLUSIVE";  break;
sl@0
  2246
        case TTYPE_IMMEDIATE:   zBegin = "BEGIN IMMEDIATE";  break;
sl@0
  2247
      }
sl@0
  2248
      pScript = objv[3];
sl@0
  2249
    }
sl@0
  2250
    inTrans = !sqlite3_get_autocommit(pDb->db);
sl@0
  2251
    if( !inTrans ){
sl@0
  2252
      pDb->disableAuth++;
sl@0
  2253
      (void)sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
sl@0
  2254
      pDb->disableAuth--;
sl@0
  2255
    }
sl@0
  2256
    rc = Tcl_EvalObjEx(interp, pScript, 0);
sl@0
  2257
    if( !inTrans ){
sl@0
  2258
      const char *zEnd;
sl@0
  2259
      if( rc==TCL_ERROR ){
sl@0
  2260
        zEnd = "ROLLBACK";
sl@0
  2261
      } else {
sl@0
  2262
        zEnd = "COMMIT";
sl@0
  2263
      }
sl@0
  2264
      pDb->disableAuth++;
sl@0
  2265
      if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){
sl@0
  2266
        sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0);
sl@0
  2267
      }
sl@0
  2268
      pDb->disableAuth--;
sl@0
  2269
    }
sl@0
  2270
    break;
sl@0
  2271
  }
sl@0
  2272
sl@0
  2273
  /*
sl@0
  2274
  **    $db update_hook ?script?
sl@0
  2275
  **    $db rollback_hook ?script?
sl@0
  2276
  */
sl@0
  2277
  case DB_UPDATE_HOOK: 
sl@0
  2278
  case DB_ROLLBACK_HOOK: {
sl@0
  2279
sl@0
  2280
    /* set ppHook to point at pUpdateHook or pRollbackHook, depending on 
sl@0
  2281
    ** whether [$db update_hook] or [$db rollback_hook] was invoked.
sl@0
  2282
    */
sl@0
  2283
    Tcl_Obj **ppHook; 
sl@0
  2284
    if( choice==DB_UPDATE_HOOK ){
sl@0
  2285
      ppHook = &pDb->pUpdateHook;
sl@0
  2286
    }else{
sl@0
  2287
      ppHook = &pDb->pRollbackHook;
sl@0
  2288
    }
sl@0
  2289
sl@0
  2290
    if( objc!=2 && objc!=3 ){
sl@0
  2291
       Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
sl@0
  2292
       return TCL_ERROR;
sl@0
  2293
    }
sl@0
  2294
    if( *ppHook ){
sl@0
  2295
      Tcl_SetObjResult(interp, *ppHook);
sl@0
  2296
      if( objc==3 ){
sl@0
  2297
        Tcl_DecrRefCount(*ppHook);
sl@0
  2298
        *ppHook = 0;
sl@0
  2299
      }
sl@0
  2300
    }
sl@0
  2301
    if( objc==3 ){
sl@0
  2302
      assert( !(*ppHook) );
sl@0
  2303
      if( Tcl_GetCharLength(objv[2])>0 ){
sl@0
  2304
        *ppHook = objv[2];
sl@0
  2305
        Tcl_IncrRefCount(*ppHook);
sl@0
  2306
      }
sl@0
  2307
    }
sl@0
  2308
sl@0
  2309
    sqlite3_update_hook(pDb->db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb);
sl@0
  2310
    sqlite3_rollback_hook(pDb->db,(pDb->pRollbackHook?DbRollbackHandler:0),pDb);
sl@0
  2311
sl@0
  2312
    break;
sl@0
  2313
  }
sl@0
  2314
sl@0
  2315
  /*    $db version
sl@0
  2316
  **
sl@0
  2317
  ** Return the version string for this database.
sl@0
  2318
  */
sl@0
  2319
  case DB_VERSION: {
sl@0
  2320
    Tcl_SetResult(interp, (char *)sqlite3_libversion(), TCL_STATIC);
sl@0
  2321
    break;
sl@0
  2322
  }
sl@0
  2323
sl@0
  2324
sl@0
  2325
  } /* End of the SWITCH statement */
sl@0
  2326
  return rc;
sl@0
  2327
}
sl@0
  2328
sl@0
  2329
/*
sl@0
  2330
**   sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN?
sl@0
  2331
**                           ?-create BOOLEAN? ?-nomutex BOOLEAN?
sl@0
  2332
**
sl@0
  2333
** This is the main Tcl command.  When the "sqlite" Tcl command is
sl@0
  2334
** invoked, this routine runs to process that command.
sl@0
  2335
**
sl@0
  2336
** The first argument, DBNAME, is an arbitrary name for a new
sl@0
  2337
** database connection.  This command creates a new command named
sl@0
  2338
** DBNAME that is used to control that connection.  The database
sl@0
  2339
** connection is deleted when the DBNAME command is deleted.
sl@0
  2340
**
sl@0
  2341
** The second argument is the name of the database file.
sl@0
  2342
**
sl@0
  2343
*/
sl@0
  2344
static int DbMain(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
sl@0
  2345
  SqliteDb *p;
sl@0
  2346
  void *pKey = 0;
sl@0
  2347
  int nKey = 0;
sl@0
  2348
  const char *zArg;
sl@0
  2349
  char *zErrMsg;
sl@0
  2350
  int i;
sl@0
  2351
  const char *zFile;
sl@0
  2352
  const char *zVfs = 0;
sl@0
  2353
  int flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_NOMUTEX;
sl@0
  2354
  Tcl_DString translatedFilename;
sl@0
  2355
  if( objc==2 ){
sl@0
  2356
    zArg = Tcl_GetStringFromObj(objv[1], 0);
sl@0
  2357
    if( strcmp(zArg,"-version")==0 ){
sl@0
  2358
      Tcl_AppendResult(interp,sqlite3_version,0);
sl@0
  2359
      return TCL_OK;
sl@0
  2360
    }
sl@0
  2361
    if( strcmp(zArg,"-has-codec")==0 ){
sl@0
  2362
#ifdef SQLITE_HAS_CODEC
sl@0
  2363
      Tcl_AppendResult(interp,"1",0);
sl@0
  2364
#else
sl@0
  2365
      Tcl_AppendResult(interp,"0",0);
sl@0
  2366
#endif
sl@0
  2367
      return TCL_OK;
sl@0
  2368
    }
sl@0
  2369
  }
sl@0
  2370
  for(i=3; i+1<objc; i+=2){
sl@0
  2371
    zArg = Tcl_GetString(objv[i]);
sl@0
  2372
    if( strcmp(zArg,"-key")==0 ){
sl@0
  2373
      pKey = Tcl_GetByteArrayFromObj(objv[i+1], &nKey);
sl@0
  2374
    }else if( strcmp(zArg, "-vfs")==0 ){
sl@0
  2375
      i++;
sl@0
  2376
      zVfs = Tcl_GetString(objv[i]);
sl@0
  2377
    }else if( strcmp(zArg, "-readonly")==0 ){
sl@0
  2378
      int b;
sl@0
  2379
      if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
sl@0
  2380
      if( b ){
sl@0
  2381
        flags &= ~(SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE);
sl@0
  2382
        flags |= SQLITE_OPEN_READONLY;
sl@0
  2383
      }else{
sl@0
  2384
        flags &= ~SQLITE_OPEN_READONLY;
sl@0
  2385
        flags |= SQLITE_OPEN_READWRITE;
sl@0
  2386
      }
sl@0
  2387
    }else if( strcmp(zArg, "-create")==0 ){
sl@0
  2388
      int b;
sl@0
  2389
      if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
sl@0
  2390
      if( b && (flags & SQLITE_OPEN_READONLY)==0 ){
sl@0
  2391
        flags |= SQLITE_OPEN_CREATE;
sl@0
  2392
      }else{
sl@0
  2393
        flags &= ~SQLITE_OPEN_CREATE;
sl@0
  2394
      }
sl@0
  2395
    }else if( strcmp(zArg, "-nomutex")==0 ){
sl@0
  2396
      int b;
sl@0
  2397
      if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
sl@0
  2398
      if( b ){
sl@0
  2399
        flags |= SQLITE_OPEN_NOMUTEX;
sl@0
  2400
        flags &= ~SQLITE_OPEN_FULLMUTEX;
sl@0
  2401
      }else{
sl@0
  2402
        flags &= ~SQLITE_OPEN_NOMUTEX;
sl@0
  2403
      }
sl@0
  2404
   }else if( strcmp(zArg, "-fullmutex")==0 ){
sl@0
  2405
      int b;
sl@0
  2406
      if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
sl@0
  2407
      if( b ){
sl@0
  2408
        flags |= SQLITE_OPEN_FULLMUTEX;
sl@0
  2409
        flags &= ~SQLITE_OPEN_NOMUTEX;
sl@0
  2410
      }else{
sl@0
  2411
        flags &= ~SQLITE_OPEN_FULLMUTEX;
sl@0
  2412
      }
sl@0
  2413
    }else{
sl@0
  2414
      Tcl_AppendResult(interp, "unknown option: ", zArg, (char*)0);
sl@0
  2415
      return TCL_ERROR;
sl@0
  2416
    }
sl@0
  2417
  }
sl@0
  2418
  if( objc<3 || (objc&1)!=1 ){
sl@0
  2419
    Tcl_WrongNumArgs(interp, 1, objv, 
sl@0
  2420
      "HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?"
sl@0
  2421
      " ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN?"
sl@0
  2422
#ifdef SQLITE_HAS_CODEC
sl@0
  2423
      " ?-key CODECKEY?"
sl@0
  2424
#endif
sl@0
  2425
    );
sl@0
  2426
    return TCL_ERROR;
sl@0
  2427
  }
sl@0
  2428
  zErrMsg = 0;
sl@0
  2429
  p = (SqliteDb*)Tcl_Alloc( sizeof(*p) );
sl@0
  2430
  if( p==0 ){
sl@0
  2431
    Tcl_SetResult(interp, "malloc failed", TCL_STATIC);
sl@0
  2432
    return TCL_ERROR;
sl@0
  2433
  }
sl@0
  2434
  memset(p, 0, sizeof(*p));
sl@0
  2435
  zFile = Tcl_GetStringFromObj(objv[2], 0);
sl@0
  2436
  zFile = Tcl_TranslateFileName(interp, zFile, &translatedFilename);
sl@0
  2437
  sqlite3_open_v2(zFile, &p->db, flags, zVfs);
sl@0
  2438
  Tcl_DStringFree(&translatedFilename);
sl@0
  2439
  if( SQLITE_OK!=sqlite3_errcode(p->db) ){
sl@0
  2440
    zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db));
sl@0
  2441
    sqlite3_close(p->db);
sl@0
  2442
    p->db = 0;
sl@0
  2443
  }
sl@0
  2444
#ifdef SQLITE_HAS_CODEC
sl@0
  2445
  if( p->db ){
sl@0
  2446
    sqlite3_key(p->db, pKey, nKey);
sl@0
  2447
  }
sl@0
  2448
#endif
sl@0
  2449
  if( p->db==0 ){
sl@0
  2450
    Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
sl@0
  2451
    Tcl_Free((char*)p);
sl@0
  2452
    sqlite3_free(zErrMsg);
sl@0
  2453
    return TCL_ERROR;
sl@0
  2454
  }
sl@0
  2455
  p->maxStmt = NUM_PREPARED_STMTS;
sl@0
  2456
  p->interp = interp;
sl@0
  2457
  zArg = Tcl_GetStringFromObj(objv[1], 0);
sl@0
  2458
  Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd);
sl@0
  2459
  return TCL_OK;
sl@0
  2460
}
sl@0
  2461
sl@0
  2462
/*
sl@0
  2463
** Provide a dummy Tcl_InitStubs if we are using this as a static
sl@0
  2464
** library.
sl@0
  2465
*/
sl@0
  2466
#ifndef USE_TCL_STUBS
sl@0
  2467
# undef  Tcl_InitStubs
sl@0
  2468
# define Tcl_InitStubs(a,b,c)
sl@0
  2469
#endif
sl@0
  2470
sl@0
  2471
/*
sl@0
  2472
** Make sure we have a PACKAGE_VERSION macro defined.  This will be
sl@0
  2473
** defined automatically by the TEA makefile.  But other makefiles
sl@0
  2474
** do not define it.
sl@0
  2475
*/
sl@0
  2476
#ifndef PACKAGE_VERSION
sl@0
  2477
# define PACKAGE_VERSION SQLITE_VERSION
sl@0
  2478
#endif
sl@0
  2479
sl@0
  2480
/*
sl@0
  2481
** Initialize this module.
sl@0
  2482
**
sl@0
  2483
** This Tcl module contains only a single new Tcl command named "sqlite".
sl@0
  2484
** (Hence there is no namespace.  There is no point in using a namespace
sl@0
  2485
** if the extension only supplies one new name!)  The "sqlite" command is
sl@0
  2486
** used to open a new SQLite database.  See the DbMain() routine above
sl@0
  2487
** for additional information.
sl@0
  2488
*/
sl@0
  2489
EXTERN int Sqlite3_Init(Tcl_Interp *interp){
sl@0
  2490
  Tcl_InitStubs(interp, "8.4", 0);
sl@0
  2491
  Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0);
sl@0
  2492
  Tcl_PkgProvide(interp, "sqlite3", PACKAGE_VERSION);
sl@0
  2493
  Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0);
sl@0
  2494
  Tcl_PkgProvide(interp, "sqlite", PACKAGE_VERSION);
sl@0
  2495
  return TCL_OK;
sl@0
  2496
}
sl@0
  2497
EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
sl@0
  2498
EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
sl@0
  2499
EXTERN int Tclsqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
sl@0
  2500
EXTERN int Sqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
sl@0
  2501
EXTERN int Tclsqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
sl@0
  2502
EXTERN int Sqlite3_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK; }
sl@0
  2503
EXTERN int Tclsqlite3_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK;}
sl@0
  2504
sl@0
  2505
sl@0
  2506
#ifndef SQLITE_3_SUFFIX_ONLY
sl@0
  2507
EXTERN int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
sl@0
  2508
EXTERN int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
sl@0
  2509
EXTERN int Sqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
sl@0
  2510
EXTERN int Tclsqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
sl@0
  2511
EXTERN int Sqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
sl@0
  2512
EXTERN int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
sl@0
  2513
EXTERN int Sqlite_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK; }
sl@0
  2514
EXTERN int Tclsqlite_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK;}
sl@0
  2515
#endif
sl@0
  2516
sl@0
  2517
#ifdef TCLSH
sl@0
  2518
/*****************************************************************************
sl@0
  2519
** The code that follows is used to build standalone TCL interpreters
sl@0
  2520
** that are statically linked with SQLite.  
sl@0
  2521
*/
sl@0
  2522
sl@0
  2523
/*
sl@0
  2524
** If the macro TCLSH is one, then put in code this for the
sl@0
  2525
** "main" routine that will initialize Tcl and take input from
sl@0
  2526
** standard input, or if a file is named on the command line
sl@0
  2527
** the TCL interpreter reads and evaluates that file.
sl@0
  2528
*/
sl@0
  2529
#if TCLSH==1
sl@0
  2530
static char zMainloop[] =
sl@0
  2531
  "set line {}\n"
sl@0
  2532
  "while {![eof stdin]} {\n"
sl@0
  2533
    "if {$line!=\"\"} {\n"
sl@0
  2534
      "puts -nonewline \"> \"\n"
sl@0
  2535
    "} else {\n"
sl@0
  2536
      "puts -nonewline \"% \"\n"
sl@0
  2537
    "}\n"
sl@0
  2538
    "flush stdout\n"
sl@0
  2539
    "append line [gets stdin]\n"
sl@0
  2540
    "if {[info complete $line]} {\n"
sl@0
  2541
      "if {[catch {uplevel #0 $line} result]} {\n"
sl@0
  2542
        "puts stderr \"Error: $result\"\n"
sl@0
  2543
      "} elseif {$result!=\"\"} {\n"
sl@0
  2544
        "puts $result\n"
sl@0
  2545
      "}\n"
sl@0
  2546
      "set line {}\n"
sl@0
  2547
    "} else {\n"
sl@0
  2548
      "append line \\n\n"
sl@0
  2549
    "}\n"
sl@0
  2550
  "}\n"
sl@0
  2551
;
sl@0
  2552
#endif
sl@0
  2553
sl@0
  2554
/*
sl@0
  2555
** If the macro TCLSH is two, then get the main loop code out of
sl@0
  2556
** the separate file "spaceanal_tcl.h".
sl@0
  2557
*/
sl@0
  2558
#if TCLSH==2
sl@0
  2559
static char zMainloop[] = 
sl@0
  2560
#include "spaceanal_tcl.h"
sl@0
  2561
;
sl@0
  2562
#endif
sl@0
  2563
sl@0
  2564
#define TCLSH_MAIN main   /* Needed to fake out mktclapp */
sl@0
  2565
int TCLSH_MAIN(int argc, char **argv){
sl@0
  2566
  Tcl_Interp *interp;
sl@0
  2567
#if defined(__SYMBIAN32__)    
sl@0
  2568
  int isChildProcess = 0;  
sl@0
  2569
  int oldArgc = 0;
sl@0
  2570
  int err = 0;
sl@0
  2571
 #endif  
sl@0
  2572
  
sl@0
  2573
  PrintS("###TclSqlite3: New instance");
sl@0
  2574
  Tcl_FindExecutable(argv[0]);
sl@0
  2575
  PrintS("###TclSqlite3: Create interpreter");
sl@0
  2576
  interp = Tcl_CreateInterp();
sl@0
  2577
#if defined(__SYMBIAN32__)    
sl@0
  2578
  PrintS("###TclSqlite3: Child process init");
sl@0
  2579
  if (ChildProcessInit(&argc, &argv))
sl@0
  2580
    {
sl@0
  2581
    oldArgc = argc;
sl@0
  2582
    argc = argc-4;	
sl@0
  2583
    isChildProcess = 1;
sl@0
  2584
    }
sl@0
  2585
  else
sl@0
  2586
    {
sl@0
  2587
    err = CopyTestFiles();
sl@0
  2588
    if(err != 0)
sl@0
  2589
      {
sl@0
  2590
      PrintS("###TclSqlite3: Exit-1");
sl@0
  2591
      return 1;
sl@0
  2592
      }
sl@0
  2593
    }
sl@0
  2594
#endif    
sl@0
  2595
  PrintS("###TclSqlite3: Init");
sl@0
  2596
  Sqlite3_Init(interp);
sl@0
  2597
#ifdef SQLITE_TEST
sl@0
  2598
  {
sl@0
  2599
    extern int Md5_Init(Tcl_Interp*);
sl@0
  2600
    extern int Sqliteconfig_Init(Tcl_Interp*);
sl@0
  2601
    extern int Sqlitetest1_Init(Tcl_Interp*);
sl@0
  2602
    extern int Sqlitetest2_Init(Tcl_Interp*);
sl@0
  2603
    extern int Sqlitetest3_Init(Tcl_Interp*);
sl@0
  2604
    extern int Sqlitetest4_Init(Tcl_Interp*);
sl@0
  2605
    extern int Sqlitetest5_Init(Tcl_Interp*);
sl@0
  2606
    extern int Sqlitetest6_Init(Tcl_Interp*);
sl@0
  2607
    extern int Sqlitetest7_Init(Tcl_Interp*);
sl@0
  2608
    extern int Sqlitetest8_Init(Tcl_Interp*);
sl@0
  2609
    extern int Sqlitetest9_Init(Tcl_Interp*);
sl@0
  2610
    extern int Sqlitetestasync_Init(Tcl_Interp*);
sl@0
  2611
    extern int Sqlitetest_autoext_Init(Tcl_Interp*);
sl@0
  2612
    extern int Sqlitetest_func_Init(Tcl_Interp*);
sl@0
  2613
    extern int Sqlitetest_hexio_Init(Tcl_Interp*);
sl@0
  2614
    extern int Sqlitetest_malloc_Init(Tcl_Interp*);
sl@0
  2615
    extern int Sqlitetest_mutex_Init(Tcl_Interp*);
sl@0
  2616
    extern int Sqlitetestschema_Init(Tcl_Interp*);
sl@0
  2617
    extern int Sqlitetestsse_Init(Tcl_Interp*);
sl@0
  2618
    extern int Sqlitetesttclvar_Init(Tcl_Interp*);
sl@0
  2619
    extern int SqlitetestThread_Init(Tcl_Interp*);
sl@0
  2620
    extern int SqlitetestOnefile_Init();
sl@0
  2621
    extern int SqlitetestOsinst_Init(Tcl_Interp*);
sl@0
  2622
sl@0
  2623
    Md5_Init(interp);
sl@0
  2624
    Sqliteconfig_Init(interp);
sl@0
  2625
    Sqlitetest1_Init(interp);
sl@0
  2626
    Sqlitetest2_Init(interp);
sl@0
  2627
    Sqlitetest3_Init(interp);
sl@0
  2628
    Sqlitetest4_Init(interp);
sl@0
  2629
    Sqlitetest5_Init(interp);
sl@0
  2630
    Sqlitetest6_Init(interp);
sl@0
  2631
    Sqlitetest7_Init(interp);
sl@0
  2632
    Sqlitetest8_Init(interp);
sl@0
  2633
    Sqlitetest9_Init(interp);
sl@0
  2634
    Sqlitetestasync_Init(interp);
sl@0
  2635
    Sqlitetest_autoext_Init(interp);
sl@0
  2636
    Sqlitetest_func_Init(interp);
sl@0
  2637
    Sqlitetest_hexio_Init(interp);
sl@0
  2638
    Sqlitetest_malloc_Init(interp);
sl@0
  2639
    Sqlitetest_mutex_Init(interp);
sl@0
  2640
    Sqlitetestschema_Init(interp);
sl@0
  2641
    Sqlitetesttclvar_Init(interp);
sl@0
  2642
    SqlitetestThread_Init(interp);
sl@0
  2643
    SqlitetestOnefile_Init(interp);
sl@0
  2644
    SqlitetestOsinst_Init(interp);
sl@0
  2645
sl@0
  2646
#ifdef SQLITE_SSE
sl@0
  2647
    Sqlitetestsse_Init(interp);
sl@0
  2648
#endif
sl@0
  2649
  }
sl@0
  2650
#endif
sl@0
  2651
  if( argc>=2 || TCLSH==2 ){
sl@0
  2652
    int i;
sl@0
  2653
    char zArgc[32];
sl@0
  2654
    sqlite3_snprintf(sizeof(zArgc), zArgc, "%d", argc-(3-TCLSH));
sl@0
  2655
    Tcl_SetVar(interp,"argc", zArgc, TCL_GLOBAL_ONLY);
sl@0
  2656
    Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
sl@0
  2657
    Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
sl@0
  2658
    for(i=3-TCLSH; i<argc; i++){
sl@0
  2659
      Tcl_SetVar(interp, "argv", argv[i],
sl@0
  2660
          TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
sl@0
  2661
    }
sl@0
  2662
#ifdef __SYMBIAN32__
sl@0
  2663
    Tcl_CreateObjCommand(interp, "delete_test_files", (Tcl_ObjCmdProc*)DeleteTestFiles, 0, 0);
sl@0
  2664
    Tcl_CreateObjCommand(interp, "print_text", (Tcl_ObjCmdProc*)PrintText, 0, 0);
sl@0
  2665
#endif		
sl@0
  2666
    PrintS("###TclSqlite3: Tests begin");
sl@0
  2667
    if( TCLSH==1 && Tcl_EvalFile(interp, argv[1])!=TCL_OK ){
sl@0
  2668
      char errMsg[1024];
sl@0
  2669
      const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
sl@0
  2670
      if( zInfo==0 ) 
sl@0
  2671
    	  zInfo = interp->result;
sl@0
  2672
      sprintf(errMsg, "###TclSqlite3: Error, argv=%s, zInfo=%s", *argv, zInfo);
sl@0
  2673
      PrintS(errMsg);
sl@0
  2674
#ifdef __SYMBIAN32__
sl@0
  2675
      ChildProcessCleanup(isChildProcess, oldArgc, argv);	  
sl@0
  2676
#endif
sl@0
  2677
      PrintS("###TclSqlite3: Exit-2");
sl@0
  2678
      return 1;
sl@0
  2679
    }
sl@0
  2680
    PrintS("###TclSqlite3: Tests end");
sl@0
  2681
  }
sl@0
  2682
  if( argc<=1 || TCLSH==2 ){
sl@0
  2683
    Tcl_GlobalEval(interp, zMainloop);
sl@0
  2684
  }
sl@0
  2685
#if defined(__SYMBIAN32__)
sl@0
  2686
  ChildProcessCleanup(isChildProcess, oldArgc, argv);
sl@0
  2687
#endif
sl@0
  2688
  PrintS("###TclSqlite3: Exit-3");
sl@0
  2689
  return 0;
sl@0
  2690
}
sl@0
  2691
#endif /* TCLSH */