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 } }
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." } ;
{ $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 }
{ $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." } ;
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." } ;
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
{ $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? }
{ $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 ;">
+}
;
! 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
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 -- )
: 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 ;
! 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> ( db -- pool )
db-pool <pool>
- swap >>db
- swap >>params ;
+ swap >>db ;
-: with-db-pool ( db params quot -- )
- >r <db-pool> r> with-pool ; inline
+: with-db-pool ( db quot -- )
+ [ <db-pool> ] dip 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
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 -- )
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 ;
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 )
[
: create-function-sql ( class -- statement )
[
- >r remove-id r>
+ [ remove-id ] dip
"create function add_" 0% dup 0%
"(" 0%
over [ "," 0% ]
where-clause
] query-make ;
+ERROR: all-slots-ignored class ;
+
M: db <select-by-slots-statement> ( tuple class -- statement )
[
"select " 0%
[ dupd filter-ignores ] dip
+ over empty? [ all-slots-ignored ] when
over
[ ", " 0% ]
[ dup column-name>> 0% 2, ] interleave
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 ;
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 -- )
[
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 ;
<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% ;
{ $list
"Make a new tuple to represent your data"
{ "Map the Factor types to the database types with " { $link define-persistent } }
- { "Make a " { $link "db-custom-database-combinators" } " to open your database and run a " { $snippet "quotation" } }
+ { "Make a custom database combinator (see" { $link "db-custom-database-combinators" } ") to open your database and run a " { $link quotation } }
{ "Create a table with " { $link create-table } ", " { $link ensure-table } ", or " { $link recreate-table } }
{ "Start making and storing objects with " { $link insert-tuple } ", " { $link update-tuple } ", " { $link delete-tuples } ", and " { $link select-tuples } }
} ;
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 ;
[ f ]
[ T{ exam { name IGNORE } { score IGNORE } } select-tuples first score>> ] unit-test
- ! FIXME
- ! [ f ]
- ! [ T{ exam { name IGNORE } { score IGNORE } { id IGNORE } } select-tuples first score>> ] unit-test
+ [ T{ exam { name IGNORE } { score IGNORE } { id IGNORE } } select-tuples first score>> ] [ class>> "EXAM" = ] must-fail-with
[
{
[ 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 ;
{ $description "" } ;
HELP: +db-assigned-id+
-{ $description "The database assigns a primary key to the object. The primary key is most likely a big integer, but is database-dependent." } ;
+{ $description "The database assigns a primary key to the object. The primary key is most likely a big integer, but is database-dependent." } ;
HELP: +default+
{ $description "" } ;
{ $description "" } ;
HELP: +random-id+
-{ $description "Factor chooses a random number and tries to insert the tuple into the database with this number as its primary key. The default number of retries to find a unique random number is 10, though in practice it will almost certainly succeed on the first try." } ;
+{ $description "Factor chooses a random number and tries to insert the tuple into the database with this number as its primary key. The default number of retries to find a unique random number is 10, though in practice it will almost certainly succeed on the first try." } ;
HELP: +serial+
{ $description "" } ;
{ $description "" } ;
HELP: +user-assigned-id+
-{ $description "The user is responsible for choosing a primary key for tuples inserted with this database type. Keys must be unique or else the database will throw an error. Usually it is better to use a " { $link +db-assigned-id+ } "." } ;
+{ $description "The user is responsible for choosing a primary key for tuples inserted with this database type. Keys must be unique or else the database will throw an error. Usually it is better to use a " { $link +db-assigned-id+ } "." } ;
HELP: <generator-bind>
{ $description "" } ;
{ $description "A 64-bit integer. Whether this number is signed or unsigned depends on the database backend." } ;
HELP: BLOB
-{ $description "A serialized Factor object. The database library automatically serializes the object for a SQL insert or update and deserializes it on a tuple query." } ;
+{ $description "A byte array." } ;
HELP: BOOLEAN
{ $description "Either true or false." } ;
{ $description "A date and a time." } ;
HELP: DOUBLE
-{ $description "Corresponds to Factor's 64bit floating-point numbers." } ;
+{ $description "Corresponds to Factor's 64-bit floating-point numbers." } ;
HELP: FACTOR-BLOB
{ $description "A serialized Factor object." } ;
{ $description "The SQL null type." } ;
HELP: REAL
-{ $description "" } ;
+{ $description "A real number of unlimited precision. May not be supported on all databases." } ;
HELP: SIGNED-BIG-INTEGER
-{ $description "For portability, if a number is known to be 64bit and signed, then this datatype may be used. Some databases, like SQLite, cannot store arbitrary bignums as BIGINT types. If storing arbitrary bignums, use " { $link FACTOR-BLOB } "." } ;
+{ $description "For portability, if a number is known to be 64bit and signed, then this datatype may be used. Some databases, like SQLite, cannot store arbitrary bignums as BIGINT types. If storing arbitrary bignums, use " { $link FACTOR-BLOB } "." } ;
HELP: TEXT
-{ $description "" } ;
+{ $description "Stores a string that is longer than a " { $link VARCHAR } ". SQLite uses this type for strings; it does not handle " { $link VARCHAR } " strings." } ;
HELP: TIME
-{ $description "" } ;
+{ $description "A timestamp without a date component." } ;
HELP: TIMESTAMP
{ $description "A Factor timestamp." } ;
HELP: UNSIGNED-BIG-INTEGER
-{ $description "For portability, if a number is known to be 64bit, then this datatype may be used. Some databases, like SQLite, cannot store arbitrary bignums as BIGINT types. If storing arbitrary bignums, use " { $link FACTOR-BLOB } "." } ;
+{ $description "For portability, if a number is known to be 64bit, then this datatype may be used. Some databases, like SQLite, cannot store arbitrary bignums as BIGINT types. If storing arbitrary bignums, use " { $link FACTOR-BLOB } "." } ;
{ INTEGER SIGNED-BIG-INTEGER UNSIGNED-BIG-INTEGER } related-words
HELP: URL
-{ $description "A Factor " { $link "urls" } " object." } ;
+{ $description "A Factor " { $link "urls" } " object." } ;
HELP: VARCHAR
-{ $description "The SQL varchar type. This type can take an integer as an argument." } ;
+{ $description "The SQL varchar type. This type can take an integer as an argument." }
+{ $examples { $unchecked-example "{ VARCHAR 256 }" "" } } ;
HELP: user-assigned-id-spec?
{ $values
{ $subsection DATETIME }
{ $subsection TIME }
{ $subsection TIMESTAMP }
-"Arbitrary Factor objects:"
+"Factor byte-arrays:"
{ $subsection BLOB }
+"Arbitrary Factor objects:"
{ $subsection FACTOR-BLOB }
"Factor URLs:"
{ $subsection URL } ;
state-classes ensure-tables
user ensure-table ;
-: <alloy> ( responder db params -- responder' )
- [ [ init-furnace-tables ] with-db ]
+: <alloy> ( responder db -- responder' )
+ [ [ init-furnace-tables ] with-db ] keep
[
- [
- <asides>
- <conversations>
- <sessions>
- ] 2dip
- <db-persistence>
- <check-form-submissions>
- ] 2bi ;
+ <asides>
+ <conversations>
+ <sessions>
+ ] dip
+ <db-persistence>
+ <check-form-submissions> ;
-: start-expiring ( db params -- )
+: start-expiring ( db -- )
'[
- _ _ [ state-classes [ expire-state ] each ] with-db
+ _ [ state-classes [ expire-state ] each ] with-db
] 5 minutes every drop ;
\r
[ "auth-test.db" temp-file delete-file ] ignore-errors\r
\r
-"auth-test.db" temp-file sqlite-db [\r
+"auth-test.db" temp-file <sqlite-db> [\r
\r
user ensure-table\r
\r
\r
TUPLE: db-persistence < filter-responder pool ;\r
\r
-: <db-persistence> ( responder params db -- responder' )\r
+: <db-persistence> ( responder db -- responder' )\r
<db-pool> db-persistence boa ;\r
\r
M: db-persistence call-responder*\r
<action>\r
[ [ ] "text/plain" <content> exit-with ] >>display ;\r
\r
-[ "auth-test.db" temp-file sqlite-db delete-file ] ignore-errors\r
+[ "auth-test.db" temp-file delete-file ] ignore-errors\r
\r
-"auth-test.db" temp-file sqlite-db [\r
+"auth-test.db" temp-file <sqlite-db> [\r
\r
<request> init-request\r
session ensure-table\r
[ stop-this-server "Goodbye" "text/html" <content> ] >>display
"quit" add-responder ;
-: test-db "test.db" temp-file sqlite-db ;
+: test-db "test.db" temp-file <sqlite-db> ;
[ test-db drop delete-file ] ignore-errors
<boilerplate>
{ planet "planet-common" } >>template ;
-: start-update-task ( db params -- )
- '[ _ _ [ update-cached-postings ] with-db ] 10 minutes every drop ;
+: start-update-task ( db -- )
+ '[ _ [ update-cached-postings ] with-db ] 10 minutes every drop ;
webapps.help ;
IN: websites.concatenative
-: test-db ( -- params db ) "resource:test.db" sqlite-db ;
+: test-db ( -- params db ) "resource:test.db" <sqlite-db> ;
: init-factor-db ( -- )
test-db [
projects / factor.git / commitdiff