add copyright notices

update postgresql for new db protocol make unit tests pass
2008-02-03 15:06:31 -06:00 · 2008-02-03 15:06:31 -06:00 · bb1e06dd8d
parent 1b03538caa
commit bb1e06dd8d
8 changed files with 161 additions and 133 deletions
--- a/extra/db/db.factor
+++ b/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>
    {
--- a/extra/db/postgresql/ffi/ffi.factor
+++ b/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
-! Updated to 8.1
+! tested on debian linux with postgresql 8.1

 USING: alien alien.syntax combinators system ;
 IN: db.postgresql.ffi
--- a/extra/db/postgresql/lib/lib.factor
+++ b/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 -- )
-    ! 1quotation \ (do-command) add db get swap call ;
-
-! : prepare ( str quot word -- conn quot )
-    ! rot 1quotation swap append swap append db get swap ;
-
-! : do-query ( str quot -- )
-    ! [ (do-query) query-res set ] prepare catch
-    ! [ rethrow ] [ query-res get PQclear ] if* ;
-
-! : 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 ;
+: do-postgresql-bound-statement ( statement -- res )
+    >r db get db-handle r>
+    [ statement-sql ] keep
+    [ statement-params length f ] keep
+    statement-params [ malloc-char-string ] map >c-void*-array
+    f f 0 PQexecParams
+    dup postgresql-result-ok? [
+        dup postgresql-result-error-message swap PQclear throw
+    ] unless ;
--- a/extra/db/postgresql/postgresql-tests.factor
+++ b/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 )
-    [ [ ] with-postgres ] catch "Error connecting!" "Connected!" ? print ;
+IN: scratchpad
+: 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)"
-    do-command ] unit-test
+            { { "Jane" "New Zealand" } } =
+            [ "test fails" throw ] unless

-    [ ] [ "select * from animal where name = 'Mufasa'" [ ] do-query ] unit-test
-    [ ] [ "select * from animal where name = 'Mufasa'" [
-            result>seq length 1 = [
-                "...there can only be one Mufasa..." throw
-            ] unless
-        ] do-query
-    ] unit-test
+            { "John" "America" }
+            swap do-bound-query
+        ] with-disposal
+    ] with-db
+] 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
-            result>seq print-table
-        ] do-query
-    ] unit-test
+            "insert into person(name, country) values('Jose', 'Mexico')" sql-command
+            "insert into person(name, country) values('Jose', 'Mexico')" sql-command
+            "oops" throw
+        ] with-transaction
+    ] with-db
+] unit-test-fails

-    ! intentional errors
-    ! [ "select asdf from animal"
-    ! [ ] do-query ] catch [ "caught: " write print ] when*
-    ! "select asdf from animal" [ ] do-query 
-    ! "aofijweafew" do-command
-] with-db
+[ 3 ] [
+    test-db [
+        "select * from person" sql-query length
+    ] with-db
+] unit-test

+[
+] [
+    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> [
-    [ ] [ "drop table animal" do-command ] unit-test
-] with-db
+[ 5 ] [
+    test-db [
+        "select * from person" sql-query length
+    ] with-db
+] unit-test
--- a/extra/db/postgresql/postgresql.factor
+++ b/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 )
-    statement-handle PQntuples ;
+M: postgresql-statement rebind-statement ( seq statement -- )
+    bind-statement* ;

-M: postgresql-result-set #columns ( statement -- n )
-    statement-handle PQnfields ;
+M: postgresql-result-set #rows ( result-set -- n )
+    result-set-handle PQntuples ;

-M: postgresql-result-set row-column ( statement n -- obj )
-    >r dup statement-handle swap statement-n r> PQgetvalue ;
+M: postgresql-result-set #columns ( result-set -- n )
+    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 -- )
-    dup result-set-max [
-        dup do-postgresql-statement over set-result-set-handle
-        dup #rows over set-result-set-max
-        -1 over set-result-set-n
-    ] unless drop ;
+M: postgresql-statement execute-statement ( statement -- )
+    query-results dispose ;

 : increment-n ( result-set -- n )
    dup result-set-n 1+ dup rot set-result-set-n ;

-M: postgresql-result-set advance-row ( result-set -- ? )
-    dup init-result-set
-    dup increment-n swap result-set-max >= ;
+M: postgresql-statement query-results ( query -- result-set )
+    dup statement-params [
+        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 ;
--- a/extra/db/sqlite/lib/lib.factor
+++ b/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) ;
--- a/extra/db/sqlite/sqlite-tests.factor
+++ b/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
--- a/extra/db/sqlite/sqlite.factor
+++ b/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 ;