remove most of the old setters
Doug Coleman
parent
4184a3ce54
commit
3be408184c
|
|
@ -23,7 +23,7 @@ IN: db.postgresql.lib
|
|||
"\n" split [ [ blank? ] trim ] map "\n" join ;
|
||||
|
||||
: postgresql-error-message ( -- str )
|
||||
db get db-handle (postgresql-error-message) ;
|
||||
db get handle>> (postgresql-error-message) ;
|
||||
|
||||
: postgresql-error ( res -- res )
|
||||
dup [ postgresql-error-message throw ] unless ;
|
||||
|
|
@ -43,7 +43,7 @@ M: postgresql-result-null summary ( obj -- str )
|
|||
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? [
|
||||
db get handle>> swap sql>> PQexec dup postgresql-result-ok? [
|
||||
dup postgresql-result-error-message swap PQclear throw
|
||||
] unless ;
|
||||
|
||||
|
|
@ -64,25 +64,19 @@ M: postgresql-result-null summary ( obj -- str )
|
|||
} case ;
|
||||
|
||||
: param-types ( statement -- seq )
|
||||
statement-in-params
|
||||
[ sql-spec-type type>oid ] map
|
||||
>c-uint-array ;
|
||||
in-params>> [ 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
|
||||
[ bind-params>> ] [ in-params>> ] bi
|
||||
[
|
||||
sql-spec-type {
|
||||
type>> {
|
||||
{ FACTOR-BLOB [
|
||||
dup [
|
||||
object>bytes
|
||||
malloc-byte-array/length ] [ 0 ] if ] }
|
||||
{ BLOB [
|
||||
dup [ malloc-byte-array/length ] [ 0 ] if ] }
|
||||
dup [ object>bytes malloc-byte-array/length ] [ 0 ] if
|
||||
] }
|
||||
{ BLOB [ dup [ malloc-byte-array/length ] [ 0 ] if ] }
|
||||
[
|
||||
drop number>string* dup [
|
||||
malloc-char-string dup free-always
|
||||
|
|
@ -96,22 +90,20 @@ M: postgresql-result-null summary ( obj -- str )
|
|||
] if ;
|
||||
|
||||
: param-formats ( statement -- seq )
|
||||
statement-in-params
|
||||
[ sql-spec-type type>param-format ] map
|
||||
>c-uint-array ;
|
||||
in-params>> [ type>> type>param-format ] map >c-uint-array ;
|
||||
|
||||
: do-postgresql-bound-statement ( statement -- res )
|
||||
[
|
||||
>r db get db-handle r>
|
||||
>r db get handle>> r>
|
||||
{
|
||||
[ statement-sql ]
|
||||
[ statement-bind-params length ]
|
||||
[ sql>> ]
|
||||
[ bind-params>> length ]
|
||||
[ param-types ]
|
||||
[ param-values ]
|
||||
[ param-formats ]
|
||||
} cleave
|
||||
0 PQexecParams dup postgresql-result-ok? [
|
||||
dup postgresql-result-error-message swap PQclear throw
|
||||
[ postgresql-result-error-message ] [ PQclear ] bi throw
|
||||
] unless
|
||||
] with-destructors ;
|
||||
|
||||
|
|
@ -120,7 +112,7 @@ M: postgresql-result-null summary ( obj -- str )
|
|||
|
||||
: pq-get-string ( handle row column -- obj )
|
||||
3dup PQgetvalue alien>char-string
|
||||
dup "" = [ >r pq-get-is-null f r> ? ] [ 3nip ] if ;
|
||||
dup empty? [ >r pq-get-is-null f r> ? ] [ 3nip ] if ;
|
||||
|
||||
: pq-get-number ( handle row column -- obj )
|
||||
pq-get-string dup [ string>number ] when ;
|
||||
|
|
|
|||
|
|
@ -57,11 +57,11 @@ M: postgresql-result-set row-column ( result-set column -- obj )
|
|||
>r [ handle>> ] [ n>> ] bi 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
|
||||
>r >r [ handle>> ] [ result-set-n ] bi r> r> postgresql-column-typed ;
|
||||
dup pick out-params>> nth type>>
|
||||
>r >r [ handle>> ] [ n>> ] bi r> r> postgresql-column-typed ;
|
||||
|
||||
M: postgresql-statement query-results ( query -- result-set )
|
||||
dup statement-bind-params [
|
||||
dup bind-params>> [
|
||||
over [ bind-statement ] keep
|
||||
do-postgresql-bound-statement
|
||||
] [
|
||||
|
|
@ -71,27 +71,29 @@ M: postgresql-statement query-results ( query -- result-set )
|
|||
dup init-result-set ;
|
||||
|
||||
M: postgresql-result-set advance-row ( result-set -- )
|
||||
dup result-set-n 1+ swap set-result-set-n ;
|
||||
[ 1+ ] change-n drop ;
|
||||
|
||||
M: postgresql-result-set more-rows? ( result-set -- ? )
|
||||
dup result-set-n swap result-set-max < ;
|
||||
[ n>> ] [ max>> ] bi < ;
|
||||
|
||||
M: postgresql-statement dispose ( query -- )
|
||||
dup statement-handle PQclear
|
||||
f swap set-statement-handle ;
|
||||
dup handle>> PQclear
|
||||
f >>handle drop ;
|
||||
|
||||
M: postgresql-result-set dispose ( result-set -- )
|
||||
dup handle>> PQclear
|
||||
0 0 f roll {
|
||||
set-result-set-n set-result-set-max set-result-set-handle
|
||||
} set-slots ;
|
||||
[ handle>> PQclear ]
|
||||
[
|
||||
0 >>n
|
||||
0 >>max
|
||||
f >>handle drop
|
||||
] bi ;
|
||||
|
||||
M: postgresql-statement prepare-statement ( statement -- )
|
||||
[
|
||||
>r db get handle>> "" r>
|
||||
[ sql>> ] [ in-params>> ] bi
|
||||
length f PQprepare postgresql-error
|
||||
] keep set-statement-handle ;
|
||||
dup
|
||||
>r db get handle>> "" r>
|
||||
[ sql>> ] [ in-params>> ] bi
|
||||
length f PQprepare postgresql-error
|
||||
>>handle drop ;
|
||||
|
||||
M: postgresql-db <simple-statement> ( sql in out -- statement )
|
||||
<postgresql-statement> ;
|
||||
|
|
@ -111,7 +113,7 @@ M: postgresql-db rollback-transaction ( -- )
|
|||
SYMBOL: postgresql-counter
|
||||
: bind-name% ( -- )
|
||||
CHAR: $ 0,
|
||||
postgresql-counter [ inc ] keep get 0# ;
|
||||
postgresql-counter [ inc ] [ get 0# ] bi ;
|
||||
|
||||
M: postgresql-db bind% ( spec -- )
|
||||
bind-name% 1, ;
|
||||
|
|
@ -142,7 +144,7 @@ M: postgresql-db bind# ( spec obj -- )
|
|||
"(" 0%
|
||||
over [ "," 0% ]
|
||||
[
|
||||
sql-spec-type f lookup-type 0%
|
||||
type>> f lookup-type 0%
|
||||
] interleave
|
||||
")" 0%
|
||||
" returns bigint as '" 0%
|
||||
|
|
@ -150,7 +152,7 @@ M: postgresql-db bind# ( spec obj -- )
|
|||
"insert into " 0%
|
||||
dup 0%
|
||||
"(" 0%
|
||||
over [ ", " 0% ] [ sql-spec-column-name 0% ] interleave
|
||||
over [ ", " 0% ] [ column-name>> 0% ] interleave
|
||||
") values(" 0%
|
||||
swap [ ", " 0% ] [ drop bind-name% ] interleave
|
||||
"); " 0%
|
||||
|
|
@ -169,7 +171,7 @@ M: postgresql-db create-sql-statement ( class -- seq )
|
|||
"drop function add_" 0% 0%
|
||||
"(" 0%
|
||||
remove-id
|
||||
[ ", " 0% ] [ sql-spec-type f lookup-type 0% ] interleave
|
||||
[ ", " 0% ] [ type>> f lookup-type 0% ] interleave
|
||||
");" 0%
|
||||
] postgresql-make ;
|
||||
|
||||
|
|
@ -199,7 +201,7 @@ M: postgresql-db <insert-nonnative-statement> ( class -- statement )
|
|||
[
|
||||
"insert into " 0% 0%
|
||||
"(" 0%
|
||||
dup [ ", " 0% ] [ sql-spec-column-name 0% ] interleave
|
||||
dup [ ", " 0% ] [ column-name>> 0% ] interleave
|
||||
")" 0%
|
||||
|
||||
" values(" 0%
|
||||
|
|
@ -216,10 +218,10 @@ M: postgresql-db <update-tuple-statement> ( class -- statement )
|
|||
" set " 0%
|
||||
dup remove-id
|
||||
[ ", " 0% ]
|
||||
[ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
|
||||
[ dup column-name>> 0% " = " 0% bind% ] interleave
|
||||
" where " 0%
|
||||
find-primary-key
|
||||
dup sql-spec-column-name 0% " = " 0% bind%
|
||||
dup column-name>> 0% " = " 0% bind%
|
||||
] postgresql-make ;
|
||||
|
||||
M: postgresql-db <delete-tuple-statement> ( class -- statement )
|
||||
|
|
@ -227,7 +229,7 @@ M: postgresql-db <delete-tuple-statement> ( class -- statement )
|
|||
"delete from " 0% 0%
|
||||
" where " 0%
|
||||
find-primary-key
|
||||
dup sql-spec-column-name 0% " = " 0% bind%
|
||||
dup column-name>> 0% " = " 0% bind%
|
||||
] postgresql-make ;
|
||||
|
||||
M: postgresql-db <select-by-slots-statement> ( tuple class -- statement )
|
||||
|
|
@ -235,16 +237,16 @@ M: postgresql-db <select-by-slots-statement> ( tuple class -- statement )
|
|||
! tuple columns table
|
||||
"select " 0%
|
||||
over [ ", " 0% ]
|
||||
[ dup sql-spec-column-name 0% 2, ] interleave
|
||||
[ dup column-name>> 0% 2, ] interleave
|
||||
|
||||
" from " 0% 0%
|
||||
[ sql-spec-slot-name swap get-slot-named ] with subset
|
||||
[ slot-name>> swap get-slot-named ] with subset
|
||||
dup empty? [
|
||||
drop
|
||||
] [
|
||||
" where " 0%
|
||||
[ " and " 0% ]
|
||||
[ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
|
||||
[ dup column-name>> 0% " = " 0% bind% ] interleave
|
||||
] if ";" 0%
|
||||
] postgresql-make ;
|
||||
|
||||
|
|
@ -276,8 +278,8 @@ M: postgresql-db create-type-table ( -- hash )
|
|||
{ "varchar" [ first number>string paren append ] }
|
||||
{ "references" [
|
||||
first2 >r [ unparse join-space ] keep db-columns r>
|
||||
swap [ sql-spec-slot-name = ] with find nip
|
||||
sql-spec-column-name paren append
|
||||
swap [ slot-name>> = ] with find nip
|
||||
column-name>> paren append
|
||||
] }
|
||||
[ "no compound found" 3array throw ]
|
||||
} case ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue