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