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