diff --git a/extra/db/db.factor b/extra/db/db.factor index e834144d0c..170d9a60f1 100755 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -34,7 +34,7 @@ HOOK: db-close db ( handle -- ) TUPLE: statement handle sql in-params out-params bind-params bound? ; TUPLE: simple-statement ; TUPLE: prepared-statement ; -TUPLE: result-set sql params handle n max ; +TUPLE: result-set sql in-params out-params handle n max ; : ( sql in out -- statement ) { (>>sql) (>>in-params) (>>out-params) } statement construct ; @@ -47,6 +47,7 @@ GENERIC: query-results ( query -- result-set ) GENERIC: #rows ( result-set -- n ) GENERIC: #columns ( result-set -- n ) GENERIC# row-column 1 ( result-set n -- obj ) +GENERIC# row-column-typed 1 ( result-set n -- sql ) GENERIC: advance-row ( result-set -- ) GENERIC: more-rows? ( result-set -- ? ) @@ -67,13 +68,16 @@ GENERIC: more-rows? ( result-set -- ? ) 0 >>n drop ; : ( query handle tuple -- result-set ) - >r >r { sql>> in-params>> } get-slots r> - { (>>sql) (>>params) (>>handle) } result-set + >r >r { sql>> in-params>> out-params>> } get-slots r> + { (>>sql) (>>in-params) (>>out-params) (>>handle) } result-set construct r> construct-delegate ; : sql-row ( result-set -- seq ) dup #columns [ row-column ] with map ; +: sql-row-typed ( result-set -- seq ) + dup #columns [ row-column-typed ] with map ; + : query-each ( statement quot -- ) over more-rows? [ [ call ] 2keep over advance-row query-each diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index 40486ba19f..f11f1e2ba6 100755 --- a/extra/db/sqlite/lib/lib.factor +++ b/extra/db/sqlite/lib/lib.factor @@ -94,7 +94,6 @@ IN: db.sqlite.lib { 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 ] } @@ -115,13 +114,31 @@ IN: db.sqlite.lib : sqlite-column ( handle index -- string ) sqlite3_column_text ; +: sqlite-column-blob ( handle index -- byte-array/f ) + [ sqlite3_column_bytes ] 2keep + pick zero? [ + 3drop f + ] [ + sqlite3_column_blob swap memory>byte-array + ] if ; + : sqlite-column-typed ( handle index type -- obj ) + dup array? [ first ] when { + { +native-id+ [ sqlite3_column_int64 ] } { INTEGER [ sqlite3_column_int ] } { BIG-INTEGER [ sqlite3_column_int64 ] } { TEXT [ sqlite3_column_text ] } + { VARCHAR [ sqlite3_column_text ] } { DOUBLE [ sqlite3_column_double ] } - { TIMESTAMP [ sqlite3_column_double ] } + { DATE [ sqlite3_column_text dup [ ymd>timestamp ] when ] } + { TIME [ sqlite3_column_text dup [ hms>timestamp ] when ] } + { TIMESTAMP [ sqlite3_column_text dup [ ymdhms>timestamp ] when ] } + { DATETIME [ sqlite3_column_text dup [ ymdhms>timestamp ] when ] } + { BLOB [ sqlite-column-blob ] } + { FACTOR-BLOB [ + sqlite-column-blob [ deserialize ] with-string-reader + ] } ! { NULL [ 2drop f ] } [ no-sql-type ] } case ; diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index 1e55dc8331..1524ee5a4f 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -80,8 +80,9 @@ M: sqlite-result-set #columns ( result-set -- n ) M: sqlite-result-set row-column ( result-set n -- obj ) >r result-set-handle r> sqlite-column ; -M: sqlite-result-set row-column-typed ( result-set n type -- obj ) - >r result-set-handle r> sqlite-column-typed ; +M: sqlite-result-set row-column-typed ( result-set n -- obj ) + dup pick result-set-out-params nth sql-spec-type + >r >r result-set-handle r> r> sqlite-column-typed ; M: sqlite-result-set advance-row ( result-set -- ) [ result-set-handle sqlite-next ] keep diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index e30b06411f..c9ceffe035 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -61,11 +61,18 @@ SYMBOL: person4 [ ] [ person3 get insert-tuple ] unit-test [ - T{ person f 3 "teddy" 10 3.14 + 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" } + B{ 115 116 111 114 101 105 110 97 98 108 111 98 } + } ] [ T{ person f 3 } select-tuple ] unit-test [ ] [ person drop-table ] unit-test ; @@ -152,8 +159,8 @@ TUPLE: annotation n paste-id summary author mode contents ; >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 ; [ @@ -166,7 +173,9 @@ TUPLE: serialize-me id data ; [ ] [ 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 + [ + { T{ serialize-me f 1 H{ { 1 2 } } } } + ] [ T{ serialize-me f 1 } select-tuples ] unit-test ] test-sqlite ! [ make-native-person-table ] test-sqlite diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index e7fe7e49c2..10a7c115ac 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -37,27 +37,24 @@ HOOK: db ( class -- obj ) HOOK: db ( tuple -- tuple ) -HOOK: row-column-typed db ( result-set n type -- sql ) HOOK: insert-tuple* db ( tuple statement -- ) : resulting-tuple ( row out-params -- tuple ) dup first sql-spec-class construct-empty [ [ - >r [ sql-spec-type sql-type>factor-type ] keep - sql-spec-slot-name r> set-slot-named + >r sql-spec-slot-name r> set-slot-named ] curry 2each ] keep ; : query-tuples ( statement -- seq ) [ statement-out-params ] keep query-results [ - [ sql-row swap resulting-tuple ] with query-map + [ sql-row-typed swap resulting-tuple ] with query-map ] with-disposal ; : query-modify-tuple ( tuple statement -- ) - [ query-results [ sql-row ] with-disposal ] keep + [ query-results [ sql-row-typed ] with-disposal ] keep statement-out-params rot [ - >r [ sql-spec-type sql-type>factor-type ] keep - sql-spec-slot-name r> set-slot-named + >r sql-spec-slot-name r> set-slot-named ] curry 2each ; : sql-props ( class -- columns table ) diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index 89c26c1dd6..c2aa825db8 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -207,22 +207,3 @@ TUPLE: no-slot-named ; >r dup sql-spec-type swap sql-spec-slot-name r> get-slot-named swap ] 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 ;