SINGLETON: throwable
SINGLETON: nonthrowable
-SINGLETON: retryable
: make-throwable ( obj -- obj' )
dup sequence? [
nonthrowable >>type
] if ;
-: make-retryable ( obj quot -- obj' )
- over sequence? [
- [ make-retryable ] curry map
- ] [
- retryable >>type
- ] if ;
-
TUPLE: result-set sql in-params out-params handle n max ;
: construct-statement ( sql in out class -- statement )
HOOK: <prepared-statement> db ( str in out -- statement )
GENERIC: prepare-statement ( statement -- )
GENERIC: bind-statement* ( statement -- )
+GENERIC: low-level-bind ( statement -- )
GENERIC: bind-tuple ( tuple statement -- )
GENERIC: query-results ( query -- result-set )
GENERIC: #rows ( result-set -- n )
M: nonthrowable execute-statement* ( statement type -- )
drop [ query-results dispose ] [ 2drop ] recover ;
-M: retryable execute-statement* ( statement type -- )
- [
- dup dup quot>> call
- [ query-results dispose ] [ 2drop ] recover
- ] curry 10 retry ;
-
: execute-statement ( statement -- )
dup sequence? [
[ execute-statement ] each
FUNCTION: int sqlite3_open ( char* filename, void* ppDb ) ;
FUNCTION: int sqlite3_close ( sqlite3* pDb ) ;
FUNCTION: char* sqlite3_errmsg ( sqlite3* pDb ) ;
-FUNCTION: int sqlite3_prepare ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ;
+FUNCTION: int sqlite3_prepare_v2 ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ;
FUNCTION: int sqlite3_finalize ( sqlite3_stmt* pStmt ) ;
FUNCTION: int sqlite3_reset ( sqlite3_stmt* pStmt ) ;
FUNCTION: int sqlite3_step ( sqlite3_stmt* pStmt ) ;
FUNCTION: int sqlite3_bind_null ( sqlite3_stmt* pStmt, int n ) ;
FUNCTION: int sqlite3_bind_text ( sqlite3_stmt* pStmt, int index, char* text, int len, int destructor ) ;
FUNCTION: int sqlite3_bind_parameter_index ( sqlite3_stmt* pStmt, char* name ) ;
+FUNCTION: int sqlite3_clear_bindings ( sqlite3_stmt* pStmt ) ;
FUNCTION: int sqlite3_column_count ( sqlite3_stmt* pStmt ) ;
FUNCTION: void* sqlite3_column_blob ( sqlite3_stmt* pStmt, int col ) ;
FUNCTION: int sqlite3_column_bytes ( sqlite3_stmt* pStmt, int col ) ;
: sqlite-prepare ( db sql -- handle )
dup length "void*" <c-object> "void*" <c-object>
- [ sqlite3_prepare sqlite-check-result ] 2keep
+ [ sqlite3_prepare_v2 sqlite-check-result ] 2keep
drop *void* ;
: sqlite-bind-parameter-index ( handle name -- index )
: sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ;
: sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ;
+: sqlite-clear-bindings ( handle -- )
+ sqlite3_clear_bindings sqlite-check-result ;
: sqlite-#columns ( query -- int ) sqlite3_column_count ;
: sqlite-column ( handle index -- string ) sqlite3_column_text ;
: sqlite-column-name ( handle index -- string ) sqlite3_column_name ;
words combinators.lib db.types combinators math.intervals
io namespaces.lib accessors vectors math.ranges random
math.bitfields.lib ;
+USE: tools.walker
IN: db.sqlite
TUPLE: sqlite-db < db path ;
M: sqlite-result-set dispose ( result-set -- )
f >>handle drop ;
-: sqlite-bind ( triples handle -- )
- swap [ first3 sqlite-bind-type ] with each ;
-
: reset-statement ( statement -- )
sqlite-maybe-prepare handle>> sqlite-reset ;
-M: sqlite-statement bind-statement* ( statement -- )
+: reset-bindings ( statement -- )
sqlite-maybe-prepare
- dup statement-bound? [ dup reset-statement ] when
+ handle>> [ sqlite3_reset drop ] [ sqlite3_clear_bindings drop ] bi ;
+
+M: sqlite-statement low-level-bind ( statement -- )
[ statement-bind-params ] [ statement-handle ] bi
- sqlite-bind ;
+ swap [ first3 sqlite-bind-type ] with each ;
+
+M: sqlite-statement bind-statement* ( statement -- )
+ sqlite-maybe-prepare
+ dup statement-bound? [ dup reset-bindings ] when
+ low-level-bind ;
GENERIC: sqlite-bind-conversion ( tuple obj -- array )
dup 0% random-id-quot
] with-random
] curry
- [ type>> ] bi 10 <generator-bind> 1,
+ [ type>> ] bi <generator-bind> 1,
] [
bind%
] if
] interleave
");" 0%
- ] sqlite-make ;
+ ] sqlite-make
+ dup in-params>> [ generator-bind? ] contains? [
+ make-retryable
+ ] when ;
M: sqlite-db <insert-nonnative-statement> ( tuple -- statement )
<insert-native-statement> ;
] unit-test
[ t ] [
- T{ secret } select-tuples length 3 =
+ T{ secret } select-tuples dup . length 3 =
] unit-test ;
[ test-random-id ] test-sqlite
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs classes db kernel namespaces
-classes.tuple words sequences slots math
+classes.tuple words sequences slots math accessors
math.parser io prettyprint db.types continuations
mirrors sequences.lib tools.walker combinators.lib ;
IN: db.tuples
HOOK: insert-tuple* db ( tuple statement -- )
+SINGLETON: retryable
+
+: make-retryable ( obj -- obj' )
+ dup sequence? [
+ [ make-retryable ] map
+ ] [
+ retryable >>type
+ ] if ;
+
+: regenerate-params ( statement -- statement )
+ dup
+ [ bind-params>> ] [ in-params>> ] bi
+ [
+ dup generator-bind? [
+ quot>> call over set-second
+ ] [
+ drop
+ ] if
+ ] 2map >>bind-params ;
+
+: handle-random-id ( statement -- )
+ dup in-params>> [ type>> +random-id+ = ] find drop >boolean [
+ retryable >>type
+ random-id-quot >>quot
+ ] when drop ;
+
+M: retryable execute-statement* ( statement type -- )
+ drop
+ [
+ [ query-results dispose t ]
+ [ ]
+ [ regenerate-params bind-statement* f ] cleanup
+ ] curry 10 retry drop ;
+
: resulting-tuple ( row out-params -- tuple )
dup first sql-spec-class new [
[
TUPLE: literal-bind key type value ;
C: <literal-bind> literal-bind
-TUPLE: generator-bind key quot type retries ;
+TUPLE: generator-bind key quot type ;
C: <generator-bind> generator-bind
SINGLETON: +native-id+
: relation? ( spec -- ? ) [ +has-many+ = ] deep-find ;
-: handle-random-id ( statement -- )
- dup in-params>> [ type>> +random-id+ = ] find drop >boolean [
- retryable >>type
- random-id-quot >>quot
- ] when drop ;
-
SYMBOLS: INTEGER BIG-INTEGER SIGNED-BIG-INTEGER UNSIGNED-BIG-INTEGER
DOUBLE REAL BOOLEAN TEXT VARCHAR DATE TIME DATETIME TIMESTAMP BLOB
FACTOR-BLOB NULL ;