steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

clean up code some 

make \# retries user configurable
db4
Doug Coleman 2008-06-01 00:48:38 -05:00
parent 41a9bb9ac4
commit a7afae250d
4 changed files with 18 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/db/db.factor
View File

@ -35,7 +35,7 @@ HOOK: db-close db ( handle -- )
handle>> db-close handle>> db-close
] with-variable ; ] with-variable ;
TUPLE: statement handle sql in-params out-params bind-params bound? type ; TUPLE: statement handle sql in-params out-params bind-params bound? type retries ;
TUPLE: simple-statement < statement ; TUPLE: simple-statement < statement ;
TUPLE: prepared-statement < statement ; TUPLE: prepared-statement < statement ;

10
extra/db/queries/queries.factor
View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel math namespaces sequences random USING: accessors kernel math namespaces sequences random
strings math.parser math.intervals combinators strings math.parser math.intervals combinators
math.bitfields.lib namespaces.lib db db.tuples db.types ; math.bitfields.lib namespaces.lib db db.tuples db.types
sequences.lib ;
IN: db.queries IN: db.queries
GENERIC: where ( specs obj -- ) GENERIC: where ( specs obj -- )
@ -99,16 +100,15 @@ M: string where ( spec obj -- ) object-where ;
] with filter ; ] with filter ;
: where-clause ( tuple specs -- ) : where-clause ( tuple specs -- )
dupd filter-slots dupd filter-slots [
dup empty? [ drop
2drop
] [ ] [
" where " 0% [ " where " 0% [
" and " 0% " and " 0%
] [ ] [
2dup slot-name>> swap get-slot-named where 2dup slot-name>> swap get-slot-named where
] interleave drop ] interleave drop
] if ; ] if-empty ;
M: db <delete-tuples-statement> ( tuple table -- sql ) M: db <delete-tuples-statement> ( tuple table -- sql )
[ [

4
extra/db/sql/sql.factor
View File

@ -5,7 +5,9 @@ IN: db.sql
SYMBOLS: insert update delete select distinct columns from as SYMBOLS: insert update delete select distinct columns from as
where group-by having order-by limit offset is-null desc all where group-by having order-by limit offset is-null desc all
any count avg table values ; any count avg table values ? ;
! Output an s-exp sql statement and an alist of keys/values
: input-spec, 1, ; : input-spec, 1, ;
: output-spec, 2, ; : output-spec, 2, ;

14
extra/db/tuples/tuples.factor
View File

@ -55,6 +55,7 @@ SINGLETON: retryable
[ make-retryable ] map [ make-retryable ] map
] [ ] [
retryable >>type retryable >>type
10 >>retries
] if ; ] if ;
: regenerate-params ( statement -- statement ) : regenerate-params ( statement -- statement )
@ -69,12 +70,13 @@ SINGLETON: retryable
] 2map >>bind-params ; ] 2map >>bind-params ;
M: retryable execute-statement* ( statement type -- ) M: retryable execute-statement* ( statement type -- )
drop drop [
[ [
[ query-results dispose t ] [ query-results dispose t ]
[ ] [ ]
[ regenerate-params bind-statement* f ] cleanup [ regenerate-params bind-statement* f ] cleanup
] curry 10 retry drop ; ] curry
] [ retries>> ] bi retry drop ;
: resulting-tuple ( class row out-params -- tuple ) : resulting-tuple ( class row out-params -- tuple )
rot class new [ rot class new [