/ Check-in [f323e4f8]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix the onecolumn method in the TCL interface so that it works the same as the eval method in all ways except for returning just the first value in the result set. (CVS 1944)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:f323e4f86a08fe6448cbd4ff7cab459e8039d9f1
User & Date: drh 2004-09-07 13:20:35
Context
2004-09-07
16:19
Wildcards with the same name map into the same variable number. New api sqlite3_bind_parameter_index() added to map wildcard names into wildcard index numbers. Support for "?nnn" wildcards. (CVS 1945) check-in: 435b3f30 user: drh tags: trunk
13:20
Fix the onecolumn method in the TCL interface so that it works the same as the eval method in all ways except for returning just the first value in the result set. (CVS 1944) check-in: f323e4f8 user: drh tags: trunk
11:28
Lemon escapes backslashes in filenames in #line directives it generates. Ticket #892. (CVS 1943) check-in: d53047cb user: drh tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/tclsqlite.c.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
..
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
...
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
...
681
682
683
684
685
686
687

688
689
690
691
692
693



694

695
696
697
698
699
700
701
702
703

704
705
706



707


708
709
710



711
712
713
714
715
716
717
...
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
...
844
845
846
847
848
849
850






851
852
853
854
855
856
857
858
859
860

861
862
863
864
865
866
867
...
888
889
890
891
892
893
894

895
896
897
898

899
900
901
902
903
904
905
...
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973



















974
975
976
977
978
979
980
**    May you do good and not evil.
**    May you find forgiveness for yourself and forgive others.
**    May you share freely, never taking more than you give.
**
*************************************************************************
** A TCL Interface to SQLite
**
** $Id: tclsqlite.c,v 1.104 2004/09/06 17:24:13 drh Exp $
*/
#ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */

#include "sqliteInt.h"
#include "hash.h"
#include "tcl.h"
#include <stdlib.h>
................................................................................
  char *zAuth;          /* The authorization callback routine */
  SqlFunc *pFunc;       /* List of SQL functions */
  SqlCollate *pCollate; /* List of SQL collation functions */
  int rc;               /* Return code of most recent sqlite3_exec() */
  Tcl_Obj *pCollateNeeded;  /* Collation needed script */
};

/*
** This is a second alternative callback for database queries.  A the
** first column of the first row of the result is made the TCL result.
*/
static int DbEvalCallback3(
  void *clientData,      /* An instance of CallbackData */
  int nCol,              /* Number of columns in the result */
  char ** azCol,         /* Data for each column */
  char ** azN            /* Name for each column */
){
  Tcl_Interp *interp = (Tcl_Interp*)clientData;
  Tcl_Obj *pElem;
  if( azCol==0 ) return 1;
  if( nCol==0 ) return 1;
#ifdef UTF_TRANSLATION_NEEDED
  {
    Tcl_DString dCol;
    Tcl_DStringInit(&dCol);
    Tcl_ExternalToUtfDString(NULL, azCol[0], -1, &dCol);
    pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
    Tcl_DStringFree(&dCol);
  }
#else
  pElem = Tcl_NewStringObj(azCol[0], -1);
#endif
  Tcl_SetObjResult(interp, pElem);
  return 1;
}

/*
** TCL calls this procedure when an sqlite3 database command is
** deleted.
*/
static void DbDeleteCmd(void *db){
  SqliteDb *pDb = (SqliteDb*)db;
  sqlite3_close(pDb->db);
................................................................................
      }else{
        sqlite3_busy_handler(pDb->db, 0, 0);
      }
    }
    break;
  }

  /*    $db progress ?N CALLBACK?
  ** 
  ** Invoke the given callback every N virtual machine opcodes while executing
  ** queries.
  */
  case DB_PROGRESS: {
    if( objc==2 ){
      if( pDb->zProgress ){
        Tcl_AppendResult(interp, pDb->zProgress, 0);
      }
    }else if( objc==4 ){
      char *zProgress;
      int len;
      int N;
      if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
	return TCL_ERROR;
      };
      if( pDb->zProgress ){
        Tcl_Free(pDb->zProgress);
      }
      zProgress = Tcl_GetStringFromObj(objv[3], &len);
      if( zProgress && len>0 ){
        pDb->zProgress = Tcl_Alloc( len + 1 );
        strcpy(pDb->zProgress, zProgress);
      }else{
        pDb->zProgress = 0;
      }
#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
      if( pDb->zProgress ){
        pDb->interp = interp;
        sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
      }else{
        sqlite3_progress_handler(pDb->db, 0, 0, 0);
      }
#endif
    }else{
      Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
      return TCL_ERROR;
    }
    break;
  }

  /*     $db changes
  **
  ** Return the number of rows that were modified, inserted, or deleted by
  ** the most recent INSERT, UPDATE or DELETE statement, not including 
  ** any changes made by trigger programs.
  */
  case DB_CHANGES: {
................................................................................
  case DB_ERRORCODE: {
    Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db)));
    break;
  }
   
  /*
  **    $db eval $sql ?array? ?{  ...code... }?

  **
  ** The SQL statement in $sql is evaluated.  For each row, the values are
  ** placed in elements of the array named "array" and ...code... is executed.
  ** If "array" and "code" are omitted, then no callback is every invoked.
  ** If "array" is an empty string, then the values are placed in variables
  ** that have the same name as the fields extracted by the query.



  */

  case DB_EVAL: {
    char const *zSql;      /* Next SQL statement to execute */
    char const *zLeft;     /* What is left after first stmt in zSql */
    sqlite3_stmt *pStmt;   /* Compiled SQL statment */
    Tcl_Obj *pArray;       /* Name of array into which results are written */
    Tcl_Obj *pScript;      /* Script to run for each result set */
    Tcl_Obj **apParm;      /* Parameters that need a Tcl_DecrRefCount() */
    int nParm;             /* Number of entries used in apParm[] */
    Tcl_Obj *aParm[10];    /* Static space for apParm[] in the common case */


    Tcl_Obj *pRet = Tcl_NewObj();
    Tcl_IncrRefCount(pRet);






    if( objc<3 || objc>5 ){
      Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?");
      return TCL_ERROR;



    }
    if( objc==3 ){
      pArray = pScript = 0;
    }else if( objc==4 ){
      pArray = 0;
      pScript = objv[3];
    }else{
................................................................................
              sqlite3_bind_text(pStmt, i, data, n, SQLITE_STATIC);
              Tcl_IncrRefCount(pVar);
              apParm[nParm++] = pVar;
            }
          }
        }
      }
   

      /* Compute column names */
      nCol = sqlite3_column_count(pStmt);
      if( pScript ){
        apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol );
        if( apColName==0 ) break;
        for(i=0; i<nCol; i++){
................................................................................
  
          if( pScript ){
            if( pArray==0 ){
              Tcl_ObjSetVar2(interp, apColName[i], 0, pVal, 0);
            }else{
              Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0);
            }






          }else{
            Tcl_ListObjAppendElement(interp, pRet, pVal);
          }
        }
  
        if( pScript ){
          rc = Tcl_EvalObjEx(interp, pScript, 0);
          if( rc!=TCL_ERROR ) rc = TCL_OK;
        }
      }


      /* Free the column name objects */
      if( pScript ){
        for(i=0; i<nCol; i++){
          Tcl_DecrRefCount(apColName[i]);
        }
        Tcl_Free((char*)apColName);
................................................................................
        break;
      }

      zSql = zLeft;
    }
    Tcl_DecrRefCount(objv[2]);


    if( rc==TCL_OK ){
      Tcl_SetObjResult(interp, pRet);
    }
    Tcl_DecrRefCount(pRet);


    break;
  }

  /*
  **     $db function NAME SCRIPT
  **
................................................................................
    rowid = sqlite3_last_insert_rowid(pDb->db);
    pResult = Tcl_GetObjResult(interp);
    Tcl_SetIntObj(pResult, rowid);
    break;
  }

  /*
  **     $db onecolumn SQL
  **
  ** Return a single column from a single row of the given SQL query.
  */
  case DB_ONECOLUMN: {
    char *zSql;
    char *zErrMsg = 0;
    if( objc!=3 ){
      Tcl_WrongNumArgs(interp, 2, objv, "SQL");
      return TCL_ERROR;
    }
    zSql = Tcl_GetStringFromObj(objv[2], 0);
    rc = sqlite3_exec(pDb->db, zSql, DbEvalCallback3, interp, &zErrMsg);
    if( rc==SQLITE_ABORT ){
      rc = SQLITE_OK;
    }else if( zErrMsg ){
      Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
      free(zErrMsg);
      rc = TCL_ERROR;
    }else if( rc!=SQLITE_OK ){
      Tcl_AppendResult(interp, sqlite3ErrStr(rc), 0);
      rc = TCL_ERROR;



















    }
    break;
  }

  /*
  **     $db rekey KEY
  **







|







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>






>
>
>

>









>

<
|
>
>
>
|
>
>
|
|
|
>
>
>







 







<







 







>
>
>
>
>
>










>







 







>
|
|
|
|
>







 







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
..
69
70
71
72
73
74
75





























76
77
78
79
80
81
82
...
463
464
465
466
467
468
469










































470
471
472
473
474
475
476
...
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639

640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
...
722
723
724
725
726
727
728

729
730
731
732
733
734
735
...
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
...
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
...
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
**    May you do good and not evil.
**    May you find forgiveness for yourself and forgive others.
**    May you share freely, never taking more than you give.
**
*************************************************************************
** A TCL Interface to SQLite
**
** $Id: tclsqlite.c,v 1.105 2004/09/07 13:20:35 drh Exp $
*/
#ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */

#include "sqliteInt.h"
#include "hash.h"
#include "tcl.h"
#include <stdlib.h>
................................................................................
  char *zAuth;          /* The authorization callback routine */
  SqlFunc *pFunc;       /* List of SQL functions */
  SqlCollate *pCollate; /* List of SQL collation functions */
  int rc;               /* Return code of most recent sqlite3_exec() */
  Tcl_Obj *pCollateNeeded;  /* Collation needed script */
};






























/*
** TCL calls this procedure when an sqlite3 database command is
** deleted.
*/
static void DbDeleteCmd(void *db){
  SqliteDb *pDb = (SqliteDb*)db;
  sqlite3_close(pDb->db);
................................................................................
      }else{
        sqlite3_busy_handler(pDb->db, 0, 0);
      }
    }
    break;
  }











































  /*     $db changes
  **
  ** Return the number of rows that were modified, inserted, or deleted by
  ** the most recent INSERT, UPDATE or DELETE statement, not including 
  ** any changes made by trigger programs.
  */
  case DB_CHANGES: {
................................................................................
  case DB_ERRORCODE: {
    Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db)));
    break;
  }
   
  /*
  **    $db eval $sql ?array? ?{  ...code... }?
  **    $db onecolumn $sql
  **
  ** The SQL statement in $sql is evaluated.  For each row, the values are
  ** placed in elements of the array named "array" and ...code... is executed.
  ** If "array" and "code" are omitted, then no callback is every invoked.
  ** If "array" is an empty string, then the values are placed in variables
  ** that have the same name as the fields extracted by the query.
  **
  ** The onecolumn method is the equivalent of:
  **     lindex [$db eval $sql] 0
  */
  case DB_ONECOLUMN:
  case DB_EVAL: {
    char const *zSql;      /* Next SQL statement to execute */
    char const *zLeft;     /* What is left after first stmt in zSql */
    sqlite3_stmt *pStmt;   /* Compiled SQL statment */
    Tcl_Obj *pArray;       /* Name of array into which results are written */
    Tcl_Obj *pScript;      /* Script to run for each result set */
    Tcl_Obj **apParm;      /* Parameters that need a Tcl_DecrRefCount() */
    int nParm;             /* Number of entries used in apParm[] */
    Tcl_Obj *aParm[10];    /* Static space for apParm[] in the common case */
    Tcl_Obj *pRet;         /* Value to be returned */


    if( choice==DB_ONECOLUMN ){
      if( objc!=3 ){
        Tcl_WrongNumArgs(interp, 2, objv, "SQL");
        return TCL_ERROR;
      }
      pRet = 0;
    }else{
      if( objc<3 || objc>5 ){
        Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?");
        return TCL_ERROR;
      }
      pRet = Tcl_NewObj();
      Tcl_IncrRefCount(pRet);
    }
    if( objc==3 ){
      pArray = pScript = 0;
    }else if( objc==4 ){
      pArray = 0;
      pScript = objv[3];
    }else{
................................................................................
              sqlite3_bind_text(pStmt, i, data, n, SQLITE_STATIC);
              Tcl_IncrRefCount(pVar);
              apParm[nParm++] = pVar;
            }
          }
        }
      }


      /* Compute column names */
      nCol = sqlite3_column_count(pStmt);
      if( pScript ){
        apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol );
        if( apColName==0 ) break;
        for(i=0; i<nCol; i++){
................................................................................
  
          if( pScript ){
            if( pArray==0 ){
              Tcl_ObjSetVar2(interp, apColName[i], 0, pVal, 0);
            }else{
              Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0);
            }
          }else if( choice==DB_ONECOLUMN ){
            if( pRet==0 ){
              pRet = pVal;
              Tcl_IncrRefCount(pRet);
            }
            goto end_step;
          }else{
            Tcl_ListObjAppendElement(interp, pRet, pVal);
          }
        }
  
        if( pScript ){
          rc = Tcl_EvalObjEx(interp, pScript, 0);
          if( rc!=TCL_ERROR ) rc = TCL_OK;
        }
      }
    end_step:

      /* Free the column name objects */
      if( pScript ){
        for(i=0; i<nCol; i++){
          Tcl_DecrRefCount(apColName[i]);
        }
        Tcl_Free((char*)apColName);
................................................................................
        break;
      }

      zSql = zLeft;
    }
    Tcl_DecrRefCount(objv[2]);

    if( pRet ){
      if( rc==TCL_OK ){
        Tcl_SetObjResult(interp, pRet);
      }
      Tcl_DecrRefCount(pRet);
    }

    break;
  }

  /*
  **     $db function NAME SCRIPT
  **
................................................................................
    rowid = sqlite3_last_insert_rowid(pDb->db);
    pResult = Tcl_GetObjResult(interp);
    Tcl_SetIntObj(pResult, rowid);
    break;
  }

  /*
  ** The DB_ONECOLUMN method is implemented together with DB_EVAL.
  */

  /*    $db progress ?N CALLBACK?
  ** 
  ** Invoke the given callback every N virtual machine opcodes while executing
  ** queries.
  */
  case DB_PROGRESS: {
    if( objc==2 ){
      if( pDb->zProgress ){
        Tcl_AppendResult(interp, pDb->zProgress, 0);
      }
    }else if( objc==4 ){
      char *zProgress;
      int len;
      int N;
      if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
	return TCL_ERROR;
      };
      if( pDb->zProgress ){
        Tcl_Free(pDb->zProgress);
      }
      zProgress = Tcl_GetStringFromObj(objv[3], &len);
      if( zProgress && len>0 ){
        pDb->zProgress = Tcl_Alloc( len + 1 );
        strcpy(pDb->zProgress, zProgress);
      }else{
        pDb->zProgress = 0;
      }
#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
      if( pDb->zProgress ){
        pDb->interp = interp;
        sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
      }else{
        sqlite3_progress_handler(pDb->db, 0, 0, 0);
      }
#endif
    }else{
      Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
      return TCL_ERROR;
    }
    break;
  }

  /*
  **     $db rekey KEY
  **

Changes to test/tclsqlite.test.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
...
166
167
168
169
170
171
172


















173
174
175
176
177
178
179
# This file implements regression tests for TCL interface to the
# SQLite library. 
#
# Actually, all tests are based on the TCL interface, so the main
# interface is pretty well tested.  This file contains some addition
# tests for fringe issues that the main test suite does not cover.
#
# $Id: tclsqlite.test,v 1.30 2004/08/20 18:34:20 drh Exp $

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

# Check the error messages generated by tclsqlite
#
if {[sqlite3 -has-codec]} {
................................................................................
  set rc [catch {db onecolumn} errmsg]
  lappend rc $errmsg
} {1 {wrong # args: should be "db onecolumn SQL"}}
do_test tcl-3.4 {
  set rc [catch {db onecolumn {SELECT bogus}} errmsg]
  lappend rc $errmsg
} {1 {no such column: bogus}}



















# Turn the busy handler on and off
#
do_test tcl-4.1 {
  proc busy_callback {cnt} {
    break
  }







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
...
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
# This file implements regression tests for TCL interface to the
# SQLite library. 
#
# Actually, all tests are based on the TCL interface, so the main
# interface is pretty well tested.  This file contains some addition
# tests for fringe issues that the main test suite does not cover.
#
# $Id: tclsqlite.test,v 1.31 2004/09/07 13:20:35 drh Exp $

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

# Check the error messages generated by tclsqlite
#
if {[sqlite3 -has-codec]} {
................................................................................
  set rc [catch {db onecolumn} errmsg]
  lappend rc $errmsg
} {1 {wrong # args: should be "db onecolumn SQL"}}
do_test tcl-3.4 {
  set rc [catch {db onecolumn {SELECT bogus}} errmsg]
  lappend rc $errmsg
} {1 {no such column: bogus}}
do_test tcl-3.5 {
  set b 50
  set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]
  lappend rc $msg
} {0 41}
do_test tcl-3.6 {
  set b 500
  set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]
  lappend rc $msg
} {0 {}}
do_test tcl-3.7 {
  set b 500
  set rc [catch {db one {
    INSERT INTO t1 VALUES(99,510);
    SELECT * FROM t1 WHERE b>$b
  }} msg]
  lappend rc $msg
} {0 99}

# Turn the busy handler on and off
#
do_test tcl-4.1 {
  proc busy_callback {cnt} {
    break
  }