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