2005-02-10 17:22:35 -05:00
|
|
|
! Copyright (C) 2005 Chris Double.
|
|
|
|
!
|
|
|
|
! Redistribution and use in source and binary forms, with or without
|
|
|
|
! modification, are permitted provided that the following conditions are met:
|
|
|
|
!
|
|
|
|
! 1. Redistributions of source code must retain the above copyright notice,
|
|
|
|
! this list of conditions and the following disclaimer.
|
|
|
|
!
|
|
|
|
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
|
|
|
! this list of conditions and the following disclaimer in the documentation
|
|
|
|
! and/or other materials provided with the distribution.
|
|
|
|
!
|
|
|
|
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
|
|
|
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
|
|
|
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
|
|
|
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
|
|
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
|
|
|
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
|
|
|
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
|
|
|
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
|
|
|
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
|
|
|
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
|
|
!
|
|
|
|
! An interface to the sqlite database. Tested against sqlite v3.0.8.
|
|
|
|
! Remeber to pass the following to factor:
|
|
|
|
! -libraries:sqlite=libsqlite3.so
|
|
|
|
!
|
|
|
|
! Not all functions have been wrapped yet. Only those directly involving
|
|
|
|
! executing SQL calls and obtaining results.
|
|
|
|
!
|
|
|
|
IN: sqlite
|
|
|
|
USE: kernel
|
|
|
|
USE: alien
|
|
|
|
USE: compiler
|
|
|
|
USE: errors
|
|
|
|
USE: strings
|
|
|
|
USE: namespaces
|
2005-04-29 23:18:56 -04:00
|
|
|
USE: sequences
|
2005-09-21 18:25:42 -04:00
|
|
|
USE: lists
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
BEGIN-STRUCT: sqlite3
|
|
|
|
END-STRUCT
|
|
|
|
|
|
|
|
BEGIN-STRUCT: sqlite3-indirect
|
|
|
|
FIELD: sqlite3* pointer
|
|
|
|
END-STRUCT
|
|
|
|
|
|
|
|
BEGIN-STRUCT: sqlite3-stmt
|
|
|
|
END-STRUCT
|
|
|
|
|
|
|
|
BEGIN-STRUCT: sqlite3-stmt-indirect
|
|
|
|
FIELD: sqlite3-stmt* pointer
|
|
|
|
END-STRUCT
|
|
|
|
|
|
|
|
BEGIN-STRUCT: char*-indirect
|
|
|
|
FIELD: char* pointer
|
|
|
|
END-STRUCT
|
|
|
|
|
|
|
|
! Return values from sqlite functions
|
|
|
|
: SQLITE_OK 0 ; ! Successful result
|
|
|
|
: SQLITE_ERROR 1 ; ! SQL error or missing database
|
|
|
|
: SQLITE_INTERNAL 2 ; ! An internal logic error in SQLite
|
|
|
|
: SQLITE_PERM 3 ; ! Access permission denied
|
|
|
|
: SQLITE_ABORT 4 ; ! Callback routine requested an abort
|
|
|
|
: SQLITE_BUSY 5 ; ! The database file is locked
|
|
|
|
: SQLITE_LOCKED 6 ; ! A table in the database is locked
|
|
|
|
: SQLITE_NOMEM 7 ; ! A malloc() failed
|
|
|
|
: SQLITE_READONLY 8 ; ! Attempt to write a readonly database
|
|
|
|
: SQLITE_INTERRUPT 9 ; ! Operation terminated by sqlite_interrupt()
|
|
|
|
: SQLITE_IOERR 10 ; ! Some kind of disk I/O error occurred
|
|
|
|
: SQLITE_CORRUPT 11 ; ! The database disk image is malformed
|
|
|
|
: SQLITE_NOTFOUND 12 ; ! (Internal Only) Table or record not found
|
|
|
|
: SQLITE_FULL 13 ; ! Insertion failed because database is full
|
|
|
|
: SQLITE_CANTOPEN 14 ; ! Unable to open the database file
|
|
|
|
: SQLITE_PROTOCOL 15 ; ! Database lock protocol error
|
|
|
|
: SQLITE_EMPTY 16 ; ! (Internal Only) Database table is empty
|
|
|
|
: SQLITE_SCHEMA 17 ; ! The database schema changed
|
|
|
|
: SQLITE_TOOBIG 18 ; ! Too much data for one row of a table
|
|
|
|
: SQLITE_CONSTRAINT 19 ; ! Abort due to contraint violation
|
|
|
|
: SQLITE_MISMATCH 20 ; ! Data type mismatch
|
|
|
|
: SQLITE_MISUSE 21 ; ! Library used incorrectly
|
|
|
|
: SQLITE_NOLFS 22 ; ! Uses OS features not supported on host
|
|
|
|
: SQLITE_AUTH 23 ; ! Authorization denied
|
|
|
|
: SQLITE_ROW 100 ; ! sqlite_step() has another row ready
|
|
|
|
: SQLITE_DONE 101 ; ! sqlite_step() has finished executing
|
|
|
|
|
|
|
|
! Return values from the sqlite3_column_type function
|
|
|
|
: SQLITE_INTEGER 1 ;
|
|
|
|
: SQLITE_FLOAT 2 ;
|
|
|
|
: SQLITE_TEXT 3 ;
|
|
|
|
: SQLITE_BLOB 4 ;
|
|
|
|
: SQLITE_NULL 5 ;
|
|
|
|
|
|
|
|
! Values for the 'destructor' parameter of the 'bind' routines.
|
|
|
|
: SQLITE_STATIC 0 ;
|
|
|
|
: SQLITE_TRANSIENT -1 ;
|
|
|
|
|
|
|
|
: sqlite3_open ( filename sqlite3-indirect -- result )
|
2005-09-21 18:25:42 -04:00
|
|
|
"int" "sqlite" "sqlite3_open" [ "char*" "sqlite3-indirect*" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_close ( db -- )
|
2005-09-21 18:25:42 -04:00
|
|
|
"int" "sqlite" "sqlite3_close" [ "sqlite3*" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_prepare ( db sql sql-len sqlite3-stmt-indirect tail -- result )
|
2005-09-21 18:25:42 -04:00
|
|
|
"int" "sqlite" "sqlite3_prepare" [ "sqlite3*" "char*" "int" "sqlite3-stmt-indirect*" "char*-indirect*" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_finalize ( stmt -- result )
|
2005-09-21 18:25:42 -04:00
|
|
|
"int" "sqlite" "sqlite3_finalize" [ "sqlite3-stmt*" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_reset ( stmt -- result )
|
2005-09-21 18:25:42 -04:00
|
|
|
"int" "sqlite" "sqlite3_reset" [ "sqlite3-stmt*" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_step ( stmt -- result )
|
2005-09-21 18:25:42 -04:00
|
|
|
"int" "sqlite" "sqlite3_step" [ "sqlite3-stmt*" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_bind_blob ( stmt index pointer len destructor -- result )
|
2005-09-21 18:25:42 -04:00
|
|
|
"int" "sqlite" "sqlite3_bind_blob" [ "sqlite3-stmt*" "int" "void*" "int" "int" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_bind_int ( stmt index int -- result )
|
2005-09-21 18:25:42 -04:00
|
|
|
"int" "sqlite" "sqlite3_bind_int" [ "sqlite3-stmt*" "int" "int" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_bind_null ( stmt index -- result )
|
2005-09-21 18:25:42 -04:00
|
|
|
"int" "sqlite" "sqlite3_bind_null" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_bind_text ( stmt index text len destructor -- result )
|
2005-09-21 18:25:42 -04:00
|
|
|
"int" "sqlite" "sqlite3_bind_text" [ "sqlite3-stmt*" "int" "char*" "int" "int" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_column_count ( stmt -- count )
|
2005-09-21 18:25:42 -04:00
|
|
|
"int" "sqlite" "sqlite3_column_count" [ "sqlite3-stmt*" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_column_blob ( stmt col -- void* )
|
2005-09-21 18:25:42 -04:00
|
|
|
"void*" "sqlite" "sqlite3_column_blob" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_column_bytes ( stmt col -- int )
|
2005-09-21 18:25:42 -04:00
|
|
|
"int" "sqlite" "sqlite3_column_bytes" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_column_decltype ( stmt col -- string )
|
2005-09-21 18:25:42 -04:00
|
|
|
"char*" "sqlite" "sqlite3_column_decltype" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_column_int ( stmt col -- int )
|
2005-09-21 18:25:42 -04:00
|
|
|
"int" "sqlite" "sqlite3_column_int" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_column_name ( stmt col -- string )
|
2005-09-21 18:25:42 -04:00
|
|
|
"char*" "sqlite" "sqlite3_column_name" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_column_text ( stmt col -- string )
|
2005-09-21 18:25:42 -04:00
|
|
|
"char*" "sqlite" "sqlite3_column_text" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite3_column_type ( stmt col -- int )
|
2005-09-21 18:25:42 -04:00
|
|
|
"int" "sqlite" "sqlite3_column_type" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
! High level sqlite routines
|
|
|
|
: sqlite-check-result ( result -- )
|
|
|
|
#! Check the result from a sqlite call is ok. If it is
|
|
|
|
#! return, otherwise throw an error. TODO: Throw the actual
|
|
|
|
#! error text message.
|
|
|
|
dup SQLITE_OK = [
|
|
|
|
drop
|
|
|
|
] [
|
|
|
|
"sqlite returned an error. See datastack for the error value." throw
|
2005-09-25 02:03:36 -04:00
|
|
|
] if ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite-open ( filename -- db )
|
|
|
|
#! Open the database referenced by the filename and return
|
|
|
|
#! a handle to that database. An error is thrown if the database
|
|
|
|
#! failed to open.
|
|
|
|
<sqlite3-indirect> tuck sqlite3_open sqlite-check-result sqlite3-indirect-pointer ;
|
|
|
|
|
|
|
|
: sqlite-close ( db -- )
|
|
|
|
#! Close the given database
|
|
|
|
sqlite3_close sqlite-check-result ;
|
|
|
|
|
|
|
|
: sqlite-prepare ( db sql -- statement )
|
|
|
|
#! Prepare a SQL statement. Returns the statement which
|
|
|
|
#! can have values bound to parameters or simply executed.
|
|
|
|
#! TODO: Support multiple statements in the SQL string.
|
2005-04-29 23:18:56 -04:00
|
|
|
dup length <sqlite3-stmt-indirect> dup >r
|
2005-02-10 17:22:35 -05:00
|
|
|
<char*-indirect> sqlite3_prepare sqlite-check-result
|
|
|
|
r> sqlite3-stmt-indirect-pointer ;
|
2005-09-21 18:25:42 -04:00
|
|
|
|
|
|
|
: sqlite-bind-text ( statement col text -- )
|
|
|
|
#! Bind the text to the parameterized value in the statement.
|
|
|
|
dup length SQLITE_TRANSIENT sqlite3_bind_text sqlite-check-result ;
|
|
|
|
|
2005-02-10 17:22:35 -05:00
|
|
|
: sqlite-finalize ( statement -- )
|
|
|
|
#! Clean up all resources related to a statement. Once called
|
|
|
|
#! the statement cannot be used. All statements must be finalized
|
|
|
|
#! before closing the database.
|
|
|
|
sqlite3_finalize sqlite-check-result ;
|
|
|
|
|
|
|
|
: sqlite-reset ( statement -- )
|
|
|
|
#! Reset a statement so it can be called again, possibly with
|
|
|
|
#! different parameters.
|
|
|
|
sqlite3_reset sqlite-check-result ;
|
|
|
|
|
|
|
|
: column-count ( statement -- int )
|
|
|
|
#! Given a prepared statement, return the number of
|
|
|
|
#! columns in each row of the result set of that statement.
|
|
|
|
sqlite3_column_count ;
|
|
|
|
|
|
|
|
: column-text ( statement column -- string )
|
|
|
|
#! Return the value of the given column, indexed
|
|
|
|
#! from zero, as a string.
|
|
|
|
sqlite3_column_text ;
|
|
|
|
|
2005-02-12 20:08:32 -05:00
|
|
|
: step-complete? ( step-result -- bool )
|
|
|
|
#! Return true if the result of a sqlite3_step is
|
|
|
|
#! such that the iteration has completed (ie. it is
|
|
|
|
#! SQLITE_DONE). Throw an error if an error occurs.
|
|
|
|
dup SQLITE_ROW = [
|
|
|
|
drop f
|
|
|
|
] [
|
2005-02-10 17:22:35 -05:00
|
|
|
dup SQLITE_DONE = [
|
2005-02-12 20:08:32 -05:00
|
|
|
drop t
|
2005-02-10 17:22:35 -05:00
|
|
|
] [
|
2005-09-21 18:25:42 -04:00
|
|
|
sqlite-check-result t
|
2005-09-25 02:03:36 -04:00
|
|
|
] if
|
|
|
|
] if ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
|
|
|
: sqlite-each ( statement quot -- )
|
2005-02-12 20:08:32 -05:00
|
|
|
#! Execute the SQL statement, and call the quotation for
|
2005-02-10 17:22:35 -05:00
|
|
|
#! each row returned from executing the statement with the
|
|
|
|
#! statement on the top of the stack.
|
2005-02-12 20:08:32 -05:00
|
|
|
over sqlite3_step step-complete? [
|
|
|
|
2drop
|
|
|
|
] [
|
2005-04-22 00:22:36 -04:00
|
|
|
[ call ] 2keep sqlite-each
|
2005-09-25 02:03:36 -04:00
|
|
|
] if ;
|
2005-02-10 17:22:35 -05:00
|
|
|
|
2005-02-12 20:08:32 -05:00
|
|
|
! For comparison, here is the linrec implementation of sqlite-each
|
|
|
|
! [ drop sqlite3_step step-complete? ]
|
|
|
|
! [ 2drop ]
|
|
|
|
! [ 2dup 2slip ]
|
2005-09-21 18:25:42 -04:00
|
|
|
! [ ] linrec ;
|
|
|
|
|
|
|
|
: (sqlite-map) ( statement quot seq -- )
|
|
|
|
pick sqlite3_step step-complete? [
|
|
|
|
2nip
|
|
|
|
] [
|
|
|
|
>r 2dup call r> cons (sqlite-map)
|
2005-09-25 02:03:36 -04:00
|
|
|
] if ;
|
2005-09-21 18:25:42 -04:00
|
|
|
|
|
|
|
: sqlite-map ( statement quot -- )
|
|
|
|
[ ] (sqlite-map) ;
|
|
|
|
|
|
|
|
|
|
|
|
USE: words
|
|
|
|
"sqlite" words [ try-compile ] each
|