parent
c68c57b5e4
commit
a4518150a7
|
@ -2,21 +2,25 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays continuations db io kernel math namespaces
|
||||
quotations sequences db.postgresql.ffi alien alien.c-types
|
||||
db.types tools.walker ;
|
||||
db.types tools.walker ascii splitting ;
|
||||
IN: db.postgresql.lib
|
||||
|
||||
: postgresql-result-error-message ( res -- str/f )
|
||||
dup zero? [
|
||||
drop f
|
||||
] [
|
||||
PQresultErrorMessage [ CHAR: \n = ] right-trim
|
||||
PQresultErrorMessage [ blank? ] trim
|
||||
] if ;
|
||||
|
||||
: postgres-result-error ( res -- )
|
||||
postgresql-result-error-message [ throw ] when* ;
|
||||
|
||||
: (postgresql-error-message) ( handle -- str )
|
||||
PQerrorMessage
|
||||
"\n" split [ [ blank? ] trim ] map "\n" join ;
|
||||
|
||||
: postgresql-error-message ( -- str )
|
||||
db get db-handle PQerrorMessage [ CHAR: \n = ] right-trim ;
|
||||
db get db-handle (postgresql-error-message) ;
|
||||
|
||||
: postgresql-error ( res -- res )
|
||||
dup [ postgresql-error-message throw ] unless ;
|
||||
|
@ -27,7 +31,7 @@ IN: db.postgresql.lib
|
|||
|
||||
: connect-postgres ( host port pgopts pgtty db user pass -- conn )
|
||||
PQsetdbLogin
|
||||
dup PQstatus zero? [ postgresql-error-message throw ] unless ;
|
||||
dup PQstatus zero? [ (postgresql-error-message) throw ] unless ;
|
||||
|
||||
: do-postgresql-statement ( statement -- res )
|
||||
db get db-handle swap statement-sql PQexec dup postgresql-result-ok? [
|
||||
|
|
|
@ -208,7 +208,7 @@ M: postgresql-db <insert-assigned-statement> ( tuple -- statement )
|
|||
");" 0%
|
||||
] postgresql-make ;
|
||||
|
||||
M: postgresql-db <update-tuple-statement> ( tuple -- statement )
|
||||
M: postgresql-db <update-tuple-statement> ( class -- statement )
|
||||
[
|
||||
"update " 0% 0%
|
||||
" set " 0%
|
||||
|
@ -220,7 +220,7 @@ M: postgresql-db <update-tuple-statement> ( tuple -- statement )
|
|||
dup sql-spec-column-name 0% " = " 0% bind%
|
||||
] postgresql-make ;
|
||||
|
||||
M: postgresql-db <delete-tuple-statement> ( tuple -- statement )
|
||||
M: postgresql-db <delete-tuple-statement> ( class -- statement )
|
||||
[
|
||||
"delete from " 0% 0%
|
||||
" where " 0%
|
||||
|
|
|
@ -31,7 +31,8 @@ SYMBOL: the-person
|
|||
|
||||
[ ] [ 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
|
||||
! [ ] [ person drop-table ] unit-test
|
||||
|
|
|
@ -32,6 +32,12 @@ HOOK: <delete-tuples-statement> db ( tuple -- obj )
|
|||
|
||||
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 )
|
||||
dupd
|
||||
[ 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
|
||||
] 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 )
|
||||
dup db-columns swap db-table ;
|
||||
|
@ -51,7 +63,7 @@ HOOK: row-column-typed db ( result-set n type -- sql )
|
|||
|
||||
: insert-native ( tuple -- )
|
||||
dup class <insert-native-statement>
|
||||
[ bind-tuple ] 2keep query-tuple ;
|
||||
[ bind-tuple ] 2keep query-tuple drop ;
|
||||
|
||||
: insert-assigned ( tuple -- )
|
||||
dup <insert-assigned-statement>
|
||||
|
@ -65,13 +77,12 @@ HOOK: row-column-typed db ( result-set n type -- sql )
|
|||
] if ;
|
||||
|
||||
: update-tuple ( tuple -- )
|
||||
<update-tuple-statement> execute-statement ;
|
||||
dup class <update-tuple-statement>
|
||||
[ bind-tuple ] keep execute-statement ;
|
||||
|
||||
: update-tuples ( seq -- )
|
||||
<update-tuples-statement> execute-statement ;
|
||||
|
||||
|
||||
|
||||
! : persist ( 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 )
|
||||
|
||||
: select-tuple ( tuple -- tuple )
|
||||
: setup-select ( tuple -- tuple 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 )
|
||||
dup dup class <select-by-slots-statement>
|
||||
[ bind-tuple ] 2keep query-tuples ;
|
||||
setup-select query-tuples ;
|
||||
|
||||
! uniqueResult
|
||||
|
|
Loading…
Reference in New Issue