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

remove most of the old setters

db4
Doug Coleman 2008-04-19 23:41:48 -05:00
parent 4184a3ce54
commit 3be408184c
2 changed files with 45 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

54
extra/db/postgresql/postgresql.factor
View File

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