steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

before major overhaul on return values

db4
Doug Coleman 2008-03-05 19:08:33 -06:00
parent f84761ae0c
commit 3eb7830d2c
4 changed files with 105 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
extra/db/sqlite/lib/lib.factor
View File

@ -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 ;

8
extra/db/sqlite/sqlite.factor
View File

@ -179,8 +179,7 @@ M: sqlite-db <select-by-slots-statement> ( 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

75
extra/db/tuples/tuples-tests.factor
View File

@ -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 ;
: <person> ( 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 ;
: <assigned-person> ( id name number the-real -- obj )
<person> [ 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 <person> the-person1 set
"johnny" 10 3.14 <person> the-person2 set ;
"billy" 10 3.14 f f f f <person> person1 set
"johnny" 10 3.14 f f f f <person> 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 } <person> 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 <assigned-person> the-person1 set
2 "johnny" 10 3.14 <assigned-person> the-person2 set ;
1 "billy" 10 3.14 f f f f <assigned-person> person1 set
2 "johnny" 10 3.14 f f f f <assigned-person> 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 } <assigned-person> 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

28
extra/db/types/types.factor
View File

@ -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 ;