diff --git a/extra/db/db.factor b/extra/db/db.factor old mode 100644 new mode 100755 index effb971e9f..5b0658883d --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -27,17 +27,14 @@ HOOK: db-close db ( handle -- ) ] with-variable ; TUPLE: statement sql params handle bound? ; - TUPLE: simple-statement ; TUPLE: prepared-statement ; HOOK: db ( str -- statement ) HOOK: db ( str -- statement ) - GENERIC: prepare-statement ( statement -- ) GENERIC: bind-statement* ( obj statement -- ) GENERIC: rebind-statement ( obj statement -- ) - GENERIC: execute-statement ( statement -- ) : bind-statement ( obj statement -- ) diff --git a/extra/db/sqlite/ffi/ffi.factor b/extra/db/sqlite/ffi/ffi.factor old mode 100644 new mode 100755 index 47f42b7e0d..9ffe797248 --- a/extra/db/sqlite/ffi/ffi.factor +++ b/extra/db/sqlite/ffi/ffi.factor @@ -1,17 +1,12 @@ ! Copyright (C) 2005 Chris Double, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -! ! An interface to the sqlite database. Tested against sqlite v3.1.3. - -! Not all functions have been wrapped yet. Only those directly involving -! executing SQL calls and obtaining results. - +! Not all functions have been wrapped. USING: alien compiler kernel math namespaces sequences strings alien.syntax system combinators ; IN: db.sqlite.ffi -<< - "sqlite" { +<< "sqlite" { { [ winnt? ] [ "sqlite3.dll" ] } { [ macosx? ] [ "/usr/lib/libsqlite3.dylib" ] } { [ unix? ] [ "libsqlite3.so" ] } @@ -76,8 +71,9 @@ IN: db.sqlite.ffi "File opened that is not a database file" } ; -: SQLITE_ROW 100 ; inline ! sqlite_step() has another row ready -: SQLITE_DONE 101 ; inline ! sqlite_step() has finished executing +! Return values from sqlite3_step +: SQLITE_ROW 100 ; inline +: SQLITE_DONE 101 ; inline ! Return values from the sqlite3_column_type function : SQLITE_INTEGER 1 ; inline @@ -103,7 +99,6 @@ IN: db.sqlite.ffi : SQLITE_OPEN_SUBJOURNAL HEX: 00002000 ; inline : SQLITE_OPEN_MASTER_JOURNAL HEX: 00004000 ; inline - TYPEDEF: void sqlite3 TYPEDEF: void sqlite3_stmt TYPEDEF: longlong sqlite3_int64 @@ -112,7 +107,8 @@ TYPEDEF: ulonglong sqlite3_uint64 LIBRARY: sqlite FUNCTION: int sqlite3_open ( char* filename, void* ppDb ) ; 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_reset ( sqlite3_stmt* pStmt ) ; FUNCTION: int sqlite3_step ( sqlite3_stmt* pStmt ) ; diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor old mode 100644 new mode 100755 index 944fc14eef..de861f0edc --- a/extra/db/sqlite/lib/lib.factor +++ b/extra/db/sqlite/lib/lib.factor @@ -1,18 +1,25 @@ ! 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 sequences -db.sqlite.ffi ; +USING: alien.c-types assocs kernel math math.parser +namespaces sequences db.sqlite.ffi db combinators +continuations ; IN: db.sqlite.lib -TUPLE: sqlite-error n message ; +: sqlite-error ( n -- * ) + sqlite-error-messages nth throw ; -: sqlite-check-result ( result -- ) - dup SQLITE_OK = [ - drop - ] [ - dup sqlite-error-messages nth - sqlite-error construct-boa throw - ] if ; +: sqlite-statement-error-string ( -- str ) + db get db-handle sqlite3_errmsg ; + +: sqlite-statement-error ( -- * ) + sqlite-statement-error-string throw ; + +: sqlite-check-result ( n -- ) + { + { [ dup SQLITE_OK = ] [ drop ] } + { [ dup SQLITE_ERROR = ] [ sqlite-statement-error ] } + { [ t ] [ sqlite-error ] } + } cond ; : sqlite-open ( filename -- db ) "void*" @@ -21,61 +28,65 @@ TUPLE: sqlite-error n message ; : sqlite-close ( db -- ) sqlite3_close sqlite-check-result ; -: sqlite-prepare ( db sql -- statement ) - #! TODO: Support multiple statements in the SQL string. +: sqlite-prepare ( db sql -- handle ) dup length "void*" "void*" - [ sqlite3_prepare sqlite-check-result ] 2keep + [ sqlite3_prepare_v2 sqlite-check-result ] 2keep drop *void* ; -: sqlite-bind-text ( statement index text -- ) - dup number? [ number>string ] when - dup length SQLITE_TRANSIENT sqlite3_bind_text sqlite-check-result ; - -: sqlite-bind-parameter-index ( statement name -- index ) +: sqlite-bind-parameter-index ( handle name -- index ) sqlite3_bind_parameter_index ; -: sqlite-bind-text-by-name ( statement name text -- ) - >r dupd sqlite-bind-parameter-index r> sqlite-bind-text ; +: parameter-index ( handle name text -- handle name text ) + >r dupd sqlite-bind-parameter-index r> ; -: sqlite-bind-assoc ( statement assoc -- ) - swap [ - -rot sqlite-bind-text-by-name - ] curry assoc-each ; +: sqlite-bind-text ( handle index text -- ) + ! dup number? [ number>string ] when + dup length SQLITE_TRANSIENT sqlite3_bind_text sqlite-check-result ; -: 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 ; -: sqlite-reset ( statement -- ) +: sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ; : sqlite-#columns ( query -- int ) sqlite3_column_count ; -: sqlite-column ( statement index -- string ) +! TODO +: sqlite-column ( handle index -- string ) sqlite3_column_text ; -: sqlite-row ( statement -- seq ) +! TODO +: sqlite-row ( handle -- seq ) 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 ) dup SQLITE_ROW = [ drop f ] [ - dup SQLITE_DONE = [ drop t ] [ sqlite-check-result t ] if - ] if ; - -: sqlite-step ( prepared -- ) - dup sqlite3_step step-complete? [ - drop - ] [ - sqlite-step + dup SQLITE_DONE = + [ drop ] [ sqlite-check-result ] if t ] if ; : sqlite-next ( prepared -- ? ) diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor old mode 100644 new mode 100755 index 093dac9d1a..9099f616bd --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -43,12 +43,17 @@ M: sqlite-statement dispose ( statement -- ) M: sqlite-result-set dispose ( result-set -- ) f swap set-result-set-handle ; -M: sqlite-statement bind-statement* ( assoc statement -- ) - statement-handle swap sqlite-bind-assoc ; +: sqlite-bind ( triples handle -- ) + [ + -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 - statement-handle swap sqlite-bind-assoc ; + bind-statement* ; M: sqlite-statement execute-statement ( statement -- ) statement-handle sqlite-next drop ; diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor old mode 100644 new mode 100755 index dcf27841cf..ac1020b0e9 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -13,7 +13,6 @@ person "PERSON" { "the-number" "AGE" INTEGER { +default+ 0 } } } define-persistent - SYMBOL: the-person : test-tuples ( -- ) @@ -43,3 +42,5 @@ test-sqlite ! resource-path [ ! test-tuples ! ] with-db ; + +! test-postgres diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor old mode 100644 new mode 100755 index c9faaf710c..4427c5300d --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -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 tuples words sequences slots slots.private math -math.parser io prettyprint db.types ; -USE: continuations +math.parser io prettyprint db.types continuations ; IN: db.tuples -! only take a tuple if you have to extract things from it -! otherwise take a class -! 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 ; +: 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 ) - "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 ) class slot-spec-named slot-spec-offset ; : 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 -- ) - tuck offset-of-slot set-slot ; - + tuck offset-of-slot [ no-slot-named ] unless* set-slot ; : primary-key-spec ( class -- spec ) db-columns [ primary-key? ] find nip ; @@ -43,7 +34,6 @@ IN: db.tuples [ class primary-key-spec first ] keep set-slot-named ; - : cache-statement ( columns class assoc quot -- statement ) [ db-table dupd ] swap [ ] 3compose cache nip ; inline @@ -101,19 +91,9 @@ HOOK: tuple>params db ( columns tuple -- obj ) : persist ( tuple -- ) dup primary-key [ update-tuple ] [ insert-tuple ] if ; -! PERSISTENT: - : define-persistent ( class table columns -- ) >r dupd "db-table" set-word-prop r> "db-columns" set-word-prop ; : define-relation ( spec -- ) drop ; - - - - - - - - diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor old mode 100644 new mode 100755 index b4785b7aa1..a6ae223a5e --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -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 sequences continuations ; IN: db.types - -! id serial not null primary key, ! ID is the Primary key SYMBOL: +native-id+ SYMBOL: +assigned-id+ @@ -19,15 +19,12 @@ SYMBOL: +unique+ SYMBOL: +default+ SYMBOL: +null+ SYMBOL: +not-null+ + SYMBOL: +has-many+ ! SQLite Types ! http://www.sqlite.org/datatype3.html -! SYMBOL: NULL -! SYMBOL: INTEGER -! SYMBOL: REAL -! SYMBOL: TEXT -! SYMBOL: BLOB +! NULL INTEGER REAL TEXT BLOB SYMBOL: INTEGER SYMBOL: DOUBLE @@ -41,11 +38,6 @@ SYMBOL: DATE SYMBOL: BIG_INTEGER -! SYMBOL: LOCALE -! SYMBOL: TIMEZONE -! SYMBOL: CURRENCY - - ! PostgreSQL Types ! http://developer.postgresql.org/pgdocs/postgres/datatype.html @@ -57,8 +49,7 @@ TUPLE: no-sql-type ; HOOK: sql-modifiers* db ( modifiers -- str ) HOOK: >sql-type db ( obj -- str ) - - +! HOOK: >factor-type db ( obj -- obj ) : maybe-remove-id ( columns -- obj ) [ +native-id+ swap member? not ] subset ;