execute-statement is now a word not a generic

sqlite works for tuple-tests
postgresql create/drop/insert works better now
db4
Doug Coleman 2008-02-14 01:27:54 -06:00
parent 35b5f222e3
commit 86667aee23
9 changed files with 130 additions and 81 deletions

View File

@ -36,13 +36,17 @@ HOOK: <prepared-statement> db ( str -- statement )
GENERIC: prepare-statement ( statement -- ) GENERIC: prepare-statement ( statement -- )
GENERIC: bind-statement* ( obj statement -- ) GENERIC: bind-statement* ( obj statement -- )
GENERIC: reset-statement ( statement -- ) GENERIC: reset-statement ( statement -- )
GENERIC: execute-statement* ( statement -- result-set ) GENERIC: insert-statement ( statement -- id )
HOOK: last-id db ( res -- id ) HOOK: last-id db ( res -- id )
: execute-statement ( statement -- )
execute-statement* dispose ;
: execute-statement-last-id ( statement -- id ) TUPLE: result-set sql params handle n max ;
execute-statement* [ last-id ] with-disposal ; 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 -- ) : bind-statement ( obj statement -- )
dup statement-bound? [ dup reset-statement ] when dup statement-bound? [ dup reset-statement ] when
@ -50,14 +54,6 @@ HOOK: last-id db ( res -- id )
[ set-statement-params ] keep [ set-statement-params ] keep
t swap set-statement-bound? ; 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 -- ) : init-result-set ( result-set -- )
dup #rows over set-result-set-max dup #rows over set-result-set-max
-1 swap set-result-set-n ; -1 swap set-result-set-n ;

View File

@ -1,7 +1,8 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays continuations db io kernel math namespaces 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 IN: db.postgresql.lib
: postgresql-result-error-message ( res -- str/f ) : postgresql-result-error-message ( res -- str/f )
@ -37,13 +38,9 @@ IN: db.postgresql.lib
>r db get db-handle r> >r db get db-handle r>
[ statement-sql ] keep [ statement-sql ] keep
[ statement-params length f ] 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 f f 0 PQexecParams
dup postgresql-result-ok? [ dup postgresql-result-ok? [
dup postgresql-result-error-message swap PQclear throw dup postgresql-result-error-message swap PQclear throw
] unless ; ] unless ;
: pq-oid-value ( res -- n )
PQoidValue dup InvalidOid = [
"postgresql returned an InvalidOid" throw
] when ;

View File

@ -2,7 +2,7 @@
! Set username and password in the 'connect' word. ! Set username and password in the 'connect' word.
USING: kernel db.postgresql alien continuations io prettyprint USING: kernel db.postgresql alien continuations io prettyprint
sequences namespaces tools.test db ; sequences namespaces tools.test db db.types ;
IN: temporary IN: temporary
IN: scratchpad IN: scratchpad
@ -40,13 +40,13 @@ IN: temporary
test-db [ test-db [
"select * from person where name = $1 and country = $2" "select * from person where name = $1 and country = $2"
<simple-statement> [ <simple-statement> [
{ "Jane" "New Zealand" } { { "Jane" TEXT } { "New Zealand" TEXT } }
over do-bound-query over do-bound-query
{ { "Jane" "New Zealand" } } = { { "Jane" "New Zealand" } } =
[ "test fails" throw ] unless [ "test fails" throw ] unless
{ "John" "America" } { { "John" TEXT } { "America" TEXT } }
swap do-bound-query swap do-bound-query
] with-disposal ] with-disposal
] with-db ] with-db

View File

@ -3,7 +3,7 @@
USING: arrays assocs alien alien.syntax continuations io USING: arrays assocs alien alien.syntax continuations io
kernel math math.parser namespaces prettyprint quotations kernel math math.parser namespaces prettyprint quotations
sequences debugger db db.postgresql.lib db.postgresql.ffi sequences debugger db db.postgresql.lib db.postgresql.ffi
db.tuples db.types ; db.tuples db.types tools.annotations ;
IN: db.postgresql IN: db.postgresql
TUPLE: postgresql-db host port pgopts pgtty db user pass ; 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 ) M: postgresql-result-set row-column ( result-set n -- obj )
>r dup result-set-handle swap result-set-n r> PQgetvalue ; >r dup result-set-handle swap result-set-n r> PQgetvalue ;
M: postgresql-statement execute-statement* ( statement -- obj ) M: postgresql-statement execute-statement ( statement -- obj )
query-results ; query-results dispose ;
M: postgresql-statement insert-statement ( statement -- id )
query-results dispose ;
: increment-n ( result-set -- n ) : increment-n ( result-set -- n )
dup result-set-n 1+ dup rot set-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 ( -- ) M: postgresql-db rollback-transaction ( -- )
"ROLLBACK" sql-command ; "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 ) M: postgresql-db create-sql ( columns table -- sql )
[ [
2dup
"create table " % % "create table " % %
" (" % [ ", " % ] [ " (" % [ ", " % ] [
dup second % " " % dup second % " " %
dup third >sql-type % " " % dup third >sql-type* % " " %
sql-modifiers " " join % sql-modifiers " " join %
] interleave ")" % ] interleave "); " %
] "" make ;
M: postgresql-db drop-sql ( table -- sql ) "create function add_" % dup %
[ "(" %
"drop table " % % over [ "," % ]
] "" make ; [ third dup array? [ first ] when >sql-type % ] interleave
")" %
" returns bigint as '" %
SYMBOL: postgresql-counter 2dup "insert into " %
M: postgresql-db insert-sql* ( columns table -- sql )
[
postgresql-counter off
"insert into " %
% %
"(" % "(" %
dup [ ", " % ] [ second % ] interleave dup [ ", " % ] [ second % ] interleave
") " % ") " %
" values (" % " values (" %
[ ", " % ] [ [ ", " % ] [ drop counter% ] interleave
drop "$" % postgresql-counter [ inc ] keep get # "); " %
] 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 ; ] "" 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 ) M: postgresql-db update-sql* ( columns table -- sql )
[ [
"update " % "update " %
% %
" set " % " set " %
dup remove-id dup remove-id
[ ", " % ] [ second dup % " = :" % % ] interleave [ ", " % ] [ second % " = " % counter% ] interleave
" where " % " where " %
[ primary-key? ] find nip second dup % " = :" % % [ primary-key? ] find nip second dup % " = " % counter%
] "" make ; ] make-postgresql-counter ;
M: postgresql-db delete-sql* ( columns table -- sql ) M: postgresql-db delete-sql* ( columns table -- sql )
[ [
"delete from " % "delete from " %
% %
" where " % " where " %
first second dup % " = :" % % first second dup % " = " % counter%
] "" make ; ] make-postgresql-counter ;
M: postgresql-db select-sql* ( columns table -- sql ) M: postgresql-db select-sql* ( columns table -- sql )
drop ; drop ;
M: postgresql-db tuple>params ( columns tuple -- obj ) M: postgresql-db tuple>params ( columns tuple -- obj )
[ [ >r dup third swap first r> get-slot-named swap ]
>r dup first r> get-slot-named swap third curry { } map>assoc ;
] curry { } map>assoc ;
M: postgresql-db last-id ( res -- id ) M: postgresql-db last-id ( res -- id )
pq-oid-value ; drop f ;
: postgresql-db-modifiers ( -- hashtable ) : postgresql-db-modifiers ( -- hashtable )
H{ H{
{ +native-id+ "primary key" } { +native-id+ "not null primary key" }
{ +assigned-id+ "primary key" } { +assigned-id+ "primary key" }
{ +autoincrement+ "autoincrement" } { +autoincrement+ "autoincrement" }
{ +unique+ "unique" } { +unique+ "unique" }
@ -189,18 +257,3 @@ M: postgresql-db sql-modifiers* ( modifiers -- str )
swap at swap at
] if ] if
] with map [ ] subset ; ] 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 ;

View File

@ -74,10 +74,11 @@ IN: db.sqlite.lib
dup array? [ first ] when dup array? [ first ] when
{ {
{ INTEGER [ sqlite-bind-int-by-name ] } { 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 ] } { TEXT [ sqlite-bind-text-by-name ] }
{ VARCHAR [ sqlite-bind-text-by-name ] } { VARCHAR [ sqlite-bind-text-by-name ] }
{ DOUBLE [ sqlite-bind-double-by-name ] } { DOUBLE [ sqlite-bind-double-by-name ] }
{ SERIAL [ sqlite-bind-int-by-name ] }
! { NULL [ sqlite-bind-null-by-name ] } ! { NULL [ sqlite-bind-null-by-name ] }
[ no-sql-type ] [ no-sql-type ]
} case ; } case ;

View File

@ -58,8 +58,8 @@ M: sqlite-statement bind-statement* ( triples statement -- )
M: sqlite-statement reset-statement ( statement -- ) M: sqlite-statement reset-statement ( statement -- )
statement-handle sqlite-reset ; statement-handle sqlite-reset ;
M: sqlite-statement execute-statement* ( statement -- obj ) M: sqlite-statement insert-statement ( statement -- id )
query-results ; query-results [ last-id ] with-disposal ;
M: sqlite-result-set #columns ( result-set -- n ) M: sqlite-result-set #columns ( result-set -- n )
result-set-handle sqlite-#columns ; result-set-handle sqlite-#columns ;
@ -93,9 +93,10 @@ M: sqlite-db create-sql ( columns table -- sql )
] interleave ")" % ] interleave ")" %
] "" make ; ] "" make ;
M: sqlite-db drop-sql ( table -- sql ) M: sqlite-db drop-sql ( columns table -- sql )
[ [
"drop table " % % "drop table " % %
drop
] "" make ; ] "" make ;
M: sqlite-db insert-sql* ( columns table -- sql ) M: sqlite-db insert-sql* ( columns table -- sql )
@ -175,6 +176,7 @@ M: sqlite-db sql-modifiers* ( modifiers -- str )
: sqlite-type-hash ( -- assoc ) : sqlite-type-hash ( -- assoc )
H{ H{
{ INTEGER "integer" } { INTEGER "integer" }
{ SERIAL "integer" }
{ TEXT "text" } { TEXT "text" }
{ VARCHAR "text" } { VARCHAR "text" }
{ DOUBLE "real" } { DOUBLE "real" }
@ -190,4 +192,3 @@ M: sqlite-db >sql-type ( obj -- str )
! HOOK: get-column-value ( n result-set type -- ) ! HOOK: get-column-value ( n result-set type -- )
! M: sqlite get-column-value { { "TEXT" get-text-column } { ! M: sqlite get-column-value { { "TEXT" get-text-column } {
! "INTEGER" get-integer-column } ... } case ; ! "INTEGER" get-integer-column } ... } case ;

View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io.files kernel tools.test db db.sqlite db.tuples USING: io.files kernel tools.test db db.sqlite db.tuples
db.types continuations namespaces db.postgresql math db.types continuations namespaces db.postgresql math ;
tools.time ; ! tools.time ;
IN: temporary IN: temporary
TUPLE: person the-id the-name the-number real ; TUPLE: person the-id the-name the-number real ;
@ -44,7 +44,7 @@ SYMBOL: the-person
person "PERSON" person "PERSON"
{ {
{ "the-id" "ROWID" INTEGER +native-id+ } { "the-id" "ID" SERIAL +native-id+ }
{ "the-name" "NAME" { VARCHAR 256 } +not-null+ } { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
{ "the-number" "AGE" INTEGER { +default+ 0 } } { "the-number" "AGE" INTEGER { +default+ 0 } }
{ "real" "REAL" DOUBLE { +default+ 0.3 } } { "real" "REAL" DOUBLE { +default+ 0.3 } }
@ -52,12 +52,12 @@ person "PERSON"
"billy" 10 3.14 <person> the-person set "billy" 10 3.14 <person> the-person set
test-sqlite test-sqlite
! test-postgresql ! test-postgresql
person "PERSON" person "PERSON"
{ {
{ "the-id" "ROWID" INTEGER +assigned-id+ } { "the-id" "ID" INTEGER +assigned-id+ }
{ "the-name" "NAME" { VARCHAR 256 } +not-null+ } { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
{ "the-number" "AGE" INTEGER { +default+ 0 } } { "the-number" "AGE" INTEGER { +default+ 0 } }
{ "real" "REAL" DOUBLE { +default+ 0.3 } } { "real" "REAL" DOUBLE { +default+ 0.3 } }
@ -65,5 +65,5 @@ person "PERSON"
1 "billy" 20 6.28 <assigned-person> the-person set 1 "billy" 20 6.28 <assigned-person> the-person set
test-sqlite test-sqlite
! test-postgresql ! test-postgresql

View File

@ -39,7 +39,7 @@ TUPLE: no-slot-named ;
[ <prepared-statement> ] 3compose cache nip ; inline [ <prepared-statement> ] 3compose cache nip ; inline
HOOK: create-sql db ( columns table -- sql ) 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: insert-sql* db ( columns table -- sql )
HOOK: update-sql* db ( columns table -- sql ) HOOK: update-sql* db ( columns table -- sql )
HOOK: delete-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 ; dup db-columns swap db-table create-sql sql-command ;
: drop-table ( class -- ) : drop-table ( class -- )
db-table drop-sql sql-command ; dup db-columns swap db-table drop-sql sql-command ;
: insert-tuple ( tuple -- ) : insert-tuple ( tuple -- )
[ [
[ maybe-remove-id ] [ insert-sql ] [ maybe-remove-id ] [ insert-sql ]
make-tuple-statement execute-statement-last-id make-tuple-statement insert-statement
] keep set-primary-key ; ] keep set-primary-key ;
: update-tuple ( tuple -- ) : update-tuple ( tuple -- )

View File

@ -22,6 +22,7 @@ SYMBOL: +not-null+
SYMBOL: +has-many+ SYMBOL: +has-many+
SYMBOL: SERIAL
SYMBOL: INTEGER SYMBOL: INTEGER
SYMBOL: DOUBLE SYMBOL: DOUBLE
SYMBOL: BOOLEAN SYMBOL: BOOLEAN