From 3eb7830d2c7c99aef369a7a3a5b1f5ec4deb0584 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Mar 2008 19:08:33 -0600 Subject: [PATCH] before major overhaul on return values --- extra/db/sqlite/lib/lib.factor | 32 +++++++++--- extra/db/sqlite/sqlite.factor | 8 ++- extra/db/tuples/tuples-tests.factor | 75 ++++++++++++++++++++++------- extra/db/types/types.factor | 28 ++++++----- 4 files changed, 105 insertions(+), 38 deletions(-) diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index 648d8493dc..40486ba19f 100755 --- a/extra/db/sqlite/lib/lib.factor +++ b/extra/db/sqlite/lib/lib.factor @@ -2,7 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types arrays assocs kernel math math.parser namespaces sequences db.sqlite.ffi db combinators -continuations db.types ; +continuations db.types calendar.format serialize +io.streams.string byte-arrays ; +USE: tools.walker IN: db.sqlite.lib : sqlite-error ( n -- * ) @@ -55,6 +57,10 @@ IN: db.sqlite.lib : sqlite-bind-null ( handle i -- ) sqlite3_bind_null sqlite-check-result ; +: sqlite-bind-blob ( handle i byte-array -- ) + dup length SQLITE_TRANSIENT + sqlite3_bind_blob sqlite-check-result ; + : sqlite-bind-text-by-name ( handle name text -- ) parameter-index sqlite-bind-text ; @@ -67,20 +73,33 @@ IN: db.sqlite.lib : sqlite-bind-double-by-name ( handle name double -- ) parameter-index sqlite-bind-double ; +: sqlite-bind-blob-by-name ( handle name blob -- ) + parameter-index sqlite-bind-blob ; + : sqlite-bind-null-by-name ( handle name obj -- ) parameter-index drop sqlite-bind-null ; : sqlite-bind-type ( handle key value type -- ) + over [ drop NULL ] unless dup array? [ first ] when { { INTEGER [ sqlite-bind-int-by-name ] } - { BIG_INTEGER [ sqlite-bind-int64-by-name ] } + { BIG-INTEGER [ sqlite-bind-int64-by-name ] } { TEXT [ sqlite-bind-text-by-name ] } { VARCHAR [ sqlite-bind-text-by-name ] } { DOUBLE [ sqlite-bind-double-by-name ] } - { TIMESTAMP [ sqlite-bind-double-by-name ] } + { DATE [ sqlite-bind-text-by-name ] } + { TIME [ sqlite-bind-text-by-name ] } + { DATETIME [ sqlite-bind-text-by-name ] } + { TIMESTAMP [ sqlite-bind-text-by-name ] } + { BLOB [ sqlite-bind-blob-by-name ] } + { FACTOR-BLOB [ + break + [ serialize ] with-string-writer >byte-array + sqlite-bind-blob-by-name + ] } { +native-id+ [ sqlite-bind-int-by-name ] } - ! { NULL [ sqlite-bind-null-by-name ] } + { NULL [ sqlite-bind-null-by-name ] } [ no-sql-type ] } case ; @@ -93,21 +112,20 @@ IN: db.sqlite.lib : sqlite-#columns ( query -- int ) sqlite3_column_count ; -! TODO : sqlite-column ( handle index -- string ) sqlite3_column_text ; : sqlite-column-typed ( handle index type -- obj ) { { INTEGER [ sqlite3_column_int ] } - { BIG_INTEGER [ sqlite3_column_int64 ] } + { BIG-INTEGER [ sqlite3_column_int64 ] } { TEXT [ sqlite3_column_text ] } { DOUBLE [ sqlite3_column_double ] } { TIMESTAMP [ sqlite3_column_double ] } + ! { NULL [ 2drop f ] } [ no-sql-type ] } case ; -! TODO : sqlite-row ( handle -- seq ) dup sqlite-#columns [ sqlite-column ] with map ; diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index cfdcfc7750..1e55dc8331 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -179,8 +179,7 @@ M: sqlite-db ( tuple class -- statement ) " where " 0% [ ", " 0% ] [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave - ";" 0% - ] if + ] if ";" 0% ] sqlite-make ; M: sqlite-db modifier-table ( -- hashtable ) @@ -209,8 +208,13 @@ M: sqlite-db type-table ( -- assoc ) { INTEGER "integer" } { TEXT "text" } { VARCHAR "text" } + { DATE "date" } + { TIME "time" } + { DATETIME "datetime" } { TIMESTAMP "timestamp" } { DOUBLE "real" } + { BLOB "blob" } + { FACTOR-BLOB "blob" } } ; M: sqlite-db create-type-table diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 517f8bcc36..e30b06411f 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -2,39 +2,45 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io.files kernel tools.test db db.tuples db.types continuations namespaces db.postgresql math -prettyprint tools.walker db.sqlite ; +prettyprint tools.walker db.sqlite calendar ; IN: db.tuples.tests -TUPLE: person the-id the-name the-number the-real ; +TUPLE: person the-id the-name the-number the-real ts date time blob ; : ( name age real -- person ) { set-person-the-name set-person-the-number set-person-the-real + set-person-ts + set-person-date + set-person-time + set-person-blob } person construct ; : ( id name number the-real -- obj ) [ set-person-the-id ] keep ; -SYMBOL: the-person1 -SYMBOL: the-person2 +SYMBOL: person1 +SYMBOL: person2 +SYMBOL: person3 +SYMBOL: person4 : test-tuples ( -- ) [ person drop-table ] [ drop ] recover [ ] [ person create-table ] unit-test [ person create-table ] must-fail - [ ] [ the-person1 get insert-tuple ] unit-test + [ ] [ person1 get insert-tuple ] unit-test - [ 1 ] [ the-person1 get person-the-id ] unit-test + [ 1 ] [ person1 get person-the-id ] unit-test - 200 the-person1 get set-person-the-number + 200 person1 get set-person-the-number - [ ] [ the-person1 get update-tuple ] unit-test + [ ] [ person1 get update-tuple ] unit-test [ T{ person f 1 "billy" 200 3.14 } ] [ T{ person f 1 } select-tuple ] unit-test - [ ] [ the-person2 get insert-tuple ] unit-test + [ ] [ person2 get insert-tuple ] unit-test [ { T{ person f 1 "billy" 200 3.14 } @@ -49,8 +55,19 @@ SYMBOL: the-person2 ] [ T{ person f } select-tuples ] unit-test - [ ] [ the-person1 get delete-tuple ] unit-test + [ ] [ person1 get delete-tuple ] unit-test [ f ] [ T{ person f 1 } select-tuple ] unit-test + + [ ] [ person3 get insert-tuple ] unit-test + + [ + T{ person f 3 "teddy" 10 3.14 + T{ timestamp f 2008 3 5 16 24 11 0 } + T{ timestamp f 2008 11 22 f f f f } + T{ timestamp f f f f 12 34 56 f } + "storeinablob" } + ] [ T{ person f 3 } select-tuple ] unit-test + [ ] [ person drop-table ] unit-test ; : make-native-person-table ( -- ) @@ -67,9 +84,14 @@ SYMBOL: the-person2 { "the-name" "NAME" { VARCHAR 256 } +not-null+ } { "the-number" "AGE" INTEGER { +default+ 0 } } { "the-real" "REAL" DOUBLE { +default+ 0.3 } } + { "ts" "TS" TIMESTAMP } + { "date" "D" DATE } + { "time" "T" TIME } + { "blob" "B" BLOB } } define-persistent - "billy" 10 3.14 the-person1 set - "johnny" 10 3.14 the-person2 set ; + "billy" 10 3.14 f f f f person1 set + "johnny" 10 3.14 f f f f person2 set + "teddy" 10 3.14 "2008-03-05 16:24:11" "2008-11-22" "12:34:56" B{ 115 116 111 114 101 105 110 97 98 108 111 98 } person3 set ; : assigned-person-schema ( -- ) person "PERSON" @@ -78,10 +100,14 @@ SYMBOL: the-person2 { "the-name" "NAME" { VARCHAR 256 } +not-null+ } { "the-number" "AGE" INTEGER { +default+ 0 } } { "the-real" "REAL" DOUBLE { +default+ 0.3 } } + { "ts" "TS" TIMESTAMP } + { "date" "D" DATE } + { "time" "T" TIME } + { "blob" "B" BLOB } } define-persistent - 1 "billy" 10 3.14 the-person1 set - 2 "johnny" 10 3.14 the-person2 set ; - + 1 "billy" 10 3.14 f f f f person1 set + 2 "johnny" 10 3.14 f f f f person2 set + 3 "teddy" 10 3.14 "2008-03-05 16:24:11" "2008-11-22" "12:34:56" B{ 115 116 111 114 101 105 110 97 98 108 111 98 } person3 set ; TUPLE: paste n summary author channel mode contents timestamp annotations ; TUPLE: annotation n paste-id summary author mode contents ; @@ -125,7 +151,22 @@ TUPLE: annotation n paste-id summary author mode contents ; : test-postgresql ( -- ) >r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ; -[ native-person-schema test-tuples ] test-sqlite -[ assigned-person-schema test-tuples ] test-sqlite + +! [ native-person-schema test-tuples ] test-sqlite +! [ assigned-person-schema test-tuples ] test-sqlite + +TUPLE: serialize-me id data ; +[ + serialize-me "SERIALIZED" + { + { "id" "ID" +native-id+ } + { "data" "DATA" FACTOR-BLOB } + } define-persistent + [ serialize-me drop-table ] [ drop ] recover + [ ] [ serialize-me create-table ] unit-test + + [ ] [ T{ serialize-me f f H{ { 1 2 } } } insert-tuple ] unit-test + [ ] [ T{ serialize-me f 1 } select-tuples ] unit-test +] test-sqlite ! [ make-native-person-table ] test-sqlite diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index c84b23c50f..89c26c1dd6 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -3,7 +3,8 @@ USING: arrays assocs db kernel math math.parser sequences continuations sequences.deep sequences.lib words namespaces tools.walker slots slots.private classes -mirrors tuples combinators ; +mirrors tuples combinators calendar.format serialize +io.streams.string ; IN: db.types HOOK: modifier-table db ( -- hash ) @@ -60,14 +61,19 @@ SYMBOL: +has-many+ : relation? ( spec -- ? ) [ +has-many+ = ] deep-find ; SYMBOL: INTEGER -SYMBOL: BIG_INTEGER +SYMBOL: BIG-INTEGER SYMBOL: DOUBLE SYMBOL: REAL SYMBOL: BOOLEAN SYMBOL: TEXT SYMBOL: VARCHAR -SYMBOL: TIMESTAMP SYMBOL: DATE +SYMBOL: TIME +SYMBOL: DATETIME +SYMBOL: TIMESTAMP +SYMBOL: BLOB +SYMBOL: FACTOR-BLOB +SYMBOL: NULL : spec>tuple ( class spec -- tuple ) [ ?first3 ] keep 3 ?tail* @@ -80,15 +86,6 @@ SYMBOL: DATE } sql-spec construct dup normalize-spec ; -: sql-type-hash ( -- assoc ) - H{ - { INTEGER "integer" } - { TEXT "text" } - { VARCHAR "varchar" } - { DOUBLE "real" } - { TIMESTAMP "timestamp" } - } ; - TUPLE: no-sql-type ; : no-sql-type ( -- * ) T{ no-sql-type } throw ; @@ -212,13 +209,20 @@ TUPLE: no-slot-named ; ] curry { } map>assoc ; : sql-type>factor-type ( obj type -- obj ) +break dup array? [ first ] when { { +native-id+ [ string>number ] } { INTEGER [ string>number ] } { DOUBLE [ string>number ] } { REAL [ string>number ] } + { DATE [ dup [ ymd>timestamp ] when ] } + { TIME [ dup [ hms>timestamp ] when ] } + { DATETIME [ dup [ ymdhms>timestamp ] when ] } + { TIMESTAMP [ dup [ ymdhms>timestamp ] when ] } { TEXT [ ] } { VARCHAR [ ] } + { BLOB [ ] } + { FACTOR-BLOB [ break [ deserialize ] with-string-reader ] } [ "no conversion from sql type to factor type" throw ] } case ;