]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor
authorDoug Coleman <doug.coleman@gmail.com>
Fri, 6 Jun 2008 05:44:11 +0000 (00:44 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Fri, 6 Jun 2008 05:44:11 +0000 (00:44 -0500)
extra/db/db.factor
extra/db/queries/queries.factor
extra/db/sql/sql.factor
extra/db/tuples/tuples.factor

index 8d1feca6c73c3efd41fa900452f6e9df4c061000..889eff196cc9d19ccd5ffbc15fd9720fb2b56022 100755 (executable)
@@ -35,7 +35,7 @@ HOOK: db-close db ( handle -- )
         handle>> db-close
     ] 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: prepared-statement < statement ;
 
@@ -89,7 +89,7 @@ M: object execute-statement* ( statement type -- )
         swap >>out-params
         swap >>in-params
         swap >>sql ;
-    
+
 : sql-row ( result-set -- seq )
     dup #columns [ row-column ] with map ;
 
index 59ee60aa1fd68b8dfbde5e2a725b7be51a062a0d..d524080e576b3ada06dcaca2401f85c194e17d54 100644 (file)
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel math namespaces sequences random
 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
 
 GENERIC: where ( specs obj -- )
@@ -99,16 +100,15 @@ M: string where ( spec obj -- ) object-where ;
     ] with filter ;
 
 : where-clause ( tuple specs -- )
-    dupd filter-slots
-    dup empty? [
-        2drop
+    dupd filter-slots [
+        drop
     ] [
         " where " 0% [
             " and " 0%
         ] [
             2dup slot-name>> swap get-slot-named where
         ] interleave drop
-    ] if ;
+    ] if-empty ;
 
 M: db <delete-tuples-statement> ( tuple table -- sql )
     [
index 82c6e370bd6dfd4456549be8dcb23d5839e63f2c..756aeea7c0d65415cbee66b314f3bdab81344202 100755 (executable)
@@ -5,7 +5,9 @@ IN: db.sql
 
 SYMBOLS: insert update delete select distinct columns from as
 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, ;
 : output-spec, 2, ;
index bac141d6d28e634b49c31fb0febc739ed152c143..09fd63b2333b8a241087f8441f2e976af6861d49 100755 (executable)
@@ -55,6 +55,7 @@ SINGLETON: retryable
         [ make-retryable ] map
     ] [
         retryable >>type
+        10 >>retries
     ] if ;
 
 : regenerate-params ( statement -- statement )
@@ -69,12 +70,13 @@ SINGLETON: retryable
     ] 2map >>bind-params ;
 
 M: retryable execute-statement* ( statement type -- )
-    drop
-    [
-        [ query-results dispose t ]
-        [ ]
-        [ regenerate-params bind-statement* f ] cleanup
-    ] curry 10 retry drop ;
+    drop [
+        [
+            [ query-results dispose t ]
+            [ ]
+            [ regenerate-params bind-statement* f ] cleanup
+        ] curry
+    ] [ retries>> ] bi retry drop ;
 
 : resulting-tuple ( class row out-params -- tuple )
     rot class new [
@@ -152,3 +154,7 @@ M: retryable execute-statement* ( statement type -- )
 : select-tuple ( tuple -- tuple/f )
     dup dup class f f f 1 <advanced-select-statement>
     do-select ?first ;
+
+: advanced-select ( tuple groups order offset limit -- tuples )
+    >r >r >r >r dup dup class r> r> r> r>
+    <advanced-select-statement> do-select ;