From 69f213fdce00ff39accc4d3bee01fe9a851d464a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 11 Mar 2008 00:05:22 -0500 Subject: [PATCH] postgresql can store binary blobs! --- extra/db/postgresql/ffi/ffi.factor | 24 +++++- extra/db/postgresql/lib/lib.factor | 119 +++++++++++++++++++++++----- extra/db/tuples/tuples-tests.factor | 4 +- 3 files changed, 124 insertions(+), 23 deletions(-) diff --git a/extra/db/postgresql/ffi/ffi.factor b/extra/db/postgresql/ffi/ffi.factor index a41e68234e..1e3a9655a2 100755 --- a/extra/db/postgresql/ffi/ffi.factor +++ b/extra/db/postgresql/ffi/ffi.factor @@ -298,8 +298,8 @@ FUNCTION: size_t PQescapeStringConn ( PGconn* conn, FUNCTION: uchar* PQescapeByteaConn ( PGconn* conn, char* from, size_t length, size_t* to_length ) ; -FUNCTION: uchar* PQunescapeBytea ( uchar* strtext, - size_t* retbuflen ) ; +FUNCTION: void* PQunescapeBytea ( uchar* strtext, size_t* retbuflen ) ; +! FUNCTION: uchar* PQunescapeBytea ( uchar* strtext, size_t* retbuflen ) ; ! These forms are deprecated! FUNCTION: size_t PQescapeString ( void* to, char* from, size_t length ) ; FUNCTION: uchar* PQescapeBytea ( uchar* bintext, size_t binlen, @@ -347,3 +347,23 @@ FUNCTION: int PQdsplen ( uchar* s, int encoding ) ; ! Get encoding id from environment variable PGCLIENTENCODING FUNCTION: int PQenv2encoding ( ) ; + +! From git, include/catalog/pg_type.h +: BOOL-OID 16 ; inline +: BYTEA-OID 17 ; inline +: CHAR-OID 18 ; inline +: NAME-OID 19 ; inline +: INT8-OID 20 ; inline +: INT2-OID 21 ; inline +: INT4-OID 23 ; inline +: TEXT-OID 23 ; inline +: OID-OID 26 ; inline +: FLOAT4-OID 700 ; inline +: FLOAT8-OID 701 ; inline +: VARCHAR-OID 1043 ; inline +: DATE-OID 1082 ; inline +: TIME-OID 1083 ; inline +: TIMESTAMP-OID 1114 ; inline +: TIMESTAMPTZ-OID 1184 ; inline +: INTERVAL-OID 1186 ; inline +: NUMERIC-OID 1700 ; inline diff --git a/extra/db/postgresql/lib/lib.factor b/extra/db/postgresql/lib/lib.factor index 7f1e50f54a..0bc7eef20c 100755 --- a/extra/db/postgresql/lib/lib.factor +++ b/extra/db/postgresql/lib/lib.factor @@ -3,7 +3,9 @@ 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 libc shuffle calendar.format ; +combinators combinators.cleave libc shuffle calendar.format +byte-arrays destructors prettyprint new-slots accessors +strings serialize io.encodings.binary io.streams.byte-array ; IN: db.postgresql.lib : postgresql-result-error-message ( res -- str/f ) @@ -39,34 +41,111 @@ IN: db.postgresql.lib dup postgresql-result-error-message swap PQclear throw ] unless ; -: do-postgresql-bound-statement ( statement -- res ) - >r db get db-handle r> - [ statement-sql ] keep - [ statement-bind-params length f ] keep - statement-bind-params - [ number>string* dup [ malloc-char-string ] when ] map +: type>oid ( symbol -- n ) + dup array? [ first ] when + { + { BLOB [ BYTEA-OID ] } + { FACTOR-BLOB [ BYTEA-OID ] } + [ drop 0 ] + } case ; + +: type>param-format ( symbol -- n ) + dup array? [ first ] when + { + { BLOB [ 1 ] } + { FACTOR-BLOB [ 1 ] } + [ drop 0 ] + } case ; + +: param-types ( statement -- seq ) + statement-in-params + [ sql-spec-type type>oid ] map + >c-uint-array ; + +: malloc-byte-array/length + [ malloc-byte-array dup free-always ] [ length ] bi ; + + +: param-values ( statement -- seq seq2 ) + [ statement-bind-params ] + [ statement-in-params ] bi [ - [ - >c-void*-array f f 0 PQexecParams - dup postgresql-result-ok? [ - dup postgresql-result-error-message swap PQclear throw - ] unless - ] keep - ] [ [ free ] each ] [ ] cleanup ; + sql-spec-type { + { FACTOR-BLOB [ + dup [ + binary [ serialize ] with-byte-writer + malloc-byte-array/length ] [ 0 ] if ] } + { BLOB [ + dup [ malloc-byte-array/length ] [ 0 ] if ] } + [ + drop number>string* dup [ + malloc-char-string dup free-always + ] when 0 + ] + } case 2array + ] 2map flip dup empty? [ + drop f f + ] [ + first2 [ >c-void*-array ] [ >c-uint-array ] bi* + ] if ; + +: param-formats ( statement -- seq ) + statement-in-params + [ sql-spec-type type>param-format ] map + >c-uint-array ; + +: do-postgresql-bound-statement ( statement -- res ) + [ + >r db get db-handle r> + { + [ statement-sql ] + [ statement-bind-params length ] + [ param-types ] + [ param-values ] + [ param-formats ] + } cleave + 0 PQexecParams dup postgresql-result-ok? [ + dup postgresql-result-error-message swap PQclear throw + ] unless + ] with-destructors ; + +: pq-get-is-null ( handle row column -- ? ) + PQgetisnull 1 = ; : pq-get-string ( handle row column -- obj ) 3dup PQgetvalue alien>char-string - dup "" = [ >r PQgetisnull 1 = f r> ? ] [ 3nip ] if ; + dup "" = [ >r pq-get-is-null f r> ? ] [ 3nip ] if ; : pq-get-number ( handle row column -- obj ) pq-get-string dup [ string>number ] when ; +TUPLE: postgresql-malloc-destructor alien ; +C: postgresql-malloc-destructor + +M: postgresql-malloc-destructor dispose ( obj -- ) + alien>> PQfreemem ; + +: postgresql-free-always ( alien -- ) + add-always-destructor ; + : pq-get-blob ( handle row column -- obj/f ) - [ PQgetvalue ] 3keep PQgetlength + [ PQgetvalue ] 3keep 3dup PQgetlength dup 0 > [ - memory>byte-array + 3nip + [ + memory>byte-array >string + 0 + [ + PQunescapeBytea dup zero? [ + postgresql-result-error-message throw + ] [ + dup postgresql-free-always + ] if + ] keep + *uint memory>byte-array + ] with-destructors ] [ - 2drop f + drop pq-get-is-null nip [ f ] [ B{ } clone ] if ] if ; : postgresql-column-typed ( handle row column type -- obj ) @@ -83,7 +162,9 @@ IN: db.postgresql.lib { 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 ] } + { FACTOR-BLOB [ + pq-get-blob + binary [ deserialize ] with-byte-reader ] } [ no-sql-type ] } case ; ! PQgetlength PQgetisnull diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 094425841c..34150f4d85 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -164,8 +164,8 @@ TUPLE: annotation n paste-id summary author mode contents ; : 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-sqlite +! [ assigned-person-schema test-tuples ] test-sqlite [ native-person-schema test-tuples ] test-postgresql [ assigned-person-schema test-tuples ] test-postgresql