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

add a new db-connection tuple for live database connections instead of reusing the db setup tuple 

update sqlite and postgresql backends for the change
db4
Doug Coleman 2008-12-17 19:35:53 -06:00
parent be5a099379
commit 4329578b2f
6 changed files with 78 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
basis/db/db.factor
View File

@ -5,24 +5,30 @@ namespaces sequences classes.tuple words strings
tools.walker accessors combinators fry ;
IN: db
TUPLE: db
SYMBOL: db
<PRIVATE
TUPLE: db-connection
handle
insert-statements
update-statements
delete-statements ;
: new-db ( class -- obj )
: new-db-connection ( class -- obj )
new
H{ } clone >>insert-statements
H{ } clone >>update-statements
H{ } clone >>delete-statements ; inline
PRIVATE>
GENERIC: db-open ( db -- db )
HOOK: db-close db ( handle -- )
: dispose-statements ( assoc -- ) values dispose-each ;
M: db dispose ( db -- )
M: db-connection dispose ( db -- )
dup db [
[ dispose-statements H{ } clone ] change-insert-statements
[ dispose-statements H{ } clone ] change-update-statements
@ -130,9 +136,9 @@ HOOK: begin-transaction db ( -- )
HOOK: commit-transaction db ( -- )
HOOK: rollback-transaction db ( -- )
M: db begin-transaction ( -- ) "BEGIN" sql-command ;
M: db commit-transaction ( -- ) "COMMIT" sql-command ;
M: db rollback-transaction ( -- ) "ROLLBACK" sql-command ;
M: db-connection begin-transaction ( -- ) "BEGIN" sql-command ;
M: db-connection commit-transaction ( -- ) "COMMIT" sql-command ;
M: db-connection rollback-transaction ( -- ) "ROLLBACK" sql-command ;
: in-transaction? ( -- ? ) in-transaction get ;

46
basis/db/postgresql/postgresql.factor
View File

@ -4,23 +4,31 @@ USING: arrays assocs alien alien.syntax continuations io
kernel math math.parser namespaces make prettyprint quotations
sequences debugger db db.postgresql.lib db.postgresql.ffi
db.tuples db.types tools.annotations math.ranges
combinators classes locals words tools.walker
combinators classes locals words tools.walker db.private
nmake accessors random db.queries destructors db.tuples.private ;
USE: tools.walker
IN: db.postgresql
TUPLE: postgresql-db < db
host port pgopts pgtty database username password ;
TUPLE: postgresql-db host port pgopts pgtty database username password ;
: <postgresql-db> ( -- postgresql-db )
postgresql-db new-db ;
postgresql-db new ;
<PRIVATE
TUPLE: postgresql-db-connection < db-connection ;
: <postgresql-db-connection> ( handle -- db-connection )
postgresql-db-connection new-db-connection
swap >>handle ;
PRIVATE>
TUPLE: postgresql-statement < statement ;
TUPLE: postgresql-result-set < result-set ;
M: postgresql-db db-open ( db -- db )
dup {
M: postgresql-db db-open ( db -- db-connection )
{
[ host>> ]
[ port>> ]
[ pgopts>> ]
@ -28,9 +36,9 @@ M: postgresql-db db-open ( db -- db )
[ database>> ]
[ username>> ]
[ password>> ]
} cleave connect-postgres >>handle ;
} cleave connect-postgres <postgresql-db-connection> ;
M: postgresql-db db-close ( handle -- )
M: postgresql-db-connection db-close ( handle -- )
PQfinish ;
M: postgresql-statement bind-statement* ( statement -- ) drop ;
@ -103,20 +111,20 @@ M: postgresql-statement prepare-statement ( statement -- )
length f PQprepare postgresql-error
>>handle drop ;
M: postgresql-db <simple-statement> ( sql in out -- statement )
M: postgresql-db-connection <simple-statement> ( sql in out -- statement )
postgresql-statement new-statement ;
M: postgresql-db <prepared-statement> ( sql in out -- statement )
M: postgresql-db-connection <prepared-statement> ( sql in out -- statement )
<simple-statement> dup prepare-statement ;
: bind-name% ( -- )
CHAR: $ 0,
sql-counter [ inc ] [ get 0# ] bi ;
M: postgresql-db bind% ( spec -- )
M: postgresql-db-connection bind% ( spec -- )
bind-name% 1, ;
M: postgresql-db bind# ( spec object -- )
M: postgresql-db-connection bind# ( spec object -- )
[ bind-name% f swap type>> ] dip
<literal-bind> 1, ;
@ -162,7 +170,7 @@ M: postgresql-db bind# ( spec object -- )
"_seq'');' language sql;" 0%
] query-make ;
M: postgresql-db create-sql-statement ( class -- seq )
M: postgresql-db-connection create-sql-statement ( class -- seq )
[
[ create-table-sql , ] keep
dup db-assigned? [ create-function-sql , ] [ drop ] if
@ -182,13 +190,13 @@ M: postgresql-db create-sql-statement ( class -- seq )
"drop table " 0% 0% drop
] query-make ;
M: postgresql-db drop-sql-statement ( class -- seq )
M: postgresql-db-connection drop-sql-statement ( class -- seq )
[
[ drop-table-sql , ] keep
dup db-assigned? [ drop-function-sql , ] [ drop ] if
] { } make ;
M: postgresql-db <insert-db-assigned-statement> ( class -- statement )
M: postgresql-db-connection <insert-db-assigned-statement> ( class -- statement )
[
"select add_" 0% 0%
"(" 0%
@ -198,7 +206,7 @@ M: postgresql-db <insert-db-assigned-statement> ( class -- statement )
");" 0%
] query-make ;
M: postgresql-db <insert-user-assigned-statement> ( class -- statement )
M: postgresql-db-connection <insert-user-assigned-statement> ( class -- statement )
[
"insert into " 0% 0%
"(" 0%
@ -221,10 +229,10 @@ M: postgresql-db <insert-user-assigned-statement> ( class -- statement )
");" 0%
] query-make ;
M: postgresql-db insert-tuple-set-key ( tuple statement -- )
M: postgresql-db-connection insert-tuple-set-key ( tuple statement -- )
query-modify-tuple ;
M: postgresql-db persistent-table ( -- hashtable )
M: postgresql-db-connection persistent-table ( -- hashtable )
H{
{ +db-assigned-id+ { "integer" "serial" f } }
{ +user-assigned-id+ { f f f } }
@ -264,7 +272,7 @@ M: postgresql-db persistent-table ( -- hashtable )
} ;
ERROR: no-compound-found string object ;
M: postgresql-db compound ( string object -- string' )
M: postgresql-db-connection compound ( string object -- string' )
over {
{ "default" [ first number>string " " glue ] }
{ "varchar" [ first number>string "(" ")" surround append ] }

13
basis/db/queries/queries.factor
View File

@ -3,7 +3,8 @@
USING: accessors kernel math namespaces make sequences random
strings math.parser math.intervals combinators math.bitwise
nmake db db.tuples db.types classes words shuffle arrays
destructors continuations db.tuples.private prettyprint ;
destructors continuations db.tuples.private prettyprint
db.private ;
IN: db.queries
GENERIC: where ( specs obj -- )
@ -62,7 +63,7 @@ M: retryable execute-statement* ( statement type -- )
dup column-name>> 0% " = " 0% bind%
] interleave ;
M: db <update-tuple-statement> ( class -- statement )
M: db-connection <update-tuple-statement> ( class -- statement )
[
"update " 0% 0%
" set " 0%
@ -142,7 +143,7 @@ M: string where ( spec obj -- ) object-where ;
: where-clause ( tuple specs -- )
dupd filter-slots [ drop ] [ many-where ] if-empty ;
M: db <delete-tuples-statement> ( tuple table -- sql )
M: db-connection <delete-tuples-statement> ( tuple table -- sql )
[
"delete from " 0% 0%
where-clause
@ -150,7 +151,7 @@ M: db <delete-tuples-statement> ( tuple table -- sql )
ERROR: all-slots-ignored class ;
M: db <select-by-slots-statement> ( tuple class -- statement )
M: db-connection <select-by-slots-statement> ( tuple class -- statement )
[
"select " 0%
[ dupd filter-ignores ] dip
@ -185,13 +186,13 @@ M: db <select-by-slots-statement> ( tuple class -- statement )
[ offset>> [ do-offset ] [ drop ] if* ]
} 2cleave ;
M: db query>statement ( query -- tuple )
M: db-connection query>statement ( query -- tuple )
[ tuple>> dup class ] keep
[ <select-by-slots-statement> ] dip make-query* ;
! select ID, NAME, SCORE from EXAM limit 1 offset 3
M: db <count-statement> ( query -- statement )
M: db-connection <count-statement> ( query -- statement )
[ tuple>> dup class ] keep
[ [ "select count(*) from " 0% 0% where-clause ] query-make ]
dip make-query* ;

5
basis/db/sqlite/lib/lib.factor
View File

@ -5,7 +5,7 @@ namespaces sequences db.sqlite.ffi db combinators
continuations db.types calendar.format serialize
io.streams.byte-array byte-arrays io.encodings.binary
io.backend db.errors present urls io.encodings.utf8
io.encodings.string accessors shuffle ;
io.encodings.string accessors shuffle io prettyprint ;
IN: db.sqlite.lib
ERROR: sqlite-error < db-error n string ;
@ -124,7 +124,8 @@ ERROR: sqlite-sql-error < sql-error n string ;
] if* (sqlite-bind-type) ;
: sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ;
: sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ;
: sqlite-reset ( handle -- )
"resetting: " write dup . sqlite3_reset sqlite-check-result ;
: sqlite-clear-bindings ( handle -- )
sqlite3_clear_bindings sqlite-check-result ;
: sqlite-#columns ( query -- int ) sqlite3_column_count ;

4
basis/db/sqlite/sqlite-tests.factor
View File

@ -3,8 +3,8 @@ kernel namespaces prettyprint tools.test db.sqlite db sequences
continuations db.types db.tuples unicode.case ;
IN: db.sqlite.tests
: db-path "test.db" temp-file ;
: test.db db-path <sqlite-db> ;
: db-path ( -- path ) "test.db" temp-file ;
: test.db ( -- sqlite-db ) db-path <sqlite-db> ;
[ ] [ [ db-path delete-file ] ignore-errors ] unit-test

44
basis/db/sqlite/sqlite.factor
View File

@ -6,28 +6,38 @@ sequences strings classes.tuple alien.c-types continuations
db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators
math.intervals io nmake accessors vectors math.ranges random
math.bitwise db.queries destructors db.tuples.private interpolate
io.streams.string multiline make ;
io.streams.string multiline make db.private ;
IN: db.sqlite
TUPLE: sqlite-db < db path ;
TUPLE: sqlite-db path ;
: <sqlite-db> ( path -- sqlite-db )
sqlite-db new-db
sqlite-db new
swap >>path ;
M: sqlite-db db-open ( db -- db )
dup path>> sqlite-open >>handle ;
<PRIVATE
M: sqlite-db db-close ( handle -- ) sqlite-close ;
TUPLE: sqlite-db-connection < db-connection ;
: <sqlite-db-connection> ( handle -- db-connection )
sqlite-db-connection new-db-connection
swap >>handle ;
PRIVATE>
M: sqlite-db db-open ( db -- db-connection )
path>> sqlite-open <sqlite-db-connection> ;
M: sqlite-db-connection db-close ( handle -- ) sqlite-close ;
TUPLE: sqlite-statement < statement ;
TUPLE: sqlite-result-set < result-set has-more? ;
M: sqlite-db <simple-statement> ( str in out -- obj )
M: sqlite-db-connection <simple-statement> ( str in out -- obj )
<prepared-statement> ;
M: sqlite-db <prepared-statement> ( str in out -- obj )
M: sqlite-db-connection <prepared-statement> ( str in out -- obj )
sqlite-statement new-statement ;
: sqlite-maybe-prepare ( statement -- statement )
@ -92,7 +102,7 @@ ERROR: sqlite-last-id-fail ;
db get handle>> sqlite3_last_insert_rowid
dup zero? [ sqlite-last-id-fail ] when ;
M: sqlite-db insert-tuple-set-key ( tuple statement -- )
M: sqlite-db-connection insert-tuple-set-key ( tuple statement -- )
execute-statement last-insert-id swap set-primary-key ;
M: sqlite-result-set #columns ( result-set -- n )
@ -116,7 +126,7 @@ M: sqlite-statement query-results ( query -- result-set )
dup handle>> sqlite-result-set new-result-set
dup advance-row ;
M: sqlite-db create-sql-statement ( class -- statement )
M: sqlite-db-connection create-sql-statement ( class -- statement )
[
dupd
"create table " 0% 0%
@ -135,10 +145,10 @@ M: sqlite-db create-sql-statement ( class -- statement )
"));" 0%
] query-make ;
M: sqlite-db drop-sql-statement ( class -- statement )
M: sqlite-db-connection drop-sql-statement ( class -- statement )
[ "drop table " 0% 0% ";" 0% drop ] query-make ;
M: sqlite-db <insert-db-assigned-statement> ( tuple -- statement )
M: sqlite-db-connection <insert-db-assigned-statement> ( tuple -- statement )
[
"insert into " 0% 0%
"(" 0%
@ -159,19 +169,19 @@ M: sqlite-db <insert-db-assigned-statement> ( tuple -- statement )
");" 0%
] query-make ;
M: sqlite-db <insert-user-assigned-statement> ( tuple -- statement )
M: sqlite-db-connection <insert-user-assigned-statement> ( tuple -- statement )
<insert-db-assigned-statement> ;
M: sqlite-db bind# ( spec obj -- )
M: sqlite-db-connection bind# ( spec obj -- )
[
[ column-name>> ":" next-sql-counter surround dup 0% ]
[ type>> ] bi
] dip <literal-bind> 1, ;
M: sqlite-db bind% ( spec -- )
M: sqlite-db-connection bind% ( spec -- )
dup 1, column-name>> ":" prepend 0% ;
M: sqlite-db persistent-table ( -- assoc )
M: sqlite-db-connection persistent-table ( -- assoc )
H{
{ +db-assigned-id+ { "integer" "integer" f } }
{ +user-assigned-id+ { f f f } }
@ -306,7 +316,7 @@ M: sqlite-db persistent-table ( -- assoc )
delete-trigger-restrict sqlite-trigger,
] if ;
M: sqlite-db compound ( string seq -- new-string )
M: sqlite-db-connection compound ( string seq -- new-string )
over {
{ "default" [ first number>string " " glue ] }
{ "references" [