remove db2 from unmaintained
Doug Coleman
parent
1a28a5e30d
commit
11be11605f
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test db2.connections db2.tester ;
|
||||
IN: db2.connections.tests
|
||||
|
||||
! Tests connection
|
||||
|
||||
{ 1 0 } [ [ ] with-db ] must-infer-as
|
||||
|
|
@ -1,20 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors destructors fry kernel namespaces ;
|
||||
IN: db2.connections
|
||||
|
||||
TUPLE: db-connection handle ;
|
||||
|
||||
: new-db-connection ( handle class -- db-connection )
|
||||
new
|
||||
swap >>handle ; inline
|
||||
|
||||
GENERIC: db-open ( db -- db-connection )
|
||||
GENERIC: db-close ( handle -- )
|
||||
|
||||
M: db-connection dispose ( db-connection -- )
|
||||
[ db-close ] [ f >>handle drop ] bi ;
|
||||
|
||||
: with-db ( db quot -- )
|
||||
[ db-open db-connection over ] dip
|
||||
'[ _ [ drop @ ] with-disposal ] with-variable ; inline
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test db2 kernel ;
|
||||
IN: db2.tests
|
||||
|
||||
|
|
@ -1,78 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors continuations db2.result-sets db2.sqlite.lib
|
||||
db2.sqlite.result-sets db2.sqlite.statements db2.statements
|
||||
destructors fry kernel math namespaces sequences strings
|
||||
db2.sqlite.types ;
|
||||
IN: db2
|
||||
|
||||
ERROR: no-in-types statement ;
|
||||
ERROR: no-out-types statement ;
|
||||
|
||||
: guard-in ( statement -- statement )
|
||||
dup in>> [ no-in-types ] unless ;
|
||||
|
||||
: guard-out ( statement -- statement )
|
||||
dup out>> [ no-out-types ] unless ;
|
||||
|
||||
GENERIC: sql-command ( object -- )
|
||||
GENERIC: sql-query ( object -- sequence )
|
||||
GENERIC: sql-bind-command ( object -- )
|
||||
GENERIC: sql-bind-query ( object -- sequence )
|
||||
GENERIC: sql-bind-typed-command ( object -- )
|
||||
GENERIC: sql-bind-typed-query ( object -- sequence )
|
||||
|
||||
M: string sql-command ( string -- )
|
||||
f f <statement> sql-command ;
|
||||
|
||||
M: string sql-query ( string -- sequence )
|
||||
f f <statement> sql-query ;
|
||||
|
||||
M: statement sql-command ( statement -- )
|
||||
[ execute-statement ] with-disposal ;
|
||||
|
||||
M: statement sql-query ( statement -- sequence )
|
||||
[ statement>result-sequence ] with-disposal ;
|
||||
|
||||
M: statement sql-bind-command ( statement -- )
|
||||
[
|
||||
guard-in
|
||||
prepare-statement
|
||||
[ bind-sequence ] [ statement>result-set drop ] bi
|
||||
] with-disposal ;
|
||||
|
||||
M: statement sql-bind-query ( statement -- sequence )
|
||||
[
|
||||
guard-in
|
||||
prepare-statement
|
||||
[ bind-sequence ] [ statement>result-sequence ] bi
|
||||
] with-disposal ;
|
||||
|
||||
M: statement sql-bind-typed-command ( statement -- )
|
||||
[
|
||||
guard-in
|
||||
prepare-statement
|
||||
[ bind-typed-sequence ] [ statement>result-set drop ] bi
|
||||
] with-disposal ;
|
||||
|
||||
M: statement sql-bind-typed-query ( statement -- sequence )
|
||||
[
|
||||
guard-in
|
||||
guard-out
|
||||
prepare-statement
|
||||
[ bind-typed-sequence ] [ statement>typed-result-sequence ] bi
|
||||
] with-disposal ;
|
||||
|
||||
M: sequence sql-command [ sql-command ] each ;
|
||||
M: sequence sql-query [ sql-query ] map ;
|
||||
M: sequence sql-bind-command [ sql-bind-command ] each ;
|
||||
M: sequence sql-bind-query [ sql-bind-query ] map ;
|
||||
M: sequence sql-bind-typed-command [ sql-bind-typed-command ] each ;
|
||||
M: sequence sql-bind-typed-query [ sql-bind-typed-query ] map ;
|
||||
|
||||
M: integer sql-command throw ;
|
||||
M: integer sql-query throw ;
|
||||
M: integer sql-bind-command throw ;
|
||||
M: integer sql-bind-query throw ;
|
||||
M: integer sql-bind-typed-command throw ;
|
||||
M: integer sql-bind-typed-query throw ;
|
||||
|
|
@ -1,42 +0,0 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel continuations fry words constructors
|
||||
db2.connections ;
|
||||
IN: db2.errors
|
||||
|
||||
ERROR: db-error ;
|
||||
ERROR: sql-error location ;
|
||||
HOOK: parse-sql-error db-connection ( error -- error' )
|
||||
|
||||
ERROR: sql-unknown-error < sql-error message ;
|
||||
CONSTRUCTOR: sql-unknown-error ( message -- error ) ;
|
||||
|
||||
ERROR: sql-table-exists < sql-error table ;
|
||||
CONSTRUCTOR: sql-table-exists ( table -- error ) ;
|
||||
|
||||
ERROR: sql-table-missing < sql-error table ;
|
||||
CONSTRUCTOR: sql-table-missing ( table -- error ) ;
|
||||
|
||||
ERROR: sql-syntax-error < sql-error message ;
|
||||
CONSTRUCTOR: sql-syntax-error ( message -- error ) ;
|
||||
|
||||
ERROR: sql-function-exists < sql-error message ;
|
||||
CONSTRUCTOR: sql-function-exists ( message -- error ) ;
|
||||
|
||||
ERROR: sql-function-missing < sql-error message ;
|
||||
CONSTRUCTOR: sql-function-missing ( message -- error ) ;
|
||||
|
||||
: ignore-error ( quot word -- )
|
||||
'[ dup _ execute [ drop ] [ rethrow ] if ] recover ; inline
|
||||
|
||||
: ignore-table-exists ( quot -- )
|
||||
\ sql-table-exists? ignore-error ; inline
|
||||
|
||||
: ignore-table-missing ( quot -- )
|
||||
\ sql-table-missing? ignore-error ; inline
|
||||
|
||||
: ignore-function-exists ( quot -- )
|
||||
\ sql-function-exists? ignore-error ; inline
|
||||
|
||||
: ignore-function-missing ( quot -- )
|
||||
\ sql-function-missing? ignore-error ; inline
|
||||
|
|
@ -1 +0,0 @@
|
|||
Errors thrown by database library
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,72 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors db2 db2.statements.tests db2.tester
|
||||
kernel tools.test db2.fql ;
|
||||
IN: db2.fql.tests
|
||||
|
||||
: test-fql ( -- )
|
||||
create-computer-table
|
||||
|
||||
[ "insert into computer (name, os) values (?, ?);" ]
|
||||
[
|
||||
"computer" { "name" "os" } { "lol" "os2" } <insert> expand-fql
|
||||
sql>>
|
||||
] unit-test
|
||||
|
||||
[ "select name, os from computer" ]
|
||||
[
|
||||
select new
|
||||
{ "name" "os" } >>names
|
||||
"computer" >>from
|
||||
expand-fql sql>>
|
||||
] unit-test
|
||||
|
||||
[ "select name, os from computer group by os order by lol offset 100 limit 3" ]
|
||||
[
|
||||
select new
|
||||
{ "name" "os" } >>names
|
||||
"computer" >>from
|
||||
"os" >>group-by
|
||||
"lol" >>order-by
|
||||
100 >>offset
|
||||
3 >>limit
|
||||
expand-fql sql>>
|
||||
] unit-test
|
||||
|
||||
[
|
||||
"select name, os from computer where (hmm > 1 or foo is NULL) group by os order by lol offset 100 limit 3"
|
||||
] [
|
||||
select new
|
||||
{ "name" "os" } >>names
|
||||
"computer" >>from
|
||||
T{ or f { "hmm > 1" "foo is NULL" } } >>where
|
||||
"os" >>group-by
|
||||
"lol" >>order-by
|
||||
100 >>offset
|
||||
3 >>limit
|
||||
expand-fql sql>>
|
||||
] unit-test
|
||||
|
||||
[ "delete from computer order by omg limit 3" ]
|
||||
[
|
||||
delete new
|
||||
"computer" >>tables
|
||||
"omg" >>order-by
|
||||
3 >>limit
|
||||
expand-fql sql>>
|
||||
] unit-test
|
||||
|
||||
[ "update computer set name = oscar order by omg limit 3" ]
|
||||
[
|
||||
update new
|
||||
"computer" >>tables
|
||||
"name" >>keys
|
||||
"oscar" >>values
|
||||
"omg" >>order-by
|
||||
3 >>limit
|
||||
expand-fql sql>>
|
||||
] unit-test
|
||||
|
||||
;
|
||||
|
||||
[ test-fql ] test-dbs
|
||||
|
|
@ -1,116 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays combinators constructors db2
|
||||
db2.private db2.sqlite.lib db2.statements db2.utils destructors
|
||||
kernel make math.parser sequences strings assocs db2.utils ;
|
||||
IN: db2.fql
|
||||
|
||||
GENERIC: expand-fql* ( object -- sequence/statement )
|
||||
GENERIC: normalize-fql ( object -- sequence/statement )
|
||||
|
||||
! M: object normalize-fql ;
|
||||
|
||||
TUPLE: insert into names values ;
|
||||
CONSTRUCTOR: insert ( into names values -- obj ) ;
|
||||
M: insert normalize-fql ( insert -- insert )
|
||||
[ ??1array ] change-names ;
|
||||
|
||||
TUPLE: update tables keys values where order-by limit ;
|
||||
CONSTRUCTOR: update ( tables keys values where -- obj ) ;
|
||||
M: update normalize-fql ( insert -- insert )
|
||||
[ ??1array ] change-tables
|
||||
[ ??1array ] change-keys
|
||||
[ ??1array ] change-values
|
||||
[ ??1array ] change-order-by ;
|
||||
|
||||
TUPLE: delete tables where order-by limit ;
|
||||
CONSTRUCTOR: delete ( tables keys values where -- obj ) ;
|
||||
M: delete normalize-fql ( insert -- insert )
|
||||
[ ??1array ] change-tables
|
||||
[ ??1array ] change-order-by ;
|
||||
|
||||
TUPLE: select names from where group-by order-by offset limit ;
|
||||
CONSTRUCTOR: select ( names from -- obj ) ;
|
||||
M: select normalize-fql ( select -- select )
|
||||
[ ??1array ] change-names
|
||||
[ ??1array ] change-from
|
||||
[ ??1array ] change-group-by
|
||||
[ ??1array ] change-order-by ;
|
||||
|
||||
! TUPLE: where sequence ;
|
||||
! M: where normalize-fql ( where -- where )
|
||||
! [ ??1array ] change-sequence ;
|
||||
|
||||
TUPLE: and sequence ;
|
||||
|
||||
TUPLE: or sequence ;
|
||||
|
||||
: expand-fql ( object1 -- object2 ) normalize-fql expand-fql* ;
|
||||
|
||||
M: or expand-fql* ( obj -- string )
|
||||
[
|
||||
sequence>> "(" %
|
||||
[ " or " % ] [ expand-fql* % ] interleave
|
||||
")" %
|
||||
] "" make ;
|
||||
|
||||
M: and expand-fql* ( obj -- string )
|
||||
[
|
||||
sequence>> "(" %
|
||||
[ " and " % ] [ expand-fql* % ] interleave
|
||||
")" %
|
||||
] "" make ;
|
||||
|
||||
M: string expand-fql* ( string -- string ) ;
|
||||
|
||||
M: insert expand-fql*
|
||||
[ statement new ] dip
|
||||
[
|
||||
{
|
||||
[ "insert into " % into>> % ]
|
||||
[ " (" % names>> ", " join % ")" % ]
|
||||
[ " values (" % values>> length "?" <array> ", " join % ");" % ]
|
||||
[ values>> >>in ]
|
||||
} cleave
|
||||
] "" make >>sql ;
|
||||
|
||||
M: update expand-fql*
|
||||
[ statement new ] dip
|
||||
[
|
||||
{
|
||||
[ "update " % tables>> ", " join % ]
|
||||
[
|
||||
" set " % [ keys>> ] [ values>> ] bi
|
||||
zip [ ", " % ] [ first2 [ % ] dip " = " % % ] interleave
|
||||
]
|
||||
! [ " " % from>> ", " join % ]
|
||||
[ where>> [ " where " % expand-fql* % ] when* ]
|
||||
[ order-by>> [ " order by " % ", " join % ] when* ]
|
||||
[ limit>> [ " limit " % # ] when* ]
|
||||
} cleave
|
||||
] "" make >>sql ;
|
||||
|
||||
M: delete expand-fql*
|
||||
[ statement new ] dip
|
||||
[
|
||||
{
|
||||
[ "delete from " % tables>> ", " join % ]
|
||||
[ where>> [ " where " % expand-fql* % ] when* ]
|
||||
[ order-by>> [ " order by " % ", " join % ] when* ]
|
||||
[ limit>> [ " limit " % # ] when* ]
|
||||
} cleave
|
||||
] "" make >>sql ;
|
||||
|
||||
M: select expand-fql*
|
||||
[ statement new ] dip
|
||||
[
|
||||
{
|
||||
[ "select " % names>> ", " join % ]
|
||||
[ " from " % from>> ", " join % ]
|
||||
[ where>> [ " where " % expand-fql* % ] when* ]
|
||||
[ group-by>> [ " group by " % ", " join % ] when* ]
|
||||
[ order-by>> [ " order by " % ", " join % ] when* ]
|
||||
[ offset>> [ " offset " % # ] when* ]
|
||||
[ limit>> [ " limit " % # ] when* ]
|
||||
} cleave
|
||||
] "" make >>sql ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,34 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators constructors db2.connections
|
||||
db2.sqlite.types kernel sequence-parser sequences splitting ;
|
||||
IN: db2.introspection
|
||||
|
||||
TUPLE: table-schema table columns ;
|
||||
CONSTRUCTOR: table-schema ( table columns -- table-schema ) ;
|
||||
|
||||
TUPLE: column name type modifiers ;
|
||||
CONSTRUCTOR: column ( name type modifiers -- column ) ;
|
||||
|
||||
HOOK: query-table-schema* db-connection ( name -- table-schema )
|
||||
HOOK: parse-create-statement db-connection ( name -- table-schema )
|
||||
|
||||
: parse-column ( string -- column )
|
||||
<sequence-parser> skip-whitespace
|
||||
[ " " take-until-sequence ]
|
||||
[ take-token sqlite-type>fql-type ]
|
||||
[ take-rest ] tri <column> ;
|
||||
|
||||
: parse-columns ( string -- seq )
|
||||
"," split [ parse-column ] map ;
|
||||
|
||||
M: object parse-create-statement ( string -- table-schema )
|
||||
<sequence-parser> {
|
||||
[ "CREATE TABLE " take-sequence* ]
|
||||
[ "(" take-until-sequence ]
|
||||
[ "(" take-sequence* ]
|
||||
[ take-rest [ CHAR: ) = ] trim-tail parse-columns ]
|
||||
} cleave <table-schema> ;
|
||||
|
||||
: query-table-schema ( name -- table-schema )
|
||||
query-table-schema* [ parse-create-statement ] map ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
||||
|
|
@ -1,23 +0,0 @@
|
|||
USING: accessors continuations db2.pools db2.sqlite
|
||||
db2.sqlite.connections destructors io.directories io.files
|
||||
io.files.temp kernel math namespaces tools.test
|
||||
db2.sqlite.connections ;
|
||||
IN: db2.pools.tests
|
||||
|
||||
\ <db-pool> must-infer
|
||||
|
||||
{ 1 0 } [ [ ] with-db-pool ] must-infer-as
|
||||
|
||||
{ 1 0 } [ [ ] with-pooled-db ] must-infer-as
|
||||
|
||||
! Test behavior after image save/load
|
||||
|
||||
[ "pool-test.db" temp-file delete-file ] ignore-errors
|
||||
|
||||
[ ] [ "pool-test.db" temp-file <sqlite-db> <db-pool> "pool" set ] unit-test
|
||||
|
||||
[ ] [ "pool" get expired>> t >>expired drop ] unit-test
|
||||
|
||||
[ ] [ 1000 [ "pool" get [ ] with-pooled-db ] times ] unit-test
|
||||
|
||||
[ ] [ "pool" get dispose ] unit-test
|
||||
|
|
@ -1,20 +0,0 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors db2.connections fry io.pools kernel
|
||||
namespaces ;
|
||||
IN: db2.pools
|
||||
|
||||
TUPLE: db-pool < pool db ;
|
||||
|
||||
: <db-pool> ( db -- pool )
|
||||
db-pool <pool>
|
||||
swap >>db ;
|
||||
|
||||
: with-db-pool ( db quot -- )
|
||||
[ <db-pool> ] dip with-pool ; inline
|
||||
|
||||
M: db-pool make-connection ( pool -- )
|
||||
db>> db-open ;
|
||||
|
||||
: with-pooled-db ( pool quot -- )
|
||||
'[ db-connection _ with-variable ] with-pooled-connection ; inline
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel sequences combinators fry ;
|
||||
IN: db2.result-sets
|
||||
|
||||
TUPLE: result-set sql in out handle n max ;
|
||||
|
||||
GENERIC: #rows ( result-set -- n )
|
||||
GENERIC: #columns ( result-set -- n )
|
||||
GENERIC: advance-row ( result-set -- )
|
||||
GENERIC: more-rows? ( result-set -- ? )
|
||||
GENERIC# column 1 ( result-set column -- obj )
|
||||
GENERIC# column-typed 2 ( result-set column type -- sql )
|
||||
|
||||
: init-result-set ( result-set -- result-set )
|
||||
dup #rows >>max
|
||||
0 >>n ;
|
||||
|
||||
: new-result-set ( query class -- result-set )
|
||||
new
|
||||
swap {
|
||||
[ handle>> >>handle ]
|
||||
[ sql>> >>sql ]
|
||||
[ in>> >>in ]
|
||||
[ out>> >>out ]
|
||||
} cleave ;
|
||||
|
||||
: sql-row ( result-set -- seq )
|
||||
dup #columns [ column ] with map ;
|
||||
|
||||
: sql-row-typed ( result-set -- seq )
|
||||
[ #columns ] [ out>> ] [ ] tri
|
||||
'[ [ _ ] 2dip column-typed ] 2map ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test db2.sqlite.connections ;
|
||||
IN: db2.sqlite.connections.tests
|
||||
|
|
@ -1,17 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators db2.connections db2.sqlite
|
||||
db2.sqlite.errors db2.sqlite.lib kernel db2.errors ;
|
||||
IN: db2.sqlite.connections
|
||||
|
||||
M: sqlite-db db-open ( db -- db-connection )
|
||||
path>> sqlite-open <sqlite-db-connection> ;
|
||||
|
||||
M: sqlite-db-connection db-close ( db-connection -- )
|
||||
handle>> sqlite-close ;
|
||||
|
||||
M: sqlite-db-connection parse-sql-error ( error -- error' )
|
||||
dup n>> {
|
||||
{ 1 [ string>> parse-sqlite-sql-error ] }
|
||||
[ drop ]
|
||||
} case ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,12 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors ;
|
||||
IN: db2.sqlite.db
|
||||
|
||||
TUPLE: sqlite-db path ;
|
||||
|
||||
: <sqlite-db> ( path -- sqlite-db )
|
||||
sqlite-db new
|
||||
swap >>path ;
|
||||
|
||||
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,35 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators db2.connections db2.errors
|
||||
db2.sqlite.ffi kernel locals namespaces peg.ebnf sequences
|
||||
strings ;
|
||||
IN: db2.sqlite.errors
|
||||
|
||||
ERROR: sqlite-error < db-error n string ;
|
||||
ERROR: sqlite-sql-error < sql-error n string ;
|
||||
|
||||
: sqlite-statement-error ( -- * )
|
||||
SQLITE_ERROR
|
||||
db-connection get handle>> sqlite3_errmsg sqlite-sql-error ;
|
||||
|
||||
TUPLE: unparsed-sqlite-error error ;
|
||||
C: <unparsed-sqlite-error> unparsed-sqlite-error
|
||||
|
||||
EBNF: parse-sqlite-sql-error
|
||||
|
||||
TableMessage = " already exists"
|
||||
SyntaxError = ": syntax error"
|
||||
|
||||
SqliteError =
|
||||
"table " (!(TableMessage).)+:table TableMessage:message
|
||||
=> [[ table >string <sql-table-exists> ]]
|
||||
| "near " (!(SyntaxError).)+:syntax SyntaxError:message
|
||||
=> [[ syntax >string <sql-syntax-error> ]]
|
||||
| "no such table: " .+:table
|
||||
=> [[ table >string <sql-table-missing> ]]
|
||||
| .*:error
|
||||
=> [[ error >string <unparsed-sqlite-error> ]]
|
||||
;EBNF
|
||||
|
||||
: throw-sqlite-error ( n -- * )
|
||||
dup sqlite-error-messages nth sqlite-error ;
|
||||
|
|
@ -1,142 +0,0 @@
|
|||
! Copyright (C) 2005 Chris Double, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
! Not all functions have been wrapped.
|
||||
USING: alien alien.libraries alien.syntax combinators system ;
|
||||
IN: db2.sqlite.ffi
|
||||
|
||||
<< "sqlite" {
|
||||
{ [ os winnt? ] [ "sqlite3.dll" ] }
|
||||
{ [ os macosx? ] [ "/usr/lib/libsqlite3.dylib" ] }
|
||||
{ [ os unix? ] [ "libsqlite3.so" ] }
|
||||
} cond "cdecl" add-library >>
|
||||
|
||||
LIBRARY: sqlite
|
||||
|
||||
! Return values from sqlite functions
|
||||
CONSTANT: SQLITE_OK 0 ! Successful result
|
||||
CONSTANT: SQLITE_ERROR 1 ! SQL error or missing database
|
||||
CONSTANT: SQLITE_INTERNAL 2 ! An internal logic error in SQLite
|
||||
CONSTANT: SQLITE_PERM 3 ! Access permission denied
|
||||
CONSTANT: SQLITE_ABORT 4 ! Callback routine requested an abort
|
||||
CONSTANT: SQLITE_BUSY 5 ! The database file is locked
|
||||
CONSTANT: SQLITE_LOCKED 6 ! A table in the database is locked
|
||||
CONSTANT: SQLITE_NOMEM 7 ! A malloc() failed
|
||||
CONSTANT: SQLITE_READONLY 8 ! Attempt to write a readonly database
|
||||
CONSTANT: SQLITE_INTERRUPT 9 ! Operation terminated by sqlite_interrupt()
|
||||
CONSTANT: SQLITE_IOERR 10 ! Some kind of disk I/O error occurred
|
||||
CONSTANT: SQLITE_CORRUPT 11 ! The database disk image is malformed
|
||||
CONSTANT: SQLITE_NOTFOUND 12 ! (Internal Only) Table or record not found
|
||||
CONSTANT: SQLITE_FULL 13 ! Insertion failed because database is full
|
||||
CONSTANT: SQLITE_CANTOPEN 14 ! Unable to open the database file
|
||||
CONSTANT: SQLITE_PROTOCOL 15 ! Database lock protocol error
|
||||
CONSTANT: SQLITE_EMPTY 16 ! (Internal Only) Database table is empty
|
||||
CONSTANT: SQLITE_SCHEMA 17 ! The database schema changed
|
||||
CONSTANT: SQLITE_TOOBIG 18 ! Too much data for one row of a table
|
||||
CONSTANT: SQLITE_CONSTRAINT 19 ! Abort due to contraint violation
|
||||
CONSTANT: SQLITE_MISMATCH 20 ! Data type mismatch
|
||||
CONSTANT: SQLITE_MISUSE 21 ! Library used incorrectly
|
||||
CONSTANT: SQLITE_NOLFS 22 ! Uses OS features not supported on host
|
||||
CONSTANT: SQLITE_AUTH 23 ! Authorization denied
|
||||
CONSTANT: SQLITE_FORMAT 24 ! Auxiliary database format error
|
||||
CONSTANT: SQLITE_RANGE 25 ! 2nd parameter to sqlite3_bind out of range
|
||||
CONSTANT: SQLITE_NOTADB 26 ! File opened that is not a database file
|
||||
|
||||
CONSTANT: sqlite-error-messages
|
||||
{
|
||||
"Successful result"
|
||||
"SQL error or missing database"
|
||||
"An internal logic error in SQLite"
|
||||
"Access permission denied"
|
||||
"Callback routine requested an abort"
|
||||
"The database file is locked"
|
||||
"A table in the database is locked"
|
||||
"A malloc() failed"
|
||||
"Attempt to write a readonly database"
|
||||
"Operation terminated by sqlite_interrupt()"
|
||||
"Some kind of disk I/O error occurred"
|
||||
"The database disk image is malformed"
|
||||
"(Internal Only) Table or record not found"
|
||||
"Insertion failed because database is full"
|
||||
"Unable to open the database file"
|
||||
"Database lock protocol error"
|
||||
"(Internal Only) Database table is empty"
|
||||
"The database schema changed"
|
||||
"Too much data for one row of a table"
|
||||
"Abort due to contraint violation"
|
||||
"Data type mismatch"
|
||||
"Library used incorrectly"
|
||||
"Uses OS features not supported on host"
|
||||
"Authorization denied"
|
||||
"Auxiliary database format error"
|
||||
"2nd parameter to sqlite3_bind out of range"
|
||||
"File opened that is not a database file"
|
||||
}
|
||||
|
||||
! Return values from sqlite3_step
|
||||
CONSTANT: SQLITE_ROW 100
|
||||
CONSTANT: SQLITE_DONE 101
|
||||
|
||||
! Return values from the sqlite3_column_type function
|
||||
CONSTANT: SQLITE_INTEGER 1
|
||||
CONSTANT: SQLITE_FLOAT 2
|
||||
CONSTANT: SQLITE_TEXT 3
|
||||
CONSTANT: SQLITE_BLOB 4
|
||||
CONSTANT: SQLITE_NULL 5
|
||||
|
||||
! Values for the 'destructor' parameter of the 'bind' routines.
|
||||
CONSTANT: SQLITE_STATIC 0
|
||||
CONSTANT: SQLITE_TRANSIENT -1
|
||||
|
||||
CONSTANT: SQLITE_OPEN_READONLY HEX: 00000001
|
||||
CONSTANT: SQLITE_OPEN_READWRITE HEX: 00000002
|
||||
CONSTANT: SQLITE_OPEN_CREATE HEX: 00000004
|
||||
CONSTANT: SQLITE_OPEN_DELETEONCLOSE HEX: 00000008
|
||||
CONSTANT: SQLITE_OPEN_EXCLUSIVE HEX: 00000010
|
||||
CONSTANT: SQLITE_OPEN_MAIN_DB HEX: 00000100
|
||||
CONSTANT: SQLITE_OPEN_TEMP_DB HEX: 00000200
|
||||
CONSTANT: SQLITE_OPEN_TRANSIENT_DB HEX: 00000400
|
||||
CONSTANT: SQLITE_OPEN_MAIN_JOURNAL HEX: 00000800
|
||||
CONSTANT: SQLITE_OPEN_TEMP_JOURNAL HEX: 00001000
|
||||
CONSTANT: SQLITE_OPEN_SUBJOURNAL HEX: 00002000
|
||||
CONSTANT: SQLITE_OPEN_MASTER_JOURNAL HEX: 00004000
|
||||
|
||||
TYPEDEF: void sqlite3
|
||||
TYPEDEF: void sqlite3_stmt
|
||||
TYPEDEF: longlong sqlite3_int64
|
||||
TYPEDEF: ulonglong sqlite3_uint64
|
||||
|
||||
FUNCTION: int sqlite3_open ( char* filename, void* ppDb ) ;
|
||||
FUNCTION: int sqlite3_close ( sqlite3* pDb ) ;
|
||||
FUNCTION: char* sqlite3_errmsg ( sqlite3* pDb ) ;
|
||||
FUNCTION: int sqlite3_prepare ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ;
|
||||
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 ) ;
|
||||
FUNCTION: sqlite3_uint64 sqlite3_last_insert_rowid ( sqlite3* pStmt ) ;
|
||||
FUNCTION: int sqlite3_bind_blob ( sqlite3_stmt* pStmt, int index, void* ptr, int len, int destructor ) ;
|
||||
FUNCTION: int sqlite3_bind_double ( sqlite3_stmt* pStmt, int index, double x ) ;
|
||||
FUNCTION: int sqlite3_bind_int ( sqlite3_stmt* pStmt, int index, int n ) ;
|
||||
FUNCTION: int sqlite3_bind_int64 ( sqlite3_stmt* pStmt, int index, sqlite3_int64 n ) ;
|
||||
! Bind the same function as above, but for unsigned 64bit integers
|
||||
: sqlite3-bind-uint64 ( pStmt index in64 -- int )
|
||||
"int" "sqlite" "sqlite3_bind_int64"
|
||||
{ "sqlite3_stmt*" "int" "sqlite3_uint64" } alien-invoke ;
|
||||
FUNCTION: int sqlite3_bind_null ( sqlite3_stmt* pStmt, int n ) ;
|
||||
FUNCTION: int sqlite3_bind_text ( sqlite3_stmt* pStmt, int index, char* text, int len, int destructor ) ;
|
||||
FUNCTION: int sqlite3_bind_parameter_index ( sqlite3_stmt* pStmt, char* name ) ;
|
||||
FUNCTION: int sqlite3_clear_bindings ( sqlite3_stmt* pStmt ) ;
|
||||
FUNCTION: int sqlite3_column_count ( sqlite3_stmt* pStmt ) ;
|
||||
FUNCTION: void* sqlite3_column_blob ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: int sqlite3_column_bytes ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: char* sqlite3_column_decltype ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: int sqlite3_column_int ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: sqlite3_int64 sqlite3_column_int64 ( sqlite3_stmt* pStmt, int col ) ;
|
||||
! Bind the same function as above, but for unsigned 64bit integers
|
||||
: sqlite3-column-uint64 ( pStmt col -- uint64 )
|
||||
"sqlite3_uint64" "sqlite" "sqlite3_column_int64"
|
||||
{ "sqlite3_stmt*" "int" } alien-invoke ;
|
||||
FUNCTION: double sqlite3_column_double ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: char* sqlite3_column_name ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: char* sqlite3_column_text ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: int sqlite3_column_type ( sqlite3_stmt* pStmt, int col ) ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,38 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: db2.connections db2.introspection
|
||||
db2.sqlite.introspection db2.tester db2.types tools.test ;
|
||||
IN: db2.sqlite.introspection.tests
|
||||
|
||||
|
||||
: test-sqlite-introspection ( -- )
|
||||
[
|
||||
{
|
||||
T{ table-schema
|
||||
{ table "computer" }
|
||||
{ columns
|
||||
{
|
||||
T{ column
|
||||
{ name "name" }
|
||||
{ type VARCHAR }
|
||||
{ modifiers "" }
|
||||
}
|
||||
T{ column
|
||||
{ name "os" }
|
||||
{ type VARCHAR }
|
||||
{ modifiers "" }
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
] [
|
||||
|
||||
sqlite-test-db [
|
||||
"computer" query-table-schema
|
||||
] with-db
|
||||
] unit-test
|
||||
|
||||
;
|
||||
|
||||
[ test-sqlite-introspection ] test-sqlite
|
||||
|
|
@ -1,16 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays db2 db2.introspection db2.sqlite multiline
|
||||
sequences ;
|
||||
IN: db2.sqlite.introspection
|
||||
|
||||
M: sqlite-db-connection query-table-schema*
|
||||
1array
|
||||
<"
|
||||
SELECT sql FROM
|
||||
(SELECT * FROM sqlite_master UNION ALL
|
||||
SELECT * FROM sqlite_temp_master)
|
||||
WHERE type!='meta' and tbl_name = ?
|
||||
ORDER BY tbl_name, type DESC, name
|
||||
">
|
||||
sql-bind-query* first ;
|
||||
|
|
@ -1,110 +0,0 @@
|
|||
! Copyright (C) 2008 Chris Double, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types arrays calendar.format
|
||||
combinators db2.sqlite.errors
|
||||
io.backend io.encodings.string io.encodings.utf8 kernel math
|
||||
namespaces present sequences serialize urls db2.sqlite.ffi ;
|
||||
IN: db2.sqlite.lib
|
||||
|
||||
: sqlite-check-result ( n -- )
|
||||
{
|
||||
{ SQLITE_OK [ ] }
|
||||
{ SQLITE_ERROR [ sqlite-statement-error ] }
|
||||
[ throw-sqlite-error ]
|
||||
} case ;
|
||||
|
||||
: sqlite-open ( path -- db )
|
||||
"void*" <c-object>
|
||||
[ sqlite3_open sqlite-check-result ] keep *void* ;
|
||||
|
||||
: sqlite-close ( db -- )
|
||||
sqlite3_close sqlite-check-result ;
|
||||
|
||||
: sqlite-prepare ( db sql -- handle )
|
||||
utf8 encode dup length "void*" <c-object> "void*" <c-object>
|
||||
[ sqlite3_prepare_v2 sqlite-check-result ] 2keep
|
||||
drop *void* ;
|
||||
|
||||
: sqlite-bind-parameter-index ( handle name -- index )
|
||||
sqlite3_bind_parameter_index ;
|
||||
|
||||
: parameter-index ( handle name text -- handle name text )
|
||||
[ dupd sqlite-bind-parameter-index ] dip ;
|
||||
|
||||
: sqlite-bind-text ( handle index text -- )
|
||||
utf8 encode dup length SQLITE_TRANSIENT
|
||||
sqlite3_bind_text sqlite-check-result ;
|
||||
|
||||
: sqlite-bind-int ( handle i n -- )
|
||||
sqlite3_bind_int sqlite-check-result ;
|
||||
|
||||
: sqlite-bind-int64 ( handle i n -- )
|
||||
sqlite3_bind_int64 sqlite-check-result ;
|
||||
|
||||
: sqlite-bind-uint64 ( handle i n -- )
|
||||
sqlite3-bind-uint64 sqlite-check-result ;
|
||||
|
||||
: sqlite-bind-boolean ( handle name obj -- )
|
||||
>boolean 1 0 ? sqlite-bind-int ;
|
||||
|
||||
: sqlite-bind-double ( handle i x -- )
|
||||
sqlite3_bind_double sqlite-check-result ;
|
||||
|
||||
: 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 ;
|
||||
|
||||
: sqlite-bind-int-by-name ( handle name int -- )
|
||||
parameter-index sqlite-bind-int ;
|
||||
|
||||
: sqlite-bind-int64-by-name ( handle name int64 -- )
|
||||
parameter-index sqlite-bind-int64 ;
|
||||
|
||||
: sqlite-bind-uint64-by-name ( handle name int64 -- )
|
||||
parameter-index sqlite-bind-uint64 ;
|
||||
|
||||
: sqlite-bind-boolean-by-name ( handle name obj -- )
|
||||
>boolean 1 0 ? parameter-index sqlite-bind-int ;
|
||||
|
||||
: 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-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ;
|
||||
: sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ;
|
||||
: sqlite-clear-bindings ( handle -- )
|
||||
sqlite3_clear_bindings sqlite-check-result ;
|
||||
: sqlite-#columns ( query -- int ) sqlite3_column_count ;
|
||||
: sqlite-column ( handle index -- string ) sqlite3_column_text ;
|
||||
: sqlite-column-name ( handle index -- string ) sqlite3_column_name ;
|
||||
: sqlite-column-type ( handle index -- string ) sqlite3_column_type ;
|
||||
|
||||
: 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-step-has-more-rows? ( prepared -- ? )
|
||||
{
|
||||
{ SQLITE_ROW [ t ] }
|
||||
{ SQLITE_DONE [ f ] }
|
||||
[ sqlite-check-result f ]
|
||||
} case ;
|
||||
|
||||
: sqlite-next ( prepared -- ? )
|
||||
sqlite3_step sqlite-step-has-more-rows? ;
|
||||
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,30 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors db2.result-sets db2.sqlite.statements
|
||||
db2.statements kernel db2.sqlite.lib destructors
|
||||
db2.sqlite.types ;
|
||||
IN: db2.sqlite.result-sets
|
||||
|
||||
TUPLE: sqlite-result-set < result-set has-more? ;
|
||||
|
||||
M: sqlite-result-set dispose
|
||||
f >>handle drop ;
|
||||
|
||||
M: sqlite-statement statement>result-set*
|
||||
prepare-statement
|
||||
sqlite-result-set new-result-set dup advance-row ;
|
||||
|
||||
M: sqlite-result-set advance-row ( result-set -- )
|
||||
dup handle>> sqlite-next >>has-more? drop ;
|
||||
|
||||
M: sqlite-result-set more-rows? ( result-set -- )
|
||||
has-more?>> ;
|
||||
|
||||
M: sqlite-result-set #columns ( result-set -- n )
|
||||
handle>> sqlite-#columns ;
|
||||
|
||||
M: sqlite-result-set column ( result-set n -- obj )
|
||||
[ handle>> ] [ sqlite-column ] bi* ;
|
||||
|
||||
M: sqlite-result-set column-typed ( result-set n type -- obj )
|
||||
[ handle>> ] 2dip sqlite-type ;
|
||||
|
|
@ -1,12 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: constructors db2.connections ;
|
||||
IN: db2.sqlite
|
||||
|
||||
TUPLE: sqlite-db path ;
|
||||
CONSTRUCTOR: sqlite-db ( path -- sqlite-db ) ;
|
||||
|
||||
TUPLE: sqlite-db-connection < db-connection ;
|
||||
|
||||
: <sqlite-db-connection> ( handle -- db-connection )
|
||||
sqlite-db-connection new-db-connection ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,19 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors db2.connections db2.sqlite.connections
|
||||
db2.sqlite.ffi db2.sqlite.lib db2.statements destructors kernel
|
||||
namespaces db2.sqlite ;
|
||||
IN: db2.sqlite.statements
|
||||
|
||||
TUPLE: sqlite-statement < statement ;
|
||||
|
||||
M: sqlite-db-connection <statement> ( string in out -- obj )
|
||||
sqlite-statement new-statement ;
|
||||
|
||||
M: sqlite-statement dispose
|
||||
handle>>
|
||||
[ [ sqlite3_reset drop ] [ sqlite-finalize ] bi ] when* ;
|
||||
|
||||
M: sqlite-statement prepare-statement* ( statement -- statement )
|
||||
db-connection get handle>> over sql>> sqlite-prepare
|
||||
>>handle ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,104 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays calendar.format combinators
|
||||
db2.sqlite.ffi db2.sqlite.lib db2.sqlite.statements
|
||||
db2.statements db2.types db2.utils fry kernel math present
|
||||
sequences serialize urls ;
|
||||
IN: db2.sqlite.types
|
||||
|
||||
: (bind-sqlite-type) ( handle key value type -- )
|
||||
dup array? [ first ] when
|
||||
{
|
||||
{ INTEGER [ sqlite-bind-int-by-name ] }
|
||||
{ BIG-INTEGER [ sqlite-bind-int64-by-name ] }
|
||||
{ SIGNED-BIG-INTEGER [ sqlite-bind-int64-by-name ] }
|
||||
{ UNSIGNED-BIG-INTEGER [ sqlite-bind-uint64-by-name ] }
|
||||
{ BOOLEAN [ sqlite-bind-boolean-by-name ] }
|
||||
{ TEXT [ sqlite-bind-text-by-name ] }
|
||||
{ VARCHAR [ sqlite-bind-text-by-name ] }
|
||||
{ DOUBLE [ sqlite-bind-double-by-name ] }
|
||||
{ DATE [ timestamp>ymd sqlite-bind-text-by-name ] }
|
||||
{ TIME [ timestamp>hms sqlite-bind-text-by-name ] }
|
||||
{ DATETIME [ timestamp>ymdhms sqlite-bind-text-by-name ] }
|
||||
{ TIMESTAMP [ timestamp>ymdhms sqlite-bind-text-by-name ] }
|
||||
{ BLOB [ sqlite-bind-blob-by-name ] }
|
||||
{ FACTOR-BLOB [ object>bytes sqlite-bind-blob-by-name ] }
|
||||
{ URL [ present sqlite-bind-text-by-name ] }
|
||||
{ +db-assigned-id+ [ sqlite-bind-int-by-name ] }
|
||||
{ +random-id+ [ sqlite-bind-int64-by-name ] }
|
||||
{ NULL [ sqlite-bind-null-by-name ] }
|
||||
[ no-sql-type ]
|
||||
} case ;
|
||||
|
||||
: bind-next-sqlite-type ( handle key value type -- )
|
||||
dup array? [ first ] when
|
||||
{
|
||||
{ INTEGER [ sqlite-bind-int ] }
|
||||
{ BIG-INTEGER [ sqlite-bind-int64 ] }
|
||||
{ SIGNED-BIG-INTEGER [ sqlite-bind-int64 ] }
|
||||
{ UNSIGNED-BIG-INTEGER [ sqlite-bind-uint64 ] }
|
||||
{ BOOLEAN [ sqlite-bind-boolean ] }
|
||||
{ TEXT [ sqlite-bind-text ] }
|
||||
{ VARCHAR [ sqlite-bind-text ] }
|
||||
{ DOUBLE [ sqlite-bind-double ] }
|
||||
{ DATE [ timestamp>ymd sqlite-bind-text ] }
|
||||
{ TIME [ timestamp>hms sqlite-bind-text ] }
|
||||
{ DATETIME [ timestamp>ymdhms sqlite-bind-text ] }
|
||||
{ TIMESTAMP [ timestamp>ymdhms sqlite-bind-text ] }
|
||||
{ BLOB [ sqlite-bind-blob ] }
|
||||
{ FACTOR-BLOB [ object>bytes sqlite-bind-blob ] }
|
||||
{ URL [ present sqlite-bind-text ] }
|
||||
{ +db-assigned-id+ [ sqlite-bind-int ] }
|
||||
{ +random-id+ [ sqlite-bind-int64 ] }
|
||||
{ NULL [ drop sqlite-bind-null ] }
|
||||
[ no-sql-type ]
|
||||
} case ;
|
||||
|
||||
: bind-sqlite-type ( handle key value type -- )
|
||||
#! null and empty values need to be set by sqlite-bind-null-by-name
|
||||
over [
|
||||
NULL = [ 2drop NULL NULL ] when
|
||||
] [
|
||||
drop NULL
|
||||
] if* (bind-sqlite-type) ;
|
||||
|
||||
: sqlite-type ( handle index type -- obj )
|
||||
dup array? [ first ] when
|
||||
{
|
||||
{ +db-assigned-id+ [ sqlite3_column_int64 ] }
|
||||
{ +random-id+ [ sqlite3-column-uint64 ] }
|
||||
{ INTEGER [ sqlite3_column_int ] }
|
||||
{ BIG-INTEGER [ sqlite3_column_int64 ] }
|
||||
{ SIGNED-BIG-INTEGER [ sqlite3_column_int64 ] }
|
||||
{ UNSIGNED-BIG-INTEGER [ sqlite3-column-uint64 ] }
|
||||
{ BOOLEAN [ sqlite3_column_int 1 = ] }
|
||||
{ DOUBLE [ sqlite3_column_double ] }
|
||||
{ TEXT [ sqlite3_column_text ] }
|
||||
{ VARCHAR [ sqlite3_column_text ] }
|
||||
{ DATE [ sqlite3_column_text [ ymd>timestamp ] ?when ] }
|
||||
{ TIME [ sqlite3_column_text [ hms>timestamp ] ?when ] }
|
||||
{ TIMESTAMP [ sqlite3_column_text [ ymdhms>timestamp ] ?when ] }
|
||||
{ DATETIME [ sqlite3_column_text [ ymdhms>timestamp ] ?when ] }
|
||||
{ BLOB [ sqlite-column-blob ] }
|
||||
{ URL [ sqlite3_column_text [ >url ] ?when ] }
|
||||
{ FACTOR-BLOB [ sqlite-column-blob [ bytes>object ] ?when ] }
|
||||
[ no-sql-type ]
|
||||
} case ;
|
||||
|
||||
M: sqlite-statement bind-sequence ( statement -- )
|
||||
[ in>> ] [ handle>> ] bi '[
|
||||
[ _ ] 2dip 1+ swap sqlite-bind-text
|
||||
] each-index ;
|
||||
|
||||
M: sqlite-statement bind-typed-sequence ( statement -- )
|
||||
[ in>> ] [ handle>> ] bi '[
|
||||
[ _ ] 2dip 1+ swap first2 swap bind-next-sqlite-type
|
||||
] each-index ;
|
||||
|
||||
ERROR: no-fql-type type ;
|
||||
|
||||
: sqlite-type>fql-type ( string -- type )
|
||||
{
|
||||
{ "varchar" [ VARCHAR ] }
|
||||
[ no-fql-type ]
|
||||
} case ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,73 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test db2.statements kernel db2 db2.tester
|
||||
continuations db2.errors accessors db2.types ;
|
||||
IN: db2.statements.tests
|
||||
|
||||
{ 1 0 } [ [ drop ] result-set-each ] must-infer-as
|
||||
{ 1 1 } [ [ ] result-set-map ] must-infer-as
|
||||
|
||||
: create-computer-table ( -- )
|
||||
[ "drop table computer;" sql-command ] ignore-errors
|
||||
|
||||
[ "drop table computer;" sql-command ]
|
||||
[ [ sql-table-missing? ] [ table>> "computer" = ] bi and ] must-fail-with
|
||||
|
||||
[ ] [
|
||||
"create table computer(name varchar, os varchar, version integer);"
|
||||
sql-command
|
||||
] unit-test ;
|
||||
|
||||
|
||||
: test-sql-command ( -- )
|
||||
create-computer-table
|
||||
|
||||
[ ] [
|
||||
"insert into computer (name, os) values('rocky', 'mac');"
|
||||
sql-command
|
||||
] unit-test
|
||||
|
||||
[ { { "rocky" "mac" } } ]
|
||||
[
|
||||
"select name, os from computer;"
|
||||
f f <statement> sql-query
|
||||
] unit-test
|
||||
|
||||
[ "insert into" sql-command ]
|
||||
[ sql-syntax-error? ] must-fail-with
|
||||
|
||||
[ "selectt" sql-query ]
|
||||
[ sql-syntax-error? ] must-fail-with
|
||||
|
||||
[ ] [
|
||||
"insert into computer (name, os, version) values(?, ?, ?);"
|
||||
{ "clubber" "windows" "7" }
|
||||
f <statement>
|
||||
sql-bind-command
|
||||
] unit-test
|
||||
|
||||
[ { { "windows" } } ] [
|
||||
"select os from computer where name = ?;"
|
||||
{ "clubber" } f <statement> sql-bind-query
|
||||
] unit-test
|
||||
|
||||
[ { { "windows" 7 } } ] [
|
||||
"select os, version from computer where name = ?;"
|
||||
{ { VARCHAR "clubber" } }
|
||||
{ VARCHAR INTEGER }
|
||||
<statement> sql-bind-typed-query
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"insert into computer (name, os, version) values(?, ?, ?);"
|
||||
{
|
||||
{ VARCHAR "paulie" }
|
||||
{ VARCHAR "netbsd" }
|
||||
{ INTEGER 7 }
|
||||
} f <statement>
|
||||
sql-bind-typed-command
|
||||
] unit-test
|
||||
|
||||
;
|
||||
|
||||
[ test-sql-command ] test-dbs
|
||||
|
|
@ -1,53 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors continuations destructors fry kernel
|
||||
sequences db2.result-sets db2.connections db2.errors ;
|
||||
IN: db2.statements
|
||||
|
||||
TUPLE: statement handle sql in out type ;
|
||||
|
||||
: new-statement ( sql in out class -- statement )
|
||||
new
|
||||
swap >>out
|
||||
swap >>in
|
||||
swap >>sql ;
|
||||
|
||||
HOOK: <statement> db-connection ( sql in out -- statement )
|
||||
GENERIC: statement>result-set* ( statement -- result-set )
|
||||
GENERIC: execute-statement* ( statement type -- )
|
||||
GENERIC: prepare-statement* ( statement -- statement' )
|
||||
GENERIC: bind-sequence ( statement -- )
|
||||
GENERIC: bind-typed-sequence ( statement -- )
|
||||
|
||||
: statement>result-set ( statement -- result-set )
|
||||
[ statement>result-set* ]
|
||||
[ dup sql-error? [ parse-sql-error ] when rethrow ] recover ;
|
||||
|
||||
M: object execute-statement* ( statement type -- )
|
||||
drop statement>result-set dispose ;
|
||||
|
||||
: execute-one-statement ( statement -- )
|
||||
dup type>> execute-statement* ;
|
||||
|
||||
: execute-statement ( statement -- )
|
||||
dup sequence?
|
||||
[ [ execute-one-statement ] each ]
|
||||
[ execute-one-statement ] if ;
|
||||
|
||||
: prepare-statement ( statement -- statement )
|
||||
dup handle>> [ prepare-statement* ] unless ;
|
||||
|
||||
: result-set-each ( statement quot: ( statement -- ) -- )
|
||||
over more-rows?
|
||||
[ [ call ] 2keep over advance-row result-set-each ]
|
||||
[ 2drop ] if ; inline recursive
|
||||
|
||||
: result-set-map ( statement quot -- sequence )
|
||||
accumulator [ result-set-each ] dip { } like ; inline
|
||||
|
||||
: statement>result-sequence ( statement -- sequence )
|
||||
statement>result-set [ [ sql-row ] result-set-map ] with-disposal ;
|
||||
|
||||
: statement>typed-result-sequence ( statement -- sequence )
|
||||
statement>result-set
|
||||
[ [ sql-row-typed ] result-set-map ] with-disposal ;
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
Slava Pestov
|
||||
Doug Coleman
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test db2.tester ;
|
||||
IN: db2.tester.tests
|
||||
|
||||
! [ ] [ sqlite-test-db db-tester ] unit-test
|
||||
! [ ] [ sqlite-test-db db-tester2 ] unit-test
|
||||
|
|
@ -1,96 +0,0 @@
|
|||
! Copyright (C) 2008 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: concurrency.combinators db2.connections
|
||||
db2.pools db2.sqlite db2.types fry io.files.temp kernel math
|
||||
namespaces random threads tools.test combinators ;
|
||||
IN: db2.tester
|
||||
USE: multiline
|
||||
|
||||
: sqlite-test-db ( -- sqlite-db )
|
||||
"tuples-test.db" temp-file <sqlite-db> ;
|
||||
|
||||
! These words leak resources, but are useful for interactivel testing
|
||||
: set-sqlite-db ( -- )
|
||||
sqlite-db db-open db-connection set ;
|
||||
|
||||
: test-sqlite ( quot -- )
|
||||
'[
|
||||
[ ] [ sqlite-test-db _ with-db ] unit-test
|
||||
] call ; inline
|
||||
|
||||
: test-dbs ( quot -- )
|
||||
{
|
||||
[ test-sqlite ]
|
||||
} cleave ;
|
||||
|
||||
/*
|
||||
: postgresql-test-db ( -- postgresql-db )
|
||||
<postgresql-db>
|
||||
"localhost" >>host
|
||||
"postgres" >>username
|
||||
"thepasswordistrust" >>password
|
||||
"factor-test" >>database ;
|
||||
|
||||
: set-postgresql-db ( -- )
|
||||
postgresql-db db-open db-connection set ;
|
||||
|
||||
: test-postgresql ( quot -- )
|
||||
'[
|
||||
os windows? cpu x86.64? and [
|
||||
[ ] [ postgresql-test-db _ with-db ] unit-test
|
||||
] unless
|
||||
] call ; inline
|
||||
|
||||
TUPLE: test-1 id a b c ;
|
||||
|
||||
test-1 "TEST1" {
|
||||
{ "id" "ID" INTEGER +db-assigned-id+ }
|
||||
{ "a" "A" { VARCHAR 256 } +not-null+ }
|
||||
{ "b" "B" { VARCHAR 256 } +not-null+ }
|
||||
{ "c" "C" { VARCHAR 256 } +not-null+ }
|
||||
} define-persistent
|
||||
|
||||
TUPLE: test-2 id x y z ;
|
||||
|
||||
test-2 "TEST2" {
|
||||
{ "id" "ID" INTEGER +db-assigned-id+ }
|
||||
{ "x" "X" { VARCHAR 256 } +not-null+ }
|
||||
{ "y" "Y" { VARCHAR 256 } +not-null+ }
|
||||
{ "z" "Z" { VARCHAR 256 } +not-null+ }
|
||||
} define-persistent
|
||||
|
||||
: db-tester ( test-db -- )
|
||||
[
|
||||
[
|
||||
test-1 ensure-table
|
||||
test-2 ensure-table
|
||||
] with-db
|
||||
] [
|
||||
10 [
|
||||
drop
|
||||
10 [
|
||||
dup [
|
||||
f 100 random 100 random 100 random test-1 boa
|
||||
insert-tuple yield
|
||||
] with-db
|
||||
] times
|
||||
] with parallel-each
|
||||
] bi ;
|
||||
|
||||
: db-tester2 ( test-db -- )
|
||||
[
|
||||
[
|
||||
test-1 ensure-table
|
||||
test-2 ensure-table
|
||||
] with-db
|
||||
] [
|
||||
<db-pool> [
|
||||
10 [
|
||||
10 [
|
||||
f 100 random 100 random 100 random test-1 boa
|
||||
insert-tuple yield
|
||||
] times
|
||||
] parallel-each
|
||||
] with-pooled-db
|
||||
] bi ;
|
||||
*/
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,26 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: continuations db2 db2.connections namespaces ;
|
||||
IN: db2.transactions
|
||||
|
||||
SYMBOL: in-transaction
|
||||
|
||||
HOOK: begin-transaction db-connection ( -- )
|
||||
|
||||
HOOK: commit-transaction db-connection ( -- )
|
||||
|
||||
HOOK: rollback-transaction db-connection ( -- )
|
||||
|
||||
M: db-connection begin-transaction ( -- ) "BEGIN" sql-command ;
|
||||
|
||||
M: db-connection commit-transaction ( -- ) "COMMIT" sql-command ;
|
||||
|
||||
M: db-connection rollback-transaction ( -- ) "ROLLBACK" sql-command ;
|
||||
|
||||
: in-transaction? ( -- ? ) in-transaction get ;
|
||||
|
||||
: with-transaction ( quot -- )
|
||||
t in-transaction [
|
||||
begin-transaction
|
||||
[ ] [ rollback-transaction ] cleanup commit-transaction
|
||||
] with-variable ; inline
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,17 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: ;
|
||||
IN: db2.types
|
||||
|
||||
SINGLETONS: +db-assigned-id+ +user-assigned-id+ +random-id+ ;
|
||||
UNION: +primary-key+ +db-assigned-id+ +user-assigned-id+ +random-id+ ;
|
||||
|
||||
SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+
|
||||
+foreign-id+ +has-many+ +on-update+ +on-delete+ +restrict+ +cascade+
|
||||
+set-null+ +set-default+ ;
|
||||
|
||||
SINGLETONS: INTEGER BIG-INTEGER SIGNED-BIG-INTEGER UNSIGNED-BIG-INTEGER
|
||||
DOUBLE REAL BOOLEAN TEXT VARCHAR DATE TIME DATETIME TIMESTAMP BLOB
|
||||
FACTOR-BLOB NULL URL ;
|
||||
|
||||
ERROR: no-sql-type type ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,32 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel math math.parser strings sequences
|
||||
words ;
|
||||
IN: db2.utils
|
||||
|
||||
: ?when ( object quot -- object' ) dupd when ; inline
|
||||
: ?1array ( obj -- array ) dup string? [ 1array ] when ; inline
|
||||
: ??1array ( obj -- array/f ) [ ?1array ] ?when ; inline
|
||||
|
||||
: ?first ( sequence -- object/f ) 0 ?nth ;
|
||||
: ?second ( sequence -- object/f ) 1 ?nth ;
|
||||
|
||||
: ?first2 ( sequence -- object1/f object2/f )
|
||||
[ ?first ] [ ?second ] bi ;
|
||||
|
||||
: assoc-with ( object sequence quot -- obj curry )
|
||||
swapd [ [ -rot ] dip call ] 2curry ; inline
|
||||
|
||||
: ?number>string ( n/string -- string )
|
||||
dup number? [ number>string ] when ;
|
||||
|
||||
ERROR: no-accessor name ;
|
||||
|
||||
: lookup-accessor ( string -- accessor )
|
||||
dup ">>" append "accessors" lookup
|
||||
[ nip ] [ no-accessor ] if* ;
|
||||
|
||||
ERROR: string-expected object ;
|
||||
|
||||
: ensure-string ( object -- string )
|
||||
dup string? [ string-expected ] unless ;
|
||||
Loading…
Reference in New Issue