diff --git a/extra/db/db.factor b/extra/db/db.factor index 81d79eb695..b765924cd6 100644 --- 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 ; + : ( query handle tuple -- result-set ) >r >r { statement-sql statement-params } get-slots r> { diff --git a/extra/db/postgresql/ffi/ffi.factor b/extra/db/postgresql/ffi/ffi.factor index 368e2fbe77..dbaa70c625 100644 --- 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 diff --git a/extra/db/postgresql/lib/lib.factor b/extra/db/postgresql/lib/lib.factor index 4b362f9931..a940a42ae4 100644 --- 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 ; diff --git a/extra/db/postgresql/postgresql-tests.factor b/extra/db/postgresql/postgresql-tests.factor index 438a80e2d8..c5a5155d12 100644 --- 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" ; +IN: temporary -[ ] [ "localhost" "" "" "" "factor-test" "postgres" "" test-connection ] unit-test +[ ] [ test-db [ ] with-db ] unit-test -[ ] [ "localhost" "postgres" "" "factor-test" [ ] 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" [ - [ ] [ "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 - - [ ] [ "insert into animal (species, name, age) values ('lion', 'Mufasa', 5)" - do-command ] unit-test +[ + { { "John" "America" } } +] [ + test-db [ + "select * from person where name = $1 and country = $2" + [ + { "Jane" "New Zealand" } + over do-bound-query - [ ] [ "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 + { { "Jane" "New Zealand" } } = + [ "test fails" throw ] unless - [ ] [ "insert into animal (species, name, age) values ('lion', 'Simba', 1)" - do-command ] unit-test + { "John" "America" } + swap do-bound-query + ] with-disposal + ] with-db +] unit-test - [ ] [ - "select * from animal" +[ + { + { "John" "America" } + { "Jane" "New Zealand" } + } +] [ test-db [ "select * from person" sql-query ] with-db ] unit-test + +[ +] [ + 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" [ - [ ] [ "drop table animal" do-command ] unit-test -] with-db +[ 5 ] [ + test-db [ + "select * from person" sql-query length + ] with-db +] unit-test diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index 2ea1b3a1dc..df778cc80d 100644 --- 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 ; : ( statement -- postgresql-statement ) postgresql-statement construct-delegate ; @@ -38,31 +36,39 @@ M: postgresql-db dispose ( db -- ) : with-postgresql ( host ust pass db quot -- ) >r 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 + 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 ( sql -- statement ) @@ -88,3 +94,12 @@ M: postgresql-db ( sql -- statement ) M: postgresql-db ( sql -- statement ) { set-statement-sql } statement construct ; + +M: postgresql-db begin-transaction ( -- ) + "BEGIN" sql-command ; + +M: postgresql-db commit-transaction ( -- ) + "COMMIT" sql-command ; + +M: postgresql-db rollback-transaction ( -- ) + "ROLLBACK" sql-command ; diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index 4e4f2ca508..e5f8425d92 100644 --- 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) ; diff --git a/extra/db/sqlite/sqlite-tests.factor b/extra/db/sqlite/sqlite-tests.factor index ef1bbfc262..f64b8d1104 100644 --- 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" [ { { ":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 diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index 8352d2e11f..49462dcc50 100644 --- 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 ; - M: sqlite-db begin-transaction ( -- ) "BEGIN" sql-command ;