fix postgresql connect error message

fix unit test
db4
Doug Coleman 2008-02-24 12:32:36 -06:00
parent c68c57b5e4
commit a4518150a7
4 changed files with 37 additions and 17 deletions

View File

@ -2,21 +2,25 @@
! 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 tools.walker ; db.types tools.walker ascii splitting ;
IN: db.postgresql.lib IN: db.postgresql.lib
: postgresql-result-error-message ( res -- str/f ) : postgresql-result-error-message ( res -- str/f )
dup zero? [ dup zero? [
drop f drop f
] [ ] [
PQresultErrorMessage [ CHAR: \n = ] right-trim PQresultErrorMessage [ blank? ] trim
] if ; ] if ;
: postgres-result-error ( res -- ) : postgres-result-error ( res -- )
postgresql-result-error-message [ throw ] when* ; postgresql-result-error-message [ throw ] when* ;
: (postgresql-error-message) ( handle -- str )
PQerrorMessage
"\n" split [ [ blank? ] trim ] map "\n" join ;
: postgresql-error-message ( -- str ) : postgresql-error-message ( -- str )
db get db-handle PQerrorMessage [ CHAR: \n = ] right-trim ; db get db-handle (postgresql-error-message) ;
: postgresql-error ( res -- res ) : postgresql-error ( res -- res )
dup [ postgresql-error-message throw ] unless ; dup [ postgresql-error-message throw ] unless ;
@ -27,7 +31,7 @@ IN: db.postgresql.lib
: connect-postgres ( host port pgopts pgtty db user pass -- conn ) : connect-postgres ( host port pgopts pgtty db user pass -- conn )
PQsetdbLogin PQsetdbLogin
dup PQstatus zero? [ postgresql-error-message throw ] unless ; dup PQstatus zero? [ (postgresql-error-message) throw ] unless ;
: do-postgresql-statement ( statement -- res ) : do-postgresql-statement ( statement -- res )
db get db-handle swap statement-sql PQexec dup postgresql-result-ok? [ db get db-handle swap statement-sql PQexec dup postgresql-result-ok? [

View File

@ -208,7 +208,7 @@ M: postgresql-db <insert-assigned-statement> ( tuple -- statement )
");" 0% ");" 0%
] postgresql-make ; ] postgresql-make ;
M: postgresql-db <update-tuple-statement> ( tuple -- statement ) M: postgresql-db <update-tuple-statement> ( class -- statement )
[ [
"update " 0% 0% "update " 0% 0%
" set " 0% " set " 0%
@ -220,7 +220,7 @@ M: postgresql-db <update-tuple-statement> ( tuple -- statement )
dup sql-spec-column-name 0% " = " 0% bind% dup sql-spec-column-name 0% " = " 0% bind%
] postgresql-make ; ] postgresql-make ;
M: postgresql-db <delete-tuple-statement> ( tuple -- statement ) M: postgresql-db <delete-tuple-statement> ( class -- statement )
[ [
"delete from " 0% 0% "delete from " 0% 0%
" where " 0% " where " 0%

View File

@ -31,7 +31,8 @@ SYMBOL: the-person
[ ] [ the-person get update-tuple ] unit-test [ ] [ the-person get update-tuple ] unit-test
! T{ person f f f 200 f } select-tuples [ T{ person f 1 "billy" 200 3.14 } ]
[ T{ person f 1 } select-tuple ] unit-test
! [ ] [ the-person get delete-tuple ] unit-test ! [ ] [ the-person get delete-tuple ] unit-test
! [ ] [ person drop-table ] unit-test ! [ ] [ person drop-table ] unit-test

View File

@ -32,6 +32,12 @@ HOOK: <delete-tuples-statement> db ( tuple -- obj )
HOOK: row-column-typed db ( result-set n type -- sql ) HOOK: row-column-typed db ( result-set n type -- sql )
: resulting-tuple ( class out-params row -- tuple )
>r >r construct-empty r> r> rot [
>r [ sql-spec-type sql-type>factor-type ] keep
sql-spec-slot-name r> set-slot-named
] curry 2each ;
: query-tuple ( tuple statement -- seq ) : query-tuple ( tuple statement -- seq )
dupd dupd
[ query-results [ sql-row ] with-disposal ] keep [ query-results [ sql-row ] with-disposal ] keep
@ -40,8 +46,14 @@ HOOK: row-column-typed db ( result-set n type -- sql )
sql-spec-slot-name r> set-slot-named sql-spec-slot-name r> set-slot-named
] curry 2each ; ] curry 2each ;
: query-tuples ( statement -- seq ) : query-tuples ( tuple statement -- seq )
; dup query-results [
statement-out-params [
break
>r [ sql-spec-type sql-type>factor-type ] keep
sql-spec-slot-name r> set-slot-named
] with with query-map
] with-disposal ;
: sql-props ( class -- columns table ) : sql-props ( class -- columns table )
dup db-columns swap db-table ; dup db-columns swap db-table ;
@ -51,7 +63,7 @@ HOOK: row-column-typed db ( result-set n type -- sql )
: insert-native ( tuple -- ) : insert-native ( tuple -- )
dup class <insert-native-statement> dup class <insert-native-statement>
[ bind-tuple ] 2keep query-tuple ; [ bind-tuple ] 2keep query-tuple drop ;
: insert-assigned ( tuple -- ) : insert-assigned ( tuple -- )
dup <insert-assigned-statement> dup <insert-assigned-statement>
@ -65,13 +77,12 @@ HOOK: row-column-typed db ( result-set n type -- sql )
] if ; ] if ;
: update-tuple ( tuple -- ) : update-tuple ( tuple -- )
<update-tuple-statement> execute-statement ; dup class <update-tuple-statement>
[ bind-tuple ] keep execute-statement ;
: update-tuples ( seq -- ) : update-tuples ( seq -- )
<update-tuples-statement> execute-statement ; <update-tuples-statement> execute-statement ;
! : persist ( tuple -- ) ! : persist ( tuple -- )
HOOK: delete-by-id db ( tuple -- ) HOOK: delete-by-id db ( tuple -- )
@ -80,10 +91,14 @@ HOOK: delete-by-id db ( tuple -- )
HOOK: <select-by-slots-statement> db ( tuple -- tuple ) HOOK: <select-by-slots-statement> db ( tuple -- tuple )
: select-tuple ( tuple -- tuple ) : setup-select ( tuple -- tuple statement )
dup dup class <select-by-slots-statement> dup dup class <select-by-slots-statement>
[ bind-tuple ] 2keep query-tuple ; [ bind-tuple ] 2keep ;
: select-tuple ( tuple -- tuple )
setup-select query-tuple ;
: select-tuples ( tuple -- tuple ) : select-tuples ( tuple -- tuple )
dup dup class <select-by-slots-statement> setup-select query-tuples ;
[ bind-tuple ] 2keep query-tuples ;
! uniqueResult