Merge branch 'master' of git://factorcode.org/git/factor

db4
John Benediktsson 2008-10-02 14:15:11 -07:00
commit dedaa03115
16 changed files with 139 additions and 167 deletions

View File

@ -5,27 +5,19 @@ alien assocs strings math multiline quotations ;
IN: db IN: db
HELP: 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 HELP: new-db
{ $values { "class" class } { "obj" object } } { $values { "class" class } { "obj" object } }
{ $description "Creates a new database object from a given class." } ; { $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: 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." } ;
HELP: db-open HELP: db-open
{ $values { "db" db } { "db" db } } { $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 HELP: db-close
{ $values { "handle" alien } } { $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 HELP: dispose-statements
{ $values { "assoc" assoc } } { $values { "assoc" assoc } }
@ -38,30 +30,18 @@ HELP: db-dispose
HELP: statement 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." } ; { $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 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." { $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-random-access-result-set" }
{ $subsection "db-sequential-result-set" } { $subsection "db-sequential-result-set" }
} ; } ;
HELP: init-result-set
{ $values
{ "result-set" result-set } }
{ $description "" } ;
HELP: new-result-set HELP: new-result-set
{ $values { $values
{ "query" "a query" } { "handle" alien } { "class" class } { "query" "a query" } { "handle" alien } { "class" class }
{ "result-set" result-set } } { "result-set" result-set } }
{ $description "Creates a new " { $link result-set } " object of type " { $snippet "class" } "." } ; { $description "Creates a new " { $link result-set } " object of type " { $snippet "class" } "." } ;
HELP: new-statement HELP: new-statement
{ $values { "sql" string } { "in" sequence } { "out" sequence } { "class" class } { "statement" statement } } { $values { "sql" string } { "in" sequence } { "out" sequence } { "class" class } { "statement" statement } }
{ $description "Makes a new statement object from the given parameters." } ; { $description "Makes a new statement object from the given parameters." } ;
@ -80,18 +60,6 @@ HELP: prepare-statement
{ $values { "statement" 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." } ; { $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 HELP: query-results
{ $values { "query" object } { $values { "query" object }
{ "result-set" result-set } { "result-set" result-set }
@ -125,41 +93,14 @@ HELP: more-rows?
{ $values { "result-set" result-set } { "?" "a boolean" } } { $values { "result-set" result-set } { "?" "a boolean" } }
{ $description "Returns true if the " { $link result-set } " has more rows to traverse." } ; { $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 HELP: begin-transaction
{ $description "Begins a new transaction. User code should make use of the " { $link with-transaction } " combinator." } ; { $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 HELP: commit-transaction
{ $description "Commits a transaction. User code should make use of the " { $link with-transaction } " combinator." } ; { $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 HELP: in-transaction
{ $description "A variable that is set true when a transaction is in progress." } ; { $description "A variable that is set true when a transaction is in progress." } ;
@ -170,14 +111,14 @@ HELP: in-transaction?
HELP: query-each HELP: query-each
{ $values { $values
{ "statement" null } { "quot" quotation } } { "statement" statement } { "quot" quotation } }
{ $description "" } ; { $description "A combinator that calls a quotation on a sequence of SQL statements to their results query results." } ;
HELP: query-map HELP: query-map
{ $values { $values
{ "statement" null } { "quot" quotation } { "statement" statement } { "quot" quotation }
{ "seq" sequence } } { "seq" sequence } }
{ $description "" } ; { $description "A combinator that maps a sequence of SQL statements to their results query results." } ;
HELP: rollback-transaction 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." } ; { $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 HELP: with-db
{ $values { $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 " } ; { $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 HELP: with-transaction
@ -247,7 +188,7 @@ $nl
{ $subsection row-column-typed } ; { $subsection row-column-typed } ;
ARTICLE: "db-sequential-result-set" "Sequential result sets" 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 $nl
"Databases which work in this way must provide methods for the following traversal words:" "Databases which work in this way must provide methods for the following traversal words:"
{ $subsection more-rows? } { $subsection more-rows? }
@ -272,26 +213,52 @@ $nl
{ $subsection row-column-typed } ; { $subsection row-column-typed } ;
ARTICLE: "db-protocol" "Low-level database protocol" 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 }
"Creating tatements:"
{ $subsection <simple-statement> }
{ $subsection <prepared-statement> }
"Using statements with the database:"
{ $subsection prepare-statement }
{ $subsection bind-statement* }
{ $subsection low-level-bind }
"Performing a query:"
{ $subsection query-results }
"Handling query results:"
{ $subsection "db-result-sets" }
; ;
! { $subsection bind-tuple }
ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial" 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" } "." "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" 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" 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 <" { $code <"
USING: db.sqlite db io.files ; USING: db.sqlite db io.files ;
: with-my-database ( quot -- ) : with-sqlite-db ( quot -- )
{ "my-database.db" temp-file } sqlite-db rot with-db ; "my-database.db" temp-file <sqlite-db> rot with-db ;"> }
"> }
{ $code <" USING: db.postgresql db ;
: with-postgresql-db ( quot -- )
<postgresql-db>
"localhost" >>host
"erg" >>username
"secrets?" >>password
"factor-test" >>database
swap with-db ;">
}
; ;

View File

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

View File

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

View File

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

View File

@ -145,10 +145,13 @@ M: db <delete-tuples-statement> ( tuple table -- sql )
where-clause where-clause
] query-make ; ] query-make ;
ERROR: all-slots-ignored class ;
M: db <select-by-slots-statement> ( tuple class -- statement ) M: db <select-by-slots-statement> ( tuple class -- statement )
[ [
"select " 0% "select " 0%
[ dupd filter-ignores ] dip [ dupd filter-ignores ] dip
over empty? [ all-slots-ignored ] when
over over
[ ", " 0% ] [ ", " 0% ]
[ dup column-name>> 0% 2, ] interleave [ dup column-name>> 0% 2, ] interleave

View File

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

View File

@ -190,7 +190,7 @@ T{ book
{ $list { $list
"Make a new tuple to represent your data" "Make a new tuple to represent your data"
{ "Map the Factor types to the database types with " { $link define-persistent } } { "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 } } { "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 } } { "Start making and storing objects with " { $link insert-tuple } ", " { $link update-tuple } ", " { $link delete-tuples } ", and " { $link select-tuples } }
} ; } ;

View File

@ -7,16 +7,34 @@ db.postgresql accessors random math.bitwise
math.ranges strings urls fry db.tuples.private ; math.ranges strings urls fry db.tuples.private ;
IN: db.tuples.tests IN: db.tuples.tests
: sqlite-db ( -- sqlite-db )
"tuples-test.db" temp-file <sqlite-db> ;
: test-sqlite ( quot -- ) : 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 -- ) : test-postgresql ( quot -- )
[ ] swap '[ '[
{ "localhost" "postgres" "foob" "factor-test" } [ ] [ postgresql-db _ with-db ] unit-test
postgresql-db _ with-db ] call ; inline
] unit-test ;
! 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 TUPLE: person the-id the-name the-number the-real
ts date time blob factor-blob url ; ts date time blob factor-blob url ;
@ -356,9 +374,7 @@ TUPLE: exam id name score ;
[ f ] [ f ]
[ T{ exam { name IGNORE } { score IGNORE } } select-tuples first score>> ] unit-test [ T{ exam { name IGNORE } { score IGNORE } } select-tuples first score>> ] unit-test
! FIXME [ T{ exam { name IGNORE } { score IGNORE } { id IGNORE } } select-tuples first score>> ] [ class>> "EXAM" = ] must-fail-with
! [ f ]
! [ T{ exam { name IGNORE } { score IGNORE } { id IGNORE } } select-tuples first score>> ] unit-test
[ [
{ {
@ -641,10 +657,3 @@ compound-foo "COMPOUND_FOO"
[ test-compound-primary-key ] test-sqlite [ test-compound-primary-key ] test-sqlite
[ test-compound-primary-key ] test-postgresql [ 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 ;

View File

@ -8,7 +8,7 @@ HELP: +autoincrement+
{ $description "" } ; { $description "" } ;
HELP: +db-assigned-id+ 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+ HELP: +default+
{ $description "" } ; { $description "" } ;
@ -29,7 +29,7 @@ HELP: +primary-key+
{ $description "" } ; { $description "" } ;
HELP: +random-id+ 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+ HELP: +serial+
{ $description "" } ; { $description "" } ;
@ -38,7 +38,7 @@ HELP: +unique+
{ $description "" } ; { $description "" } ;
HELP: +user-assigned-id+ 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> HELP: <generator-bind>
{ $description "" } ; { $description "" } ;
@ -53,7 +53,7 @@ HELP: BIG-INTEGER
{ $description "A 64-bit integer. Whether this number is signed or unsigned depends on the database backend." } ; { $description "A 64-bit integer. Whether this number is signed or unsigned depends on the database backend." } ;
HELP: BLOB 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 HELP: BOOLEAN
{ $description "Either true or false." } ; { $description "Either true or false." } ;
@ -65,7 +65,7 @@ HELP: DATETIME
{ $description "A date and a time." } ; { $description "A date and a time." } ;
HELP: DOUBLE HELP: DOUBLE
{ $description "Corresponds to Factor's 64bit floating-point numbers." } ; { $description "Corresponds to Factor's 64-bit floating-point numbers." } ;
HELP: FACTOR-BLOB HELP: FACTOR-BLOB
{ $description "A serialized Factor object." } ; { $description "A serialized Factor object." } ;
@ -77,30 +77,31 @@ HELP: NULL
{ $description "The SQL null type." } ; { $description "The SQL null type." } ;
HELP: REAL HELP: REAL
{ $description "" } ; { $description "A real number of unlimited precision. May not be supported on all databases." } ;
HELP: SIGNED-BIG-INTEGER 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 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 HELP: TIME
{ $description "" } ; { $description "A timestamp without a date component." } ;
HELP: TIMESTAMP HELP: TIMESTAMP
{ $description "A Factor timestamp." } ; { $description "A Factor timestamp." } ;
HELP: UNSIGNED-BIG-INTEGER 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 { INTEGER SIGNED-BIG-INTEGER UNSIGNED-BIG-INTEGER } related-words
HELP: URL HELP: URL
{ $description "A Factor " { $link "urls" } " object." } ; { $description "A Factor " { $link "urls" } " object." } ;
HELP: VARCHAR 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? HELP: user-assigned-id-spec?
{ $values { $values
@ -279,8 +280,9 @@ ARTICLE: "db.types" "Database types"
{ $subsection DATETIME } { $subsection DATETIME }
{ $subsection TIME } { $subsection TIME }
{ $subsection TIMESTAMP } { $subsection TIMESTAMP }
"Arbitrary Factor objects:" "Factor byte-arrays:"
{ $subsection BLOB } { $subsection BLOB }
"Arbitrary Factor objects:"
{ $subsection FACTOR-BLOB } { $subsection FACTOR-BLOB }
"Factor URLs:" "Factor URLs:"
{ $subsection URL } ; { $subsection URL } ;

View File

@ -17,19 +17,17 @@ IN: furnace.alloy
state-classes ensure-tables state-classes ensure-tables
user ensure-table ; user ensure-table ;
: <alloy> ( responder db params -- responder' ) : <alloy> ( responder db -- responder' )
[ [ init-furnace-tables ] with-db ] [ [ init-furnace-tables ] with-db ] keep
[ [
[ <asides>
<asides> <conversations>
<conversations> <sessions>
<sessions> ] dip
] 2dip <db-persistence>
<db-persistence> <check-form-submissions> ;
<check-form-submissions>
] 2bi ;
: 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 ; ] 5 minutes every drop ;

View File

@ -11,7 +11,7 @@ io.files accessors kernel ;
[ "auth-test.db" temp-file delete-file ] ignore-errors [ "auth-test.db" temp-file delete-file ] ignore-errors
"auth-test.db" temp-file sqlite-db [ "auth-test.db" temp-file <sqlite-db> [
user ensure-table user ensure-table

View File

@ -6,7 +6,7 @@ IN: furnace.db
TUPLE: db-persistence < filter-responder pool ; TUPLE: db-persistence < filter-responder pool ;
: <db-persistence> ( responder params db -- responder' ) : <db-persistence> ( responder db -- responder' )
<db-pool> db-persistence boa ; <db-pool> db-persistence boa ;
M: db-persistence call-responder* M: db-persistence call-responder*

View File

@ -48,9 +48,9 @@ M: foo call-responder*
<action> <action>
[ [ ] "text/plain" <content> exit-with ] >>display ; [ [ ] "text/plain" <content> exit-with ] >>display ;
[ "auth-test.db" temp-file sqlite-db delete-file ] ignore-errors [ "auth-test.db" temp-file delete-file ] ignore-errors
"auth-test.db" temp-file sqlite-db [ "auth-test.db" temp-file <sqlite-db> [
<request> init-request <request> init-request
session ensure-table session ensure-table

View File

@ -182,7 +182,7 @@ http.server.dispatchers db.tuples ;
[ stop-this-server "Goodbye" "text/html" <content> ] >>display [ stop-this-server "Goodbye" "text/html" <content> ] >>display
"quit" add-responder ; "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 [ test-db drop delete-file ] ignore-errors

View File

@ -195,5 +195,5 @@ posting "POSTINGS"
<boilerplate> <boilerplate>
{ planet "planet-common" } >>template ; { planet "planet-common" } >>template ;
: start-update-task ( db params -- ) : start-update-task ( db -- )
'[ _ _ [ update-cached-postings ] with-db ] 10 minutes every drop ; '[ _ [ update-cached-postings ] with-db ] 10 minutes every drop ;

View File

@ -26,7 +26,7 @@ webapps.user-admin
webapps.help ; webapps.help ;
IN: websites.concatenative IN: websites.concatenative
: test-db ( -- params db ) "resource:test.db" sqlite-db ; : test-db ( -- params db ) "resource:test.db" <sqlite-db> ;
: init-factor-db ( -- ) : init-factor-db ( -- )
test-db [ test-db [