From 896c920d85008304c9896ca0daf46e91b9faadea Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 19 Apr 2008 22:09:36 -0500 Subject: [PATCH] retryable statements actually retry now --- extra/db/db.factor | 15 +----------- extra/db/sqlite/ffi/ffi.factor | 3 ++- extra/db/sqlite/lib/lib.factor | 4 +++- extra/db/sqlite/sqlite.factor | 24 ++++++++++++------- extra/db/tuples/tuples-tests.factor | 2 +- extra/db/tuples/tuples.factor | 36 ++++++++++++++++++++++++++++- extra/db/types/types.factor | 8 +------ 7 files changed, 59 insertions(+), 33 deletions(-) diff --git a/extra/db/db.factor b/extra/db/db.factor index ce6232f414..82193ed467 100755 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -42,7 +42,6 @@ TUPLE: prepared-statement < statement ; SINGLETON: throwable SINGLETON: nonthrowable -SINGLETON: retryable : make-throwable ( obj -- obj' ) dup sequence? [ @@ -58,13 +57,6 @@ SINGLETON: retryable 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 ) @@ -78,6 +70,7 @@ HOOK: db ( str in out -- statement ) HOOK: 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 ) @@ -95,12 +88,6 @@ M: throwable execute-statement* ( statement type -- ) 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 diff --git a/extra/db/sqlite/ffi/ffi.factor b/extra/db/sqlite/ffi/ffi.factor index 6b94c02c65..4b5a019fca 100755 --- a/extra/db/sqlite/ffi/ffi.factor +++ b/extra/db/sqlite/ffi/ffi.factor @@ -108,7 +108,7 @@ LIBRARY: sqlite 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 ) ; @@ -123,6 +123,7 @@ FUNCTION: int sqlite3_bind_int64 ( sqlite3_stmt* pStmt, int index, sqlite3_int64 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 ) ; diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index 61070b078b..b6078fc983 100755 --- a/extra/db/sqlite/lib/lib.factor +++ b/extra/db/sqlite/lib/lib.factor @@ -33,7 +33,7 @@ IN: db.sqlite.lib : sqlite-prepare ( db sql -- handle ) dup length "void*" "void*" - [ sqlite3_prepare sqlite-check-result ] 2keep + [ sqlite3_prepare_v2 sqlite-check-result ] 2keep drop *void* ; : sqlite-bind-parameter-index ( handle name -- index ) @@ -114,6 +114,8 @@ IN: db.sqlite.lib : 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 ; diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index 093a705b0d..6dc394abd9 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -7,6 +7,7 @@ continuations db.sqlite.lib db.sqlite.ffi db.tuples 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 ; @@ -43,17 +44,21 @@ M: sqlite-statement dispose ( statement -- ) 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 ; +: reset-bindings ( statement -- ) + sqlite-maybe-prepare + handle>> [ sqlite3_reset drop ] [ sqlite3_clear_bindings drop ] bi ; + +M: sqlite-statement low-level-bind ( statement -- ) + [ statement-bind-params ] [ statement-handle ] bi + swap [ first3 sqlite-bind-type ] with each ; + M: sqlite-statement bind-statement* ( statement -- ) sqlite-maybe-prepare - dup statement-bound? [ dup reset-statement ] when - [ statement-bind-params ] [ statement-handle ] bi - sqlite-bind ; + dup statement-bound? [ dup reset-bindings ] when + low-level-bind ; GENERIC: sqlite-bind-conversion ( tuple obj -- array ) @@ -140,13 +145,16 @@ M: sqlite-db ( tuple -- statement ) dup 0% random-id-quot ] with-random ] curry - [ type>> ] bi 10 1, + [ type>> ] bi 1, ] [ bind% ] if ] interleave ");" 0% - ] sqlite-make ; + ] sqlite-make + dup in-params>> [ generator-bind? ] contains? [ + make-retryable + ] when ; M: sqlite-db ( tuple -- statement ) ; diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 083cf059c9..2eb31ebe18 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -346,7 +346,7 @@ C: secret ] unit-test [ t ] [ - T{ secret } select-tuples length 3 = + T{ secret } select-tuples dup . length 3 = ] unit-test ; [ test-random-id ] test-sqlite diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index e0b4fce2f3..1b1e48ddee 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -1,7 +1,7 @@ ! 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 @@ -49,6 +49,40 @@ HOOK: db ( tuple class -- tuple ) 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 [ [ diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index b8855ce296..9f111a42e4 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -19,7 +19,7 @@ TUPLE: sql-spec class slot-name column-name type primary-key modifiers ; TUPLE: literal-bind key type value ; C: literal-bind -TUPLE: generator-bind key quot type retries ; +TUPLE: generator-bind key quot type ; C: generator-bind SINGLETON: +native-id+ @@ -64,12 +64,6 @@ SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+ : 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 ;