contrib/sqlite/sqlite.factor

   1 ! Copyright (C) 2005 Chris Double.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 !
   4 ! An interface to the sqlite database. Tested against sqlite v3.0.8.
   5 ! Remeber to pass the following to factor:
   6 !  -libraries:sqlite=libsqlite3.so
   7 !
   8 ! Not all functions have been wrapped yet. Only those directly involving
   9 ! executing SQL calls and obtaining results.
  10 !
  11 IN: sqlite
  12 USE: kernel
  13 USE: alien
  14 USE: errors
  15 USE: strings
  16 USE: namespaces
  17 USE: sequences
  18 USE: compiler
  19
  20 "sqlite" windows? [ "sqlite3.dll" ] [ "libsqlite3.so" ] if "cdecl" add-library
  21 BEGIN-STRUCT: sqlite3
  22 END-STRUCT
  23
  24 BEGIN-STRUCT: sqlite3-indirect
  25   FIELD: sqlite3* pointer
  26 END-STRUCT
  27
  28 BEGIN-STRUCT: sqlite3-stmt
  29 END-STRUCT
  30
  31 BEGIN-STRUCT: sqlite3-stmt-indirect
  32   FIELD: sqlite3-stmt* pointer
  33 END-STRUCT
  34
  35 BEGIN-STRUCT: char*-indirect
  36   FIELD: char* pointer
  37 END-STRUCT
  38
  39 ! Return values from sqlite functions
  40 : SQLITE_OK           0   ; ! Successful result
  41 : SQLITE_ERROR        1   ; ! SQL error or missing database
  42 : SQLITE_INTERNAL     2   ; ! An internal logic error in SQLite
  43 : SQLITE_PERM         3   ; ! Access permission denied
  44 : SQLITE_ABORT        4   ; ! Callback routine requested an abort
  45 : SQLITE_BUSY         5   ; ! The database file is locked
  46 : SQLITE_LOCKED       6   ; ! A table in the database is locked
  47 : SQLITE_NOMEM        7   ; ! A malloc() failed
  48 : SQLITE_READONLY     8   ; ! Attempt to write a readonly database
  49 : SQLITE_INTERRUPT    9   ; ! Operation terminated by sqlite_interrupt()
  50 : SQLITE_IOERR       10   ; ! Some kind of disk I/O error occurred
  51 : SQLITE_CORRUPT     11   ; ! The database disk image is malformed
  52 : SQLITE_NOTFOUND    12   ; ! (Internal Only) Table or record not found
  53 : SQLITE_FULL        13   ; ! Insertion failed because database is full
  54 : SQLITE_CANTOPEN    14   ; ! Unable to open the database file
  55 : SQLITE_PROTOCOL    15   ; ! Database lock protocol error
  56 : SQLITE_EMPTY       16   ; ! (Internal Only) Database table is empty
  57 : SQLITE_SCHEMA      17   ; ! The database schema changed
  58 : SQLITE_TOOBIG      18   ; ! Too much data for one row of a table
  59 : SQLITE_CONSTRAINT  19   ; ! Abort due to contraint violation
  60 : SQLITE_MISMATCH    20   ; ! Data type mismatch
  61 : SQLITE_MISUSE      21   ; ! Library used incorrectly
  62 : SQLITE_NOLFS       22   ; ! Uses OS features not supported on host
  63 : SQLITE_AUTH        23   ; ! Authorization denied
  64 : SQLITE_ROW         100  ; ! sqlite_step() has another row ready
  65 : SQLITE_DONE        101  ; ! sqlite_step() has finished executing
  66
  67 ! Return values from the sqlite3_column_type function
  68 : SQLITE_INTEGER     1 ;
  69 : SQLITE_FLOAT       2 ;
  70 : SQLITE_TEXT        3 ;
  71 : SQLITE_BLOB        4 ;
  72 : SQLITE_NULL        5 ;
  73
  74 ! Values for the 'destructor' parameter of the 'bind' routines.
  75 : SQLITE_STATIC      0  ;
  76 : SQLITE_TRANSIENT   -1 ;
  77
  78 : sqlite3_open ( filename sqlite3-indirect -- result )
  79   "int" "sqlite" "sqlite3_open" [ "char*" "sqlite3-indirect*" ] alien-invoke ;
  80
  81 : sqlite3_close ( db -- result )
  82   "int" "sqlite" "sqlite3_close" [ "sqlite3*" ] alien-invoke ;
  83
  84 : sqlite3_prepare ( db sql sql-len sqlite3-stmt-indirect tail -- result )
  85   "int" "sqlite" "sqlite3_prepare" [ "sqlite3*" "char*" "int" "sqlite3-stmt-indirect*" "char*-indirect*" ] alien-invoke ;
  86
  87 : sqlite3_finalize ( stmt -- result )
  88   "int" "sqlite" "sqlite3_finalize" [ "sqlite3-stmt*" ] alien-invoke ;
  89
  90 : sqlite3_reset ( stmt -- result )
  91   "int" "sqlite" "sqlite3_reset" [ "sqlite3-stmt*" ] alien-invoke ;
  92
  93 : sqlite3_step ( stmt -- result )
  94   "int" "sqlite" "sqlite3_step" [ "sqlite3-stmt*" ] alien-invoke ;
  95
  96 : sqlite3_last_insert_rowid ( stmt -- result )
  97   "int" "sqlite" "sqlite3_last_insert_rowid" [ "sqlite3*" ] alien-invoke ;
  98
  99 : sqlite3_bind_blob ( stmt index pointer len destructor -- result )
 100   "int" "sqlite" "sqlite3_bind_blob" [ "sqlite3-stmt*" "int" "void*" "int" "int" ] alien-invoke ;
 101
 102 : sqlite3_bind_int ( stmt index int -- result )
 103   "int" "sqlite" "sqlite3_bind_int" [ "sqlite3-stmt*" "int" "int" ] alien-invoke ;
 104
 105 : sqlite3_bind_null ( stmt index  -- result )
 106   "int" "sqlite" "sqlite3_bind_null" [ "sqlite3-stmt*" "int" ] alien-invoke ;
 107
 108 : sqlite3_bind_text ( stmt index text len destructor -- result )
 109   "int" "sqlite" "sqlite3_bind_text" [ "sqlite3-stmt*" "int" "char*" "int" "int" ] alien-invoke ;
 110
 111 : sqlite3_bind_parameter_index ( stmt name -- result )
 112   "int" "sqlite" "sqlite3_bind_parameter_index" [ "sqlite3-stmt*" "char*" ] alien-invoke ;
 113
 114 : sqlite3_column_count ( stmt -- count )
 115   "int" "sqlite" "sqlite3_column_count" [ "sqlite3-stmt*" ] alien-invoke ;
 116
 117 : sqlite3_column_blob ( stmt col -- void* )
 118   "void*" "sqlite" "sqlite3_column_blob" [ "sqlite3-stmt*" "int" ] alien-invoke ;
 119
 120 : sqlite3_column_bytes ( stmt col -- int )
 121   "int" "sqlite" "sqlite3_column_bytes" [ "sqlite3-stmt*" "int" ] alien-invoke ;
 122
 123 : sqlite3_column_decltype ( stmt col -- string )
 124   "char*" "sqlite" "sqlite3_column_decltype" [ "sqlite3-stmt*" "int" ] alien-invoke ;
 125
 126 : sqlite3_column_int ( stmt col -- int )
 127   "int" "sqlite" "sqlite3_column_int" [ "sqlite3-stmt*" "int" ] alien-invoke ;
 128
 129 : sqlite3_column_name ( stmt col -- string )
 130   "char*" "sqlite" "sqlite3_column_name" [ "sqlite3-stmt*" "int" ] alien-invoke ;
 131
 132 : sqlite3_column_text ( stmt col -- string )
 133   "char*" "sqlite" "sqlite3_column_text" [ "sqlite3-stmt*" "int" ] alien-invoke ;
 134
 135 : sqlite3_column_type ( stmt col -- int )
 136   "int" "sqlite" "sqlite3_column_type" [ "sqlite3-stmt*" "int" ] alien-invoke ;
 137
 138 ! High level sqlite routines
 139 : sqlite-check-result ( result -- )
 140   #! Check the result from a sqlite call is ok. If it is
 141   #! return, otherwise throw an error. TODO: Throw the actual
 142   #! error text message.
 143   dup SQLITE_OK = [
 144     drop
 145   ] [
 146     "sqlite returned an error. See datastack for the error value." throw
 147   ] if ;
 148
 149 : sqlite-open ( filename -- db )
 150   #! Open the database referenced by the filename and return
 151   #! a handle to that database. An error is thrown if the database
 152   #! failed to open.
 153   "sqlite3-indirect" <c-object> tuck sqlite3_open sqlite-check-result sqlite3-indirect-pointer ;
 154
 155 : sqlite-close ( db -- )
 156   #! Close the given database
 157   sqlite3_close sqlite-check-result ;
 158
 159 : sqlite-last-insert-rowid ( db -- rowid )
 160   #! Return the rowid of the last insert
 161   sqlite3_last_insert_rowid ;
 162
 163 : sqlite-prepare ( db sql -- statement )
 164   #! Prepare a SQL statement. Returns the statement which
 165   #! can have values bound to parameters or simply executed.
 166   #! TODO: Support multiple statements in the SQL string.
 167   dup length "sqlite3-stmt-indirect" <c-object> dup >r
 168   "char*-indirect" <c-object> sqlite3_prepare sqlite-check-result
 169   r> sqlite3-stmt-indirect-pointer ;
 170
 171 : sqlite-bind-text ( statement index text -- )
 172   #! Bind the text to the parameterized value in the statement.
 173   dup length SQLITE_TRANSIENT sqlite3_bind_text sqlite-check-result ;
 174
 175 : sqlite-bind-parameter-index ( statement name -- index )
 176   sqlite3_bind_parameter_index ;
 177
 178 : sqlite-bind-text-by-name ( statement name text -- )
 179   >r dupd sqlite-bind-parameter-index r> sqlite-bind-text ;
 180
 181 : sqlite-finalize ( statement -- )
 182   #! Clean up all resources related to a statement. Once called
 183   #! the statement cannot be used. All statements must be finalized
 184   #! before closing the database.
 185   sqlite3_finalize sqlite-check-result ;
 186
 187 : sqlite-reset ( statement -- )
 188   #! Reset a statement so it can be called again, possibly with
 189   #! different parameters.
 190   sqlite3_reset sqlite-check-result ;
 191
 192 : column-count ( statement -- int )
 193   #! Given a prepared statement, return the number of
 194   #! columns in each row of the result set of that statement.
 195   sqlite3_column_count ;
 196
 197 : column-text ( statement index -- string )
 198   #! Return the value of the given column, indexed
 199   #! from zero, as a string.
 200   sqlite3_column_text ;
 201
 202 : step-complete? ( step-result -- bool )
 203   #! Return true if the result of a sqlite3_step is
 204   #! such that the iteration has completed (ie. it is
 205   #! SQLITE_DONE). Throw an error if an error occurs.
 206   dup SQLITE_ROW =  [
 207     drop f
 208   ] [
 209     dup SQLITE_DONE = [
 210       drop t
 211     ] [
 212       sqlite-check-result t
 213     ] if
 214   ] if ;
 215
 216 : sqlite-each ( statement quot -- )
 217   #! Execute the SQL statement, and call the quotation for
 218   #! each row returned from executing the statement with the
 219   #! statement on the top of the stack.
 220   over sqlite3_step step-complete? [
 221     2drop
 222   ] [
 223     [ call ] 2keep sqlite-each
 224   ] if ; inline
 225
 226 ! For comparison, here is the linrec implementation of sqlite-each
 227 ! [ drop sqlite3_step step-complete? ]
 228 ! [ 2drop ]
 229 ! [ 2dup 2slip ]
 230 ! [ ] linrec ;
 231
 232 DEFER: (sqlite-map)
 233
 234 : (sqlite-map) ( statement quot seq -- )
 235   pick sqlite3_step step-complete? [
 236     2nip
 237   ] [
 238     >r 2dup call r> curry (sqlite-map)
 239   ] if ;
 240
 241 : sqlite-map ( statement quot -- seq )
 242   [ ] (sqlite-map) ;