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

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

@ -5,27 +5,19 @@ alien assocs strings math multiline quotations ;
IN: db
HELP: db
{ $description "The " { $snippet "db" } " class is the superclass of all other database classes. It stores a " { $snippet "handle" } " to the database as well as insert, update, and delete queries." } ;
{ $description "The " { $snippet "db" } " class is the superclass of all other database classes. It stores a " { $snippet "handle" } " to the database as well as insert, update, and delete queries." } ;
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
@ -247,7 +188,7 @@ $nl
{ $subsection row-column-typed } ;
ARTICLE: "db-sequential-result-set" "Sequential result sets"
"Sequential result sets can be iterated one element after the next. SQLite's result sets offer this method of traversal."
"Sequential result sets can be iterated one element after the next. SQLite's result sets offer this method of traversal."
$nl
"Databases which work in this way must provide methods for the following traversal words:"
{ $subsection more-rows? }
@ -272,26 +213,44 @@ $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"
"Although Factor makes integrating a database with its object system easy (see " { $vocab-link "db.tuples" } "), sometimes you may want to write SQL directly and get the results back as arrays of strings, for instance, when interfacing with a legacy database that doesn't easily map to " { $snippet "tuples" } "."
;
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
"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% ]

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

@ -11,8 +11,9 @@ IN: db.sqlite
TUPLE: sqlite-db < db path ;
M: sqlite-db make-db* ( path db -- db )
swap >>path ;
: <sqlite-db> ( path -- sqlite-db )
sqlite-db new-db
swap >>path ;
M: sqlite-db db-open ( db -- db )
dup path>> sqlite-open >>handle ;
@ -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, ;
[
[ column-name>> ":" swap next-sql-counter 3append dup 0% ]
[ type>> ] bi
] 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 ;