From 67683dde20affbdc8c8897c95b614a66e3758dff Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 12:11:56 -0500 Subject: [PATCH] make-db is gone, use or instead. docs. use dip instead of >r r> --- basis/db/db-docs.factor | 113 ++++++++------------------ basis/db/db.factor | 13 +-- basis/db/pools/pools.factor | 8 +- basis/db/postgresql/postgresql.factor | 25 +++--- basis/db/sqlite/sqlite.factor | 18 ++-- basis/db/tuples/tuples-tests.factor | 39 +++++---- 6 files changed, 90 insertions(+), 126 deletions(-) diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor index 74b72b8789..a4a948d07f 100644 --- a/basis/db/db-docs.factor +++ b/basis/db/db-docs.factor @@ -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 ;"> +} ; diff --git a/basis/db/db.factor b/basis/db/db.factor index 87bf21d261..5b159d0ea1 100755 --- a/basis/db/db.factor +++ b/basis/db/db.factor @@ -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 ; diff --git a/basis/db/pools/pools.factor b/basis/db/pools/pools.factor index 63153c451e..45f37f8f7c 100644 --- a/basis/db/pools/pools.factor +++ b/basis/db/pools/pools.factor @@ -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 ; : ( params db -- pool ) db-pool @@ -15,7 +15,7 @@ TUPLE: db-pool < pool db params ; >r 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 diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index 28548d1260..08df25c13a 100755 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -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 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> 1, ; + [ bind-name% f swap type>> ] dip + 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% ] diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index dfd9fab08c..dfe4fdf475 100755 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -11,8 +11,9 @@ IN: db.sqlite TUPLE: sqlite-db < db path ; -M: sqlite-db make-db* ( path db -- db ) - swap >>path ; +: ( 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 ; + [ [ key>> ] [ type>> ] bi ] dip + swap ; 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 ( tuple -- statement ) ; M: sqlite-db bind# ( spec obj -- ) - >r - [ column-name>> ":" swap next-sql-counter 3append dup 0% ] - [ type>> ] bi - r> 1, ; + [ + [ column-name>> ":" swap next-sql-counter 3append dup 0% ] + [ type>> ] bi + ] dip 1, ; M: sqlite-db bind% ( spec -- ) dup 1, column-name>> ":" prepend 0% ; diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index 406d4756a2..f5569a97cd 100755 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -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 ; + : test-sqlite ( quot -- ) - [ ] swap '[ - "tuples-test.db" temp-file sqlite-db _ with-db - ] unit-test ; + '[ + [ ] [ + "tuples-test.db" temp-file _ with-db + ] unit-test + ] call ; inline + +: 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 ;