libs/sql/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 USING: alien compiler errors generic libsqlite kernel math namespaces
  13 prettyprint sequences sql strings sql:utils ;
  14
  15 TUPLE: sqlite-error n message ;
  16
  17 ! High level sqlite routines
  18 : sqlite-check-result ( result -- )
  19   #! Check the result from a sqlite call is ok. If it is
  20   #! return, otherwise throw an error.
  21   dup SQLITE_OK = [
  22     drop
  23   ] [
  24     dup sqlite-error-messages nth <sqlite-error> throw
  25   ] if ;
  26
  27 : sqlite-open ( filename -- db )
  28   #! Open the database referenced by the filename and return
  29   #! a handle to that database. An error is thrown if the database
  30   #! failed to open.
  31   "void*" <c-object> [ sqlite3_open sqlite-check-result ] keep *void* ;
  32
  33 : sqlite-close ( db -- )
  34   #! Close the given database
  35   sqlite3_close sqlite-check-result ;
  36
  37 : sqlite-last-insert-rowid ( db -- rowid )
  38   #! Return the rowid of the last insert
  39   sqlite3_last_insert_rowid ;
  40
  41 : sqlite-prepare ( db sql -- statement )
  42   #! Prepare a SQL statement. Returns the statement which
  43   #! can have values bound to parameters or simply executed.
  44   #! TODO: Support multiple statements in the SQL string.
  45   dup length "void*" <c-object> "void*" <c-object>
  46   [ sqlite3_prepare sqlite-check-result ] 2keep
  47   drop *void* ;
  48
  49 : sqlite-bind-text ( statement index text -- )
  50   #! Bind the text to the parameterized value in the statement.
  51   dup length SQLITE_TRANSIENT sqlite3_bind_text sqlite-check-result ;
  52
  53 : sqlite-bind-parameter-index ( statement name -- index )
  54   sqlite3_bind_parameter_index ;
  55
  56  : sqlite-bind-text-by-name ( statement name text -- )
  57   >r dupd sqlite-bind-parameter-index r> sqlite-bind-text ;
  58
  59 : sqlite-finalize ( statement -- )
  60   #! Clean up all resources related to a statement. Once called
  61   #! the statement cannot be used. All statements must be finalized
  62   #! before closing the database.
  63   sqlite3_finalize sqlite-check-result ;
  64
  65 : sqlite-reset ( statement -- )
  66   #! Reset a statement so it can be called again, possibly with
  67   #! different parameters.
  68   sqlite3_reset sqlite-check-result ;
  69
  70 : column-count ( statement -- int )
  71   #! Given a prepared statement, return the number of
  72   #! columns in each row of the result set of that statement.
  73   sqlite3_column_count ;
  74
  75 : column-text ( statement index -- string )
  76   #! Return the value of the given column, indexed
  77   #! from zero, as a string.
  78   sqlite3_column_text ;
  79
  80 : step-complete? ( step-result -- bool )
  81   #! Return true if the result of a sqlite3_step is
  82   #! such that the iteration has completed (ie. it is
  83   #! SQLITE_DONE). Throw an error if an error occurs.
  84   dup SQLITE_ROW =  [
  85     drop f
  86   ] [
  87     dup SQLITE_DONE = [
  88       drop t
  89     ] [
  90       sqlite-check-result t
  91     ] if
  92   ] if ;
  93
  94 : sqlite-each ( statement quot -- )
  95   #! Execute the SQL statement, and call the quotation for
  96   #! each row returned from executing the statement with the
  97   #! statement on the top of the stack.
  98   over sqlite3_step step-complete? [
  99     2drop
 100   ] [
 101     [ call ] 2keep sqlite-each
 102   ] if ; inline
 103
 104 ! For comparison, here is the linrec implementation of sqlite-each
 105 ! [ drop sqlite3_step step-complete? ]
 106 ! [ 2drop ]
 107 ! [ 2dup 2slip ]
 108 ! [ ] linrec ;
 109
 110 DEFER: (sqlite-map)
 111
 112 : (sqlite-map) ( statement quot seq -- )
 113   pick sqlite3_step step-complete? [
 114     2nip
 115   ] [
 116     >r 2dup call r> curry (sqlite-map)
 117   ] if ;
 118
 119 : sqlite-map ( statement quot -- seq )
 120   [ ] (sqlite-map) ;
 121
 122 : with-sqlite ( path quot -- )
 123     [
 124         >r sqlite-open db set r>
 125         [ db get sqlite-close ] cleanup
 126     ] with-scope ;
 127
 128 : bind-for-sql ( statement alist -- )
 129     [
 130         first2 >r field>sqlite-bind-name r>
 131         obj>string/f sqlite-bind-text-by-name
 132     ] each-with ;
 133
 134 : bind-for-insert ( statement tuple -- )
 135     tuple>insert-alist dupd dupd bind-for-sql ;
 136
 137 : bind-for-update ( statement tuple -- )
 138     tuple>update-alist dupd dupd dupd bind-for-sql ;
 139
 140 : bind-for-delete ( statement tuple -- )
 141     tuple>delete-alist dupd dupd bind-for-sql ;
 142
 143 : bind-for-select ( statement tuple -- )
 144     tuple>select-alist dupd dupd bind-for-sql ;
 145
 146 : restore-tuple ( statement tuple -- tuple )
 147     break
 148     clone dup dup full-tuple>fields
 149     [
 150         2drop
 151         ! over 1+ >r
 152         ! db-field-slot >r
 153         ! pick swap column-text
 154         ! over r> set-slot r>
 155     ] each-with
 156     ! drop make-persistent swap 0 column-text swap
 157     ! [ set-persistent-key ] keep
 158     ;
 159