redoing db framework. it'll live in extra until it can replace db in basis

extra/db2/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/db2/connections/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/db2/connections/connections.factor

@@ -0,0 +1,17 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors destructors fry kernel namespaces ;
+IN: db2.connections
+
+TUPLE: db-connection handle ;
+
+GENERIC: db-open ( db -- db-connection )
+HOOK: db-close db-connection ( handle -- )
+HOOK: parse-db-error db-connection ( error -- error' )
+
+M: db-connection dispose ( db-connection -- )
+    [ db-close f ] change-handle drop ;
+
+: with-db ( db quot -- )
+    [ db-open db-connection dup ] dip
+    '[ _ [ drop @ ] with-disposal ] with-variable ; inline

extra/db2/db2.factor

@@ -0,0 +1,20 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors continuations destructors fry kernel
+namespaces sequences strings db2.statements ;
+IN: db2
+
+<PRIVATE
+
+: execute-sql-string ( string -- )
+    f f <statement> [ execute-statement ] with-disposal ;
+
+PRIVATE>
+
+: sql-command ( sql -- )
+    dup string?
+    [ execute-sql-string ]
+    [ [ execute-sql-string ] each ] if ;
+
+: sql-query ( sql -- sequence )
+    f f <statement> [ statement>result-sequence ] with-disposal ;

extra/db2/result-sets/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/db2/result-sets/result-sets.factor

@@ -0,0 +1,29 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel sequences ;
+IN: db2.result-sets
+
+TUPLE: result-set sql in out handle n max ;
+
+GENERIC: #rows ( result-set -- n )
+GENERIC: #columns ( result-set -- n )
+GENERIC: advance-row ( result-set -- )
+GENERIC: more-rows? ( result-set -- ? )
+GENERIC# column 1 ( result-set column -- obj )
+GENERIC# column-typed 1 ( result-set column -- sql )
+
+: init-result-set ( result-set -- result-set )
+    dup #rows >>max
+    0 >>n ;
+
+: new-result-set ( query handle class -- result-set )
+    new
+        swap >>handle
+        swap [ sql>> >>sql ] [ in>> >>in ] [ out>> >>out ] tri ;
+
+: sql-row ( result-set -- seq )
+    dup #columns [ column ] with map ;
+
+: sql-row-typed ( result-set -- seq )
+    dup #columns [ column-typed ] with map ;
+

extra/db2/statements/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/db2/statements/statements.factor

@@ -0,0 +1,40 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors continuations destructors fry kernel
+sequences db2.result-sets db2.connections ;
+IN: db2.statements
+
+TUPLE: statement handle sql in out ;
+
+: new-statement ( sql in out class -- statement )
+    new
+        swap >>out
+        swap >>in
+        swap >>sql ;
+
+HOOK: <statement> db-connection ( sql in out -- statement )
+GENERIC: execute-statement* ( statement type -- )
+GENERIC: statement>result-set ( statement -- result-set )
+
+M: object execute-statement* ( statement type -- )
+    drop '[ _ statement>result-set dispose ]
+    [ parse-db-error rethrow ] recover ;
+
+: execute-one-statement ( statement -- )
+    dup type>> execute-statement* ;
+
+: execute-statement ( statement -- )
+    dup sequence?
+    [ [ execute-one-statement ] each ]
+    [ execute-one-statement ] if ;
+
+: statement-each ( statement quot: ( statement -- ) -- )
+    over more-rows?
+    [ [ call ] 2keep over advance-row statement-each ]
+    [ 2drop ] if ; inline recursive
+
+: statement-map ( statement quot -- sequence )
+    accumulator [ statement-each ] dip { } like ; inline
+
+: statement>result-sequence ( statement -- sequence )
+    statement>result-set [ [ sql-row ] statement-map ] with-disposal ;

extra/db2/transactions/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/db2/transactions/transactions.factor

@@ -0,0 +1,23 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: db2 ;
+IN: db2.transactions
+
+! Transactions
+SYMBOL: in-transaction
+
+HOOK: begin-transaction db-connection ( -- )
+HOOK: commit-transaction db-connection ( -- )
+HOOK: rollback-transaction db-connection ( -- )
+
+M: db-connection begin-transaction ( -- ) "BEGIN" sql-command ;
+M: db-connection commit-transaction ( -- ) "COMMIT" sql-command ;
+M: db-connection rollback-transaction ( -- ) "ROLLBACK" sql-command ;
+
+: in-transaction? ( -- ? ) in-transaction get ;
+
+: with-transaction ( quot -- )
+    t in-transaction [
+        begin-transaction
+        [ ] [ rollback-transaction ] cleanup commit-transaction
+    ] with-variable ; inline