From 86667aee238c9e710ffad94dbd1393474d9ff627 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 14 Feb 2008 01:27:54 -0600 Subject: [PATCH] execute-statement is now a word not a generic sqlite works for tuple-tests postgresql create/drop/insert works better now --- extra/db/db.factor | 22 ++- extra/db/postgresql/lib/lib.factor | 11 +- extra/db/postgresql/postgresql-tests.factor | 6 +- extra/db/postgresql/postgresql.factor | 141 ++++++++++++++------ extra/db/sqlite/lib/lib.factor | 3 +- extra/db/sqlite/sqlite.factor | 9 +- extra/db/tuples/tuples-tests.factor | 12 +- extra/db/tuples/tuples.factor | 6 +- extra/db/types/types.factor | 1 + 9 files changed, 130 insertions(+), 81 deletions(-) diff --git a/extra/db/db.factor b/extra/db/db.factor index 46b257ce7a..365f0c009c 100755 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -36,13 +36,17 @@ HOOK: db ( str -- statement ) GENERIC: prepare-statement ( statement -- ) GENERIC: bind-statement* ( obj statement -- ) GENERIC: reset-statement ( statement -- ) -GENERIC: execute-statement* ( statement -- result-set ) +GENERIC: insert-statement ( statement -- id ) HOOK: last-id db ( res -- id ) -: execute-statement ( statement -- ) - execute-statement* dispose ; -: execute-statement-last-id ( statement -- id ) - execute-statement* [ last-id ] with-disposal ; +TUPLE: result-set sql params handle n max ; +GENERIC: query-results ( query -- result-set ) +GENERIC: #rows ( result-set -- n ) +GENERIC: #columns ( result-set -- n ) +GENERIC# row-column 1 ( result-set n -- obj ) +GENERIC: advance-row ( result-set -- ? ) + +: execute-statement ( statement -- ) query-results dispose ; : bind-statement ( obj statement -- ) dup statement-bound? [ dup reset-statement ] when @@ -50,14 +54,6 @@ HOOK: last-id db ( res -- id ) [ set-statement-params ] keep t swap set-statement-bound? ; -TUPLE: result-set sql params handle n max ; - -GENERIC: query-results ( query -- result-set ) -GENERIC: #rows ( result-set -- n ) -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 ; diff --git a/extra/db/postgresql/lib/lib.factor b/extra/db/postgresql/lib/lib.factor index d8381ca83a..c48eff964a 100644 --- a/extra/db/postgresql/lib/lib.factor +++ b/extra/db/postgresql/lib/lib.factor @@ -1,7 +1,8 @@ ! 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 alien alien.c-types ; +quotations sequences db.postgresql.ffi alien alien.c-types +db.types ; IN: db.postgresql.lib : postgresql-result-error-message ( res -- str/f ) @@ -37,13 +38,9 @@ IN: db.postgresql.lib >r db get db-handle r> [ statement-sql ] keep [ statement-params length f ] keep - statement-params [ second malloc-char-string ] map >c-void*-array + statement-params + [ first number>string* malloc-char-string ] map >c-void*-array f f 0 PQexecParams dup postgresql-result-ok? [ dup postgresql-result-error-message swap PQclear throw ] unless ; - -: pq-oid-value ( res -- n ) - PQoidValue dup InvalidOid = [ - "postgresql returned an InvalidOid" throw - ] when ; diff --git a/extra/db/postgresql/postgresql-tests.factor b/extra/db/postgresql/postgresql-tests.factor index 8c6791c767..36b6fc829b 100644 --- a/extra/db/postgresql/postgresql-tests.factor +++ b/extra/db/postgresql/postgresql-tests.factor @@ -2,7 +2,7 @@ ! Set username and password in the 'connect' word. USING: kernel db.postgresql alien continuations io prettyprint -sequences namespaces tools.test db ; +sequences namespaces tools.test db db.types ; IN: temporary IN: scratchpad @@ -40,13 +40,13 @@ IN: temporary test-db [ "select * from person where name = $1 and country = $2" [ - { "Jane" "New Zealand" } + { { "Jane" TEXT } { "New Zealand" TEXT } } over do-bound-query { { "Jane" "New Zealand" } } = [ "test fails" throw ] unless - { "John" "America" } + { { "John" TEXT } { "America" TEXT } } swap do-bound-query ] with-disposal ] with-db diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index dac4d78b78..93c66708b4 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -3,7 +3,7 @@ USING: arrays assocs alien alien.syntax continuations io kernel math math.parser namespaces prettyprint quotations sequences debugger db db.postgresql.lib db.postgresql.ffi -db.tuples db.types ; +db.tuples db.types tools.annotations ; IN: db.postgresql TUPLE: postgresql-db host port pgopts pgtty db user pass ; @@ -52,8 +52,11 @@ M: postgresql-result-set #columns ( result-set -- n ) M: postgresql-result-set row-column ( result-set n -- obj ) >r dup result-set-handle swap result-set-n r> PQgetvalue ; -M: postgresql-statement execute-statement* ( statement -- obj ) - query-results ; +M: postgresql-statement execute-statement ( statement -- obj ) + query-results dispose ; + +M: postgresql-statement insert-statement ( statement -- id ) + query-results dispose ; : increment-n ( result-set -- n ) dup result-set-n 1+ dup rot set-result-set-n ; @@ -105,72 +108,137 @@ M: postgresql-db commit-transaction ( -- ) M: postgresql-db rollback-transaction ( -- ) "ROLLBACK" sql-command ; +SYMBOL: postgresql-counter + +: make-postgresql-counter ( quot -- ) + [ postgresql-counter off ] swap compose "" make ; + +: counter% ( -- ) + CHAR: $ , + postgresql-counter [ inc ] keep get # ; + +: postgresql-type-hash* ( -- assoc ) + H{ + { SERIAL "serial" } + } ; + +: postgresql-type-hash ( -- assoc ) + H{ + { INTEGER "integer" } + { SERIAL "integer" } + { TEXT "text" } + { VARCHAR "varchar" } + { DOUBLE "real" } + } ; + +: enquote ( str -- newstr ) "(" swap ")" 3append ; + +: postgresql-type ( str n/str -- newstr ) + " " swap number>string* enquote 3append ; + +: >sql-type* ( obj -- str ) + dup pair? [ + first2 >r >sql-type* r> postgresql-type + ] [ + dup postgresql-type-hash* at* [ + nip + ] [ + drop >sql-type + ] if + ] if ; + +M: postgresql-db >sql-type ( hash obj -- str ) + dup pair? [ + first2 >r >sql-type r> postgresql-type + ] [ + postgresql-type-hash at* [ + no-sql-type + ] unless + ] if ; M: postgresql-db create-sql ( columns table -- sql ) [ + 2dup "create table " % % " (" % [ ", " % ] [ dup second % " " % - dup third >sql-type % " " % + dup third >sql-type* % " " % sql-modifiers " " join % - ] interleave ")" % - ] "" make ; + ] interleave "); " % -M: postgresql-db drop-sql ( table -- sql ) - [ - "drop table " % % - ] "" make ; + "create function add_" % dup % + "(" % + over [ "," % ] + [ third dup array? [ first ] when >sql-type % ] interleave + ")" % + " returns bigint as '" % -SYMBOL: postgresql-counter - -M: postgresql-db insert-sql* ( columns table -- sql ) - [ - postgresql-counter off - "insert into " % + 2dup "insert into " % % "(" % dup [ ", " % ] [ second % ] interleave ") " % " values (" % - [ ", " % ] [ - drop "$" % postgresql-counter [ inc ] keep get # - ] interleave + [ ", " % ] [ drop counter% ] interleave + "); " % + + "select currval(''" % % "_id_seq'');' language sql;" % + drop + ] make-postgresql-counter dup . ; + +M: postgresql-db drop-sql ( columns table -- sql ) + [ + dup "drop table " % % + "; drop function add_" % % + "(" % + [ "," % ] [ third >sql-type % ] interleave ")" % + ] "" make ; +! \ create-sql reset +! \ create-sql watch + +M: postgresql-db insert-sql* ( columns table -- sql ) + [ + "select add_" % % + "(" % + [ ", " % ] [ counter% ] interleave + ")" % + ] make-postgresql-counter ; + M: postgresql-db update-sql* ( columns table -- sql ) [ "update " % % " set " % dup remove-id - [ ", " % ] [ second dup % " = :" % % ] interleave + [ ", " % ] [ second % " = " % counter% ] interleave " where " % - [ primary-key? ] find nip second dup % " = :" % % - ] "" make ; + [ primary-key? ] find nip second dup % " = " % counter% + ] make-postgresql-counter ; M: postgresql-db delete-sql* ( columns table -- sql ) [ "delete from " % % " where " % - first second dup % " = :" % % - ] "" make ; + first second dup % " = " % counter% + ] make-postgresql-counter ; M: postgresql-db select-sql* ( columns table -- sql ) drop ; M: postgresql-db tuple>params ( columns tuple -- obj ) - [ - >r dup first r> get-slot-named swap third - ] curry { } map>assoc ; + [ >r dup third swap first r> get-slot-named swap ] + curry { } map>assoc ; M: postgresql-db last-id ( res -- id ) - pq-oid-value ; + drop f ; : postgresql-db-modifiers ( -- hashtable ) H{ - { +native-id+ "primary key" } + { +native-id+ "not null primary key" } { +assigned-id+ "primary key" } { +autoincrement+ "autoincrement" } { +unique+ "unique" } @@ -189,18 +257,3 @@ M: postgresql-db sql-modifiers* ( modifiers -- str ) swap at ] if ] with map [ ] subset ; - -: postgresql-type-hash ( -- assoc ) - H{ - { INTEGER "integer" } - { TEXT "text" } - { VARCHAR "text" } - { DOUBLE "real" } - } ; - -M: postgresql-db >sql-type ( obj -- str ) - dup pair? [ - first >sql-type - ] [ - postgresql-type-hash at* [ T{ no-sql-type } throw ] unless - ] if ; diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index e97dcf80c9..2c0f2ae130 100755 --- a/extra/db/sqlite/lib/lib.factor +++ b/extra/db/sqlite/lib/lib.factor @@ -74,10 +74,11 @@ IN: db.sqlite.lib dup array? [ first ] when { { INTEGER [ sqlite-bind-int-by-name ] } - { BIG_INTEGER [ sqlite-bind-int-by-name ] } + { BIG_INTEGER [ sqlite-bind-int64-by-name ] } { TEXT [ sqlite-bind-text-by-name ] } { VARCHAR [ sqlite-bind-text-by-name ] } { DOUBLE [ sqlite-bind-double-by-name ] } + { SERIAL [ sqlite-bind-int-by-name ] } ! { NULL [ sqlite-bind-null-by-name ] } [ no-sql-type ] } case ; diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index f58c669681..d83642bd8c 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -58,8 +58,8 @@ M: sqlite-statement bind-statement* ( triples statement -- ) M: sqlite-statement reset-statement ( statement -- ) statement-handle sqlite-reset ; -M: sqlite-statement execute-statement* ( statement -- obj ) - query-results ; +M: sqlite-statement insert-statement ( statement -- id ) + query-results [ last-id ] with-disposal ; M: sqlite-result-set #columns ( result-set -- n ) result-set-handle sqlite-#columns ; @@ -93,9 +93,10 @@ M: sqlite-db create-sql ( columns table -- sql ) ] interleave ")" % ] "" make ; -M: sqlite-db drop-sql ( table -- sql ) +M: sqlite-db drop-sql ( columns table -- sql ) [ "drop table " % % + drop ] "" make ; M: sqlite-db insert-sql* ( columns table -- sql ) @@ -175,6 +176,7 @@ M: sqlite-db sql-modifiers* ( modifiers -- str ) : sqlite-type-hash ( -- assoc ) H{ { INTEGER "integer" } + { SERIAL "integer" } { TEXT "text" } { VARCHAR "text" } { DOUBLE "real" } @@ -190,4 +192,3 @@ M: sqlite-db >sql-type ( obj -- str ) ! HOOK: get-column-value ( n result-set type -- ) ! M: sqlite get-column-value { { "TEXT" get-text-column } { ! "INTEGER" get-integer-column } ... } case ; - diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 6945ccc722..cb4129965c 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: io.files kernel tools.test db db.sqlite db.tuples -db.types continuations namespaces db.postgresql math -tools.time ; +db.types continuations namespaces db.postgresql math ; +! tools.time ; IN: temporary TUPLE: person the-id the-name the-number real ; @@ -44,7 +44,7 @@ SYMBOL: the-person person "PERSON" { - { "the-id" "ROWID" INTEGER +native-id+ } + { "the-id" "ID" SERIAL +native-id+ } { "the-name" "NAME" { VARCHAR 256 } +not-null+ } { "the-number" "AGE" INTEGER { +default+ 0 } } { "real" "REAL" DOUBLE { +default+ 0.3 } } @@ -52,12 +52,12 @@ person "PERSON" "billy" 10 3.14 the-person set -test-sqlite + test-sqlite ! test-postgresql person "PERSON" { - { "the-id" "ROWID" INTEGER +assigned-id+ } + { "the-id" "ID" INTEGER +assigned-id+ } { "the-name" "NAME" { VARCHAR 256 } +not-null+ } { "the-number" "AGE" INTEGER { +default+ 0 } } { "real" "REAL" DOUBLE { +default+ 0.3 } } @@ -65,5 +65,5 @@ person "PERSON" 1 "billy" 20 6.28 the-person set -test-sqlite + test-sqlite ! test-postgresql diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 783001f3f8..1697de83d3 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -39,7 +39,7 @@ TUPLE: no-slot-named ; [ ] 3compose cache nip ; inline HOOK: create-sql db ( columns table -- sql ) -HOOK: drop-sql db ( table -- sql ) +HOOK: drop-sql db ( columns table -- sql ) HOOK: insert-sql* db ( columns table -- sql ) HOOK: update-sql* db ( columns table -- sql ) HOOK: delete-sql* db ( columns table -- sql ) @@ -75,12 +75,12 @@ HOOK: tuple>params db ( columns tuple -- obj ) dup db-columns swap db-table create-sql sql-command ; : drop-table ( class -- ) - db-table drop-sql sql-command ; + dup db-columns swap db-table drop-sql sql-command ; : insert-tuple ( tuple -- ) [ [ maybe-remove-id ] [ insert-sql ] - make-tuple-statement execute-statement-last-id + make-tuple-statement insert-statement ] keep set-primary-key ; : update-tuple ( tuple -- ) diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index b8c82524a8..30c15682fa 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -22,6 +22,7 @@ SYMBOL: +not-null+ SYMBOL: +has-many+ +SYMBOL: SERIAL SYMBOL: INTEGER SYMBOL: DOUBLE SYMBOL: BOOLEAN