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

make-db is gone, use <sqlite-db> or <postgresql-db> instead. docs. use dip instead of >r r>

db4
Doug Coleman 2008-10-02 12:11:56 -05:00
parent 668fa4d6f8
commit 67683dde20
6 changed files with 90 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

105
basis/db/db-docs.factor
View File

@ -9,23 +9,15 @@ HELP: db
HELP: new-db
{ $values { "class" class } { "obj" object } }
{ $description "Creates a new database object from a given class." } ;
HELP: make-db*
{ $values { "object" object } { "db" object } { "db" object } }
{ $description "Takes a sequence of parameters specific to each database and a class name of the database, and constructs a new database object." } ;
HELP: make-db
{ $values { "object" object } { "class" class } { "db" db } }
{ $description "Takes a sequence of parameters specific to each database and a class name of the database, and constructs a new database object." } ;
{ $description "Creates a new database object from a given class with caches for prepared statements. Does not actually connect to the database until " { $link db-open } " or " { $link with-db } " is called." } ;
HELP: db-open
{ $values { "db" db } { "db" db } }
{ $description "Opens a database using the configuration data stored in a " { $link db } " tuple." } ;
{ $description "Opens a database using the configuration data stored in a " { $link db } " tuple. The database object now references a database handle that must be cleaned up. Therefore, it is better to use the " { $link with-db } " combinator than calling this word directly." } ;
HELP: db-close
{ $values { "handle" alien } }
{ $description "Closes a database using the handle provided." } ;
{ $description "Closes a database using the handle provided. Use of the " { $link with-db } " combinator is preferred over manually opening and closing databases so that resources are not leaked." } ;
HELP: dispose-statements
{ $values { "assoc" assoc } }
@ -38,30 +30,18 @@ HELP: db-dispose
HELP: statement
{ $description "A " { $snippet "statement" } " stores the information about a statemen, such as the SQL statement text, the in/out parameters, and type information." } ;
HELP: simple-statement
{ $description } ;
HELP: prepared-statement
{ $description } ;
HELP: result-set
{ $description "An object encapsulating a raw SQL result object. There are two ways in which a result set can be accessed, but they are specific to the database backend in use."
{ $subsection "db-random-access-result-set" }
{ $subsection "db-sequential-result-set" }
} ;
HELP: init-result-set
{ $values
{ "result-set" result-set } }
{ $description "" } ;
HELP: new-result-set
{ $values
{ "query" "a query" } { "handle" alien } { "class" class }
{ "result-set" result-set } }
{ $description "Creates a new " { $link result-set } " object of type " { $snippet "class" } "." } ;
HELP: new-statement
{ $values { "sql" string } { "in" sequence } { "out" sequence } { "class" class } { "statement" statement } }
{ $description "Makes a new statement object from the given parameters." } ;
@ -80,18 +60,6 @@ HELP: prepare-statement
{ $values { "statement" statement } }
{ $description "For databases which implement a method on this generic, it does some internal processing to ready the statement for execution." } ;
HELP: bind-statement*
{ $values { "statement" statement } }
{ $description "" } ;
HELP: low-level-bind
{ $values { "statement" statement } }
{ $description "" } ;
HELP: bind-tuple
{ $values { "tuple" tuple } { "statement" statement } }
{ $description "" } ;
HELP: query-results
{ $values { "query" object }
{ "result-set" result-set }
@ -125,41 +93,14 @@ HELP: more-rows?
{ $values { "result-set" result-set } { "?" "a boolean" } }
{ $description "Returns true if the " { $link result-set } " has more rows to traverse." } ;
HELP: execute-statement*
{ $values { "statement" statement } { "type" object } }
{ $description } ;
HELP: execute-one-statement
{ $values
{ "statement" null } }
{ $description "" } ;
HELP: execute-statement
{ $values { "statement" statement } }
{ $description "" } ;
HELP: begin-transaction
{ $description "Begins a new transaction. User code should make use of the " { $link with-transaction } " combinator." } ;
HELP: bind-statement
{ $values
{ "obj" object } { "statement" null } }
{ $description "" } ;
HELP: commit-transaction
{ $description "Commits a transaction. User code should make use of the " { $link with-transaction } " combinator." } ;
HELP: default-query
{ $values
{ "query" null }
{ "result-set" null } }
{ $description "" } ;
HELP: in-transaction
{ $description "A variable that is set true when a transaction is in progress." } ;
@ -170,14 +111,14 @@ HELP: in-transaction?
HELP: query-each
{ $values
{ "statement" null } { "quot" quotation } }
{ $description "" } ;
{ "statement" statement } { "quot" quotation } }
{ $description "A combinator that calls a quotation on a sequence of SQL statments to their results query results." } ;
HELP: query-map
{ $values
{ "statement" null } { "quot" quotation }
{ "statement" statement } { "quot" quotation }
{ "seq" sequence } }
{ $description "" } ;
{ $description "A combinator that maps a sequence of SQL statments to their results query results." } ;
HELP: rollback-transaction
{ $description "Rolls back a transaction; no data is committed to the database. User code should make use of the " { $link with-transaction } " combinator." } ;
@ -211,7 +152,7 @@ HELP: sql-row-typed
HELP: with-db
{ $values
{ "seq" sequence } { "class" class } { "quot" quotation } }
{ "db" db } { "quot" quotation } }
{ $description "Calls the quotation with a database bound to the " { $link db } " symbol. The database called is based on the " { $snippet "class" } " with the " } ;
HELP: with-transaction
@ -272,7 +213,18 @@ $nl
{ $subsection row-column-typed } ;
ARTICLE: "db-protocol" "Low-level database protocol"
"The high-level protocol (see " { $vocab-link "db.tuples" } ") uses this low-level protocol for executing statements and queries."
"The high-level protocol (see " { $vocab-link "db.tuples" } ") uses this low-level protocol for executing statements and queries." $nl
"Opening a database:"
{ $subsection db-open }
"Closing a database:"
{ $subsection db-close }
"Performing a query:"
{ $subsection query-results }
"Handling query results:"
{ $subsection "db-result-sets" }
;
ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial"
@ -280,18 +232,25 @@ ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial"
;
ARTICLE: "db-porting-the-library" "Porting the database library"
"This section is not yet written."
"There are two layers to implement when porting the database library."
{ $subsection "db-protocol" }
;
ARTICLE: "db-custom-database-combinators" "Custom database combinators"
"Every database library requires some effort on the programmer's part to initialize and open a database. SQLite uses files on your harddisk, so a simple pathname is all the setup required. With PostgreSQL, you log in to a networked server as a user on a specfic port." $nl
"Make a " { $snippet "with-" } " word to open, close, and use your database."
"Make a " { $snippet "with-" } " combinator to open and close a database so that resources are not leaked."
{ $code <"
USING: db.sqlite db io.files ;
: with-my-database ( quot -- )
{ "my-database.db" temp-file } sqlite-db rot with-db ;
"> }
: with-sqlite-db ( quot -- )
"my-database.db" temp-file sqlite-db rot with-db ;"> }
{ $code <"
USING: db.postgresql db ;
: with-postgresql-db ( quot -- )
{ "localhost" "db-username" "db-password" "db-name" }
postgresql-db rot with-db ;">
}
;

13
basis/db/db.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs classes continuations destructors kernel math
namespaces sequences classes.tuple words strings
tools.walker accessors combinators ;
tools.walker accessors combinators fry ;
IN: db
TUPLE: db
@ -17,10 +17,6 @@ TUPLE: db
H{ } clone >>update-statements
H{ } clone >>delete-statements ; inline
GENERIC: make-db* ( object db -- db )
: make-db ( object class -- db ) new-db make-db* ;
GENERIC: db-open ( db -- db )
HOOK: db-close db ( handle -- )
@ -111,10 +107,9 @@ M: object execute-statement* ( statement type -- )
: query-map ( statement quot -- seq )
accumulator [ query-each ] dip { } like ; inline
: with-db ( seq class quot -- )
[ make-db db-open db ] dip
[ db get swap [ drop ] prepose with-disposal ] curry with-variable ;
inline
: with-db ( db quot -- )
[ db-open db ] dip
'[ db get [ drop @ ] with-disposal ] with-variable ; inline
: default-query ( query -- result-set )
query-results [ [ sql-row ] query-map ] with-disposal ;

8
basis/db/pools/pools.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel arrays namespaces sequences continuations
io.pools db ;
io.pools db fry ;
IN: db.pools
TUPLE: db-pool < pool db params ;
TUPLE: db-pool < pool db ;
: <db-pool> ( params db -- pool )
db-pool <pool>
@ -15,7 +15,7 @@ TUPLE: db-pool < pool db params ;
>r <db-pool> r> with-pool ; inline
M: db-pool make-connection ( pool -- )
[ params>> ] [ db>> ] bi make-db db-open ;
db>> db-open ;
: with-pooled-db ( pool quot -- )
[ db swap with-variable ] curry with-pooled-connection ; inline
'[ db _ with-variable ] with-pooled-connection ; inline

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

@ -10,28 +10,24 @@ USE: tools.walker
IN: db.postgresql
TUPLE: postgresql-db < db
host port pgopts pgtty db user pass ;
host port pgopts pgtty database username password ;
: <postgresql-db> ( -- postgresql-db )
postgresql-db new-db ;
TUPLE: postgresql-statement < statement ;
TUPLE: postgresql-result-set < result-set ;
M: postgresql-db make-db* ( seq db -- db )
>r first4 r>
swap >>db
swap >>pass
swap >>user
swap >>host ;
M: postgresql-db db-open ( db -- db )
dup {
[ host>> ]
[ port>> ]
[ pgopts>> ]
[ pgtty>> ]
[ db>> ]
[ user>> ]
[ pass>> ]
[ database>> ]
[ username>> ]
[ password>> ]
} cleave connect-postgres >>handle ;
M: postgresql-db dispose ( db -- )
@ -102,7 +98,7 @@ M: postgresql-result-set dispose ( result-set -- )
M: postgresql-statement prepare-statement ( statement -- )
dup
>r db get handle>> f r>
[ db get handle>> f ] dip
[ sql>> ] [ in-params>> ] bi
length f PQprepare postgresql-error
>>handle drop ;
@ -121,7 +117,8 @@ M: postgresql-db bind% ( spec -- )
bind-name% 1, ;
M: postgresql-db bind# ( spec object -- )
>r bind-name% f swap type>> r> <literal-bind> 1, ;
[ bind-name% f swap type>> ] dip
<literal-bind> 1, ;
: create-table-sql ( class -- statement )
[
@ -143,7 +140,7 @@ M: postgresql-db bind# ( spec object -- )
: create-function-sql ( class -- statement )
[
>r remove-id r>
[ remove-id ] dip
"create function add_" 0% dup 0%
"(" 0%
over [ "," 0% ]

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

@ -11,7 +11,8 @@ IN: db.sqlite
TUPLE: sqlite-db < db path ;
M: sqlite-db make-db* ( path db -- db )
: <sqlite-db> ( path -- sqlite-db )
sqlite-db new-db
swap >>path ;
M: sqlite-db db-open ( db -- db )
@ -78,7 +79,8 @@ M: generator-bind sqlite-bind-conversion ( tuple generate-bind -- array )
tuck
[ generator-singleton>> eval-generator tuck ] [ slot-name>> ] bi
rot set-slot-named
>r [ key>> ] [ type>> ] bi r> swap <sqlite-low-level-binding> ;
[ [ key>> ] [ type>> ] bi ] dip
swap <sqlite-low-level-binding> ;
M: sqlite-statement bind-tuple ( tuple statement -- )
[
@ -100,7 +102,7 @@ M: sqlite-result-set row-column ( result-set n -- obj )
M: sqlite-result-set row-column-typed ( result-set n -- obj )
dup pick out-params>> nth type>>
>r >r handle>> r> r> sqlite-column-typed ;
[ handle>> ] 2dip sqlite-column-typed ;
M: sqlite-result-set advance-row ( result-set -- )
dup handle>> sqlite-next >>has-more? drop ;
@ -160,10 +162,10 @@ M: sqlite-db <insert-user-assigned-statement> ( tuple -- statement )
<insert-db-assigned-statement> ;
M: sqlite-db bind# ( spec obj -- )
>r
[
[ column-name>> ":" swap next-sql-counter 3append dup 0% ]
[ type>> ] bi
r> <literal-bind> 1, ;
] dip <literal-bind> 1, ;
M: sqlite-db bind% ( spec -- )
dup 1, column-name>> ":" prepend 0% ;

39
basis/db/tuples/tuples-tests.factor
View File

@ -7,16 +7,34 @@ db.postgresql accessors random math.bitwise
math.ranges strings urls fry db.tuples.private ;
IN: db.tuples.tests
: sqlite-db ( -- sqlite-db )
"tuples-test.db" temp-file <sqlite-db> ;
: test-sqlite ( quot -- )
[ ] swap '[
"tuples-test.db" temp-file sqlite-db _ with-db
] unit-test ;
'[
[ ] [
"tuples-test.db" temp-file <sqlite-db> _ with-db
] unit-test
] call ; inline
: postgresql-db ( -- postgresql-db )
<postgresql-db>
"localhost" >>host
"postgres" >>username
"thepasswordistrust" >>password
"factor-test" >>database ;
: test-postgresql ( quot -- )
[ ] swap '[
{ "localhost" "postgres" "foob" "factor-test" }
postgresql-db _ with-db
] unit-test ;
'[
[ ] [ postgresql-db _ with-db ] unit-test
] call ; inline
! These words leak resources, but are useful for interactivel testing
: sqlite-test-db ( -- )
sqlite-db db-open db set ;
: postgresql-test-db ( -- )
postgresql-db db-open db set ;
TUPLE: person the-id the-name the-number the-real
ts date time blob factor-blob url ;
@ -639,10 +657,3 @@ compound-foo "COMPOUND_FOO"
[ test-compound-primary-key ] test-sqlite
[ test-compound-primary-key ] test-postgresql
: sqlite-test-db ( -- )
"tuples-test.db" temp-file sqlite-db make-db db-open db set ;
: postgresql-test-db ( -- )
{ "localhost" "postgres" "foob" "factor-test" } postgresql-db
make-db db-open db set ;