diff --git a/extra/db/db.factor b/extra/db/db.factor index 5b0658883d..7bdb75af22 100755 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -34,22 +34,18 @@ HOOK: db ( str -- statement ) HOOK: db ( str -- statement ) GENERIC: prepare-statement ( statement -- ) GENERIC: bind-statement* ( obj statement -- ) -GENERIC: rebind-statement ( obj statement -- ) +GENERIC: reset-statement ( statement -- ) GENERIC: execute-statement ( statement -- ) : bind-statement ( obj statement -- ) - 2dup dup statement-bound? [ - rebind-statement - ] [ - bind-statement* - ] if - tuck set-statement-params + dup statement-bound? [ dup reset-statement ] when + [ bind-statement* ] 2keep + [ set-statement-params ] keep t swap set-statement-bound? ; TUPLE: result-set sql params handle n max ; GENERIC: query-results ( query -- result-set ) - GENERIC: #rows ( result-set -- n ) GENERIC: #columns ( result-set -- n ) GENERIC# row-column 1 ( result-set n -- obj ) diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index de861f0edc..1780cc4a2d 100755 --- a/extra/db/sqlite/lib/lib.factor +++ b/extra/db/sqlite/lib/lib.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Chris Double, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types assocs kernel math math.parser +USING: alien.c-types arrays assocs kernel math math.parser namespaces sequences db.sqlite.ffi db combinators -continuations ; +continuations db.types ; IN: db.sqlite.lib : sqlite-error ( n -- * ) @@ -40,30 +40,48 @@ IN: db.sqlite.lib >r dupd sqlite-bind-parameter-index r> ; : sqlite-bind-text ( handle index text -- ) - ! dup number? [ number>string ] when - dup length SQLITE_TRANSIENT sqlite3_bind_text sqlite-check-result ; + dup length SQLITE_TRANSIENT + sqlite3_bind_text sqlite-check-result ; -: sqlite-bind-int ( handle name n -- ) +: sqlite-bind-int ( handle i n -- ) sqlite3_bind_int sqlite-check-result ; -: sqlite-bind-int64 ( handle name n -- ) +: sqlite-bind-int64 ( handle i n -- ) sqlite3_bind_int64 sqlite-check-result ; -: sqlite-bind-null ( handle n -- ) +: sqlite-bind-double ( handle i x -- ) + sqlite3_bind_double sqlite-check-result ; + +: sqlite-bind-null ( handle i -- ) sqlite3_bind_null sqlite-check-result ; : sqlite-bind-text-by-name ( handle name text -- ) parameter-index sqlite-bind-text ; -: sqlite-bind-int-by-name ( handle name text -- ) +: sqlite-bind-int-by-name ( handle name int -- ) parameter-index sqlite-bind-int ; -: sqlite-bind-int64-by-name ( handle name text -- ) +: sqlite-bind-int64-by-name ( handle name int64 -- ) parameter-index sqlite-bind-int ; +: sqlite-bind-double-by-name ( handle name double -- ) + parameter-index sqlite-bind-double ; + : sqlite-bind-null-by-name ( handle name obj -- ) parameter-index drop sqlite-bind-null ; +: sqlite-bind-type ( handle key value type -- ) + dup array? [ first ] when + { + { INTEGER [ sqlite-bind-int-by-name ] } + { BIG_INTEGER [ sqlite-bind-int-by-name ] } + { TEXT [ sqlite-bind-text-by-name ] } + { VARCHAR [ sqlite-bind-text-by-name ] } + { DOUBLE [ sqlite-bind-double-by-name ] } + ! { NULL [ sqlite-bind-null-by-name ] } + [ no-sql-type ] + } case ; + : sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ; diff --git a/extra/db/sqlite/sqlite-tests.factor b/extra/db/sqlite/sqlite-tests.factor index cd6a099ead..d3388b4648 100644 --- a/extra/db/sqlite/sqlite-tests.factor +++ b/extra/db/sqlite/sqlite-tests.factor @@ -1,6 +1,6 @@ USING: io io.files io.launcher kernel namespaces prettyprint tools.test db.sqlite db sequences -continuations ; +continuations db.types ; IN: temporary : test.db "extra/db/sqlite/test.db" resource-path ; @@ -26,13 +26,13 @@ IN: temporary test.db [ "select * from person where name = :name and country = :country" [ - { { ":name" "Jane" } { ":country" "New Zealand" } } + { { ":name" "Jane" TEXT } { ":country" "New Zealand" TEXT } } over do-bound-query { { "Jane" "New Zealand" } } = [ "test fails" throw ] unless - { { ":name" "John" } { ":country" "America" } } + { { ":name" "John" TEXT } { ":country" "America" TEXT } } swap do-bound-query ] with-disposal ] with-sqlite diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index 9099f616bd..ad3a43bae3 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -44,16 +44,13 @@ M: sqlite-result-set dispose ( result-set -- ) f swap set-result-set-handle ; : sqlite-bind ( triples handle -- ) - [ - -rot sqlite-bind-text-by-name - ] curry assoc-each ; + swap [ first3 sqlite-bind-type ] with each ; M: sqlite-statement bind-statement* ( triples statement -- ) statement-handle sqlite-bind ; -M: sqlite-statement rebind-statement ( triples statement -- ) - dup statement-handle sqlite-reset - bind-statement* ; +M: sqlite-statement reset-statement ( statement -- ) + statement-handle sqlite-reset ; M: sqlite-statement execute-statement ( statement -- ) statement-handle sqlite-next drop ; @@ -123,7 +120,7 @@ M: sqlite-db delete-sql* ( columns table -- sql ) % " where " % first second dup % " = :" % % - ] "" make dup . ; + ] "" make ; M: sqlite-db select-sql* ( columns table -- sql ) [ @@ -136,9 +133,10 @@ M: sqlite-db select-sql* ( columns table -- sql ) M: sqlite-db tuple>params ( columns tuple -- obj ) [ - >r [ second ":" swap append ] keep first r> get-slot-named - number>string* - ] curry { } map>assoc ; + >r [ second ":" swap append ] keep r> + dupd >r first r> get-slot-named swap + third 3array + ] curry map ; M: sqlite-db last-id ( -- id ) db get db-handle sqlite3_last_insert_rowid ; @@ -171,6 +169,7 @@ M: sqlite-db sql-modifiers* ( modifiers -- str ) { INTEGER "integer" } { TEXT "text" } { VARCHAR "text" } + { DOUBLE "real" } } ; M: sqlite-db >sql-type ( obj -- str ) diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index ac1020b0e9..474593ae3f 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -1,25 +1,25 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: io.files kernel tools.test db db.sqlite db.tuples db.types continuations namespaces ; IN: temporary -TUPLE: person the-id the-name the-number ; +TUPLE: person the-id the-name the-number real ; : ( name age -- person ) - { set-person-the-name set-person-the-number } person construct ; + { + set-person-the-name + set-person-the-number + set-person-real + } person construct ; -person "PERSON" -{ - { "the-id" "ROWID" INTEGER +native-id+ } - { "the-name" "NAME" { VARCHAR 256 } +not-null+ } - { "the-number" "AGE" INTEGER { +default+ 0 } } -} define-persistent +: ( id name number real -- obj ) + [ set-person-the-id ] keep ; SYMBOL: the-person : test-tuples ( -- ) - [ person drop-table ] [ ] recover - person create-table - f "billy" 100 person construct-boa - the-person set + [ person drop-table ] [ drop ] recover + [ ] [ person create-table ] unit-test [ ] [ the-person get insert-tuple ] unit-test @@ -36,11 +36,33 @@ SYMBOL: the-person test-tuples ] with-db ; -test-sqlite - ! : test-postgres ( -- ) ! resource-path [ ! test-tuples ! ] with-db ; +person "PERSON" +{ + { "the-id" "ROWID" INTEGER +native-id+ } + { "the-name" "NAME" { VARCHAR 256 } +not-null+ } + { "the-number" "AGE" INTEGER { +default+ 0 } } + { "real" "REAL" DOUBLE { +default+ 0.3 } } +} define-persistent + +"billy" 10 3.14 the-person set + +test-sqlite +! test-postgres + +person "PERSON" +{ + { "the-id" "ROWID" INTEGER +assigned-id+ } + { "the-name" "NAME" { VARCHAR 256 } +not-null+ } + { "the-number" "AGE" INTEGER { +default+ 0 } } + { "real" "REAL" DOUBLE { +default+ 0.3 } } +} define-persistent + +1 "billy" 20 6.28 the-person set + +test-sqlite ! test-postgres diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 4427c5300d..099326e4c1 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -61,11 +61,12 @@ HOOK: tuple>params db ( columns tuple -- obj ) : tuple-statement ( columns tuple quot -- statement ) >r [ tuple>params ] 2keep class r> call + 2dup . . [ bind-statement ] keep ; : do-tuple-statement ( tuple columns-quot statement-quot -- ) >r [ class db-columns ] swap compose keep - r> tuple-statement dup . execute-statement ; + r> tuple-statement execute-statement ; : create-table ( class -- ) dup db-columns swap db-table create-sql sql-command ; diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index a6ae223a5e..b8c82524a8 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -22,10 +22,6 @@ SYMBOL: +not-null+ SYMBOL: +has-many+ -! SQLite Types -! http://www.sqlite.org/datatype3.html -! NULL INTEGER REAL TEXT BLOB - SYMBOL: INTEGER SYMBOL: DOUBLE SYMBOL: BOOLEAN @@ -38,19 +34,17 @@ SYMBOL: DATE SYMBOL: BIG_INTEGER -! PostgreSQL Types -! http://developer.postgresql.org/pgdocs/postgres/datatype.html - - -: number>string* ( num/str -- str ) - dup number? [ number>string ] when ; - TUPLE: no-sql-type ; +: no-sql-type ( -- * ) T{ no-sql-type } throw ; + HOOK: sql-modifiers* db ( modifiers -- str ) HOOK: >sql-type db ( obj -- str ) ! HOOK: >factor-type db ( obj -- obj ) +: number>string* ( n/str -- str ) + dup number? [ number>string ] when ; + : maybe-remove-id ( columns -- obj ) [ +native-id+ swap member? not ] subset ; @@ -59,3 +53,8 @@ HOOK: >sql-type db ( obj -- str ) : sql-modifiers ( spec -- seq ) 3 tail sql-modifiers* ; + +! SQLite Types: http://www.sqlite.org/datatype3.html +! NULL INTEGER REAL TEXT BLOB +! PostgreSQL Types: +! http://developer.postgresql.org/pgdocs/postgres/datatype.html