add copyright notices

update postgresql for new db protocol
make unit tests pass

extra/db/db.factor

@@ -44,6 +44,10 @@ GENERIC: #columns ( result-set -- n )
 GENERIC# row-column 1 ( result-set n -- obj )
 GENERIC: advance-row ( result-set -- ? )
 
+: init-result-set ( result-set -- )
+    dup #rows over set-result-set-max
+    -1 swap set-result-set-n ;
+
 : <result-set> ( query handle tuple -- result-set )
     >r >r { statement-sql statement-params } get-slots r>
     {

extra/db/postgresql/ffi/ffi.factor

@@ -1,9 +1,7 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-
 ! adapted from libpq-fe.h version 7.4.7
-! tested on debian linux with postgresql 7.4.7
+! tested on debian linux with postgresql 8.1
-! Updated to 8.1
 
 USING: alien alien.syntax combinators system ;
 IN: db.postgresql.ffi

extra/db/postgresql/lib/lib.factor

@@ -1,13 +1,9 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
 USING: arrays continuations db io kernel math namespaces
-quotations sequences db.postgresql.ffi ;
+quotations sequences db.postgresql.ffi alien alien.c-types ;
 IN: db.postgresql.lib
 
-SYMBOL: query-res
-
-: connect-postgres ( host port pgopts pgtty db user pass -- conn )
-    PQsetdbLogin
-    dup PQstatus zero? [ "couldn't connect to database" throw ] unless ;
-
 : postgresql-result-error-message ( res -- str/f )
     dup zero? [
         drop f
@@ -28,45 +24,21 @@ SYMBOL: query-res
     PQresultStatus
     PGRES_COMMAND_OK PGRES_TUPLES_OK 2array member? ;
 
+: connect-postgres ( host port pgopts pgtty db user pass -- conn )
+    PQsetdbLogin
+    dup PQstatus zero? [ postgresql-error-message throw ] unless ;
+
 : do-postgresql-statement ( statement -- res )
     db get db-handle swap statement-sql PQexec dup postgresql-result-ok? [
         dup postgresql-result-error-message swap PQclear throw
     ] unless ;
 
-! : do-command ( str -- )
+: do-postgresql-bound-statement ( statement -- res )
-    ! 1quotation \ (do-command) add db get swap call ;
+    >r db get db-handle r>
-
+    [ statement-sql ] keep
-! : prepare ( str quot word -- conn quot )
+    [ statement-params length f ] keep
-    ! rot 1quotation swap append swap append db get swap ;
+    statement-params [ malloc-char-string ] map >c-void*-array
-
+    f f 0 PQexecParams
-! : do-query ( str quot -- )
+    dup postgresql-result-ok? [
-    ! [ (do-query) query-res set ] prepare catch
+        dup postgresql-result-error-message swap PQclear throw
-    ! [ rethrow ] [ query-res get PQclear ] if* ;
+    ] unless ;
-
-! : result>seq ( -- seq )
-    ! query-res get [ PQnfields ] keep PQntuples
-    ! [ swap [ query-res get -rot PQgetvalue ] with map ] with map ;
-! 
-! : print-table ( seq -- )
-    ! [ [ write bl ] each "\n" write ] each ;
-
-
-
-! select * from animal where name = 'Simba'
-! select * from animal where name = $1
-
-! : (do-query) ( PGconn query -- PGresult* )
-    ! ! For queries that do not return rows, PQexec() returns PGRES_COMMAND_OK
-    ! ! For queries that return rows, PQexec() returns PGRES_TUPLES_OK
-    ! PQexec dup postgresql-result-ok? [
-        ! dup postgresql-error-message swap PQclear throw
-    ! ] unless ;
-
-! : (do-command) ( PGconn query -- PGresult* )
-    ! [ (do-query) ] catch
-    ! [
-        ! swap
-        ! "non-fatal error: " print
-        ! "\tQuery: " write "'" write write "'" print
-        ! "\t" write print
-    ! ] when* drop ;

extra/db/postgresql/postgresql-tests.factor

@@ -2,53 +2,109 @@
 ! Set username and password in  the 'connect' word.
 
 USING: kernel db.postgresql alien continuations io prettyprint
-sequences namespaces tools.test ;
+sequences namespaces tools.test db ;
 IN: temporary
 
-: test-connection ( host port pgopts pgtty db user pass -- bool )
+IN: scratchpad
-    [ [ ] with-postgres ] catch "Error connecting!" "Connected!" ? print ;
+: test-db ( -- postgresql-db )
+    "localhost" "postgres" "" "factor-test" <postgresql-db> ;
+IN: temporary
 
-[ ] [ "localhost" "" "" "" "factor-test" "postgres" "" test-connection ] unit-test
+[ ] [ test-db [ ] with-db ] unit-test
 
-[ ] [ "localhost" "postgres" "" "factor-test" <postgresql-db> [ ] with-db ] unit-test
+[ ] [
+    test-db [
+        [ "drop table person;" sql-command ] catch drop
+        "create table person (name varchar(30), country varchar(30));"
+            sql-command
 
-! just a basic demo
+        "insert into person values('John', 'America');" sql-command
+        "insert into person values('Jane', 'New Zealand');" sql-command
+    ] with-db
+] unit-test
 
-"localhost" "postgres" "" "factor-test" <postgresql-db> [
+[
-    [ ] [ "drop table animal" do-command ] unit-test
+    {
+        { "John" "America" }
+        { "Jane" "New Zealand" }
+    }
+] [
+    test-db [
+        "select * from person" sql-query
+    ] with-db
+] unit-test
 
-    [ ] [ "create table animal (id serial not null primary key, species varchar(256), name varchar(256), age integer)" do-command ] unit-test
+[
+    { { "John" "America" } }
+] [
+    test-db [
+        "select * from person where name = $1 and country = $2"
+        <simple-statement> [
+            { "Jane" "New Zealand" }
+            over do-bound-query
 
-    [ ] [ "insert into animal (species, name, age) values ('lion', 'Mufasa', 5)"
+            { { "Jane" "New Zealand" } } =
-    do-command ] unit-test
+            [ "test fails" throw ] unless
 
-    [ ] [ "select * from animal where name = 'Mufasa'" [ ] do-query ] unit-test
+            { "John" "America" }
-    [ ] [ "select * from animal where name = 'Mufasa'" [
+            swap do-bound-query
-            result>seq length 1 = [
+        ] with-disposal
-                "...there can only be one Mufasa..." throw
+    ] with-db
-            ] unless
+] unit-test
-        ] do-query
-    ] unit-test
 
-    [ ] [ "insert into animal (species, name, age) values ('lion', 'Simba', 1)"
+[
-    do-command ] unit-test
+    {
+        { "John" "America" }
+        { "Jane" "New Zealand" }
+    }
+] [ test-db [ "select * from person" sql-query ] with-db ] unit-test
 
-    [ ] [
+[
-        "select * from animal" 
+] [
+    test-db [
+        "insert into person(name, country) values('Jimmy', 'Canada')"
+        sql-command
+    ] with-db
+] unit-test
+
+[
+    {
+        { "John" "America" }
+        { "Jane" "New Zealand" }
+        { "Jimmy" "Canada" }
+    }
+] [ test-db [ "select * from person" sql-query ] with-db ] unit-test
+
+[
+    test-db [
         [
-            "Animal table:" print
+            "insert into person(name, country) values('Jose', 'Mexico')" sql-command
-            result>seq print-table
+            "insert into person(name, country) values('Jose', 'Mexico')" sql-command
-        ] do-query
+            "oops" throw
-    ] unit-test
+        ] with-transaction
+    ] with-db
+] unit-test-fails
 
-    ! intentional errors
+[ 3 ] [
-    ! [ "select asdf from animal"
+    test-db [
-    ! [ ] do-query ] catch [ "caught: " write print ] when*
+        "select * from person" sql-query length
-    ! "select asdf from animal" [ ] do-query 
+    ] with-db
-    ! "aofijweafew" do-command
+] unit-test
-] with-db
 
+[
+] [
+    test-db [
+        [
+            "insert into person(name, country) values('Jose', 'Mexico')"
+            sql-command
+            "insert into person(name, country) values('Jose', 'Mexico')"
+            sql-command
+        ] with-transaction
+    ] with-db
+] unit-test
 
-"localhost" "postgres" "" "factor-test" <postgresql-db> [
+[ 5 ] [
-    [ ] [ "drop table animal" do-command ] unit-test
+    test-db [
-] with-db
+        "select * from person" sql-query length
+    ] with-db
+] unit-test

extra/db/postgresql/postgresql.factor

@@ -1,8 +1,5 @@
-! Copyright (C) 2007 Doug Coleman.
+! Copyright (C) 2007, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-! adapted from libpq-fe.h version 7.4.7
-! tested on debian linux with postgresql 7.4.7
-
 USING: arrays assocs alien alien.syntax continuations io
 kernel math namespaces prettyprint quotations
 sequences debugger db db.postgresql.lib db.postgresql.ffi ;
@@ -10,6 +7,7 @@ IN: db.postgresql
 
 TUPLE: postgresql-db host port pgopts pgtty db user pass ;
 TUPLE: postgresql-statement ;
+TUPLE: postgresql-result-set ;
 : <postgresql-statement> ( statement -- postgresql-statement )
     postgresql-statement construct-delegate ;
 
@@ -38,31 +36,39 @@ M: postgresql-db dispose ( db -- )
 : with-postgresql ( host ust pass db quot -- )
     >r <postgresql-db> r> with-disposal ;
 
+M: postgresql-statement bind-statement* ( seq statement -- )
+    set-statement-params ;
 
-M: postgresql-result-set #rows ( statement -- n )
+M: postgresql-statement rebind-statement ( seq statement -- )
-    statement-handle PQntuples ;
+    bind-statement* ;
 
-M: postgresql-result-set #columns ( statement -- n )
+M: postgresql-result-set #rows ( result-set -- n )
-    statement-handle PQnfields ;
+    result-set-handle PQntuples ;
 
-M: postgresql-result-set row-column ( statement n -- obj )
+M: postgresql-result-set #columns ( result-set -- n )
-    >r dup statement-handle swap statement-n r> PQgetvalue ;
+    result-set-handle PQnfields ;
 
+M: postgresql-result-set row-column ( result-set n -- obj )
+    >r dup result-set-handle swap result-set-n r> PQgetvalue ;
 
-: init-result-set ( result-set -- )
+M: postgresql-statement execute-statement ( statement -- )
-    dup result-set-max [
+    query-results dispose ;
-        dup do-postgresql-statement over set-result-set-handle
-        dup #rows over set-result-set-max
-        -1 over set-result-set-n
-    ] unless drop ;
 
 : increment-n ( result-set -- n )
     dup result-set-n 1+ dup rot set-result-set-n ;
 
-M: postgresql-result-set advance-row ( result-set -- ? )
+M: postgresql-statement query-results ( query -- result-set )
-    dup init-result-set
+    dup statement-params [
-    dup increment-n swap result-set-max >= ;
+        over [ bind-statement ] keep
+        do-postgresql-bound-statement
+    ] [
+        dup do-postgresql-statement
+    ] if*
+    postgresql-result-set <result-set>
+    dup init-result-set ;
 
+M: postgresql-result-set advance-row ( result-set -- ? )
+    dup increment-n swap result-set-max >= ;
 
 M: postgresql-statement dispose ( query -- )
     dup statement-handle PQclear
@@ -71,14 +77,14 @@ M: postgresql-statement dispose ( query -- )
 M: postgresql-result-set dispose ( result-set -- )
     dup result-set-handle PQclear
     0 0 f roll {
-        set-statement-n set-statement-max set-statement-handle
+        set-result-set-n set-result-set-max set-result-set-handle
     } set-slots ;
 
 M: postgresql-statement prepare-statement ( statement -- )
     [
         >r db get db-handle "" r>
         dup statement-sql swap statement-params
-        dup assoc-size swap PQprepare postgresql-error
+        length f PQprepare postgresql-error
     ] keep set-statement-handle ;
 
 M: postgresql-db <simple-statement> ( sql -- statement )
@@ -88,3 +94,12 @@ M: postgresql-db <simple-statement> ( sql -- statement )
 M: postgresql-db <prepared-statement> ( sql -- statement )
     { set-statement-sql } statement construct
     <postgresql-statement> ;
+
+M: postgresql-db begin-transaction ( -- )
+    "BEGIN" sql-command ;
+
+M: postgresql-db commit-transaction ( -- )
+    "COMMIT" sql-command ;
+
+M: postgresql-db rollback-transaction ( -- )
+    "ROLLBACK" sql-command ;

extra/db/sqlite/lib/lib.factor

@@ -1,3 +1,5 @@
+! Copyright (C) 2008 Chris Double, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types assocs kernel math math.parser sequences
 db.sqlite.ffi ;
 IN: db.sqlite.lib
@@ -65,7 +67,6 @@ TUPLE: sqlite-error n message ;
 ! SQLITE_BLOB        4
 ! SQLITE_NULL        5
 
-
 : step-complete? ( step-result -- bool )
     dup SQLITE_ROW =  [
         drop f
@@ -82,22 +83,3 @@ TUPLE: sqlite-error n message ;
 
 : sqlite-next ( prepared -- ? )
     sqlite3_step step-complete? ;
-
-: sqlite-each ( statement quot -- )    
-    over sqlite3_step step-complete? [
-        2drop
-    ] [
-        [ call ] 2keep sqlite-each
-    ] if ; inline 
-
-DEFER: (sqlite-map)
-
-: (sqlite-map) ( statement quot seq -- )
-    pick sqlite3_step step-complete? [
-        2nip
-    ] [
-        >r 2dup call r> swap add (sqlite-map)
-    ] if ;
-
-: sqlite-map ( statement quot -- seq )
-    { } (sqlite-map) ;

extra/db/sqlite/sqlite-tests.factor

@@ -5,12 +5,14 @@ IN: temporary
 
 ! "sqlite3 -init test.txt test.db"
 
+IN: scratchpad
 : test.db "extra/db/sqlite/test.db" resource-path ;
 
+IN: temporary
 : (create-db) ( -- str )
     [
         "sqlite3 -init " %
-        "extra/db/sqlite/test.txt" resource-path %
+        test.db %
         " " %
         test.db %
     ] "" make ;
@@ -27,7 +29,7 @@ IN: temporary
         { "Jane" "New Zealand" }
     }
 ] [
-    "extra/db/sqlite/test.db" resource-path [
+    test.db [
         "select * from person" sql-query
     ] with-sqlite
 ] unit-test
@@ -35,7 +37,7 @@ IN: temporary
 [
     { { "John" "America" } }
 ] [
-    "extra/db/sqlite/test.db" resource-path [
+    test.db [
         "select * from person where name = :name and country = :country"
         <simple-statement> [
             { { ":name" "Jane" } { ":country" "New Zealand" } }
@@ -59,7 +61,7 @@ IN: temporary
 
 [
 ] [
-    "extra/db/sqlite/test.db" resource-path [
+    test.db [
         "insert into person(name, country) values('Jimmy', 'Canada')"
         sql-command
     ] with-sqlite
@@ -74,7 +76,7 @@ IN: temporary
 ] [ test.db [ "select rowid, * from person" sql-query ] with-sqlite ] unit-test
 
 [
-    "extra/db/sqlite/test.db" resource-path [
+    test.db [
         [
             "insert into person(name, country) values('Jose', 'Mexico')" sql-command
             "insert into person(name, country) values('Jose', 'Mexico')" sql-command
@@ -84,14 +86,14 @@ IN: temporary
 ] unit-test-fails
 
 [ 3 ] [
-    "extra/db/sqlite/test.db" resource-path [
+    test.db [
         "select * from person" sql-query length
     ] with-sqlite
 ] unit-test
 
 [
 ] [
-    "extra/db/sqlite/test.db" resource-path [
+    test.db [
         [
             "insert into person(name, country) values('Jose', 'Mexico')"
             sql-command
@@ -102,7 +104,7 @@ IN: temporary
 ] unit-test
 
 [ 5 ] [
-    "extra/db/sqlite/test.db" resource-path [
+    test.db [
         "select * from person" sql-query length
     ] with-sqlite
 ] unit-test

extra/db/sqlite/sqlite.factor

@@ -64,7 +64,6 @@ M: sqlite-result-set advance-row ( result-set -- handle ? )
 M: sqlite-statement query-results ( query -- result-set )
     dup statement-handle sqlite-result-set <result-set> ;
 
-
 M: sqlite-db begin-transaction ( -- )
     "BEGIN" sql-command ;