From 563565d76df177cd8dfa61b49a3b723ea4f1d3b8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 10 Mar 2008 17:00:28 -0500 Subject: [PATCH] postgresql almost works with blobs --- extra/db/postgresql/ffi/ffi.factor | 3 +- extra/db/postgresql/lib/lib.factor | 57 ++++++++++++++++++--------- extra/db/postgresql/postgresql.factor | 18 ++++++--- extra/db/tuples/tuples-tests.factor | 9 +++-- 4 files changed, 59 insertions(+), 28 deletions(-) diff --git a/extra/db/postgresql/ffi/ffi.factor b/extra/db/postgresql/ffi/ffi.factor index d14ec13ff8..a41e68234e 100755 --- a/extra/db/postgresql/ffi/ffi.factor +++ b/extra/db/postgresql/ffi/ffi.factor @@ -270,7 +270,8 @@ FUNCTION: char* PQcmdStatus ( PGresult* res ) ; FUNCTION: char* PQoidStatus ( PGresult* res ) ; FUNCTION: Oid PQoidValue ( PGresult* res ) ; FUNCTION: char* PQcmdTuples ( PGresult* res ) ; -FUNCTION: char* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ; +! FUNCTION: char* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ; +FUNCTION: void* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ; FUNCTION: int PQgetlength ( PGresult* res, int tup_num, int field_num ) ; FUNCTION: int PQgetisnull ( PGresult* res, int tup_num, int field_num ) ; diff --git a/extra/db/postgresql/lib/lib.factor b/extra/db/postgresql/lib/lib.factor index d584632609..7f1e50f54a 100755 --- a/extra/db/postgresql/lib/lib.factor +++ b/extra/db/postgresql/lib/lib.factor @@ -3,7 +3,7 @@ USING: arrays continuations db io kernel math namespaces quotations sequences db.postgresql.ffi alien alien.c-types db.types tools.walker ascii splitting math.parser -combinators combinators.cleave ; +combinators combinators.cleave libc shuffle calendar.format ; IN: db.postgresql.lib : postgresql-result-error-message ( res -- str/f ) @@ -44,27 +44,46 @@ IN: db.postgresql.lib [ statement-sql ] keep [ statement-bind-params length f ] keep statement-bind-params - [ 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 ; + [ number>string* dup [ malloc-char-string ] when ] map + [ + [ + >c-void*-array f f 0 PQexecParams + dup postgresql-result-ok? [ + dup postgresql-result-error-message swap PQclear throw + ] unless + ] keep + ] [ [ free ] each ] [ ] cleanup ; + +: pq-get-string ( handle row column -- obj ) + 3dup PQgetvalue alien>char-string + dup "" = [ >r PQgetisnull 1 = f r> ? ] [ 3nip ] if ; + +: pq-get-number ( handle row column -- obj ) + pq-get-string dup [ string>number ] when ; + +: pq-get-blob ( handle row column -- obj/f ) + [ PQgetvalue ] 3keep PQgetlength + dup 0 > [ + memory>byte-array + ] [ + 2drop f + ] if ; : postgresql-column-typed ( handle row column type -- obj ) dup array? [ first ] when { - { +native-id+ [ ] } - { INTEGER [ PQgetvalue string>number ] } - { BIG-INTEGER [ PQgetvalue string>number ] } - { DOUBLE [ PQgetvalue string>number ] } - { TEXT [ PQgetvalue ] } - { VARCHAR [ PQgetvalue ] } - { DATE [ PQgetvalue ] } - { TIME [ PQgetvalue ] } - { TIMESTAMP [ PQgetvalue ] } - { DATETIME [ PQgetvalue ] } - { BLOB [ [ PQgetvalue ] 3keep PQgetlength ] } - { FACTOR-BLOB [ [ PQgetvalue ] 3keep PQgetlength ] } + { +native-id+ [ pq-get-number ] } + { INTEGER [ pq-get-number ] } + { BIG-INTEGER [ pq-get-number ] } + { DOUBLE [ pq-get-number ] } + { TEXT [ pq-get-string ] } + { VARCHAR [ pq-get-string ] } + { DATE [ pq-get-string dup [ ymd>timestamp ] when ] } + { TIME [ pq-get-string dup [ hms>timestamp ] when ] } + { TIMESTAMP [ pq-get-string dup [ ymdhms>timestamp ] when ] } + { DATETIME [ pq-get-string dup [ ymdhms>timestamp ] when ] } + { BLOB [ pq-get-blob ] } + { FACTOR-BLOB [ pq-get-blob ] } [ no-sql-type ] } case ; - ! PQgetlength PQgetisnull \ No newline at end of file + ! PQgetlength PQgetisnull diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index 2c234ec419..26b6cbe75c 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -55,7 +55,7 @@ M: postgresql-result-set #columns ( result-set -- n ) result-set-handle PQnfields ; M: postgresql-result-set row-column ( result-set column -- obj ) - >r dup result-set-handle swap result-set-n r> PQgetvalue ; + >r dup result-set-handle swap result-set-n r> pq-get-string ; M: postgresql-result-set row-column-typed ( result-set column -- obj ) dup pick result-set-out-params nth sql-spec-type @@ -238,10 +238,13 @@ M: postgresql-db ( tuple class -- statement ) " from " 0% 0% [ sql-spec-slot-name swap get-slot-named ] with subset - " where " 0% - [ ", " 0% ] - [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave - ";" 0% + dup empty? [ + drop + ] [ + " where " 0% + [ " and " 0% ] + [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave + ] if ";" 0% ] postgresql-make ; M: postgresql-db type-table ( -- hash ) @@ -251,7 +254,12 @@ M: postgresql-db type-table ( -- hash ) { VARCHAR "varchar" } { INTEGER "integer" } { DOUBLE "real" } + { DATE "date" } + { TIME "time" } + { DATETIME "timestamp" } { TIMESTAMP "timestamp" } + { BLOB "bytea" } + { FACTOR-BLOB "bytea" } } ; M: postgresql-db create-type-table ( -- hash ) diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 5913f053da..094425841c 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -3,7 +3,7 @@ USING: io.files kernel tools.test db db.tuples db.types continuations namespaces math prettyprint tools.walker db.sqlite calendar -math.intervals ; +math.intervals db.postgresql ; IN: db.tuples.tests TUPLE: person the-id the-name the-number the-real ts date time blob ; @@ -161,12 +161,15 @@ TUPLE: annotation n paste-id summary author mode contents ; : test-sqlite ( quot -- ) >r "tuples-test.db" temp-file sqlite-db r> with-db ; -! : test-postgresql ( -- ) -! >r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ; +: test-postgresql ( -- ) +>r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ; [ native-person-schema test-tuples ] test-sqlite [ assigned-person-schema test-tuples ] test-sqlite +[ native-person-schema test-tuples ] test-postgresql +[ assigned-person-schema test-tuples ] test-postgresql + TUPLE: serialize-me id data ; : test-serialize ( -- )