steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

postgresql can store binary blobs!

db4
Doug Coleman 2008-03-11 00:05:22 -05:00
parent 563565d76d
commit 69f213fdce
3 changed files with 124 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
extra/db/postgresql/ffi/ffi.factor
View File

@ -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

119
extra/db/postgresql/lib/lib.factor
View File

@ -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> postgresql-malloc-destructor
M: postgresql-malloc-destructor dispose ( obj -- )
alien>> PQfreemem ;
: postgresql-free-always ( alien -- )
<postgresql-malloc-destructor> 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 <uint>
[
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

4
extra/db/tuples/tuples-tests.factor
View File

@ -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