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