clean up db code

ready to implement types for bind-statement
db4
Doug Coleman 2008-02-12 15:47:01 -06:00
parent 19154db596
commit 00a7df11a9
7 changed files with 88 additions and 107 deletions

3
extra/db/db.factor Normal file → Executable file
View File

@ -27,17 +27,14 @@ HOOK: db-close db ( handle -- )
] with-variable ; ] with-variable ;
TUPLE: statement sql params handle bound? ; TUPLE: statement sql params handle bound? ;
TUPLE: simple-statement ; TUPLE: simple-statement ;
TUPLE: prepared-statement ; TUPLE: prepared-statement ;
HOOK: <simple-statement> db ( str -- statement ) HOOK: <simple-statement> db ( str -- statement )
HOOK: <prepared-statement> db ( str -- statement ) HOOK: <prepared-statement> db ( str -- statement )
GENERIC: prepare-statement ( statement -- ) GENERIC: prepare-statement ( statement -- )
GENERIC: bind-statement* ( obj statement -- ) GENERIC: bind-statement* ( obj statement -- )
GENERIC: rebind-statement ( obj statement -- ) GENERIC: rebind-statement ( obj statement -- )
GENERIC: execute-statement ( statement -- ) GENERIC: execute-statement ( statement -- )
: bind-statement ( obj statement -- ) : bind-statement ( obj statement -- )

18
extra/db/sqlite/ffi/ffi.factor Normal file → Executable file
View File

@ -1,17 +1,12 @@
! Copyright (C) 2005 Chris Double, Doug Coleman. ! Copyright (C) 2005 Chris Double, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
!
! An interface to the sqlite database. Tested against sqlite v3.1.3. ! An interface to the sqlite database. Tested against sqlite v3.1.3.
! Not all functions have been wrapped.
! Not all functions have been wrapped yet. Only those directly involving
! executing SQL calls and obtaining results.
USING: alien compiler kernel math namespaces sequences strings alien.syntax USING: alien compiler kernel math namespaces sequences strings alien.syntax
system combinators ; system combinators ;
IN: db.sqlite.ffi IN: db.sqlite.ffi
<< << "sqlite" {
"sqlite" {
{ [ winnt? ] [ "sqlite3.dll" ] } { [ winnt? ] [ "sqlite3.dll" ] }
{ [ macosx? ] [ "/usr/lib/libsqlite3.dylib" ] } { [ macosx? ] [ "/usr/lib/libsqlite3.dylib" ] }
{ [ unix? ] [ "libsqlite3.so" ] } { [ unix? ] [ "libsqlite3.so" ] }
@ -76,8 +71,9 @@ IN: db.sqlite.ffi
"File opened that is not a database file" "File opened that is not a database file"
} ; } ;
: SQLITE_ROW 100 ; inline ! sqlite_step() has another row ready ! Return values from sqlite3_step
: SQLITE_DONE 101 ; inline ! sqlite_step() has finished executing : SQLITE_ROW 100 ; inline
: SQLITE_DONE 101 ; inline
! Return values from the sqlite3_column_type function ! Return values from the sqlite3_column_type function
: SQLITE_INTEGER 1 ; inline : SQLITE_INTEGER 1 ; inline
@ -103,7 +99,6 @@ IN: db.sqlite.ffi
: SQLITE_OPEN_SUBJOURNAL HEX: 00002000 ; inline : SQLITE_OPEN_SUBJOURNAL HEX: 00002000 ; inline
: SQLITE_OPEN_MASTER_JOURNAL HEX: 00004000 ; inline : SQLITE_OPEN_MASTER_JOURNAL HEX: 00004000 ; inline
TYPEDEF: void sqlite3 TYPEDEF: void sqlite3
TYPEDEF: void sqlite3_stmt TYPEDEF: void sqlite3_stmt
TYPEDEF: longlong sqlite3_int64 TYPEDEF: longlong sqlite3_int64
@ -112,7 +107,8 @@ TYPEDEF: ulonglong sqlite3_uint64
LIBRARY: sqlite LIBRARY: sqlite
FUNCTION: int sqlite3_open ( char* filename, void* ppDb ) ; FUNCTION: int sqlite3_open ( char* filename, void* ppDb ) ;
FUNCTION: int sqlite3_close ( sqlite3* pDb ) ; FUNCTION: int sqlite3_close ( sqlite3* pDb ) ;
FUNCTION: int sqlite3_prepare ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ; FUNCTION: char* sqlite3_errmsg ( sqlite3* pDb ) ;
FUNCTION: int sqlite3_prepare_v2 ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ;
FUNCTION: int sqlite3_finalize ( sqlite3_stmt* pStmt ) ; FUNCTION: int sqlite3_finalize ( sqlite3_stmt* pStmt ) ;
FUNCTION: int sqlite3_reset ( sqlite3_stmt* pStmt ) ; FUNCTION: int sqlite3_reset ( sqlite3_stmt* pStmt ) ;
FUNCTION: int sqlite3_step ( sqlite3_stmt* pStmt ) ; FUNCTION: int sqlite3_step ( sqlite3_stmt* pStmt ) ;

97
extra/db/sqlite/lib/lib.factor Normal file → Executable file
View File

@ -1,18 +1,25 @@
! Copyright (C) 2008 Chris Double, Doug Coleman. ! Copyright (C) 2008 Chris Double, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types assocs kernel math math.parser sequences USING: alien.c-types assocs kernel math math.parser
db.sqlite.ffi ; namespaces sequences db.sqlite.ffi db combinators
continuations ;
IN: db.sqlite.lib IN: db.sqlite.lib
TUPLE: sqlite-error n message ; : sqlite-error ( n -- * )
sqlite-error-messages nth throw ;
: sqlite-check-result ( result -- ) : sqlite-statement-error-string ( -- str )
dup SQLITE_OK = [ db get db-handle sqlite3_errmsg ;
drop
] [ : sqlite-statement-error ( -- * )
dup sqlite-error-messages nth sqlite-statement-error-string throw ;
sqlite-error construct-boa throw
] if ; : sqlite-check-result ( n -- )
{
{ [ dup SQLITE_OK = ] [ drop ] }
{ [ dup SQLITE_ERROR = ] [ sqlite-statement-error ] }
{ [ t ] [ sqlite-error ] }
} cond ;
: sqlite-open ( filename -- db ) : sqlite-open ( filename -- db )
"void*" <c-object> "void*" <c-object>
@ -21,61 +28,65 @@ TUPLE: sqlite-error n message ;
: sqlite-close ( db -- ) : sqlite-close ( db -- )
sqlite3_close sqlite-check-result ; sqlite3_close sqlite-check-result ;
: sqlite-prepare ( db sql -- statement ) : sqlite-prepare ( db sql -- handle )
#! TODO: Support multiple statements in the SQL string.
dup length "void*" <c-object> "void*" <c-object> dup length "void*" <c-object> "void*" <c-object>
[ sqlite3_prepare sqlite-check-result ] 2keep [ sqlite3_prepare_v2 sqlite-check-result ] 2keep
drop *void* ; drop *void* ;
: sqlite-bind-text ( statement index text -- ) : sqlite-bind-parameter-index ( handle name -- index )
dup number? [ number>string ] when
dup length SQLITE_TRANSIENT sqlite3_bind_text sqlite-check-result ;
: sqlite-bind-parameter-index ( statement name -- index )
sqlite3_bind_parameter_index ; sqlite3_bind_parameter_index ;
: sqlite-bind-text-by-name ( statement name text -- ) : parameter-index ( handle name text -- handle name text )
>r dupd sqlite-bind-parameter-index r> sqlite-bind-text ; >r dupd sqlite-bind-parameter-index r> ;
: sqlite-bind-assoc ( statement assoc -- ) : sqlite-bind-text ( handle index text -- )
swap [ ! dup number? [ number>string ] when
-rot sqlite-bind-text-by-name dup length SQLITE_TRANSIENT sqlite3_bind_text sqlite-check-result ;
] curry assoc-each ;
: sqlite-finalize ( statement -- ) : sqlite-bind-int ( handle name n -- )
sqlite3_bind_int sqlite-check-result ;
: sqlite-bind-int64 ( handle name n -- )
sqlite3_bind_int64 sqlite-check-result ;
: sqlite-bind-null ( handle n -- )
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 -- )
parameter-index sqlite-bind-int ;
: sqlite-bind-int64-by-name ( handle name text -- )
parameter-index sqlite-bind-int ;
: sqlite-bind-null-by-name ( handle name obj -- )
parameter-index drop sqlite-bind-null ;
: sqlite-finalize ( handle -- )
sqlite3_finalize sqlite-check-result ; sqlite3_finalize sqlite-check-result ;
: sqlite-reset ( statement -- ) : sqlite-reset ( handle -- )
sqlite3_reset sqlite-check-result ; sqlite3_reset sqlite-check-result ;
: sqlite-#columns ( query -- int ) : sqlite-#columns ( query -- int )
sqlite3_column_count ; sqlite3_column_count ;
: sqlite-column ( statement index -- string ) ! TODO
: sqlite-column ( handle index -- string )
sqlite3_column_text ; sqlite3_column_text ;
: sqlite-row ( statement -- seq ) ! TODO
: sqlite-row ( handle -- seq )
dup sqlite-#columns [ sqlite-column ] with map ; dup sqlite-#columns [ sqlite-column ] with map ;
! 2dup sqlite3_column_type .
! SQLITE_INTEGER 1
! SQLITE_FLOAT 2
! SQLITE_TEXT 3
! SQLITE_BLOB 4
! SQLITE_NULL 5
: step-complete? ( step-result -- bool ) : step-complete? ( step-result -- bool )
dup SQLITE_ROW = [ dup SQLITE_ROW = [
drop f drop f
] [ ] [
dup SQLITE_DONE = [ drop t ] [ sqlite-check-result t ] if dup SQLITE_DONE =
] if ; [ drop ] [ sqlite-check-result ] if t
: sqlite-step ( prepared -- )
dup sqlite3_step step-complete? [
drop
] [
sqlite-step
] if ; ] if ;
: sqlite-next ( prepared -- ? ) : sqlite-next ( prepared -- ? )

13
extra/db/sqlite/sqlite.factor Normal file → Executable file
View File

@ -43,12 +43,17 @@ M: sqlite-statement dispose ( statement -- )
M: sqlite-result-set dispose ( result-set -- ) M: sqlite-result-set dispose ( result-set -- )
f swap set-result-set-handle ; f swap set-result-set-handle ;
M: sqlite-statement bind-statement* ( assoc statement -- ) : sqlite-bind ( triples handle -- )
statement-handle swap sqlite-bind-assoc ; [
-rot sqlite-bind-text-by-name
] curry assoc-each ;
M: sqlite-statement rebind-statement ( assoc statement -- ) M: sqlite-statement bind-statement* ( triples statement -- )
statement-handle sqlite-bind ;
M: sqlite-statement rebind-statement ( triples statement -- )
dup statement-handle sqlite-reset dup statement-handle sqlite-reset
statement-handle swap sqlite-bind-assoc ; bind-statement* ;
M: sqlite-statement execute-statement ( statement -- ) M: sqlite-statement execute-statement ( statement -- )
statement-handle sqlite-next drop ; statement-handle sqlite-next drop ;

3
extra/db/tuples/tuples-tests.factor Normal file → Executable file
View File

@ -13,7 +13,6 @@ person "PERSON"
{ "the-number" "AGE" INTEGER { +default+ 0 } } { "the-number" "AGE" INTEGER { +default+ 0 } }
} define-persistent } define-persistent
SYMBOL: the-person SYMBOL: the-person
: test-tuples ( -- ) : test-tuples ( -- )
@ -43,3 +42,5 @@ test-sqlite
! resource-path <postgresql-db> [ ! resource-path <postgresql-db> [
! test-tuples ! test-tuples
! ] with-db ; ! ] with-db ;
! test-postgres

42
extra/db/tuples/tuples.factor Normal file → Executable file
View File

@ -1,37 +1,28 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs classes db kernel namespaces USING: arrays assocs classes db kernel namespaces
tuples words sequences slots slots.private math tuples words sequences slots slots.private math
math.parser io prettyprint db.types ; math.parser io prettyprint db.types continuations ;
USE: continuations
IN: db.tuples IN: db.tuples
! only take a tuple if you have to extract things from it : db-columns ( class -- obj ) "db-columns" word-prop ;
! otherwise take a class : db-table ( class -- obj ) "db-table" word-prop ;
! primary-key vs primary-key-spec
! define-persistent should enforce a primary key
! in sqlite, defining a new primary key makes it an alias for rowid, _rowid_, and oid
! -sql outputs sql code
! table - string
! columns - seq of column specifiers
: db-columns ( class -- obj )
"db-columns" word-prop ;
: db-table ( class -- obj )
"db-table" word-prop ;
TUPLE: no-slot-named ;
: no-slot-named ( -- * ) T{ no-slot-named } throw ;
: slot-spec-named ( str class -- slot-spec ) : slot-spec-named ( str class -- slot-spec )
"slots" word-prop [ slot-spec-name = ] with find nip ; "slots" word-prop [ slot-spec-name = ] with find nip
[ no-slot-named ] unless* ;
: offset-of-slot ( str obj -- n ) : offset-of-slot ( str obj -- n )
class slot-spec-named slot-spec-offset ; class slot-spec-named slot-spec-offset ;
: get-slot-named ( str obj -- value ) : get-slot-named ( str obj -- value )
tuck offset-of-slot slot ; tuck offset-of-slot [ no-slot-named ] unless* slot ;
: set-slot-named ( value str obj -- ) : set-slot-named ( value str obj -- )
tuck offset-of-slot set-slot ; tuck offset-of-slot [ no-slot-named ] unless* set-slot ;
: primary-key-spec ( class -- spec ) : primary-key-spec ( class -- spec )
db-columns [ primary-key? ] find nip ; db-columns [ primary-key? ] find nip ;
@ -43,7 +34,6 @@ IN: db.tuples
[ class primary-key-spec first ] keep [ class primary-key-spec first ] keep
set-slot-named ; set-slot-named ;
: cache-statement ( columns class assoc quot -- statement ) : cache-statement ( columns class assoc quot -- statement )
[ db-table dupd ] swap [ db-table dupd ] swap
[ <prepared-statement> ] 3compose cache nip ; inline [ <prepared-statement> ] 3compose cache nip ; inline
@ -101,19 +91,9 @@ HOOK: tuple>params db ( columns tuple -- obj )
: persist ( tuple -- ) : persist ( tuple -- )
dup primary-key [ update-tuple ] [ insert-tuple ] if ; dup primary-key [ update-tuple ] [ insert-tuple ] if ;
! PERSISTENT:
: define-persistent ( class table columns -- ) : define-persistent ( class table columns -- )
>r dupd "db-table" set-word-prop r> >r dupd "db-table" set-word-prop r>
"db-columns" set-word-prop ; "db-columns" set-word-prop ;
: define-relation ( spec -- ) : define-relation ( spec -- )
drop ; drop ;

19
extra/db/types/types.factor Normal file → Executable file
View File

@ -1,9 +1,9 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs db kernel math math.parser USING: arrays assocs db kernel math math.parser
sequences continuations ; sequences continuations ;
IN: db.types IN: db.types
! id serial not null primary key,
! ID is the Primary key ! ID is the Primary key
SYMBOL: +native-id+ SYMBOL: +native-id+
SYMBOL: +assigned-id+ SYMBOL: +assigned-id+
@ -19,15 +19,12 @@ SYMBOL: +unique+
SYMBOL: +default+ SYMBOL: +default+
SYMBOL: +null+ SYMBOL: +null+
SYMBOL: +not-null+ SYMBOL: +not-null+
SYMBOL: +has-many+ SYMBOL: +has-many+
! SQLite Types ! SQLite Types
! http://www.sqlite.org/datatype3.html ! http://www.sqlite.org/datatype3.html
! SYMBOL: NULL ! NULL INTEGER REAL TEXT BLOB
! SYMBOL: INTEGER
! SYMBOL: REAL
! SYMBOL: TEXT
! SYMBOL: BLOB
SYMBOL: INTEGER SYMBOL: INTEGER
SYMBOL: DOUBLE SYMBOL: DOUBLE
@ -41,11 +38,6 @@ SYMBOL: DATE
SYMBOL: BIG_INTEGER SYMBOL: BIG_INTEGER
! SYMBOL: LOCALE
! SYMBOL: TIMEZONE
! SYMBOL: CURRENCY
! PostgreSQL Types ! PostgreSQL Types
! http://developer.postgresql.org/pgdocs/postgres/datatype.html ! http://developer.postgresql.org/pgdocs/postgres/datatype.html
@ -57,8 +49,7 @@ TUPLE: no-sql-type ;
HOOK: sql-modifiers* db ( modifiers -- str ) HOOK: sql-modifiers* db ( modifiers -- str )
HOOK: >sql-type db ( obj -- str ) HOOK: >sql-type db ( obj -- str )
! HOOK: >factor-type db ( obj -- obj )
: maybe-remove-id ( columns -- obj ) : maybe-remove-id ( columns -- obj )
[ +native-id+ swap member? not ] subset ; [ +native-id+ swap member? not ] subset ;