From 509399b620e7046abac9bb67a84ce1a90c6b3b04 Mon Sep 17 00:00:00 2001 From: Maxim Savchenko Date: Wed, 1 Apr 2009 19:11:08 -0400 Subject: [PATCH 01/37] Basic sandboxing --- extra/sandbox/authors.txt | 1 + extra/sandbox/sandbox-tests.factor | 57 ++++++++++++++++++++++++++++++ extra/sandbox/sandbox.factor | 23 ++++++++++++ extra/sandbox/summary.txt | 1 + extra/sandbox/syntax/syntax.factor | 26 ++++++++++++++ 5 files changed, 108 insertions(+) create mode 100644 extra/sandbox/authors.txt create mode 100644 extra/sandbox/sandbox-tests.factor create mode 100644 extra/sandbox/sandbox.factor create mode 100644 extra/sandbox/summary.txt create mode 100644 extra/sandbox/syntax/syntax.factor diff --git a/extra/sandbox/authors.txt b/extra/sandbox/authors.txt new file mode 100644 index 0000000000..f97e1bfbf9 --- /dev/null +++ b/extra/sandbox/authors.txt @@ -0,0 +1 @@ +Maxim Savchenko diff --git a/extra/sandbox/sandbox-tests.factor b/extra/sandbox/sandbox-tests.factor new file mode 100644 index 0000000000..5d0496e77b --- /dev/null +++ b/extra/sandbox/sandbox-tests.factor @@ -0,0 +1,57 @@ +! Copyright (C) 2009 Maxim Savchenko +! See http://factorcode.org/license.txt for BSD license. + +USING: kernel accessors continuations lexer vocabs vocabs.parser + combinators.short-circuit sandbox tools.test ; + +IN: sandbox.tests + +<< "sandbox.syntax" load-vocab drop >> +USE: sandbox.syntax.private + +: run-script ( x lines -- y ) + H{ { "kernel" "kernel" } { "math" "math" } { "sequences" "sequences" } } + parse-sandbox call( x -- x! ) ; + +[ 120 ] +[ + 5 + { + "! Simple factorial example" + "APPLYING: kernel math sequences ;" + "1 swap [ 1+ * ] each" + } run-script +] unit-test + +[ + 5 + { + "! Jailbreak attempt with USE:" + "USE: io" + "\"Hello world!\" print" + } run-script +] +[ + { + [ lexer-error? ] + [ error>> condition? ] + [ error>> error>> no-word-error? ] + [ error>> error>> name>> "USE:" = ] + } 1&& +] must-fail-with + +[ + 5 + { + "! Jailbreak attempt with unauthorized APPLY:" + "APPLY: io" + "\"Hello world!\" print" + } run-script +] +[ + { + [ lexer-error? ] + [ error>> sandbox-error? ] + [ error>> vocab>> "io" = ] + } 1&& +] must-fail-with diff --git a/extra/sandbox/sandbox.factor b/extra/sandbox/sandbox.factor new file mode 100644 index 0000000000..a9d65ee5ab --- /dev/null +++ b/extra/sandbox/sandbox.factor @@ -0,0 +1,23 @@ +! Copyright (C) 2009 Maxim Savchenko. +! See http://factorcode.org/license.txt for BSD license. + +USING: kernel sequences vectors assocs namespaces parser lexer vocabs + combinators.short-circuit vocabs.parser ; + +IN: sandbox + +SYMBOL: whitelist + +: with-sandbox-vocabs ( quot -- ) + "sandbox.syntax" load-vocab vocab-words 1vector + use [ call ] with-variable ; inline + +: parse-sandbox ( lines assoc -- quot ) + whitelist [ [ parse-lines ] with-sandbox-vocabs ] with-variable ; + +: reveal-in ( name -- ) + [ { [ search ] [ no-word ] } 1|| ] keep current-vocab vocab-words set-at ; + +SYNTAX: REVEAL: scan reveal-in ; + +SYNTAX: REVEALING: ";" parse-tokens [ reveal-in ] each ; diff --git a/extra/sandbox/summary.txt b/extra/sandbox/summary.txt new file mode 100644 index 0000000000..3ca1e25684 --- /dev/null +++ b/extra/sandbox/summary.txt @@ -0,0 +1 @@ +Basic sandboxing diff --git a/extra/sandbox/syntax/syntax.factor b/extra/sandbox/syntax/syntax.factor new file mode 100644 index 0000000000..2ff5f070c7 --- /dev/null +++ b/extra/sandbox/syntax/syntax.factor @@ -0,0 +1,26 @@ +! Copyright (C) 2009 Maxim Savchenko. +! See http://factorcode.org/license.txt for BSD license. + +USING: kernel sequences assocs namespaces lexer vocabs.parser sandbox ; +IN: sandbox.syntax + + + +SYNTAX: APPLY: scan sandbox-use+ ; + +SYNTAX: APPLYING: ";" parse-tokens [ sandbox-use+ ] each ; + +REVEALING: + ! #! + HEX: OCT: BIN: f t CHAR: " + [ { T{ + ] } ; + +REVEAL: ; From ee30ab92cd14bfd7e134c25afbbd120ea6f57bb8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 11 Apr 2009 13:02:47 -0500 Subject: [PATCH 02/37] redoing db framework. it'll live in extra until it can replace db in basis --- extra/db2/authors.txt | 1 + extra/db2/connections/authors.txt | 1 + extra/db2/connections/connections.factor | 17 +++++++++ extra/db2/db2.factor | 20 +++++++++++ extra/db2/result-sets/authors.txt | 1 + extra/db2/result-sets/result-sets.factor | 29 ++++++++++++++++ extra/db2/statements/authors.txt | 1 + extra/db2/statements/statements.factor | 40 ++++++++++++++++++++++ extra/db2/transactions/authors.txt | 1 + extra/db2/transactions/transactions.factor | 23 +++++++++++++ 10 files changed, 134 insertions(+) create mode 100644 extra/db2/authors.txt create mode 100644 extra/db2/connections/authors.txt create mode 100644 extra/db2/connections/connections.factor create mode 100644 extra/db2/db2.factor create mode 100644 extra/db2/result-sets/authors.txt create mode 100644 extra/db2/result-sets/result-sets.factor create mode 100644 extra/db2/statements/authors.txt create mode 100644 extra/db2/statements/statements.factor create mode 100644 extra/db2/transactions/authors.txt create mode 100644 extra/db2/transactions/transactions.factor diff --git a/extra/db2/authors.txt b/extra/db2/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/connections/authors.txt b/extra/db2/connections/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/connections/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/connections/connections.factor b/extra/db2/connections/connections.factor new file mode 100644 index 0000000000..c622f9a4b4 --- /dev/null +++ b/extra/db2/connections/connections.factor @@ -0,0 +1,17 @@ +! 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 ; + +GENERIC: db-open ( db -- db-connection ) +HOOK: db-close db-connection ( handle -- ) +HOOK: parse-db-error db-connection ( error -- error' ) + +M: db-connection dispose ( db-connection -- ) + [ db-close f ] change-handle drop ; + +: with-db ( db quot -- ) + [ db-open db-connection dup ] dip + '[ _ [ drop @ ] with-disposal ] with-variable ; inline diff --git a/extra/db2/db2.factor b/extra/db2/db2.factor new file mode 100644 index 0000000000..16afbd2782 --- /dev/null +++ b/extra/db2/db2.factor @@ -0,0 +1,20 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors continuations destructors fry kernel +namespaces sequences strings db2.statements ; +IN: db2 + + [ execute-statement ] with-disposal ; + +PRIVATE> + +: sql-command ( sql -- ) + dup string? + [ execute-sql-string ] + [ [ execute-sql-string ] each ] if ; + +: sql-query ( sql -- sequence ) + f f [ statement>result-sequence ] with-disposal ; diff --git a/extra/db2/result-sets/authors.txt b/extra/db2/result-sets/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/result-sets/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/result-sets/result-sets.factor b/extra/db2/result-sets/result-sets.factor new file mode 100644 index 0000000000..0f242da473 --- /dev/null +++ b/extra/db2/result-sets/result-sets.factor @@ -0,0 +1,29 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors kernel sequences ; +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 1 ( result-set column -- sql ) + +: init-result-set ( result-set -- result-set ) + dup #rows >>max + 0 >>n ; + +: new-result-set ( query handle class -- result-set ) + new + swap >>handle + swap [ sql>> >>sql ] [ in>> >>in ] [ out>> >>out ] tri ; + +: sql-row ( result-set -- seq ) + dup #columns [ column ] with map ; + +: sql-row-typed ( result-set -- seq ) + dup #columns [ column-typed ] with map ; + diff --git a/extra/db2/statements/authors.txt b/extra/db2/statements/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/statements/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/statements/statements.factor b/extra/db2/statements/statements.factor new file mode 100644 index 0000000000..282fb7d5bf --- /dev/null +++ b/extra/db2/statements/statements.factor @@ -0,0 +1,40 @@ +! 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 ; +IN: db2.statements + +TUPLE: statement handle sql in out ; + +: new-statement ( sql in out class -- statement ) + new + swap >>out + swap >>in + swap >>sql ; + +HOOK: db-connection ( sql in out -- statement ) +GENERIC: execute-statement* ( statement type -- ) +GENERIC: statement>result-set ( statement -- result-set ) + +M: object execute-statement* ( statement type -- ) + drop '[ _ statement>result-set dispose ] + [ parse-db-error rethrow ] recover ; + +: execute-one-statement ( statement -- ) + dup type>> execute-statement* ; + +: execute-statement ( statement -- ) + dup sequence? + [ [ execute-one-statement ] each ] + [ execute-one-statement ] if ; + +: statement-each ( statement quot: ( statement -- ) -- ) + over more-rows? + [ [ call ] 2keep over advance-row statement-each ] + [ 2drop ] if ; inline recursive + +: statement-map ( statement quot -- sequence ) + accumulator [ statement-each ] dip { } like ; inline + +: statement>result-sequence ( statement -- sequence ) + statement>result-set [ [ sql-row ] statement-map ] with-disposal ; diff --git a/extra/db2/transactions/authors.txt b/extra/db2/transactions/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/transactions/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/transactions/transactions.factor b/extra/db2/transactions/transactions.factor new file mode 100644 index 0000000000..081c8dbe57 --- /dev/null +++ b/extra/db2/transactions/transactions.factor @@ -0,0 +1,23 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: db2 ; +IN: db2.transactions + +! 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 From 72205363fdff7b8dcdb8cfda0f24a4b9c208990f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 11 Apr 2009 13:44:06 -0500 Subject: [PATCH 03/37] porting more things over to extra/db2 --- extra/db2/errors/errors.factor | 40 +++++ extra/db2/errors/postgresql/authors.txt | 1 + .../errors/postgresql/postgresql-tests.factor | 32 ++++ extra/db2/errors/postgresql/postgresql.factor | 53 +++++++ extra/db2/errors/sqlite/authors.txt | 1 + extra/db2/errors/sqlite/sqlite-tests.factor | 26 ++++ extra/db2/errors/sqlite/sqlite.factor | 28 ++++ extra/db2/errors/summary.txt | 1 + extra/db2/pools/authors.txt | 1 + extra/db2/pools/pools-tests.factor | 22 +++ extra/db2/pools/pools.factor | 20 +++ extra/db2/result-sets/result-sets.factor | 1 - extra/db2/sqlite/authors.txt | 1 + extra/db2/sqlite/ffi/ffi.factor | 142 ++++++++++++++++++ extra/db2/sqlite/lib/lib.factor | 119 +++++++++++++++ extra/db2/sqlite/sqlite.factor | 4 + extra/db2/sqlite/types/authors.txt | 1 + extra/db2/sqlite/types/types.factor | 62 ++++++++ extra/db2/transactions/transactions.factor | 3 +- extra/db2/types/authors.txt | 1 + extra/db2/types/types.factor | 17 +++ 21 files changed, 573 insertions(+), 3 deletions(-) create mode 100644 extra/db2/errors/errors.factor create mode 100644 extra/db2/errors/postgresql/authors.txt create mode 100644 extra/db2/errors/postgresql/postgresql-tests.factor create mode 100644 extra/db2/errors/postgresql/postgresql.factor create mode 100644 extra/db2/errors/sqlite/authors.txt create mode 100644 extra/db2/errors/sqlite/sqlite-tests.factor create mode 100644 extra/db2/errors/sqlite/sqlite.factor create mode 100644 extra/db2/errors/summary.txt create mode 100644 extra/db2/pools/authors.txt create mode 100644 extra/db2/pools/pools-tests.factor create mode 100644 extra/db2/pools/pools.factor create mode 100644 extra/db2/sqlite/authors.txt create mode 100644 extra/db2/sqlite/ffi/ffi.factor create mode 100644 extra/db2/sqlite/lib/lib.factor create mode 100644 extra/db2/sqlite/sqlite.factor create mode 100644 extra/db2/sqlite/types/authors.txt create mode 100644 extra/db2/sqlite/types/types.factor create mode 100644 extra/db2/types/authors.txt create mode 100644 extra/db2/types/types.factor diff --git a/extra/db2/errors/errors.factor b/extra/db2/errors/errors.factor new file mode 100644 index 0000000000..bd330e6191 --- /dev/null +++ b/extra/db2/errors/errors.factor @@ -0,0 +1,40 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors kernel continuations fry words constructors ; +IN: db2.errors + +ERROR: db-error ; +ERROR: sql-error location ; + +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 diff --git a/extra/db2/errors/postgresql/authors.txt b/extra/db2/errors/postgresql/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/errors/postgresql/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/errors/postgresql/postgresql-tests.factor b/extra/db2/errors/postgresql/postgresql-tests.factor new file mode 100644 index 0000000000..f6668031e5 --- /dev/null +++ b/extra/db2/errors/postgresql/postgresql-tests.factor @@ -0,0 +1,32 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators.short-circuit db db.errors +db.errors.postgresql db.postgresql io.files.unique kernel namespaces +tools.test db.tester continuations ; +IN: db.errors.postgresql.tests + +[ + + [ "drop table foo;" sql-command ] ignore-errors + [ "drop table ship;" sql-command ] ignore-errors + + [ + "insert into foo (id) values('1');" sql-command + ] [ + { [ sql-table-missing? ] [ table>> "foo" = ] } 1&& + ] must-fail-with + + [ + "create table ship(id integer);" sql-command + "create table ship(id integer);" sql-command + ] [ + { [ sql-table-exists? ] [ table>> "ship" = ] } 1&& + ] must-fail-with + + [ + "create table foo(id) lol;" sql-command + ] [ + sql-syntax-error? + ] must-fail-with + +] test-postgresql diff --git a/extra/db2/errors/postgresql/postgresql.factor b/extra/db2/errors/postgresql/postgresql.factor new file mode 100644 index 0000000000..02b43ecd88 --- /dev/null +++ b/extra/db2/errors/postgresql/postgresql.factor @@ -0,0 +1,53 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel db.errors peg.ebnf strings sequences math +combinators.short-circuit accessors math.parser quoting ; +IN: db.errors.postgresql + +EBNF: parse-postgresql-sql-error + +Error = "ERROR:" [ ]+ + +TableError = + Error ("relation "|"table ")(!(" already exists").)+:table " already exists" + => [[ table >string unquote ]] + | Error ("relation "|"table ")(!(" does not exist").)+:table " does not exist" + => [[ table >string unquote ]] + +FunctionError = + Error "function" (!(" already exists").)+:table " already exists" + => [[ table >string ]] + | Error "function" (!(" does not exist").)+:table " does not exist" + => [[ table >string ]] + +SyntaxError = + Error "syntax error at end of input":error + => [[ error >string ]] + | Error "syntax error at or near " .+:syntaxerror + => [[ syntaxerror >string unquote ]] + +UnknownError = .* => [[ >string ]] + +PostgresqlSqlError = (TableError | FunctionError | SyntaxError | UnknownError) + +;EBNF + + +ERROR: parse-postgresql-location column line text ; +C: parse-postgresql-location + +EBNF: parse-postgresql-line-error + +Line = "LINE " [0-9]+:line ": " .+:sql + => [[ f line >string string>number sql >string ]] + +;EBNF + +:: set-caret-position ( error caret-line -- error ) + caret-line length + error line>> number>string length "LINE : " length + + - [ error ] dip >>column ; + +: postgresql-location ( line column -- obj ) + [ parse-postgresql-line-error ] dip + set-caret-position ; diff --git a/extra/db2/errors/sqlite/authors.txt b/extra/db2/errors/sqlite/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/errors/sqlite/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/errors/sqlite/sqlite-tests.factor b/extra/db2/errors/sqlite/sqlite-tests.factor new file mode 100644 index 0000000000..68ae55f8a8 --- /dev/null +++ b/extra/db2/errors/sqlite/sqlite-tests.factor @@ -0,0 +1,26 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators.short-circuit db db.errors +db.errors.sqlite db.sqlite io.files.unique kernel namespaces +tools.test ; +IN: db.errors.sqlite.tests + +: sqlite-error-test-db-path ( -- path ) + "sqlite" "error-test" make-unique-file ; + +sqlite-error-test-db-path [ + + [ + "insert into foo (id) values('1');" sql-command + ] [ + { [ sql-table-missing? ] [ table>> "foo" = ] } 1&& + ] must-fail-with + + [ + "create table foo(id);" sql-command + "create table foo(id);" sql-command + ] [ + { [ sql-table-exists? ] [ table>> "foo" = ] } 1&& + ] must-fail-with + +] with-db \ No newline at end of file diff --git a/extra/db2/errors/sqlite/sqlite.factor b/extra/db2/errors/sqlite/sqlite.factor new file mode 100644 index 0000000000..c73409b850 --- /dev/null +++ b/extra/db2/errors/sqlite/sqlite.factor @@ -0,0 +1,28 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators db kernel sequences peg.ebnf +strings db.errors ; +IN: db.errors.sqlite + +TUPLE: unparsed-sqlite-error error ; +C: unparsed-sqlite-error + +SINGLETONS: table-exists table-missing ; + +: sqlite-table-error ( table message -- error ) + { + { table-exists [ ] } + } case ; + +EBNF: parse-sqlite-sql-error + +TableMessage = " already exists" => [[ table-exists ]] + +SqliteError = + "table " (!(TableMessage).)+:table TableMessage:message + => [[ table >string message sqlite-table-error ]] + | "no such table: " .+:table + => [[ table >string ]] + | .*:error + => [[ error >string ]] +;EBNF diff --git a/extra/db2/errors/summary.txt b/extra/db2/errors/summary.txt new file mode 100644 index 0000000000..1cd102173f --- /dev/null +++ b/extra/db2/errors/summary.txt @@ -0,0 +1 @@ +Errors thrown by database library diff --git a/extra/db2/pools/authors.txt b/extra/db2/pools/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/db2/pools/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/db2/pools/pools-tests.factor b/extra/db2/pools/pools-tests.factor new file mode 100644 index 0000000000..7ff2a33d92 --- /dev/null +++ b/extra/db2/pools/pools-tests.factor @@ -0,0 +1,22 @@ +IN: db.pools.tests +USING: db.pools tools.test continuations io.files io.files.temp +io.directories namespaces accessors kernel math destructors ; + +\ must-infer + +{ 1 0 } [ [ ] with-db-pool ] must-infer-as + +{ 1 0 } [ [ ] with-pooled-db ] must-infer-as + +! Test behavior after image save/load +USE: db.sqlite + +[ "pool-test.db" temp-file delete-file ] ignore-errors + +[ ] [ "pool-test.db" temp-file "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 diff --git a/extra/db2/pools/pools.factor b/extra/db2/pools/pools.factor new file mode 100644 index 0000000000..b22dbde398 --- /dev/null +++ b/extra/db2/pools/pools.factor @@ -0,0 +1,20 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors db2.connections fry io.pools kernel +namespaces ; +IN: db.pools + +TUPLE: db-pool < pool db ; + +: ( db -- pool ) + db-pool + swap >>db ; + +: with-db-pool ( db quot -- ) + [ ] 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 diff --git a/extra/db2/result-sets/result-sets.factor b/extra/db2/result-sets/result-sets.factor index 0f242da473..8e35dc3862 100644 --- a/extra/db2/result-sets/result-sets.factor +++ b/extra/db2/result-sets/result-sets.factor @@ -26,4 +26,3 @@ GENERIC# column-typed 1 ( result-set column -- sql ) : sql-row-typed ( result-set -- seq ) dup #columns [ column-typed ] with map ; - diff --git a/extra/db2/sqlite/authors.txt b/extra/db2/sqlite/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/sqlite/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/sqlite/ffi/ffi.factor b/extra/db2/sqlite/ffi/ffi.factor new file mode 100644 index 0000000000..2594978ddf --- /dev/null +++ b/extra/db2/sqlite/ffi/ffi.factor @@ -0,0 +1,142 @@ +! 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 ) ; diff --git a/extra/db2/sqlite/lib/lib.factor b/extra/db2/sqlite/lib/lib.factor new file mode 100644 index 0000000000..2fe6d9cbdf --- /dev/null +++ b/extra/db2/sqlite/lib/lib.factor @@ -0,0 +1,119 @@ +! 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.connections db2.sqlite.ffi db2.errors +io.backend io.encodings.string io.encodings.utf8 kernel math +namespaces present sequences serialize urls ; +IN: db2.sqlite.lib + +: ?when ( object quot -- object' ) dupd when ; inline + +ERROR: sqlite-error < db-error n string ; +ERROR: sqlite-sql-error < sql-error n string ; + +: throw-sqlite-error ( n -- * ) + dup sqlite-error-messages nth sqlite-error ; + +: sqlite-statement-error ( -- * ) + SQLITE_ERROR + db-connection get handle>> sqlite3_errmsg sqlite-sql-error ; + +: sqlite-check-result ( n -- ) + { + { SQLITE_OK [ ] } + { SQLITE_ERROR [ sqlite-statement-error ] } + [ throw-sqlite-error ] + } case ; + +: sqlite-open ( path -- db ) + normalize-path + "void*" + [ 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*" "void*" + [ 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-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? ; diff --git a/extra/db2/sqlite/sqlite.factor b/extra/db2/sqlite/sqlite.factor new file mode 100644 index 0000000000..edb74dd06f --- /dev/null +++ b/extra/db2/sqlite/sqlite.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: ; +IN: db2.sqlite diff --git a/extra/db2/sqlite/types/authors.txt b/extra/db2/sqlite/types/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/sqlite/types/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/sqlite/types/types.factor b/extra/db2/sqlite/types/types.factor new file mode 100644 index 0000000000..86ad92c60e --- /dev/null +++ b/extra/db2/sqlite/types/types.factor @@ -0,0 +1,62 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays calendar.format combinators db2.types +db2.sqlite.ffi db2.sqlite.lib +kernel 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-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 ; + diff --git a/extra/db2/transactions/transactions.factor b/extra/db2/transactions/transactions.factor index 081c8dbe57..eb8c48e336 100644 --- a/extra/db2/transactions/transactions.factor +++ b/extra/db2/transactions/transactions.factor @@ -1,9 +1,8 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: db2 ; +USING: continuations db2 db2.connections namespaces ; IN: db2.transactions -! Transactions SYMBOL: in-transaction HOOK: begin-transaction db-connection ( -- ) diff --git a/extra/db2/types/authors.txt b/extra/db2/types/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/types/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/types/types.factor b/extra/db2/types/types.factor new file mode 100644 index 0000000000..97f9ca0a0c --- /dev/null +++ b/extra/db2/types/types.factor @@ -0,0 +1,17 @@ +! 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 ; From dd9ef140f98b93ea0a648bc8b7307593aca5df5a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 11 Apr 2009 13:46:25 -0500 Subject: [PATCH 04/37] gitignore a.out --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 22dda8efb4..aa877b1cb5 100644 --- a/.gitignore +++ b/.gitignore @@ -25,3 +25,4 @@ build-support/wordsize .#* *.swo checksums.txt +a.out From badbd014be33b04e5a26a9ed6dd9b646f4a64317 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 11 Apr 2009 16:19:41 -0500 Subject: [PATCH 05/37] more parsers for c syntax --- .../sequence-parser-tests.factor | 15 ++- extra/sequence-parser/sequence-parser.factor | 102 +++++++++++------- 2 files changed, 80 insertions(+), 37 deletions(-) diff --git a/extra/sequence-parser/sequence-parser-tests.factor b/extra/sequence-parser/sequence-parser-tests.factor index 3b2fcad5eb..da097f4c00 100644 --- a/extra/sequence-parser/sequence-parser-tests.factor +++ b/extra/sequence-parser/sequence-parser-tests.factor @@ -1,4 +1,5 @@ -USING: tools.test sequence-parser ascii kernel accessors ; +USING: tools.test sequence-parser unicode.categories kernel +accessors ; IN: sequence-parser.tests [ "hello" ] @@ -189,3 +190,15 @@ IN: sequence-parser.tests [ "123u" ] [ "123u" take-c-integer ] unit-test + +[ 36 ] +[ + " //jofiejoe\n //eoieow\n/*asdf*/\n " + skip-whitespace/comments n>> +] unit-test + +[ f ] +[ "\n" take-integer ] unit-test + +[ "\n" ] [ "\n" [ ] take-while ] unit-test +[ f ] [ "\n" [ not ] take-while ] unit-test diff --git a/extra/sequence-parser/sequence-parser.factor b/extra/sequence-parser/sequence-parser.factor index 4f57a7ccae..4cc10fd5fd 100644 --- a/extra/sequence-parser/sequence-parser.factor +++ b/extra/sequence-parser/sequence-parser.factor @@ -52,7 +52,7 @@ TUPLE: sequence-parser sequence n ; ] [ [ drop n>> ] [ skip-until ] - [ drop [ n>> ] [ sequence>> ] bi ] 2tri subseq + [ drop [ n>> ] [ sequence>> ] bi ] 2tri subseq f like ] if ; inline : take-while ( sequence-parser quot: ( obj -- ? ) -- sequence/f ) @@ -104,6 +104,45 @@ TUPLE: sequence-parser sequence n ; : skip-whitespace ( sequence-parser -- sequence-parser ) [ [ current blank? not ] take-until drop ] keep ; +: skip-whitespace-eol ( sequence-parser -- sequence-parser ) + [ [ current " \t\r" member? not ] take-until drop ] keep ; + +: take-c-comment ( sequence-parser -- seq/f ) + [ + dup "/*" take-sequence [ + "*/" take-until-sequence* + ] [ + drop f + ] if + ] with-sequence-parser ; + +: take-c++-comment ( sequence-parser -- seq/f ) + [ + dup "//" take-sequence [ + [ + [ + { [ current CHAR: \n = ] [ sequence-parse-end? ] } 1|| + ] take-until + ] [ + advance drop + ] bi + ] [ + drop f + ] if + ] with-sequence-parser ; + +: skip-whitespace/comments ( sequence-parser -- sequence-parser ) + skip-whitespace-eol + { + { [ dup take-c-comment ] [ skip-whitespace/comments ] } + { [ dup take-c++-comment ] [ skip-whitespace/comments ] } + [ ] + } cond ; + +: take-define-identifier ( sequence-parser -- string ) + skip-whitespace/comments + [ current { [ blank? ] [ CHAR: ( = ] } 1|| ] take-until ; + : take-rest-slice ( sequence-parser -- sequence/f ) [ sequence>> ] [ n>> ] bi 2dup [ length ] dip < [ 2drop f ] [ tail-slice ] if ; inline @@ -157,30 +196,6 @@ TUPLE: sequence-parser sequence n ; sequence-parser [ n + ] change-n drop ] if ; -: take-c-comment ( sequence-parser -- seq/f ) - [ - dup "/*" take-sequence [ - "*/" take-until-sequence* - ] [ - drop f - ] if - ] with-sequence-parser ; - -: take-c++-comment ( sequence-parser -- seq/f ) - [ - dup "//" take-sequence [ - [ - [ - { [ current CHAR: \n = ] [ sequence-parse-end? ] } 1|| - ] take-until - ] [ - advance drop - ] bi - ] [ - drop f - ] if - ] with-sequence-parser ; - : c-identifier-begin? ( ch -- ? ) CHAR: a CHAR: z [a,b] CHAR: A CHAR: Z [a,b] @@ -192,29 +207,30 @@ TUPLE: sequence-parser sequence n ; CHAR: 0 CHAR: 9 [a,b] { CHAR: _ } 4 nappend member? ; -: take-c-identifier ( state-parser -- string/f ) - [ - dup current c-identifier-begin? [ - [ current c-identifier-ch? ] take-while - ] [ - drop f - ] if - ] with-sequence-parser ; +: (take-c-identifier) ( sequence-parser -- string/f ) + dup current c-identifier-begin? [ + [ current c-identifier-ch? ] take-while + ] [ + drop f + ] if ; + +: take-c-identifier ( sequence-parser -- string/f ) + [ (take-c-identifier) ] with-sequence-parser ; << "length" [ length ] define-sorting >> : sort-tokens ( seq -- seq' ) { length>=< <=> } sort-by ; -: take-first-matching ( state-parser seq -- seq ) +: take-first-matching ( sequence-parser seq -- seq ) swap '[ _ [ swap take-sequence ] with-sequence-parser ] find nip ; -: take-longest ( state-parser seq -- seq ) +: take-longest ( sequence-parser seq -- seq ) sort-tokens take-first-matching ; -: take-c-integer ( state-parser -- string/f ) +: take-c-integer ( sequence-parser -- string/f ) [ dup take-integer [ swap @@ -225,5 +241,19 @@ TUPLE: sequence-parser sequence n ; ] if* ] with-sequence-parser ; +CONSTANT: c-punctuators + { + "[" "]" "(" ")" "{" "}" "." "->" + "++" "--" "&" "*" "+" "-" "~" "!" + "/" "%" "<<" ">>" "<" ">" "<=" ">=" "==" "!=" "^" "|" "&&" "||" + "?" ":" ";" "..." + "=" "*=" "/=" "%=" "+=" "-=" "<<=" ">>=" "&=" "^=" "|=" + "," "#" "##" + "<:" ":>" "<%" "%>" "%:" "%:%:" + } + +: take-c-punctuator ( sequence-parser -- string/f ) + c-punctuators take-longest ; + : write-full ( sequence-parser -- ) sequence>> write ; : write-rest ( sequence-parser -- ) take-rest write ; From ee45c8ff20d357bb9fd4d2e15bcf88f3210b144c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 11 Apr 2009 20:21:04 -0500 Subject: [PATCH 06/37] more work on db2 --- extra/db2/connections/connections.factor | 12 +++++++++--- extra/db2/pools/pools-tests.factor | 9 +++++---- extra/db2/pools/pools.factor | 2 +- extra/db2/sqlite/sqlite.factor | 10 +++++++++- extra/db2/transactions/transactions.factor | 4 ++++ 5 files changed, 28 insertions(+), 9 deletions(-) diff --git a/extra/db2/connections/connections.factor b/extra/db2/connections/connections.factor index c622f9a4b4..faea6406fe 100644 --- a/extra/db2/connections/connections.factor +++ b/extra/db2/connections/connections.factor @@ -5,13 +5,19 @@ IN: db2.connections TUPLE: db-connection handle ; +: new-db-connection ( handle class -- db-connection ) + new + swap >>handle ; inline + GENERIC: db-open ( db -- db-connection ) -HOOK: db-close db-connection ( handle -- ) + +GENERIC: db-close ( handle -- ) + HOOK: parse-db-error db-connection ( error -- error' ) M: db-connection dispose ( db-connection -- ) - [ db-close f ] change-handle drop ; + [ db-close ] [ f >>handle drop ] bi ; : with-db ( db quot -- ) - [ db-open db-connection dup ] dip + [ db-open db-connection over ] dip '[ _ [ drop @ ] with-disposal ] with-variable ; inline diff --git a/extra/db2/pools/pools-tests.factor b/extra/db2/pools/pools-tests.factor index 7ff2a33d92..d61b745b03 100644 --- a/extra/db2/pools/pools-tests.factor +++ b/extra/db2/pools/pools-tests.factor @@ -1,6 +1,8 @@ -IN: db.pools.tests -USING: db.pools tools.test continuations io.files io.files.temp -io.directories namespaces accessors kernel math destructors ; +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 \ must-infer @@ -9,7 +11,6 @@ io.directories namespaces accessors kernel math destructors ; { 1 0 } [ [ ] with-pooled-db ] must-infer-as ! Test behavior after image save/load -USE: db.sqlite [ "pool-test.db" temp-file delete-file ] ignore-errors diff --git a/extra/db2/pools/pools.factor b/extra/db2/pools/pools.factor index b22dbde398..2b1aa2f0bf 100644 --- a/extra/db2/pools/pools.factor +++ b/extra/db2/pools/pools.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors db2.connections fry io.pools kernel namespaces ; -IN: db.pools +IN: db2.pools TUPLE: db-pool < pool db ; diff --git a/extra/db2/sqlite/sqlite.factor b/extra/db2/sqlite/sqlite.factor index edb74dd06f..82337ae30b 100644 --- a/extra/db2/sqlite/sqlite.factor +++ b/extra/db2/sqlite/sqlite.factor @@ -1,4 +1,12 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: ; +USING: constructors db2.connections ; IN: db2.sqlite + +TUPLE: sqlite-db path ; +CONSTRUCTOR: sqlite-db ( path -- sqlite-db ) ; + +TUPLE: sqlite-db-connection < db-connection ; + +: ( handle -- db-connection ) + sqlite-db-connection new-db-connection ; diff --git a/extra/db2/transactions/transactions.factor b/extra/db2/transactions/transactions.factor index eb8c48e336..fd0e6ade74 100644 --- a/extra/db2/transactions/transactions.factor +++ b/extra/db2/transactions/transactions.factor @@ -6,11 +6,15 @@ 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 ; From 956a119991c360b577c04b7b4f460bf4603c27e3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 11 Apr 2009 21:05:18 -0500 Subject: [PATCH 07/37] still working on db2 --- .../db2/connections/connections-tests.factor | 8 ++ extra/db2/connections/connections.factor | 2 - extra/db2/db2-tests.factor | 5 + extra/db2/errors/errors.factor | 4 +- .../errors/postgresql/postgresql-tests.factor | 32 ------- extra/db2/errors/postgresql/postgresql.factor | 53 ---------- extra/db2/errors/sqlite/sqlite-tests.factor | 26 ----- .../connections}/authors.txt | 0 .../connections/connections-tests.factor | 4 + .../db2/sqlite/connections/connections.factor | 22 +++++ .../{errors/sqlite => sqlite/db}/authors.txt | 0 extra/db2/sqlite/db/db.factor | 12 +++ extra/db2/sqlite/errors/authors.txt | 1 + .../errors/errors.factor} | 23 +++-- extra/db2/sqlite/lib/lib.factor | 11 +-- extra/db2/sqlite/result-sets/authors.txt | 1 + .../db2/sqlite/result-sets/result-sets.factor | 7 ++ extra/db2/sqlite/statements/authors.txt | 1 + extra/db2/sqlite/statements/statements.factor | 11 +++ extra/db2/statements/statements-tests.factor | 13 +++ extra/db2/tester/authors.txt | 2 + extra/db2/tester/tester-tests.factor | 7 ++ extra/db2/tester/tester.factor | 96 +++++++++++++++++++ 23 files changed, 210 insertions(+), 131 deletions(-) create mode 100644 extra/db2/connections/connections-tests.factor create mode 100644 extra/db2/db2-tests.factor delete mode 100644 extra/db2/errors/postgresql/postgresql-tests.factor delete mode 100644 extra/db2/errors/postgresql/postgresql.factor delete mode 100644 extra/db2/errors/sqlite/sqlite-tests.factor rename extra/db2/{errors/postgresql => sqlite/connections}/authors.txt (100%) create mode 100644 extra/db2/sqlite/connections/connections-tests.factor create mode 100644 extra/db2/sqlite/connections/connections.factor rename extra/db2/{errors/sqlite => sqlite/db}/authors.txt (100%) create mode 100644 extra/db2/sqlite/db/db.factor create mode 100644 extra/db2/sqlite/errors/authors.txt rename extra/db2/{errors/sqlite/sqlite.factor => sqlite/errors/errors.factor} (50%) create mode 100644 extra/db2/sqlite/result-sets/authors.txt create mode 100644 extra/db2/sqlite/result-sets/result-sets.factor create mode 100644 extra/db2/sqlite/statements/authors.txt create mode 100644 extra/db2/sqlite/statements/statements.factor create mode 100644 extra/db2/statements/statements-tests.factor create mode 100644 extra/db2/tester/authors.txt create mode 100644 extra/db2/tester/tester-tests.factor create mode 100644 extra/db2/tester/tester.factor diff --git a/extra/db2/connections/connections-tests.factor b/extra/db2/connections/connections-tests.factor new file mode 100644 index 0000000000..f96a201bf6 --- /dev/null +++ b/extra/db2/connections/connections-tests.factor @@ -0,0 +1,8 @@ +! 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 diff --git a/extra/db2/connections/connections.factor b/extra/db2/connections/connections.factor index faea6406fe..0caee54726 100644 --- a/extra/db2/connections/connections.factor +++ b/extra/db2/connections/connections.factor @@ -10,9 +10,7 @@ TUPLE: db-connection handle ; swap >>handle ; inline GENERIC: db-open ( db -- db-connection ) - GENERIC: db-close ( handle -- ) - HOOK: parse-db-error db-connection ( error -- error' ) M: db-connection dispose ( db-connection -- ) diff --git a/extra/db2/db2-tests.factor b/extra/db2/db2-tests.factor new file mode 100644 index 0000000000..30ee7b3581 --- /dev/null +++ b/extra/db2/db2-tests.factor @@ -0,0 +1,5 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test db2 kernel ; +IN: db2.tests + diff --git a/extra/db2/errors/errors.factor b/extra/db2/errors/errors.factor index bd330e6191..45353f6fb9 100644 --- a/extra/db2/errors/errors.factor +++ b/extra/db2/errors/errors.factor @@ -1,10 +1,12 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel continuations fry words constructors ; +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 ) ; diff --git a/extra/db2/errors/postgresql/postgresql-tests.factor b/extra/db2/errors/postgresql/postgresql-tests.factor deleted file mode 100644 index f6668031e5..0000000000 --- a/extra/db2/errors/postgresql/postgresql-tests.factor +++ /dev/null @@ -1,32 +0,0 @@ -! Copyright (C) 2009 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators.short-circuit db db.errors -db.errors.postgresql db.postgresql io.files.unique kernel namespaces -tools.test db.tester continuations ; -IN: db.errors.postgresql.tests - -[ - - [ "drop table foo;" sql-command ] ignore-errors - [ "drop table ship;" sql-command ] ignore-errors - - [ - "insert into foo (id) values('1');" sql-command - ] [ - { [ sql-table-missing? ] [ table>> "foo" = ] } 1&& - ] must-fail-with - - [ - "create table ship(id integer);" sql-command - "create table ship(id integer);" sql-command - ] [ - { [ sql-table-exists? ] [ table>> "ship" = ] } 1&& - ] must-fail-with - - [ - "create table foo(id) lol;" sql-command - ] [ - sql-syntax-error? - ] must-fail-with - -] test-postgresql diff --git a/extra/db2/errors/postgresql/postgresql.factor b/extra/db2/errors/postgresql/postgresql.factor deleted file mode 100644 index 02b43ecd88..0000000000 --- a/extra/db2/errors/postgresql/postgresql.factor +++ /dev/null @@ -1,53 +0,0 @@ -! Copyright (C) 2009 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel db.errors peg.ebnf strings sequences math -combinators.short-circuit accessors math.parser quoting ; -IN: db.errors.postgresql - -EBNF: parse-postgresql-sql-error - -Error = "ERROR:" [ ]+ - -TableError = - Error ("relation "|"table ")(!(" already exists").)+:table " already exists" - => [[ table >string unquote ]] - | Error ("relation "|"table ")(!(" does not exist").)+:table " does not exist" - => [[ table >string unquote ]] - -FunctionError = - Error "function" (!(" already exists").)+:table " already exists" - => [[ table >string ]] - | Error "function" (!(" does not exist").)+:table " does not exist" - => [[ table >string ]] - -SyntaxError = - Error "syntax error at end of input":error - => [[ error >string ]] - | Error "syntax error at or near " .+:syntaxerror - => [[ syntaxerror >string unquote ]] - -UnknownError = .* => [[ >string ]] - -PostgresqlSqlError = (TableError | FunctionError | SyntaxError | UnknownError) - -;EBNF - - -ERROR: parse-postgresql-location column line text ; -C: parse-postgresql-location - -EBNF: parse-postgresql-line-error - -Line = "LINE " [0-9]+:line ": " .+:sql - => [[ f line >string string>number sql >string ]] - -;EBNF - -:: set-caret-position ( error caret-line -- error ) - caret-line length - error line>> number>string length "LINE : " length + - - [ error ] dip >>column ; - -: postgresql-location ( line column -- obj ) - [ parse-postgresql-line-error ] dip - set-caret-position ; diff --git a/extra/db2/errors/sqlite/sqlite-tests.factor b/extra/db2/errors/sqlite/sqlite-tests.factor deleted file mode 100644 index 68ae55f8a8..0000000000 --- a/extra/db2/errors/sqlite/sqlite-tests.factor +++ /dev/null @@ -1,26 +0,0 @@ -! Copyright (C) 2009 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators.short-circuit db db.errors -db.errors.sqlite db.sqlite io.files.unique kernel namespaces -tools.test ; -IN: db.errors.sqlite.tests - -: sqlite-error-test-db-path ( -- path ) - "sqlite" "error-test" make-unique-file ; - -sqlite-error-test-db-path [ - - [ - "insert into foo (id) values('1');" sql-command - ] [ - { [ sql-table-missing? ] [ table>> "foo" = ] } 1&& - ] must-fail-with - - [ - "create table foo(id);" sql-command - "create table foo(id);" sql-command - ] [ - { [ sql-table-exists? ] [ table>> "foo" = ] } 1&& - ] must-fail-with - -] with-db \ No newline at end of file diff --git a/extra/db2/errors/postgresql/authors.txt b/extra/db2/sqlite/connections/authors.txt similarity index 100% rename from extra/db2/errors/postgresql/authors.txt rename to extra/db2/sqlite/connections/authors.txt diff --git a/extra/db2/sqlite/connections/connections-tests.factor b/extra/db2/sqlite/connections/connections-tests.factor new file mode 100644 index 0000000000..ed80810508 --- /dev/null +++ b/extra/db2/sqlite/connections/connections-tests.factor @@ -0,0 +1,4 @@ +! 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 diff --git a/extra/db2/sqlite/connections/connections.factor b/extra/db2/sqlite/connections/connections.factor new file mode 100644 index 0000000000..ba9869633b --- /dev/null +++ b/extra/db2/sqlite/connections/connections.factor @@ -0,0 +1,22 @@ +! 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 ; +IN: db2.sqlite.connections + +TUPLE: sqlite-db-connection < db-connection ; + +: ( handle -- db-connection ) + sqlite-db-connection new-db-connection ; + +M: sqlite-db db-open ( db -- db-connection ) + path>> sqlite-open ; + +M: sqlite-db-connection db-close ( db-connection -- ) + handle>> sqlite-close ; + +M: sqlite-db-connection parse-db-error ( error -- error' ) + dup n>> { + { 1 [ string>> parse-sqlite-sql-error ] } + [ drop ] + } case ; diff --git a/extra/db2/errors/sqlite/authors.txt b/extra/db2/sqlite/db/authors.txt similarity index 100% rename from extra/db2/errors/sqlite/authors.txt rename to extra/db2/sqlite/db/authors.txt diff --git a/extra/db2/sqlite/db/db.factor b/extra/db2/sqlite/db/db.factor new file mode 100644 index 0000000000..d5d580cb1a --- /dev/null +++ b/extra/db2/sqlite/db/db.factor @@ -0,0 +1,12 @@ +! 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 ; + +: ( path -- sqlite-db ) + sqlite-db new + swap >>path ; + + diff --git a/extra/db2/sqlite/errors/authors.txt b/extra/db2/sqlite/errors/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/sqlite/errors/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/errors/sqlite/sqlite.factor b/extra/db2/sqlite/errors/errors.factor similarity index 50% rename from extra/db2/errors/sqlite/sqlite.factor rename to extra/db2/sqlite/errors/errors.factor index c73409b850..eff73b6796 100644 --- a/extra/db2/errors/sqlite/sqlite.factor +++ b/extra/db2/sqlite/errors/errors.factor @@ -1,22 +1,31 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators db kernel sequences peg.ebnf -strings db.errors ; -IN: db.errors.sqlite +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 ; + +: throw-sqlite-error ( n -- * ) + dup sqlite-error-messages nth sqlite-error ; + +: sqlite-statement-error ( -- * ) + SQLITE_ERROR + db-connection get handle>> sqlite3_errmsg sqlite-sql-error ; TUPLE: unparsed-sqlite-error error ; C: unparsed-sqlite-error -SINGLETONS: table-exists table-missing ; - : sqlite-table-error ( table message -- error ) { - { table-exists [ ] } + { sql-table-exists [ ] } } case ; EBNF: parse-sqlite-sql-error -TableMessage = " already exists" => [[ table-exists ]] +TableMessage = " already exists" => [[ sql-table-exists ]] SqliteError = "table " (!(TableMessage).)+:table TableMessage:message diff --git a/extra/db2/sqlite/lib/lib.factor b/extra/db2/sqlite/lib/lib.factor index 2fe6d9cbdf..f3e3058582 100644 --- a/extra/db2/sqlite/lib/lib.factor +++ b/extra/db2/sqlite/lib/lib.factor @@ -3,20 +3,11 @@ USING: accessors alien.c-types arrays calendar.format combinators db2.connections db2.sqlite.ffi db2.errors io.backend io.encodings.string io.encodings.utf8 kernel math -namespaces present sequences serialize urls ; +namespaces present sequences serialize urls db2.sqlite.errors ; IN: db2.sqlite.lib : ?when ( object quot -- object' ) dupd when ; inline -ERROR: sqlite-error < db-error n string ; -ERROR: sqlite-sql-error < sql-error n string ; - -: throw-sqlite-error ( n -- * ) - dup sqlite-error-messages nth sqlite-error ; - -: sqlite-statement-error ( -- * ) - SQLITE_ERROR - db-connection get handle>> sqlite3_errmsg sqlite-sql-error ; : sqlite-check-result ( n -- ) { diff --git a/extra/db2/sqlite/result-sets/authors.txt b/extra/db2/sqlite/result-sets/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/sqlite/result-sets/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/sqlite/result-sets/result-sets.factor b/extra/db2/sqlite/result-sets/result-sets.factor new file mode 100644 index 0000000000..14e8e52f0e --- /dev/null +++ b/extra/db2/sqlite/result-sets/result-sets.factor @@ -0,0 +1,7 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: db2.result-sets ; +IN: db2.sqlite.result-sets + +TUPLE: sqlite-result-set < result-set has-more? ; + diff --git a/extra/db2/sqlite/statements/authors.txt b/extra/db2/sqlite/statements/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/sqlite/statements/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/sqlite/statements/statements.factor b/extra/db2/sqlite/statements/statements.factor new file mode 100644 index 0000000000..fde2de7bf6 --- /dev/null +++ b/extra/db2/sqlite/statements/statements.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: db2.connections db2.statements db2.sqlite.connections +db2.sqlite.lib ; +IN: db2.sqlite.statements + +TUPLE: sqlite-statement < statement ; + +M: sqlite-db-connection ( string in out -- obj ) + sqlite-statement new-statement ; + diff --git a/extra/db2/statements/statements-tests.factor b/extra/db2/statements/statements-tests.factor new file mode 100644 index 0000000000..548300b417 --- /dev/null +++ b/extra/db2/statements/statements-tests.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test db2.statements kernel ; +IN: db2.statements.tests + +{ 1 0 } [ [ drop ] statement-each ] must-infer-as +{ 1 1 } [ [ ] statement-map ] must-infer-as + +[ ] +[ + "insert into computer (name, os) values('rocky', 'mac');" + +] unit-test diff --git a/extra/db2/tester/authors.txt b/extra/db2/tester/authors.txt new file mode 100644 index 0000000000..f372b574ae --- /dev/null +++ b/extra/db2/tester/authors.txt @@ -0,0 +1,2 @@ +Slava Pestov +Doug Coleman diff --git a/extra/db2/tester/tester-tests.factor b/extra/db2/tester/tester-tests.factor new file mode 100644 index 0000000000..b3e8f19e6a --- /dev/null +++ b/extra/db2/tester/tester-tests.factor @@ -0,0 +1,7 @@ +! 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 diff --git a/extra/db2/tester/tester.factor b/extra/db2/tester/tester.factor new file mode 100644 index 0000000000..471752f413 --- /dev/null +++ b/extra/db2/tester/tester.factor @@ -0,0 +1,96 @@ +! 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 ; + +! 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 ) + + "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 + ] [ + [ + 10 [ + 10 [ + f 100 random 100 random 100 random test-1 boa + insert-tuple yield + ] times + ] parallel-each + ] with-pooled-db + ] bi ; +*/ From 48a0858135321fda82cc02befb147ffca87f382f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 13 Apr 2009 15:37:29 -0500 Subject: [PATCH 08/37] raw sql queries work again --- extra/db2/connections/connections.factor | 1 - extra/db2/db2.factor | 1 + .../db2/sqlite/connections/connections.factor | 4 +-- extra/db2/sqlite/errors/errors.factor | 18 +++++----- extra/db2/sqlite/lib/lib.factor | 1 - .../db2/sqlite/result-sets/result-sets.factor | 22 +++++++++++- extra/db2/sqlite/statements/statements.factor | 14 ++++++-- extra/db2/statements/statements-tests.factor | 35 ++++++++++++++++--- extra/db2/statements/statements.factor | 13 ++++--- 9 files changed, 82 insertions(+), 27 deletions(-) diff --git a/extra/db2/connections/connections.factor b/extra/db2/connections/connections.factor index 0caee54726..7957cb918a 100644 --- a/extra/db2/connections/connections.factor +++ b/extra/db2/connections/connections.factor @@ -11,7 +11,6 @@ TUPLE: db-connection handle ; GENERIC: db-open ( db -- db-connection ) GENERIC: db-close ( handle -- ) -HOOK: parse-db-error db-connection ( error -- error' ) M: db-connection dispose ( db-connection -- ) [ db-close ] [ f >>handle drop ] bi ; diff --git a/extra/db2/db2.factor b/extra/db2/db2.factor index 16afbd2782..e1723160c0 100644 --- a/extra/db2/db2.factor +++ b/extra/db2/db2.factor @@ -18,3 +18,4 @@ PRIVATE> : sql-query ( sql -- sequence ) f f [ statement>result-sequence ] with-disposal ; + diff --git a/extra/db2/sqlite/connections/connections.factor b/extra/db2/sqlite/connections/connections.factor index ba9869633b..b99603f4ef 100644 --- a/extra/db2/sqlite/connections/connections.factor +++ b/extra/db2/sqlite/connections/connections.factor @@ -1,7 +1,7 @@ ! 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.sqlite.errors db2.sqlite.lib kernel db2.errors ; IN: db2.sqlite.connections TUPLE: sqlite-db-connection < db-connection ; @@ -15,7 +15,7 @@ M: sqlite-db db-open ( db -- db-connection ) M: sqlite-db-connection db-close ( db-connection -- ) handle>> sqlite-close ; -M: sqlite-db-connection parse-db-error ( error -- error' ) +M: sqlite-db-connection parse-sql-error ( error -- error' ) dup n>> { { 1 [ string>> parse-sqlite-sql-error ] } [ drop ] diff --git a/extra/db2/sqlite/errors/errors.factor b/extra/db2/sqlite/errors/errors.factor index eff73b6796..61e70f210d 100644 --- a/extra/db2/sqlite/errors/errors.factor +++ b/extra/db2/sqlite/errors/errors.factor @@ -8,9 +8,6 @@ IN: db2.sqlite.errors ERROR: sqlite-error < db-error n string ; ERROR: sqlite-sql-error < sql-error n string ; -: throw-sqlite-error ( n -- * ) - dup sqlite-error-messages nth sqlite-error ; - : sqlite-statement-error ( -- * ) SQLITE_ERROR db-connection get handle>> sqlite3_errmsg sqlite-sql-error ; @@ -18,20 +15,21 @@ ERROR: sqlite-sql-error < sql-error n string ; TUPLE: unparsed-sqlite-error error ; C: unparsed-sqlite-error -: sqlite-table-error ( table message -- error ) - { - { sql-table-exists [ ] } - } case ; - EBNF: parse-sqlite-sql-error -TableMessage = " already exists" => [[ sql-table-exists ]] +TableMessage = " already exists" +SyntaxError = ": syntax error" SqliteError = "table " (!(TableMessage).)+:table TableMessage:message - => [[ table >string message sqlite-table-error ]] + => [[ table >string ]] + | "near " (!(SyntaxError).)+:syntax SyntaxError:message + => [[ syntax >string ]] | "no such table: " .+:table => [[ table >string ]] | .*:error => [[ error >string ]] ;EBNF + +: throw-sqlite-error ( n -- * ) + dup sqlite-error-messages nth sqlite-error ; diff --git a/extra/db2/sqlite/lib/lib.factor b/extra/db2/sqlite/lib/lib.factor index f3e3058582..34918efb8d 100644 --- a/extra/db2/sqlite/lib/lib.factor +++ b/extra/db2/sqlite/lib/lib.factor @@ -8,7 +8,6 @@ IN: db2.sqlite.lib : ?when ( object quot -- object' ) dupd when ; inline - : sqlite-check-result ( n -- ) { { SQLITE_OK [ ] } diff --git a/extra/db2/sqlite/result-sets/result-sets.factor b/extra/db2/sqlite/result-sets/result-sets.factor index 14e8e52f0e..a8bf11fc56 100644 --- a/extra/db2/sqlite/result-sets/result-sets.factor +++ b/extra/db2/sqlite/result-sets/result-sets.factor @@ -1,7 +1,27 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: db2.result-sets ; +USING: accessors db2.result-sets db2.sqlite.statements +db2.statements kernel db2.sqlite.lib destructors ; 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* + sqlite-maybe-prepare + dup handle>> 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* ; diff --git a/extra/db2/sqlite/statements/statements.factor b/extra/db2/sqlite/statements/statements.factor index fde2de7bf6..a856c48075 100644 --- a/extra/db2/sqlite/statements/statements.factor +++ b/extra/db2/sqlite/statements/statements.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: db2.connections db2.statements db2.sqlite.connections -db2.sqlite.lib ; +USING: accessors db2.connections db2.sqlite.connections +db2.sqlite.ffi db2.sqlite.lib db2.statements destructors kernel +namespaces ; IN: db2.sqlite.statements TUPLE: sqlite-statement < statement ; @@ -9,3 +10,12 @@ TUPLE: sqlite-statement < statement ; M: sqlite-db-connection ( string in out -- obj ) sqlite-statement new-statement ; +M: sqlite-statement dispose + handle>> + [ [ sqlite3_reset drop ] [ sqlite-finalize ] bi ] when* ; + +: sqlite-maybe-prepare ( statement -- statement ) + dup handle>> [ + db-connection get handle>> over sql>> sqlite-prepare + >>handle + ] unless ; diff --git a/extra/db2/statements/statements-tests.factor b/extra/db2/statements/statements-tests.factor index 548300b417..43564c8b29 100644 --- a/extra/db2/statements/statements-tests.factor +++ b/extra/db2/statements/statements-tests.factor @@ -1,13 +1,38 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test db2.statements kernel ; +USING: tools.test db2.statements kernel db2 db2.tester +continuations db2.errors ; IN: db2.statements.tests { 1 0 } [ [ drop ] statement-each ] must-infer-as { 1 1 } [ [ ] statement-map ] must-infer-as -[ ] -[ - "insert into computer (name, os) values('rocky', 'mac');" + +: test-sql-command ( -- ) + [ "drop table computer;" sql-command ] ignore-errors + + [ ] [ + "create table computer(name varchar, os varchar);" + sql-command + ] unit-test -] unit-test + [ ] [ + "insert into computer (name, os) values('rocky', 'mac');" + sql-command + ] unit-test + + [ { { "rocky" "mac" } } ] + [ + "select name, os from computer;" sql-query + ] unit-test + + [ "insert into" sql-command ] + [ sql-syntax-error? ] must-fail-with + + [ "selectt" sql-query ] + [ sql-syntax-error? ] must-fail-with + + ; + +[ test-sql-command ] test-dbs + diff --git a/extra/db2/statements/statements.factor b/extra/db2/statements/statements.factor index 282fb7d5bf..006cda3532 100644 --- a/extra/db2/statements/statements.factor +++ b/extra/db2/statements/statements.factor @@ -1,10 +1,10 @@ ! 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 ; +sequences db2.result-sets db2.connections db2.errors ; IN: db2.statements -TUPLE: statement handle sql in out ; +TUPLE: statement handle sql in out type ; : new-statement ( sql in out class -- statement ) new @@ -13,12 +13,15 @@ TUPLE: statement handle sql in out ; swap >>sql ; HOOK: db-connection ( sql in out -- statement ) +GENERIC: statement>result-set* ( statement -- result-set ) GENERIC: execute-statement* ( statement type -- ) -GENERIC: statement>result-set ( statement -- result-set ) + +: 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 ] - [ parse-db-error rethrow ] recover ; + drop statement>result-set dispose ; : execute-one-statement ( statement -- ) dup type>> execute-statement* ; From 1789a58bbfe5de47c3647bc6650e623558331544 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 13 Apr 2009 17:27:31 -0500 Subject: [PATCH 09/37] add sql-bind-query, sql-bind-command for writing raw sql --- extra/db2/db2.factor | 22 +++++++++++++++++-- extra/db2/result-sets/result-sets.factor | 12 ++++++---- .../db2/sqlite/result-sets/result-sets.factor | 2 +- extra/db2/statements/statements-tests.factor | 17 ++++++++++++-- 4 files changed, 44 insertions(+), 9 deletions(-) diff --git a/extra/db2/db2.factor b/extra/db2/db2.factor index e1723160c0..708caa97ab 100644 --- a/extra/db2/db2.factor +++ b/extra/db2/db2.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors continuations destructors fry kernel -namespaces sequences strings db2.statements ; +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 ; IN: db2 : sql-query ( sql -- sequence ) f f [ statement>result-sequence ] with-disposal ; +: sql-bind-command ( sequence string -- ) + f f [ + sqlite-maybe-prepare [ + handle>> '[ [ _ ] 2dip 1+ swap sqlite-bind-text ] each-index + ] [ + sqlite-result-set new-result-set advance-row + ] bi + ] with-disposal ; + +: sql-bind-query ( in-sequence string -- out-sequence ) + f f [ + sqlite-maybe-prepare [ + handle>> '[ [ _ ] 2dip 1+ swap sqlite-bind-text ] each-index + ] [ + statement>result-sequence + ] bi + ] with-disposal ; diff --git a/extra/db2/result-sets/result-sets.factor b/extra/db2/result-sets/result-sets.factor index 8e35dc3862..6f69c26ab2 100644 --- a/extra/db2/result-sets/result-sets.factor +++ b/extra/db2/result-sets/result-sets.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel sequences ; +USING: accessors kernel sequences combinators ; IN: db2.result-sets TUPLE: result-set sql in out handle n max ; @@ -16,10 +16,14 @@ GENERIC# column-typed 1 ( result-set column -- sql ) dup #rows >>max 0 >>n ; -: new-result-set ( query handle class -- result-set ) +: new-result-set ( query class -- result-set ) new - swap >>handle - swap [ sql>> >>sql ] [ in>> >>in ] [ out>> >>out ] tri ; + swap { + [ handle>> >>handle ] + [ sql>> >>sql ] + [ in>> >>in ] + [ out>> >>out ] + } cleave ; : sql-row ( result-set -- seq ) dup #columns [ column ] with map ; diff --git a/extra/db2/sqlite/result-sets/result-sets.factor b/extra/db2/sqlite/result-sets/result-sets.factor index a8bf11fc56..e77ade567a 100644 --- a/extra/db2/sqlite/result-sets/result-sets.factor +++ b/extra/db2/sqlite/result-sets/result-sets.factor @@ -11,7 +11,7 @@ M: sqlite-result-set dispose M: sqlite-statement statement>result-set* sqlite-maybe-prepare - dup handle>> sqlite-result-set new-result-set + sqlite-result-set new-result-set dup advance-row ; M: sqlite-result-set advance-row ( result-set -- ) diff --git a/extra/db2/statements/statements-tests.factor b/extra/db2/statements/statements-tests.factor index 43564c8b29..6afcfb0c95 100644 --- a/extra/db2/statements/statements-tests.factor +++ b/extra/db2/statements/statements-tests.factor @@ -1,7 +1,7 @@ ! 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 ; +continuations db2.errors accessors ; IN: db2.statements.tests { 1 0 } [ [ drop ] statement-each ] must-infer-as @@ -11,6 +11,9 @@ IN: db2.statements.tests : test-sql-command ( -- ) [ "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);" sql-command @@ -32,7 +35,17 @@ IN: db2.statements.tests [ "selectt" sql-query ] [ sql-syntax-error? ] must-fail-with + [ ] [ + { "clubber" "windows" } + "insert into computer (name, os) values(?, ?);" + sql-bind-command + ] unit-test + + [ { { "windows" } } ] [ + { "clubber" } + "select os from computer where name = ?;" sql-bind-query + ] unit-test + ; [ test-sql-command ] test-dbs - From c9db0fdee1f4ff607a9c9ca1316e0878bf850cc5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 13 Apr 2009 17:40:35 -0500 Subject: [PATCH 10/37] refactor sqlite bind --- extra/db2/db2.factor | 4 ++-- extra/db2/sqlite/lib/lib.factor | 6 ++++++ 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/extra/db2/db2.factor b/extra/db2/db2.factor index 708caa97ab..8278d18598 100644 --- a/extra/db2/db2.factor +++ b/extra/db2/db2.factor @@ -23,7 +23,7 @@ PRIVATE> : sql-bind-command ( sequence string -- ) f f [ sqlite-maybe-prepare [ - handle>> '[ [ _ ] 2dip 1+ swap sqlite-bind-text ] each-index + handle>> swap sqlite-bind-sequence ] [ sqlite-result-set new-result-set advance-row ] bi @@ -32,7 +32,7 @@ PRIVATE> : sql-bind-query ( in-sequence string -- out-sequence ) f f [ sqlite-maybe-prepare [ - handle>> '[ [ _ ] 2dip 1+ swap sqlite-bind-text ] each-index + handle>> swap sqlite-bind-sequence ] [ statement>result-sequence ] bi diff --git a/extra/db2/sqlite/lib/lib.factor b/extra/db2/sqlite/lib/lib.factor index 34918efb8d..26c56cbbd2 100644 --- a/extra/db2/sqlite/lib/lib.factor +++ b/extra/db2/sqlite/lib/lib.factor @@ -8,6 +8,9 @@ IN: db2.sqlite.lib : ?when ( object quot -- object' ) dupd when ; inline +: assoc-with ( object sequence quot -- obj curry ) + swapd [ [ -rot ] dip call ] 2curry ; inline + : sqlite-check-result ( n -- ) { { SQLITE_OK [ ] } @@ -107,3 +110,6 @@ IN: db2.sqlite.lib : sqlite-next ( prepared -- ? ) sqlite3_step sqlite-step-has-more-rows? ; + +: sqlite-bind-sequence ( handle sequence -- ) + [ 1+ swap sqlite-bind-text ] assoc-with each-index ; From 6db099977571285c35c97d48cb475095dd283e31 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 13 Apr 2009 18:04:06 -0500 Subject: [PATCH 11/37] add raw, typed bind statements --- extra/db2/db2.factor | 23 +++++++++++++-- extra/db2/sqlite/lib/lib.factor | 6 ++++ .../db2/sqlite/result-sets/result-sets.factor | 4 +-- extra/db2/sqlite/types/types.factor | 28 ++++++++++++++++++- extra/db2/statements/statements-tests.factor | 17 ++++++++++- 5 files changed, 71 insertions(+), 7 deletions(-) diff --git a/extra/db2/db2.factor b/extra/db2/db2.factor index 8278d18598..71f181e8d7 100644 --- a/extra/db2/db2.factor +++ b/extra/db2/db2.factor @@ -2,7 +2,8 @@ ! 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 ; +destructors fry kernel math namespaces sequences strings +db2.sqlite.types ; IN: db2 sqlite-maybe-prepare [ handle>> swap sqlite-bind-sequence ] [ - sqlite-result-set new-result-set advance-row + >sqlite-result-set drop ] bi ] with-disposal ; @@ -37,3 +38,21 @@ PRIVATE> statement>result-sequence ] bi ] with-disposal ; + +: sql-bind-typed-command ( in-sequence string -- ) + f f [ + sqlite-maybe-prepare [ + handle>> swap sqlite-bind-typed-sequence + ] [ + >sqlite-result-set drop + ] bi + ] with-disposal ; + +: sql-bind-typed-query ( in-sequence string -- out-sequence ) + f f [ + sqlite-maybe-prepare [ + handle>> swap sqlite-bind-typed-sequence + ] [ + statement>result-sequence + ] bi + ] with-disposal ; diff --git a/extra/db2/sqlite/lib/lib.factor b/extra/db2/sqlite/lib/lib.factor index 26c56cbbd2..483987d803 100644 --- a/extra/db2/sqlite/lib/lib.factor +++ b/extra/db2/sqlite/lib/lib.factor @@ -50,6 +50,9 @@ IN: db2.sqlite.lib : 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 ; @@ -113,3 +116,6 @@ IN: db2.sqlite.lib : sqlite-bind-sequence ( handle sequence -- ) [ 1+ swap sqlite-bind-text ] assoc-with each-index ; + +: >sqlite-result-set ( statement -- result-set ) + sqlite-result-set new-result-set dup advance-row ; diff --git a/extra/db2/sqlite/result-sets/result-sets.factor b/extra/db2/sqlite/result-sets/result-sets.factor index e77ade567a..afc0c7bfc2 100644 --- a/extra/db2/sqlite/result-sets/result-sets.factor +++ b/extra/db2/sqlite/result-sets/result-sets.factor @@ -10,9 +10,7 @@ M: sqlite-result-set dispose f >>handle drop ; M: sqlite-statement statement>result-set* - sqlite-maybe-prepare - sqlite-result-set new-result-set - dup advance-row ; + sqlite-maybe-prepare >sqlite-result-set ; M: sqlite-result-set advance-row ( result-set -- ) dup handle>> sqlite-next >>has-more? drop ; diff --git a/extra/db2/sqlite/types/types.factor b/extra/db2/sqlite/types/types.factor index 86ad92c60e..5429de0d7c 100644 --- a/extra/db2/sqlite/types/types.factor +++ b/extra/db2/sqlite/types/types.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: arrays calendar.format combinators db2.types -db2.sqlite.ffi db2.sqlite.lib +db2.sqlite.ffi db2.sqlite.lib math fry kernel present sequences serialize urls ; IN: db2.sqlite.types @@ -29,6 +29,30 @@ IN: db2.sqlite.types [ 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 [ @@ -60,3 +84,5 @@ IN: db2.sqlite.types [ no-sql-type ] } case ; +: sqlite-bind-typed-sequence ( handle sequence -- ) + [ 1+ swap first2 swap bind-next-sqlite-type ] assoc-with each-index ; diff --git a/extra/db2/statements/statements-tests.factor b/extra/db2/statements/statements-tests.factor index 6afcfb0c95..ed4b7babb8 100644 --- a/extra/db2/statements/statements-tests.factor +++ b/extra/db2/statements/statements-tests.factor @@ -1,7 +1,7 @@ ! 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 ; +continuations db2.errors accessors db2.types ; IN: db2.statements.tests { 1 0 } [ [ drop ] statement-each ] must-infer-as @@ -46,6 +46,21 @@ IN: db2.statements.tests "select os from computer where name = ?;" sql-bind-query ] unit-test + [ { { "windows" } } ] [ + { { VARCHAR "clubber" } } + "select os from computer where name = ?;" sql-bind-typed-query + ] unit-test + + [ ] [ + { + { VARCHAR "clubber" } + { VARCHAR "windows" } + } + "insert into computer (name, os) values(?, ?);" + sql-bind-typed-command + ] unit-test + + ; [ test-sql-command ] test-dbs From 66a4ec5896b8819024ebd8db93a9eb40ef86adf9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 13 Apr 2009 18:19:37 -0500 Subject: [PATCH 12/37] more generics in the statement protocol --- extra/db2/db2.factor | 28 ++++++------------- extra/db2/sqlite/lib/lib.factor | 3 -- extra/db2/sqlite/statements/statements.factor | 8 ++---- extra/db2/sqlite/types/types.factor | 11 ++++++-- extra/db2/statements/statements.factor | 6 ++++ 5 files changed, 26 insertions(+), 30 deletions(-) diff --git a/extra/db2/db2.factor b/extra/db2/db2.factor index 71f181e8d7..8d4bfd19a0 100644 --- a/extra/db2/db2.factor +++ b/extra/db2/db2.factor @@ -23,36 +23,24 @@ PRIVATE> : sql-bind-command ( sequence string -- ) f f [ - sqlite-maybe-prepare [ - handle>> swap sqlite-bind-sequence - ] [ - >sqlite-result-set drop - ] bi + prepare-statement + [ bind-sequence ] [ statement>result-set drop ] bi ] with-disposal ; : sql-bind-query ( in-sequence string -- out-sequence ) f f [ - sqlite-maybe-prepare [ - handle>> swap sqlite-bind-sequence - ] [ - statement>result-sequence - ] bi + prepare-statement + [ bind-sequence ] [ statement>result-sequence ] bi ] with-disposal ; : sql-bind-typed-command ( in-sequence string -- ) f f [ - sqlite-maybe-prepare [ - handle>> swap sqlite-bind-typed-sequence - ] [ - >sqlite-result-set drop - ] bi + prepare-statement + [ bind-typed-sequence ] [ statement>result-set drop ] bi ] with-disposal ; : sql-bind-typed-query ( in-sequence string -- out-sequence ) f f [ - sqlite-maybe-prepare [ - handle>> swap sqlite-bind-typed-sequence - ] [ - statement>result-sequence - ] bi + prepare-statement + [ bind-typed-sequence ] [ statement>result-sequence ] bi ] with-disposal ; diff --git a/extra/db2/sqlite/lib/lib.factor b/extra/db2/sqlite/lib/lib.factor index 483987d803..f8503ee90f 100644 --- a/extra/db2/sqlite/lib/lib.factor +++ b/extra/db2/sqlite/lib/lib.factor @@ -114,8 +114,5 @@ IN: db2.sqlite.lib : sqlite-next ( prepared -- ? ) sqlite3_step sqlite-step-has-more-rows? ; -: sqlite-bind-sequence ( handle sequence -- ) - [ 1+ swap sqlite-bind-text ] assoc-with each-index ; - : >sqlite-result-set ( statement -- result-set ) sqlite-result-set new-result-set dup advance-row ; diff --git a/extra/db2/sqlite/statements/statements.factor b/extra/db2/sqlite/statements/statements.factor index a856c48075..64ce390308 100644 --- a/extra/db2/sqlite/statements/statements.factor +++ b/extra/db2/sqlite/statements/statements.factor @@ -14,8 +14,6 @@ M: sqlite-statement dispose handle>> [ [ sqlite3_reset drop ] [ sqlite-finalize ] bi ] when* ; -: sqlite-maybe-prepare ( statement -- statement ) - dup handle>> [ - db-connection get handle>> over sql>> sqlite-prepare - >>handle - ] unless ; +M: sqlite-statement prepare-statement* ( statement -- statement ) + db-connection get handle>> over sql>> sqlite-prepare + >>handle ; diff --git a/extra/db2/sqlite/types/types.factor b/extra/db2/sqlite/types/types.factor index 5429de0d7c..7124568fbe 100644 --- a/extra/db2/sqlite/types/types.factor +++ b/extra/db2/sqlite/types/types.factor @@ -84,5 +84,12 @@ IN: db2.sqlite.types [ no-sql-type ] } case ; -: sqlite-bind-typed-sequence ( handle sequence -- ) - [ 1+ swap first2 swap bind-next-sqlite-type ] assoc-with each-index ; +M: sqlite-statement bind-sequence ( sequence statement -- ) + handle>> '[ + [ _ ] 2dip 1+ swap sqlite-bind-text + ] each-index ; + +M: sqlite-statement bind-typed-sequence ( sequence statement -- ) + handle>> '[ + [ _ ] 2dip 1+ swap first2 swap bind-next-sqlite-type + ] each-index ; diff --git a/extra/db2/statements/statements.factor b/extra/db2/statements/statements.factor index 006cda3532..989391473d 100644 --- a/extra/db2/statements/statements.factor +++ b/extra/db2/statements/statements.factor @@ -15,6 +15,9 @@ TUPLE: statement handle sql in out type ; HOOK: 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 ( sequence statement -- ) +GENERIC: bind-typed-sequence ( sequence statement -- ) : statement>result-set ( statement -- result-set ) [ statement>result-set* ] @@ -31,6 +34,9 @@ M: object execute-statement* ( statement type -- ) [ [ execute-one-statement ] each ] [ execute-one-statement ] if ; +: prepare-statement ( statement -- statement ) + dup handle>> [ prepare-statement* ] unless ; + : statement-each ( statement quot: ( statement -- ) -- ) over more-rows? [ [ call ] 2keep over advance-row statement-each ] From d20fb81a9cbe778679702a903a72ca053c9b5c53 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 13 Apr 2009 19:51:19 -0500 Subject: [PATCH 13/37] working out the dispatch for bound queries, first stab at fql --- extra/db2/db2.factor | 45 +++++++---- extra/db2/fql/authors.txt | 1 + extra/db2/fql/fql-tests.factor | 27 +++++++ extra/db2/fql/fql.factor | 79 ++++++++++++++++++++ extra/db2/sqlite/lib/lib.factor | 10 +-- extra/db2/statements/statements-tests.factor | 17 +++-- extra/db2/utils/authors.txt | 1 + extra/db2/utils/utils.factor | 9 +++ 8 files changed, 161 insertions(+), 28 deletions(-) create mode 100644 extra/db2/fql/authors.txt create mode 100644 extra/db2/fql/fql-tests.factor create mode 100644 extra/db2/fql/fql.factor create mode 100644 extra/db2/utils/authors.txt create mode 100644 extra/db2/utils/utils.factor diff --git a/extra/db2/db2.factor b/extra/db2/db2.factor index 8d4bfd19a0..4687a6329f 100644 --- a/extra/db2/db2.factor +++ b/extra/db2/db2.factor @@ -6,41 +6,58 @@ destructors fry kernel math namespaces sequences strings db2.sqlite.types ; IN: db2 - [ execute-statement ] with-disposal ; -PRIVATE> - -: sql-command ( sql -- ) - dup string? - [ execute-sql-string ] - [ [ execute-sql-string ] each ] if ; - -: sql-query ( sql -- sequence ) +M: string sql-query ( sql -- sequence ) f f [ statement>result-sequence ] with-disposal ; -: sql-bind-command ( sequence string -- ) +M: string sql-bind-command* ( sequence string -- ) f f [ prepare-statement [ bind-sequence ] [ statement>result-set drop ] bi ] with-disposal ; -: sql-bind-query ( in-sequence string -- out-sequence ) +M: string sql-bind-query* ( in-sequence string -- out-sequence ) f f [ prepare-statement [ bind-sequence ] [ statement>result-sequence ] bi ] with-disposal ; -: sql-bind-typed-command ( in-sequence string -- ) +M: string sql-bind-typed-command* ( in-sequence string -- ) f f [ prepare-statement [ bind-typed-sequence ] [ statement>result-set drop ] bi ] with-disposal ; -: sql-bind-typed-query ( in-sequence string -- out-sequence ) +M: string sql-bind-typed-query* ( in-sequence string -- out-sequence ) f f [ prepare-statement [ bind-typed-sequence ] [ statement>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* ] with each ; +M: sequence sql-bind-query* [ sql-bind-query* ] with map ; +M: sequence sql-bind-typed-command* [ sql-bind-typed-command* ] with each ; +M: sequence sql-bind-typed-query* [ sql-bind-typed-query* ] with map ; + +! M: string sql-command [ sql-command ] each ; +! M: string sql-query [ sql-query ] map ; +! M: string sql-bind-command* sql-bind-command* ; +! M: string sql-bind-query* sql-bind-query* ; +! M: string sql-bind-typed-command sql-bind-typed-command* ; +! M: string sql-bind-typed-query sql-bind-typed-query* ; diff --git a/extra/db2/fql/authors.txt b/extra/db2/fql/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/fql/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/fql/fql-tests.factor b/extra/db2/fql/fql-tests.factor new file mode 100644 index 0000000000..6a6f782b1e --- /dev/null +++ b/extra/db2/fql/fql-tests.factor @@ -0,0 +1,27 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors db2 db2.fql db2.statements.tests db2.tester +kernel tools.test ; +IN: db2.fql.tests + +: test-fql ( -- ) + create-computer-table + + [ "insert into computer (name, os) values (?, ?);" ] + [ + "computer" { "name" "os" } { "lol" "os2" } expand-fql + sql>> + ] unit-test + + [ "select name, os from computer" ] + [ + select new + { "name" "os" } >>names + "computer" >>from + expand-fql sql>> + ] unit-test + + + ; + +[ test-fql ] test-dbs diff --git a/extra/db2/fql/fql.factor b/extra/db2/fql/fql.factor new file mode 100644 index 0000000000..78abc5ee0b --- /dev/null +++ b/extra/db2/fql/fql.factor @@ -0,0 +1,79 @@ +! 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 ; +IN: db2.fql + +TUPLE: fql-statement sql in out ; + +GENERIC: expand-fql* ( object -- sequence/fql-statement ) +GENERIC: normalize-fql ( object -- sequence/fql-statement ) + +! M: object normalize-fql ; + + +: ?1array ( obj -- array ) + dup string? [ 1array ] when ; inline + + +TUPLE: insert into names values ; +CONSTRUCTOR: insert ( into names values -- obj ) ; +M: insert normalize-fql ( insert -- insert ) + [ [ ?1array ] ?when ] change-names ; + +TUPLE: select names from where group-by order-by offset limit ; +CONSTRUCTOR: select ( names from -- obj ) ; +M: select normalize-fql ( select -- select ) + [ [ ?1array ] ?when ] change-names + [ [ ?1array ] ?when ] change-from + [ [ ?1array ] ?when ] change-group-by + [ [ ?1array ] ?when ] change-order-by ; + +TUPLE: where ; + +: expand-fql ( object1 -- object2 ) normalize-fql expand-fql* ; + +M: insert expand-fql* + [ fql-statement new ] dip + [ + { + [ "insert into " % into>> % ] + [ " (" % names>> ", " join % ")" % ] + [ " values (" % values>> length "?" ", " join % ");" % ] + [ values>> >>in ] + } cleave + ] "" make >>sql ; + +M: select expand-fql* + [ fql-statement new ] dip + [ + { + [ "select " % names>> ", " join % ] + [ " from " % from>> ", " join % ] + [ where>> [ " where " % [ expand-fql % ] when* ] when* ] + [ group-by>> [ " group by " % ", " join % ] when* ] + [ order-by>> [ " order by " % ", " join % ] when* ] + [ offset>> [ " offset " % # ] when* ] + [ limit>> [ " limit " % # ] when* ] + } cleave + ] "" make >>sql ; + + +M: fql-statement sql-command ( sql -- ) + sql>> sql-command ; + +M: fql-statement sql-query ( sql -- sequence ) + sql>> sql-query ; + +M: fql-statement sql-bind-command ( fql-statement -- ) + [ in>> ] [ sql>> ] bi sql-bind-command* ; + +M: fql-statement sql-bind-query ( fql-statement -- out-sequence ) + [ in>> ] [ sql>> ] bi sql-bind-query* ; + +M: fql-statement sql-bind-typed-command ( string -- ) + [ in>> ] [ sql>> ] bi sql-bind-typed-command* ; + +M: fql-statement sql-bind-typed-query ( string -- out-sequence ) + [ in>> ] [ sql>> ] bi sql-bind-typed-query* ; diff --git a/extra/db2/sqlite/lib/lib.factor b/extra/db2/sqlite/lib/lib.factor index f8503ee90f..261a2d42f3 100644 --- a/extra/db2/sqlite/lib/lib.factor +++ b/extra/db2/sqlite/lib/lib.factor @@ -1,16 +1,12 @@ ! 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.connections db2.sqlite.ffi db2.errors +combinators db2.connections db2.errors db2.result-sets +db2.sqlite.errors db2.sqlite.ffi db2.sqlite.result-sets io.backend io.encodings.string io.encodings.utf8 kernel math -namespaces present sequences serialize urls db2.sqlite.errors ; +namespaces present sequences serialize urls ; IN: db2.sqlite.lib -: ?when ( object quot -- object' ) dupd when ; inline - -: assoc-with ( object sequence quot -- obj curry ) - swapd [ [ -rot ] dip call ] 2curry ; inline - : sqlite-check-result ( n -- ) { { SQLITE_OK [ ] } diff --git a/extra/db2/statements/statements-tests.factor b/extra/db2/statements/statements-tests.factor index ed4b7babb8..56c73211c9 100644 --- a/extra/db2/statements/statements-tests.factor +++ b/extra/db2/statements/statements-tests.factor @@ -7,8 +7,7 @@ IN: db2.statements.tests { 1 0 } [ [ drop ] statement-each ] must-infer-as { 1 1 } [ [ ] statement-map ] must-infer-as - -: test-sql-command ( -- ) +: create-computer-table ( -- ) [ "drop table computer;" sql-command ] ignore-errors [ "drop table computer;" sql-command ] @@ -17,7 +16,11 @@ IN: db2.statements.tests [ ] [ "create table computer(name varchar, os varchar);" sql-command - ] unit-test + ] unit-test ; + + +: test-sql-command ( -- ) + create-computer-table [ ] [ "insert into computer (name, os) values('rocky', 'mac');" @@ -38,17 +41,17 @@ IN: db2.statements.tests [ ] [ { "clubber" "windows" } "insert into computer (name, os) values(?, ?);" - sql-bind-command + sql-bind-command* ] unit-test [ { { "windows" } } ] [ { "clubber" } - "select os from computer where name = ?;" sql-bind-query + "select os from computer where name = ?;" sql-bind-query* ] unit-test [ { { "windows" } } ] [ { { VARCHAR "clubber" } } - "select os from computer where name = ?;" sql-bind-typed-query + "select os from computer where name = ?;" sql-bind-typed-query* ] unit-test [ ] [ @@ -57,7 +60,7 @@ IN: db2.statements.tests { VARCHAR "windows" } } "insert into computer (name, os) values(?, ?);" - sql-bind-typed-command + sql-bind-typed-command* ] unit-test diff --git a/extra/db2/utils/authors.txt b/extra/db2/utils/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/utils/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/utils/utils.factor b/extra/db2/utils/utils.factor new file mode 100644 index 0000000000..2f5c9a277a --- /dev/null +++ b/extra/db2/utils/utils.factor @@ -0,0 +1,9 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel ; +IN: db2.utils + +: ?when ( object quot -- object' ) dupd when ; inline + +: assoc-with ( object sequence quot -- obj curry ) + swapd [ [ -rot ] dip call ] 2curry ; inline From 7ab58fa3b3f4752e14e0b4f19b5f3697edfd0f01 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 13 Apr 2009 19:53:53 -0500 Subject: [PATCH 14/37] add test for all features of select except where clauses --- extra/db2/fql/fql-tests.factor | 11 +++++++++++ extra/db2/fql/fql.factor | 2 -- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/extra/db2/fql/fql-tests.factor b/extra/db2/fql/fql-tests.factor index 6a6f782b1e..cb1bee24ca 100644 --- a/extra/db2/fql/fql-tests.factor +++ b/extra/db2/fql/fql-tests.factor @@ -21,6 +21,17 @@ IN: db2.fql.tests 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 ; diff --git a/extra/db2/fql/fql.factor b/extra/db2/fql/fql.factor index 78abc5ee0b..222135606e 100644 --- a/extra/db2/fql/fql.factor +++ b/extra/db2/fql/fql.factor @@ -12,11 +12,9 @@ GENERIC: normalize-fql ( object -- sequence/fql-statement ) ! M: object normalize-fql ; - : ?1array ( obj -- array ) dup string? [ 1array ] when ; inline - TUPLE: insert into names values ; CONSTRUCTOR: insert ( into names values -- obj ) ; M: insert normalize-fql ( insert -- insert ) From 447a55418c0740ce9566a0c273dde3a88b280167 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 13 Apr 2009 20:26:48 -0500 Subject: [PATCH 15/37] add update, delete to fql --- extra/db2/fql/fql-tests.factor | 20 ++++++++++++++++ extra/db2/fql/fql.factor | 44 ++++++++++++++++++++++++++++++++-- 2 files changed, 62 insertions(+), 2 deletions(-) diff --git a/extra/db2/fql/fql-tests.factor b/extra/db2/fql/fql-tests.factor index cb1bee24ca..ca7b46b283 100644 --- a/extra/db2/fql/fql-tests.factor +++ b/extra/db2/fql/fql-tests.factor @@ -33,6 +33,26 @@ IN: db2.fql.tests 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 diff --git a/extra/db2/fql/fql.factor b/extra/db2/fql/fql.factor index 222135606e..b71258c9d2 100644 --- a/extra/db2/fql/fql.factor +++ b/extra/db2/fql/fql.factor @@ -2,7 +2,7 @@ ! 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 ; +kernel make math.parser sequences strings assocs ; IN: db2.fql TUPLE: fql-statement sql in out ; @@ -20,6 +20,20 @@ CONSTRUCTOR: insert ( into names values -- obj ) ; M: insert normalize-fql ( insert -- insert ) [ [ ?1array ] ?when ] 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 ] ?when ] change-tables + [ [ ?1array ] ?when ] change-keys + [ [ ?1array ] ?when ] change-values + [ [ ?1array ] ?when ] change-order-by ; + +TUPLE: delete tables where order-by limit ; +CONSTRUCTOR: delete ( tables keys values where -- obj ) ; +M: delete normalize-fql ( insert -- insert ) + [ [ ?1array ] ?when ] change-tables + [ [ ?1array ] ?when ] 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 ) @@ -43,6 +57,33 @@ M: insert expand-fql* } cleave ] "" make >>sql ; +M: update expand-fql* + [ fql-statement new ] dip + [ + { + [ "update " % tables>> ", " join % ] + [ + " set " % [ keys>> ] [ values>> ] bi + zip [ ", " % ] [ first2 [ % ] dip " = " % % ] interleave + ] + ! [ " " % from>> ", " join % ] + [ where>> [ " where " % [ expand-fql % ] when* ] when* ] + [ order-by>> [ " order by " % ", " join % ] when* ] + [ limit>> [ " limit " % # ] when* ] + } cleave + ] "" make >>sql ; + +M: delete expand-fql* + [ fql-statement new ] dip + [ + { + [ "delete from " % tables>> ", " join % ] + [ where>> [ " where " % [ expand-fql % ] when* ] when* ] + [ order-by>> [ " order by " % ", " join % ] when* ] + [ limit>> [ " limit " % # ] when* ] + } cleave + ] "" make >>sql ; + M: select expand-fql* [ fql-statement new ] dip [ @@ -57,7 +98,6 @@ M: select expand-fql* } cleave ] "" make >>sql ; - M: fql-statement sql-command ( sql -- ) sql>> sql-command ; From 7fcf5d55623a8dff41ae486e6fa152bcb7c11064 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 13 Apr 2009 20:50:32 -0500 Subject: [PATCH 16/37] remove check for GLU from factor.sh --- build-support/factor.sh | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/build-support/factor.sh b/build-support/factor.sh index ad64c541fe..e3c56b13c8 100755 --- a/build-support/factor.sh +++ b/build-support/factor.sh @@ -139,7 +139,6 @@ check_library_exists() { } check_X11_libraries() { - check_library_exists GLU check_library_exists GL check_library_exists X11 check_library_exists pango-1.0 @@ -491,7 +490,7 @@ make_boot_image() { } install_build_system_apt() { - sudo apt-get --yes install libc6-dev libpango1.0-dev libx11-dev xorg-dev glutg3-dev wget git-core git-doc rlwrap gcc make + sudo apt-get --yes install libc6-dev libpango1.0-dev libx11-dev xorg-dev wget git-core git-doc rlwrap gcc make check_ret sudo } From 0f4711abe3e48cc7c41f383be3ec1b6de4a9c964 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 13 Apr 2009 21:41:01 -0500 Subject: [PATCH 17/37] support AND and OR for where slot --- extra/db2/fql/fql-tests.factor | 18 +++++++++-- extra/db2/fql/fql.factor | 57 ++++++++++++++++++++++------------ extra/db2/utils/utils.factor | 2 ++ 3 files changed, 56 insertions(+), 21 deletions(-) diff --git a/extra/db2/fql/fql-tests.factor b/extra/db2/fql/fql-tests.factor index ca7b46b283..84698c09c2 100644 --- a/extra/db2/fql/fql-tests.factor +++ b/extra/db2/fql/fql-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors db2 db2.fql db2.statements.tests db2.tester -kernel tools.test ; +USING: accessors db2 db2.statements.tests db2.tester +kernel tools.test db2.fql ; IN: db2.fql.tests : test-fql ( -- ) @@ -33,6 +33,20 @@ IN: db2.fql.tests 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 diff --git a/extra/db2/fql/fql.factor b/extra/db2/fql/fql.factor index b71258c9d2..e286e56a81 100644 --- a/extra/db2/fql/fql.factor +++ b/extra/db2/fql/fql.factor @@ -2,7 +2,7 @@ ! 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 ; +kernel make math.parser sequences strings assocs db2.utils ; IN: db2.fql TUPLE: fql-statement sql in out ; @@ -12,40 +12,59 @@ GENERIC: normalize-fql ( object -- sequence/fql-statement ) ! M: object normalize-fql ; -: ?1array ( obj -- array ) - dup string? [ 1array ] when ; inline - TUPLE: insert into names values ; CONSTRUCTOR: insert ( into names values -- obj ) ; M: insert normalize-fql ( insert -- insert ) - [ [ ?1array ] ?when ] change-names ; + [ ??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 ] ?when ] change-tables - [ [ ?1array ] ?when ] change-keys - [ [ ?1array ] ?when ] change-values - [ [ ?1array ] ?when ] change-order-by ; + [ ??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 ] ?when ] change-tables - [ [ ?1array ] ?when ] change-order-by ; + [ ??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 ] ?when ] change-names - [ [ ?1array ] ?when ] change-from - [ [ ?1array ] ?when ] change-group-by - [ [ ?1array ] ?when ] change-order-by ; + [ ??1array ] change-names + [ ??1array ] change-from + [ ??1array ] change-group-by + [ ??1array ] change-order-by ; -TUPLE: where ; +! 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* [ fql-statement new ] dip [ @@ -67,7 +86,7 @@ M: update expand-fql* zip [ ", " % ] [ first2 [ % ] dip " = " % % ] interleave ] ! [ " " % from>> ", " join % ] - [ where>> [ " where " % [ expand-fql % ] when* ] when* ] + [ where>> [ " where " % expand-fql* % ] when* ] [ order-by>> [ " order by " % ", " join % ] when* ] [ limit>> [ " limit " % # ] when* ] } cleave @@ -78,7 +97,7 @@ M: delete expand-fql* [ { [ "delete from " % tables>> ", " join % ] - [ where>> [ " where " % [ expand-fql % ] when* ] when* ] + [ where>> [ " where " % expand-fql* % ] when* ] [ order-by>> [ " order by " % ", " join % ] when* ] [ limit>> [ " limit " % # ] when* ] } cleave @@ -90,7 +109,7 @@ M: select expand-fql* { [ "select " % names>> ", " join % ] [ " from " % from>> ", " join % ] - [ where>> [ " where " % [ expand-fql % ] when* ] when* ] + [ where>> [ " where " % expand-fql* % ] when* ] [ group-by>> [ " group by " % ", " join % ] when* ] [ order-by>> [ " order by " % ", " join % ] when* ] [ offset>> [ " offset " % # ] when* ] diff --git a/extra/db2/utils/utils.factor b/extra/db2/utils/utils.factor index 2f5c9a277a..c9b009e917 100644 --- a/extra/db2/utils/utils.factor +++ b/extra/db2/utils/utils.factor @@ -4,6 +4,8 @@ USING: kernel ; 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 : assoc-with ( object sequence quot -- obj curry ) swapd [ [ -rot ] dip call ] 2curry ; inline From 14948008405aaaa72fe44e645d7168a03d08d309 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 14 Apr 2009 11:26:54 -0500 Subject: [PATCH 18/37] add introspection vocab to examine tables --- extra/db2/db2.factor | 7 ---- extra/db2/introspection/authors.txt | 1 + extra/db2/introspection/introspection.factor | 34 +++++++++++++++++ .../db2/sqlite/connections/connections.factor | 5 --- extra/db2/sqlite/introspection/authors.txt | 1 + .../introspection/introspection-tests.factor | 38 +++++++++++++++++++ .../sqlite/introspection/introspection.factor | 16 ++++++++ extra/db2/sqlite/statements/statements.factor | 2 +- extra/db2/sqlite/types/types.factor | 15 ++++++-- extra/db2/utils/utils.factor | 5 ++- 10 files changed, 107 insertions(+), 17 deletions(-) create mode 100644 extra/db2/introspection/authors.txt create mode 100644 extra/db2/introspection/introspection.factor create mode 100644 extra/db2/sqlite/introspection/authors.txt create mode 100644 extra/db2/sqlite/introspection/introspection-tests.factor create mode 100644 extra/db2/sqlite/introspection/introspection.factor diff --git a/extra/db2/db2.factor b/extra/db2/db2.factor index 4687a6329f..bda3d7ad70 100644 --- a/extra/db2/db2.factor +++ b/extra/db2/db2.factor @@ -54,10 +54,3 @@ M: sequence sql-bind-command* [ sql-bind-command* ] with each ; M: sequence sql-bind-query* [ sql-bind-query* ] with map ; M: sequence sql-bind-typed-command* [ sql-bind-typed-command* ] with each ; M: sequence sql-bind-typed-query* [ sql-bind-typed-query* ] with map ; - -! M: string sql-command [ sql-command ] each ; -! M: string sql-query [ sql-query ] map ; -! M: string sql-bind-command* sql-bind-command* ; -! M: string sql-bind-query* sql-bind-query* ; -! M: string sql-bind-typed-command sql-bind-typed-command* ; -! M: string sql-bind-typed-query sql-bind-typed-query* ; diff --git a/extra/db2/introspection/authors.txt b/extra/db2/introspection/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/introspection/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/introspection/introspection.factor b/extra/db2/introspection/introspection.factor new file mode 100644 index 0000000000..8ab08876aa --- /dev/null +++ b/extra/db2/introspection/introspection.factor @@ -0,0 +1,34 @@ +! 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 ) + skip-whitespace + [ " " take-until-sequence ] + [ take-token sqlite-type>fql-type ] + [ take-rest ] tri ; + +: parse-columns ( string -- seq ) + "," split [ parse-column ] map ; + +M: object parse-create-statement ( string -- table-schema ) + { + [ "CREATE TABLE " take-sequence* ] + [ "(" take-until-sequence ] + [ "(" take-sequence* ] + [ take-rest [ CHAR: ) = ] trim-tail parse-columns ] + } cleave ; + +: query-table-schema ( name -- table-schema ) + query-table-schema* [ parse-create-statement ] map ; diff --git a/extra/db2/sqlite/connections/connections.factor b/extra/db2/sqlite/connections/connections.factor index b99603f4ef..ae96e58d28 100644 --- a/extra/db2/sqlite/connections/connections.factor +++ b/extra/db2/sqlite/connections/connections.factor @@ -4,11 +4,6 @@ USING: accessors combinators db2.connections db2.sqlite db2.sqlite.errors db2.sqlite.lib kernel db2.errors ; IN: db2.sqlite.connections -TUPLE: sqlite-db-connection < db-connection ; - -: ( handle -- db-connection ) - sqlite-db-connection new-db-connection ; - M: sqlite-db db-open ( db -- db-connection ) path>> sqlite-open ; diff --git a/extra/db2/sqlite/introspection/authors.txt b/extra/db2/sqlite/introspection/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/db2/sqlite/introspection/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/db2/sqlite/introspection/introspection-tests.factor b/extra/db2/sqlite/introspection/introspection-tests.factor new file mode 100644 index 0000000000..d8ebc4d60e --- /dev/null +++ b/extra/db2/sqlite/introspection/introspection-tests.factor @@ -0,0 +1,38 @@ +! 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 diff --git a/extra/db2/sqlite/introspection/introspection.factor b/extra/db2/sqlite/introspection/introspection.factor new file mode 100644 index 0000000000..41def2c558 --- /dev/null +++ b/extra/db2/sqlite/introspection/introspection.factor @@ -0,0 +1,16 @@ +! 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 ; diff --git a/extra/db2/sqlite/statements/statements.factor b/extra/db2/sqlite/statements/statements.factor index 64ce390308..0033ad06e1 100644 --- a/extra/db2/sqlite/statements/statements.factor +++ b/extra/db2/sqlite/statements/statements.factor @@ -2,7 +2,7 @@ ! 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 ; +namespaces db2.sqlite ; IN: db2.sqlite.statements TUPLE: sqlite-statement < statement ; diff --git a/extra/db2/sqlite/types/types.factor b/extra/db2/sqlite/types/types.factor index 7124568fbe..c8df3b2272 100644 --- a/extra/db2/sqlite/types/types.factor +++ b/extra/db2/sqlite/types/types.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays calendar.format combinators db2.types -db2.sqlite.ffi db2.sqlite.lib math fry -kernel present sequences serialize urls ; +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 -- ) @@ -93,3 +94,11 @@ M: sqlite-statement bind-typed-sequence ( sequence statement -- ) handle>> '[ [ _ ] 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 ; diff --git a/extra/db2/utils/utils.factor b/extra/db2/utils/utils.factor index c9b009e917..71fa9bc5ae 100644 --- a/extra/db2/utils/utils.factor +++ b/extra/db2/utils/utils.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel ; +USING: arrays kernel math math.parser strings ; IN: db2.utils : ?when ( object quot -- object' ) dupd when ; inline @@ -9,3 +9,6 @@ IN: db2.utils : assoc-with ( object sequence quot -- obj curry ) swapd [ [ -rot ] dip call ] 2curry ; inline + +: ?number>string ( n/string -- string ) + dup number? [ number>string ] when ; From 6f1d15e84c1eaaa917f61a61ed5bab0cdaf22393 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 14 Apr 2009 16:14:40 -0500 Subject: [PATCH 19/37] refactoring the db protocol, remove fql-statements --- extra/db2/db2.factor | 43 ++++++++++---------- extra/db2/fql/fql.factor | 32 +++------------ extra/db2/result-sets/result-sets.factor | 2 +- extra/db2/sqlite/types/types.factor | 8 ++-- extra/db2/statements/statements-tests.factor | 21 ++++++---- extra/db2/statements/statements.factor | 8 +++- 6 files changed, 51 insertions(+), 63 deletions(-) diff --git a/extra/db2/db2.factor b/extra/db2/db2.factor index bda3d7ad70..e67cb8d200 100644 --- a/extra/db2/db2.factor +++ b/extra/db2/db2.factor @@ -8,49 +8,50 @@ IN: db2 GENERIC: sql-command ( object -- ) GENERIC: sql-query ( object -- sequence ) -GENERIC: sql-bind-command* ( sequence object -- ) -GENERIC: sql-bind-query* ( sequence object -- sequence ) -GENERIC: sql-bind-typed-command* ( sequence object -- ) -GENERIC: sql-bind-typed-query* ( sequence 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 ( sql -- ) - f f [ execute-statement ] with-disposal ; +M: string sql-command ( string -- ) + f f sql-command ; -M: string sql-query ( sql -- sequence ) - f f [ statement>result-sequence ] with-disposal ; +M: string sql-query ( string -- sequence ) + f f sql-query ; -M: string sql-bind-command* ( sequence string -- ) - f f [ +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 -- ) + [ prepare-statement [ bind-sequence ] [ statement>result-set drop ] bi ] with-disposal ; -M: string sql-bind-query* ( in-sequence string -- out-sequence ) - f f [ +M: statement sql-bind-query ( statement -- sequence ) + [ prepare-statement [ bind-sequence ] [ statement>result-sequence ] bi ] with-disposal ; -M: string sql-bind-typed-command* ( in-sequence string -- ) - f f [ +M: statement sql-bind-typed-command ( statement -- ) + [ prepare-statement [ bind-typed-sequence ] [ statement>result-set drop ] bi ] with-disposal ; -M: string sql-bind-typed-query* ( in-sequence string -- out-sequence ) - f f [ +M: statement sql-bind-typed-query ( statement -- sequence ) + [ prepare-statement [ bind-typed-sequence ] [ statement>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* ] with each ; -M: sequence sql-bind-query* [ sql-bind-query* ] with map ; -M: sequence sql-bind-typed-command* [ sql-bind-typed-command* ] with each ; -M: sequence sql-bind-typed-query* [ sql-bind-typed-query* ] with 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 ; diff --git a/extra/db2/fql/fql.factor b/extra/db2/fql/fql.factor index e286e56a81..0896899b01 100644 --- a/extra/db2/fql/fql.factor +++ b/extra/db2/fql/fql.factor @@ -5,10 +5,8 @@ db2.private db2.sqlite.lib db2.statements db2.utils destructors kernel make math.parser sequences strings assocs db2.utils ; IN: db2.fql -TUPLE: fql-statement sql in out ; - -GENERIC: expand-fql* ( object -- sequence/fql-statement ) -GENERIC: normalize-fql ( object -- sequence/fql-statement ) +GENERIC: expand-fql* ( object -- sequence/statement ) +GENERIC: normalize-fql ( object -- sequence/statement ) ! M: object normalize-fql ; @@ -66,7 +64,7 @@ M: and expand-fql* ( obj -- string ) M: string expand-fql* ( string -- string ) ; M: insert expand-fql* - [ fql-statement new ] dip + [ statement new ] dip [ { [ "insert into " % into>> % ] @@ -77,7 +75,7 @@ M: insert expand-fql* ] "" make >>sql ; M: update expand-fql* - [ fql-statement new ] dip + [ statement new ] dip [ { [ "update " % tables>> ", " join % ] @@ -93,7 +91,7 @@ M: update expand-fql* ] "" make >>sql ; M: delete expand-fql* - [ fql-statement new ] dip + [ statement new ] dip [ { [ "delete from " % tables>> ", " join % ] @@ -104,7 +102,7 @@ M: delete expand-fql* ] "" make >>sql ; M: select expand-fql* - [ fql-statement new ] dip + [ statement new ] dip [ { [ "select " % names>> ", " join % ] @@ -116,21 +114,3 @@ M: select expand-fql* [ limit>> [ " limit " % # ] when* ] } cleave ] "" make >>sql ; - -M: fql-statement sql-command ( sql -- ) - sql>> sql-command ; - -M: fql-statement sql-query ( sql -- sequence ) - sql>> sql-query ; - -M: fql-statement sql-bind-command ( fql-statement -- ) - [ in>> ] [ sql>> ] bi sql-bind-command* ; - -M: fql-statement sql-bind-query ( fql-statement -- out-sequence ) - [ in>> ] [ sql>> ] bi sql-bind-query* ; - -M: fql-statement sql-bind-typed-command ( string -- ) - [ in>> ] [ sql>> ] bi sql-bind-typed-command* ; - -M: fql-statement sql-bind-typed-query ( string -- out-sequence ) - [ in>> ] [ sql>> ] bi sql-bind-typed-query* ; diff --git a/extra/db2/result-sets/result-sets.factor b/extra/db2/result-sets/result-sets.factor index 6f69c26ab2..5bf148d4be 100644 --- a/extra/db2/result-sets/result-sets.factor +++ b/extra/db2/result-sets/result-sets.factor @@ -29,4 +29,4 @@ GENERIC# column-typed 1 ( result-set column -- sql ) dup #columns [ column ] with map ; : sql-row-typed ( result-set -- seq ) - dup #columns [ column-typed ] with map ; + dup #columns [ B column-typed ] with map ; diff --git a/extra/db2/sqlite/types/types.factor b/extra/db2/sqlite/types/types.factor index c8df3b2272..d2047c1aeb 100644 --- a/extra/db2/sqlite/types/types.factor +++ b/extra/db2/sqlite/types/types.factor @@ -85,13 +85,13 @@ IN: db2.sqlite.types [ no-sql-type ] } case ; -M: sqlite-statement bind-sequence ( sequence statement -- ) - handle>> '[ +M: sqlite-statement bind-sequence ( statement -- ) + [ in>> ] [ handle>> ] bi '[ [ _ ] 2dip 1+ swap sqlite-bind-text ] each-index ; -M: sqlite-statement bind-typed-sequence ( sequence statement -- ) - handle>> '[ +M: sqlite-statement bind-typed-sequence ( statement -- ) + [ in>> ] [ handle>> ] bi '[ [ _ ] 2dip 1+ swap first2 swap bind-next-sqlite-type ] each-index ; diff --git a/extra/db2/statements/statements-tests.factor b/extra/db2/statements/statements-tests.factor index 56c73211c9..6a4b774713 100644 --- a/extra/db2/statements/statements-tests.factor +++ b/extra/db2/statements/statements-tests.factor @@ -29,7 +29,8 @@ IN: db2.statements.tests [ { { "rocky" "mac" } } ] [ - "select name, os from computer;" sql-query + "select name, os from computer;" + f f sql-query ] unit-test [ "insert into" sql-command ] @@ -39,28 +40,30 @@ IN: db2.statements.tests [ sql-syntax-error? ] must-fail-with [ ] [ - { "clubber" "windows" } "insert into computer (name, os) values(?, ?);" - sql-bind-command* + { "clubber" "windows" } + f + sql-bind-command ] unit-test [ { { "windows" } } ] [ - { "clubber" } - "select os from computer where name = ?;" sql-bind-query* + "select os from computer where name = ?;" + { "clubber" } f sql-bind-query ] unit-test [ { { "windows" } } ] [ + "select os from computer where name = ?;" { { VARCHAR "clubber" } } - "select os from computer where name = ?;" sql-bind-typed-query* + f sql-bind-typed-query ] unit-test [ ] [ + "insert into computer (name, os) values(?, ?);" { { VARCHAR "clubber" } { VARCHAR "windows" } - } - "insert into computer (name, os) values(?, ?);" - sql-bind-typed-command* + } f + sql-bind-typed-command ] unit-test diff --git a/extra/db2/statements/statements.factor b/extra/db2/statements/statements.factor index 989391473d..929b303d4b 100644 --- a/extra/db2/statements/statements.factor +++ b/extra/db2/statements/statements.factor @@ -16,8 +16,8 @@ HOOK: 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 ( sequence statement -- ) -GENERIC: bind-typed-sequence ( sequence statement -- ) +GENERIC: bind-sequence ( statement -- ) +GENERIC: bind-typed-sequence ( statement -- ) : statement>result-set ( statement -- result-set ) [ statement>result-set* ] @@ -47,3 +47,7 @@ M: object execute-statement* ( statement type -- ) : statement>result-sequence ( statement -- sequence ) statement>result-set [ [ sql-row ] statement-map ] with-disposal ; + +: statement>typed-result-sequence ( statement -- sequence ) + [ out>> ] [ statement>result-set ] bi + [ [ sql-row-typed ] with statement-map ] with-disposal ; From 1f004a11009e95b649ea981c0845c25c87ff91c3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 14 Apr 2009 17:10:16 -0500 Subject: [PATCH 20/37] support typed queries --- extra/db2/db2.factor | 23 ++++++++++++++++++- extra/db2/result-sets/result-sets.factor | 7 +++--- .../db2/sqlite/result-sets/result-sets.factor | 8 +++++-- extra/db2/statements/statements-tests.factor | 7 +++--- extra/db2/statements/statements.factor | 14 +++++------ 5 files changed, 43 insertions(+), 16 deletions(-) diff --git a/extra/db2/db2.factor b/extra/db2/db2.factor index e67cb8d200..b14ee969be 100644 --- a/extra/db2/db2.factor +++ b/extra/db2/db2.factor @@ -6,6 +6,15 @@ 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 -- ) @@ -27,26 +36,31 @@ M: statement sql-query ( statement -- sequence ) 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>result-sequence ] bi + [ bind-typed-sequence ] [ statement>typed-result-sequence ] bi ] with-disposal ; M: sequence sql-command [ sql-command ] each ; @@ -55,3 +69,10 @@ 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 ; diff --git a/extra/db2/result-sets/result-sets.factor b/extra/db2/result-sets/result-sets.factor index 5bf148d4be..499808930a 100644 --- a/extra/db2/result-sets/result-sets.factor +++ b/extra/db2/result-sets/result-sets.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel sequences combinators ; +USING: accessors kernel sequences combinators fry ; IN: db2.result-sets TUPLE: result-set sql in out handle n max ; @@ -10,7 +10,7 @@ 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 1 ( result-set column -- sql ) +GENERIC# column-typed 2 ( result-set column type -- sql ) : init-result-set ( result-set -- result-set ) dup #rows >>max @@ -29,4 +29,5 @@ GENERIC# column-typed 1 ( result-set column -- sql ) dup #columns [ column ] with map ; : sql-row-typed ( result-set -- seq ) - dup #columns [ B column-typed ] with map ; + [ #columns ] [ out>> ] [ ] tri + '[ [ _ ] 2dip column-typed ] 2map ; diff --git a/extra/db2/sqlite/result-sets/result-sets.factor b/extra/db2/sqlite/result-sets/result-sets.factor index afc0c7bfc2..f3d677ed21 100644 --- a/extra/db2/sqlite/result-sets/result-sets.factor +++ b/extra/db2/sqlite/result-sets/result-sets.factor @@ -1,7 +1,8 @@ ! 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.statements kernel db2.sqlite.lib destructors +db2.sqlite.types ; IN: db2.sqlite.result-sets TUPLE: sqlite-result-set < result-set has-more? ; @@ -10,7 +11,7 @@ M: sqlite-result-set dispose f >>handle drop ; M: sqlite-statement statement>result-set* - sqlite-maybe-prepare >sqlite-result-set ; + prepare-statement >sqlite-result-set ; M: sqlite-result-set advance-row ( result-set -- ) dup handle>> sqlite-next >>has-more? drop ; @@ -23,3 +24,6 @@ M: sqlite-result-set #columns ( result-set -- n ) 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 ; diff --git a/extra/db2/statements/statements-tests.factor b/extra/db2/statements/statements-tests.factor index 6a4b774713..d90e70ea70 100644 --- a/extra/db2/statements/statements-tests.factor +++ b/extra/db2/statements/statements-tests.factor @@ -4,8 +4,8 @@ USING: tools.test db2.statements kernel db2 db2.tester continuations db2.errors accessors db2.types ; IN: db2.statements.tests -{ 1 0 } [ [ drop ] statement-each ] must-infer-as -{ 1 1 } [ [ ] statement-map ] must-infer-as +{ 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 @@ -54,7 +54,8 @@ IN: db2.statements.tests [ { { "windows" } } ] [ "select os from computer where name = ?;" { { VARCHAR "clubber" } } - f sql-bind-typed-query + { VARCHAR } + sql-bind-typed-query ] unit-test [ ] [ diff --git a/extra/db2/statements/statements.factor b/extra/db2/statements/statements.factor index 929b303d4b..9ddd74ded7 100644 --- a/extra/db2/statements/statements.factor +++ b/extra/db2/statements/statements.factor @@ -37,17 +37,17 @@ M: object execute-statement* ( statement type -- ) : prepare-statement ( statement -- statement ) dup handle>> [ prepare-statement* ] unless ; -: statement-each ( statement quot: ( statement -- ) -- ) +: result-set-each ( statement quot: ( statement -- ) -- ) over more-rows? - [ [ call ] 2keep over advance-row statement-each ] + [ [ call ] 2keep over advance-row result-set-each ] [ 2drop ] if ; inline recursive -: statement-map ( statement quot -- sequence ) - accumulator [ statement-each ] dip { } like ; inline +: result-set-map ( statement quot -- sequence ) + accumulator [ result-set-each ] dip { } like ; inline : statement>result-sequence ( statement -- sequence ) - statement>result-set [ [ sql-row ] statement-map ] with-disposal ; + statement>result-set [ [ sql-row ] result-set-map ] with-disposal ; : statement>typed-result-sequence ( statement -- sequence ) - [ out>> ] [ statement>result-set ] bi - [ [ sql-row-typed ] with statement-map ] with-disposal ; + statement>result-set + [ [ sql-row-typed ] result-set-map ] with-disposal ; From a3d25ed3222f554bee74f35d5df719c8065ba4f6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 14 Apr 2009 17:18:48 -0500 Subject: [PATCH 21/37] more tests --- extra/db2/statements/statements-tests.factor | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/extra/db2/statements/statements-tests.factor b/extra/db2/statements/statements-tests.factor index d90e70ea70..8a872293d9 100644 --- a/extra/db2/statements/statements-tests.factor +++ b/extra/db2/statements/statements-tests.factor @@ -14,7 +14,7 @@ IN: db2.statements.tests [ [ sql-table-missing? ] [ table>> "computer" = ] bi and ] must-fail-with [ ] [ - "create table computer(name varchar, os varchar);" + "create table computer(name varchar, os varchar, version integer);" sql-command ] unit-test ; @@ -40,8 +40,8 @@ IN: db2.statements.tests [ sql-syntax-error? ] must-fail-with [ ] [ - "insert into computer (name, os) values(?, ?);" - { "clubber" "windows" } + "insert into computer (name, os, version) values(?, ?, ?);" + { "clubber" "windows" "7" } f sql-bind-command ] unit-test @@ -51,23 +51,23 @@ IN: db2.statements.tests { "clubber" } f sql-bind-query ] unit-test - [ { { "windows" } } ] [ - "select os from computer where name = ?;" + [ { { "windows" 7 } } ] [ + "select os, version from computer where name = ?;" { { VARCHAR "clubber" } } - { VARCHAR } + { VARCHAR INTEGER } sql-bind-typed-query ] unit-test [ ] [ - "insert into computer (name, os) values(?, ?);" + "insert into computer (name, os, version) values(?, ?, ?);" { - { VARCHAR "clubber" } - { VARCHAR "windows" } + { VARCHAR "paulie" } + { VARCHAR "netbsd" } + { INTEGER 7 } } f sql-bind-typed-command ] unit-test - ; [ test-sql-command ] test-dbs From 8644c9854938dcb1efb1cd2c253cc0e06e308dd0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 14 Apr 2009 22:47:39 -0500 Subject: [PATCH 22/37] fix up tar --- extra/tar/tar.factor | 78 +++++++++++++++++++++++--------------------- 1 file changed, 41 insertions(+), 37 deletions(-) diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index 37c022fe43..e83908b002 100755 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -1,8 +1,10 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: combinators io io.files io.files.links io.directories io.pathnames io.streams.string kernel math math.parser continuations namespaces pack prettyprint sequences strings system tools.hexdump io.encodings.binary summary accessors -io.backend byte-arrays ; +io.backend byte-arrays io.streams.byte-array splitting ; IN: tar CONSTANT: zero-checksum 256 @@ -10,37 +12,35 @@ CONSTANT: block-size 512 TUPLE: tar-header name mode uid gid size mtime checksum typeflag linkname magic version uname gname devmajor devminor prefix ; + ERROR: checksum-error ; -SYMBOLS: base-dir filename ; +: trim-string ( seq -- newseq ) [ "\0 " member? ] trim ; -: tar-trim ( seq -- newseq ) [ "\0 " member? ] trim ; - -: read-c-string* ( n -- str/f ) +: read-c-string ( n -- str/f ) read [ zero? ] trim-tail [ f ] when-empty ; : read-tar-header ( -- obj ) \ tar-header new - 100 read-c-string* >>name - 8 read-c-string* tar-trim oct> >>mode - 8 read-c-string* tar-trim oct> >>uid - 8 read-c-string* tar-trim oct> >>gid - 12 read-c-string* tar-trim oct> >>size - 12 read-c-string* tar-trim oct> >>mtime - 8 read-c-string* tar-trim oct> >>checksum - read1 >>typeflag - 100 read-c-string* >>linkname - 6 read >>magic - 2 read >>version - 32 read-c-string* >>uname - 32 read-c-string* >>gname - 8 read tar-trim oct> >>devmajor - 8 read tar-trim oct> >>devminor - 155 read-c-string* >>prefix ; + 100 read-c-string >>name + 8 read-c-string trim-string oct> >>mode + 8 read-c-string trim-string oct> >>uid + 8 read-c-string trim-string oct> >>gid + 12 read-c-string trim-string oct> >>size + 12 read-c-string trim-string oct> >>mtime + 8 read-c-string trim-string oct> >>checksum + read1 >>typeflag + 100 read-c-string >>linkname + 6 read >>magic + 2 read >>version + 32 read-c-string >>uname + 32 read-c-string >>gname + 8 read trim-string oct> >>devmajor + 8 read trim-string oct> >>devminor + 155 read-c-string >>prefix ; -: header-checksum ( seq -- x ) - 148 cut-slice 8 tail-slice - [ sum ] bi@ + 256 + ; +: checksum-header ( seq -- n ) + 148 cut-slice 8 tail-slice [ sum ] bi@ + 256 + ; : read-data-blocks ( tar-header -- ) dup size>> 0 > [ @@ -60,29 +60,33 @@ SYMBOLS: base-dir filename ; ] if ; : parse-tar-header ( seq -- obj ) - [ header-checksum ] keep over zero-checksum = [ + [ checksum-header ] keep over zero-checksum = [ 2drop \ tar-header new 0 >>size 0 >>checksum ] [ - [ read-tar-header ] with-string-reader + binary [ read-tar-header ] with-byte-reader [ checksum>> = [ checksum-error ] unless ] keep ] if ; ERROR: unknown-typeflag ch ; M: unknown-typeflag summary ( obj -- str ) - ch>> 1string "Unknown typeflag: " prepend ; - -: tar-prepend-path ( path -- newpath ) - base-dir get prepend-path ; + ch>> "Unknown typeflag: " prefix ; : read/write-blocks ( tar-header path -- ) binary [ read-data-blocks ] with-file-writer ; +: prepend-current-directory ( path -- path' ) + current-directory get prepend-path ; + ! Normal file : typeflag-0 ( header -- ) - dup name>> tar-prepend-path read/write-blocks ; + dup name>> dup global_pax_header = [ + [ read-data-blocks ] with-string-writer drop + ] [ + prepend-current-directory read/write-blocks + ] if ; ! Hard link : typeflag-1 ( header -- ) unknown-typeflag ; @@ -99,7 +103,7 @@ M: unknown-typeflag summary ( obj -- str ) ! Directory : typeflag-5 ( header -- ) - name>> tar-prepend-path make-directories ; + name>> prepend-current-directory make-directories ; ! FIFO : typeflag-6 ( header -- ) unknown-typeflag ; @@ -139,7 +143,7 @@ M: unknown-typeflag summary ( obj -- str ) drop ; ! [ read-data-blocks ] keep ! >string [ zero? ] trim-tail filename set - ! filename get tar-prepend-path make-directories ; + ! filename get prepend-current-directory make-directories ; ! Multi volume continuation entry : typeflag-M ( header -- ) unknown-typeflag ; @@ -157,7 +161,7 @@ M: unknown-typeflag summary ( obj -- str ) : typeflag-X ( header -- ) unknown-typeflag ; : (parse-tar) ( -- ) - block-size read dup length 512 = [ + block-size read dup length block-size = [ parse-tar-header dup typeflag>> { @@ -189,7 +193,7 @@ M: unknown-typeflag summary ( obj -- str ) drop ] if ; -: parse-tar ( path -- ) - normalize-path dup parent-directory base-dir [ +: untar ( path -- ) + normalize-path [ ] [ parent-directory ] bi [ binary [ (parse-tar) ] with-file-reader - ] with-variable ; + ] with-directory ; From 34e945fd28cc4f2048eb84eb61acb8f4b734c78e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 14 Apr 2009 22:54:28 -0500 Subject: [PATCH 23/37] use prefix correctly --- extra/tar/tar.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index e83908b002..50d3f25593 100755 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -71,8 +71,9 @@ ERROR: checksum-error ; ] if ; ERROR: unknown-typeflag ch ; + M: unknown-typeflag summary ( obj -- str ) - ch>> "Unknown typeflag: " prefix ; + ch>> [ "Unknown typeflag: " ] dip prefix ; : read/write-blocks ( tar-header path -- ) binary [ read-data-blocks ] with-file-writer ; From 2ca8e69348b838e81bc7b2ad0b5326d00ded749e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 14 Apr 2009 22:59:45 -0500 Subject: [PATCH 24/37] fix handling of global_pax_header --- extra/tar/tar.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index 50d3f25593..297157c08b 100755 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -83,8 +83,8 @@ M: unknown-typeflag summary ( obj -- str ) ! Normal file : typeflag-0 ( header -- ) - dup name>> dup global_pax_header = [ - [ read-data-blocks ] with-string-writer drop + dup name>> dup "global_pax_header" = [ + drop [ read-data-blocks ] with-string-writer drop ] [ prepend-current-directory read/write-blocks ] if ; From 840675e242b88353a43e8fdeb1abdcaeb62a69a7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 15 Apr 2009 18:32:07 -0500 Subject: [PATCH 25/37] fix circularity --- extra/db2/sqlite/lib/lib.factor | 8 ++------ extra/db2/sqlite/result-sets/result-sets.factor | 3 ++- 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/extra/db2/sqlite/lib/lib.factor b/extra/db2/sqlite/lib/lib.factor index 261a2d42f3..e366305fcd 100644 --- a/extra/db2/sqlite/lib/lib.factor +++ b/extra/db2/sqlite/lib/lib.factor @@ -1,10 +1,9 @@ ! 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.connections db2.errors db2.result-sets -db2.sqlite.errors db2.sqlite.ffi db2.sqlite.result-sets +combinators db2.sqlite.errors io.backend io.encodings.string io.encodings.utf8 kernel math -namespaces present sequences serialize urls ; +namespaces present sequences serialize urls db2.sqlite.ffi ; IN: db2.sqlite.lib : sqlite-check-result ( n -- ) @@ -15,7 +14,6 @@ IN: db2.sqlite.lib } case ; : sqlite-open ( path -- db ) - normalize-path "void*" [ sqlite3_open sqlite-check-result ] keep *void* ; @@ -110,5 +108,3 @@ IN: db2.sqlite.lib : sqlite-next ( prepared -- ? ) sqlite3_step sqlite-step-has-more-rows? ; -: >sqlite-result-set ( statement -- result-set ) - sqlite-result-set new-result-set dup advance-row ; diff --git a/extra/db2/sqlite/result-sets/result-sets.factor b/extra/db2/sqlite/result-sets/result-sets.factor index f3d677ed21..3b3226ef39 100644 --- a/extra/db2/sqlite/result-sets/result-sets.factor +++ b/extra/db2/sqlite/result-sets/result-sets.factor @@ -11,7 +11,8 @@ M: sqlite-result-set dispose f >>handle drop ; M: sqlite-statement statement>result-set* - prepare-statement >sqlite-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 ; From f9afd7136931a5e31b89aa0f8dc5922a0d4063b6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 16 Apr 2009 15:19:05 -0500 Subject: [PATCH 26/37] add more db.utils --- extra/db2/utils/utils.factor | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/extra/db2/utils/utils.factor b/extra/db2/utils/utils.factor index 71fa9bc5ae..0557593209 100644 --- a/extra/db2/utils/utils.factor +++ b/extra/db2/utils/utils.factor @@ -1,14 +1,32 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel math math.parser strings ; +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 ; From 08d80f623742d396a9626d2242470c9d43ccf1d0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Apr 2009 21:11:50 -0500 Subject: [PATCH 27/37] use HOMEDRIVE/HOMEPATH for HOME, then USERPROFILE, the default to a directory if no env vars are set --- basis/io/files/windows/nt/nt.factor | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/basis/io/files/windows/nt/nt.factor b/basis/io/files/windows/nt/nt.factor index 9e449982fb..afc81c784c 100755 --- a/basis/io/files/windows/nt/nt.factor +++ b/basis/io/files/windows/nt/nt.factor @@ -4,7 +4,7 @@ io.backend.windows io.files.windows io.encodings.utf16n windows windows.kernel32 kernel libc math threads system environment alien.c-types alien.arrays alien.strings sequences combinators combinators.short-circuit ascii splitting alien strings assocs -namespaces make accessors tr windows.time ; +namespaces make accessors tr windows.time windows.shell32 ; IN: io.files.windows.nt M: winnt cwd @@ -58,4 +58,9 @@ M: winnt open-append [ dup windows-file-size ] [ drop 0 ] recover [ (open-append) ] dip >>ptr ; -M: winnt home "USERPROFILE" os-env ; +M: winnt home + { + [ "HOMEDRIVE" os-env "HOMEPATH" os-env append-path ] + [ "USERPROFILE" os-env ] + [ my-documents ] + } 0|| ; From 1e21f0ef4373d07bb4050b73aa7721b8329b457d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Apr 2009 21:17:18 -0500 Subject: [PATCH 28/37] better docs for emacs setup --- basis/editors/emacs/authors.txt | 1 + basis/editors/emacs/emacs-docs.factor | 19 ++++++++++++++++--- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/basis/editors/emacs/authors.txt b/basis/editors/emacs/authors.txt index 6cfd5da273..07c1c4a765 100644 --- a/basis/editors/emacs/authors.txt +++ b/basis/editors/emacs/authors.txt @@ -1 +1,2 @@ Eduardo Cavazos +Doug Coleman diff --git a/basis/editors/emacs/emacs-docs.factor b/basis/editors/emacs/emacs-docs.factor index f55068e143..adf6d8a7b7 100644 --- a/basis/editors/emacs/emacs-docs.factor +++ b/basis/editors/emacs/emacs-docs.factor @@ -2,10 +2,23 @@ USING: help help.syntax help.markup ; IN: editors.emacs ARTICLE: "editors.emacs" "Integration with Emacs" -"Put this in your " { $snippet ".emacs" } " file:" +"Full Emacs integration with Factor requires the use of two executable files -- " { $snippet "emacs" } " and " { $snippet "emacsclient" } ", which act as a client/server pair. To start the server, run the " { $snippet "emacs" } " binary and run " { $snippet "M-x server-start" } " or start " { $snippet "emacs" } " with the following line in your " { $snippet ".emacs" } " file:" { $code "(server-start)" } +"On Windows, if you install Emacs to " { $snippet "Program Files" } " or " { $snippet "Program Files(x86)" } ", Factor will automatically detect the path to " { $snippet "emacsclient.exe" } ". On Unix systems, make sure that " { $snippet "emacsclient" } " is in your path. To set the path manually, use the following snippet:" +{ $code "USE: edtiors.emacs" + "\"/my/crazy/bin/emacsclient\" emacsclient-path set-global" +} + "If you would like a new window to open when you ask Factor to edit an object, put this in your " { $snippet ".emacs" } " file:" { $code "(setq server-window 'switch-to-buffer-other-frame)" } -{ $see-also "editor" } ; -ABOUT: "editors.emacs" \ No newline at end of file +"To quickly scaffold a " { $snippet ".emacs" } " file, run the following code:" +{ $code "USE: tools.scaffold" + "scaffold-emacs" +} + +{ $see-also "editor" } + +; + +ABOUT: "editors.emacs" From 687190bbeebd5687d6392afc7030a1db03999920 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Apr 2009 21:32:23 -0500 Subject: [PATCH 29/37] fix a bug in db.tester --- basis/db/tester/tester.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/db/tester/tester.factor b/basis/db/tester/tester.factor index fcc5abf1cf..a700e3eaa2 100644 --- a/basis/db/tester/tester.factor +++ b/basis/db/tester/tester.factor @@ -3,7 +3,7 @@ USING: concurrency.combinators db.pools db.sqlite db.tuples db.types kernel math random threads tools.test db sequences io prettyprint db.postgresql db.sqlite accessors io.files.temp -namespaces fry system ; +namespaces fry system math.parser ; IN: db.tester : postgresql-test-db ( -- postgresql-db ) @@ -67,8 +67,8 @@ test-2 "TEST2" { drop 10 [ dup [ - f 100 random 100 random 100 random test-1 boa - insert-tuple yield + f 100 random 100 random 100 random [ number>string ] tri@ + test-1 boa insert-tuple yield ] with-db ] times ] with parallel-each From 706fb78d5b9ff3a9f905539e0cbee3a39ea29685 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Apr 2009 21:47:16 -0500 Subject: [PATCH 30/37] better fix for db.tester --- basis/db/tester/tester.factor | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/basis/db/tester/tester.factor b/basis/db/tester/tester.factor index a700e3eaa2..56bac7efcd 100644 --- a/basis/db/tester/tester.factor +++ b/basis/db/tester/tester.factor @@ -56,6 +56,10 @@ test-2 "TEST2" { { "z" "Z" { VARCHAR 256 } +not-null+ } } define-persistent +: test-1-tuple ( -- tuple ) + f 100 random 100 random 100 random [ number>string ] tri@ + test-1 boa ; + : db-tester ( test-db -- ) [ [ @@ -67,8 +71,7 @@ test-2 "TEST2" { drop 10 [ dup [ - f 100 random 100 random 100 random [ number>string ] tri@ - test-1 boa insert-tuple yield + test-1-tuple insert-tuple yield ] with-db ] times ] with parallel-each @@ -84,8 +87,7 @@ test-2 "TEST2" { [ 10 [ 10 [ - f 100 random 100 random 100 random test-1 boa - insert-tuple yield + test-1-tuple insert-tuple yield ] times ] parallel-each ] with-pooled-db From 2f0058e46ab0c50e7cbb6648a67a132625860bb6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Apr 2009 23:23:16 -0500 Subject: [PATCH 31/37] factor.sh now has an exit routine. it will print _something_ so it doesn't loop when looking for a make target --- build-support/factor.sh | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/build-support/factor.sh b/build-support/factor.sh index 53aab9ad04..3ece72306a 100755 --- a/build-support/factor.sh +++ b/build-support/factor.sh @@ -22,6 +22,13 @@ test_program_installed() { return 1; } +exit_script() { + if [[ $FIND_MAKE_TARGET -eq true ]] ; then + echo $MAKE_TARGET; + fi + exit $1 +} + ensure_program_installed() { installed=0; for i in $* ; @@ -43,7 +50,7 @@ ensure_program_installed() { $ECHO -n "any of [ $* ]" fi $ECHO " and try again." - exit 1 + exit_script 1; fi } @@ -51,7 +58,7 @@ check_ret() { RET=$? if [[ $RET -ne 0 ]] ; then $ECHO $1 failed - exit 2 + exit_script 2 fi } @@ -62,7 +69,7 @@ check_gcc_version() { if [[ $GCC_VERSION == *3.3.* ]] ; then $ECHO "You have a known buggy version of gcc (3.3)" $ECHO "Install gcc 3.4 or higher and try again." - exit 3 + exit_script 3 elif [[ $GCC_VERSION == *4.3.* ]] ; then MAKE_OPTS="$MAKE_OPTS SITE_CFLAGS=-fno-forward-propagate" fi @@ -154,7 +161,7 @@ check_factor_exists() { if [[ -d "factor" ]] ; then $ECHO "A directory called 'factor' already exists." $ECHO "Rename or delete it and try again." - exit 4 + exit_script 4 fi } @@ -279,7 +286,7 @@ check_os_arch_word() { $ECHO "OS, ARCH, or WORD is empty. Please report this." echo $MAKE_TARGET - exit 5 + exit_script 5 fi } @@ -385,7 +392,7 @@ check_makefile_exists() { echo "You are likely in the wrong directory." echo "Run this script from your factor directory:" echo " ./build-support/factor.sh" - exit 6 + exit_script 6 fi } @@ -536,6 +543,6 @@ case "$1" in bootstrap) get_config_info; bootstrap ;; report) find_build_info ;; net-bootstrap) get_config_info; update_boot_images; bootstrap ;; - make-target) ECHO=false; find_build_info; echo $MAKE_TARGET ;; + make-target) FIND_MAKE_TARGET=true; ECHO=false; find_build_info; exit_script ;; *) usage ;; esac From 784f34e49f70b0e00b84321856dddaa989e13ab3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 21 Apr 2009 01:44:25 -0500 Subject: [PATCH 32/37] turn off autouse for sandboxed code --- extra/sandbox/sandbox.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/sandbox/sandbox.factor b/extra/sandbox/sandbox.factor index a9d65ee5ab..097a7c8d8a 100644 --- a/extra/sandbox/sandbox.factor +++ b/extra/sandbox/sandbox.factor @@ -10,7 +10,7 @@ SYMBOL: whitelist : with-sandbox-vocabs ( quot -- ) "sandbox.syntax" load-vocab vocab-words 1vector - use [ call ] with-variable ; inline + use [ auto-use? off call ] with-variable ; inline : parse-sandbox ( lines assoc -- quot ) whitelist [ [ parse-lines ] with-sandbox-vocabs ] with-variable ; From 1a28a5e30def0484375d11fd67416c0bca3c82b5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 21 Apr 2009 02:01:35 -0500 Subject: [PATCH 33/37] accidentally checked in db2 branch. move to unmaintained for now --- {extra => unmaintained}/db2/authors.txt | 0 {extra => unmaintained}/db2/connections/authors.txt | 0 {extra => unmaintained}/db2/connections/connections-tests.factor | 0 {extra => unmaintained}/db2/connections/connections.factor | 0 {extra => unmaintained}/db2/db2-tests.factor | 0 {extra => unmaintained}/db2/db2.factor | 0 {extra => unmaintained}/db2/errors/errors.factor | 0 {extra => unmaintained}/db2/errors/summary.txt | 0 {extra => unmaintained}/db2/fql/authors.txt | 0 {extra => unmaintained}/db2/fql/fql-tests.factor | 0 {extra => unmaintained}/db2/fql/fql.factor | 0 {extra => unmaintained}/db2/introspection/authors.txt | 0 {extra => unmaintained}/db2/introspection/introspection.factor | 0 {extra => unmaintained}/db2/pools/authors.txt | 0 {extra => unmaintained}/db2/pools/pools-tests.factor | 0 {extra => unmaintained}/db2/pools/pools.factor | 0 {extra => unmaintained}/db2/result-sets/authors.txt | 0 {extra => unmaintained}/db2/result-sets/result-sets.factor | 0 {extra => unmaintained}/db2/sqlite/authors.txt | 0 {extra => unmaintained}/db2/sqlite/connections/authors.txt | 0 .../db2/sqlite/connections/connections-tests.factor | 0 {extra => unmaintained}/db2/sqlite/connections/connections.factor | 0 {extra => unmaintained}/db2/sqlite/db/authors.txt | 0 {extra => unmaintained}/db2/sqlite/db/db.factor | 0 {extra => unmaintained}/db2/sqlite/errors/authors.txt | 0 {extra => unmaintained}/db2/sqlite/errors/errors.factor | 0 {extra => unmaintained}/db2/sqlite/ffi/ffi.factor | 0 {extra => unmaintained}/db2/sqlite/introspection/authors.txt | 0 .../db2/sqlite/introspection/introspection-tests.factor | 0 .../db2/sqlite/introspection/introspection.factor | 0 {extra => unmaintained}/db2/sqlite/lib/lib.factor | 0 {extra => unmaintained}/db2/sqlite/result-sets/authors.txt | 0 {extra => unmaintained}/db2/sqlite/result-sets/result-sets.factor | 0 {extra => unmaintained}/db2/sqlite/sqlite.factor | 0 {extra => unmaintained}/db2/sqlite/statements/authors.txt | 0 {extra => unmaintained}/db2/sqlite/statements/statements.factor | 0 {extra => unmaintained}/db2/sqlite/types/authors.txt | 0 {extra => unmaintained}/db2/sqlite/types/types.factor | 0 {extra => unmaintained}/db2/statements/authors.txt | 0 {extra => unmaintained}/db2/statements/statements-tests.factor | 0 {extra => unmaintained}/db2/statements/statements.factor | 0 {extra => unmaintained}/db2/tester/authors.txt | 0 {extra => unmaintained}/db2/tester/tester-tests.factor | 0 {extra => unmaintained}/db2/tester/tester.factor | 0 {extra => unmaintained}/db2/transactions/authors.txt | 0 {extra => unmaintained}/db2/transactions/transactions.factor | 0 {extra => unmaintained}/db2/types/authors.txt | 0 {extra => unmaintained}/db2/types/types.factor | 0 {extra => unmaintained}/db2/utils/authors.txt | 0 {extra => unmaintained}/db2/utils/utils.factor | 0 50 files changed, 0 insertions(+), 0 deletions(-) rename {extra => unmaintained}/db2/authors.txt (100%) rename {extra => unmaintained}/db2/connections/authors.txt (100%) rename {extra => unmaintained}/db2/connections/connections-tests.factor (100%) rename {extra => unmaintained}/db2/connections/connections.factor (100%) rename {extra => unmaintained}/db2/db2-tests.factor (100%) rename {extra => unmaintained}/db2/db2.factor (100%) rename {extra => unmaintained}/db2/errors/errors.factor (100%) rename {extra => unmaintained}/db2/errors/summary.txt (100%) rename {extra => unmaintained}/db2/fql/authors.txt (100%) rename {extra => unmaintained}/db2/fql/fql-tests.factor (100%) rename {extra => unmaintained}/db2/fql/fql.factor (100%) rename {extra => unmaintained}/db2/introspection/authors.txt (100%) rename {extra => unmaintained}/db2/introspection/introspection.factor (100%) rename {extra => unmaintained}/db2/pools/authors.txt (100%) rename {extra => unmaintained}/db2/pools/pools-tests.factor (100%) rename {extra => unmaintained}/db2/pools/pools.factor (100%) rename {extra => unmaintained}/db2/result-sets/authors.txt (100%) rename {extra => unmaintained}/db2/result-sets/result-sets.factor (100%) rename {extra => unmaintained}/db2/sqlite/authors.txt (100%) rename {extra => unmaintained}/db2/sqlite/connections/authors.txt (100%) rename {extra => unmaintained}/db2/sqlite/connections/connections-tests.factor (100%) rename {extra => unmaintained}/db2/sqlite/connections/connections.factor (100%) rename {extra => unmaintained}/db2/sqlite/db/authors.txt (100%) rename {extra => unmaintained}/db2/sqlite/db/db.factor (100%) rename {extra => unmaintained}/db2/sqlite/errors/authors.txt (100%) rename {extra => unmaintained}/db2/sqlite/errors/errors.factor (100%) rename {extra => unmaintained}/db2/sqlite/ffi/ffi.factor (100%) rename {extra => unmaintained}/db2/sqlite/introspection/authors.txt (100%) rename {extra => unmaintained}/db2/sqlite/introspection/introspection-tests.factor (100%) rename {extra => unmaintained}/db2/sqlite/introspection/introspection.factor (100%) rename {extra => unmaintained}/db2/sqlite/lib/lib.factor (100%) rename {extra => unmaintained}/db2/sqlite/result-sets/authors.txt (100%) rename {extra => unmaintained}/db2/sqlite/result-sets/result-sets.factor (100%) rename {extra => unmaintained}/db2/sqlite/sqlite.factor (100%) rename {extra => unmaintained}/db2/sqlite/statements/authors.txt (100%) rename {extra => unmaintained}/db2/sqlite/statements/statements.factor (100%) rename {extra => unmaintained}/db2/sqlite/types/authors.txt (100%) rename {extra => unmaintained}/db2/sqlite/types/types.factor (100%) rename {extra => unmaintained}/db2/statements/authors.txt (100%) rename {extra => unmaintained}/db2/statements/statements-tests.factor (100%) rename {extra => unmaintained}/db2/statements/statements.factor (100%) rename {extra => unmaintained}/db2/tester/authors.txt (100%) rename {extra => unmaintained}/db2/tester/tester-tests.factor (100%) rename {extra => unmaintained}/db2/tester/tester.factor (100%) rename {extra => unmaintained}/db2/transactions/authors.txt (100%) rename {extra => unmaintained}/db2/transactions/transactions.factor (100%) rename {extra => unmaintained}/db2/types/authors.txt (100%) rename {extra => unmaintained}/db2/types/types.factor (100%) rename {extra => unmaintained}/db2/utils/authors.txt (100%) rename {extra => unmaintained}/db2/utils/utils.factor (100%) diff --git a/extra/db2/authors.txt b/unmaintained/db2/authors.txt similarity index 100% rename from extra/db2/authors.txt rename to unmaintained/db2/authors.txt diff --git a/extra/db2/connections/authors.txt b/unmaintained/db2/connections/authors.txt similarity index 100% rename from extra/db2/connections/authors.txt rename to unmaintained/db2/connections/authors.txt diff --git a/extra/db2/connections/connections-tests.factor b/unmaintained/db2/connections/connections-tests.factor similarity index 100% rename from extra/db2/connections/connections-tests.factor rename to unmaintained/db2/connections/connections-tests.factor diff --git a/extra/db2/connections/connections.factor b/unmaintained/db2/connections/connections.factor similarity index 100% rename from extra/db2/connections/connections.factor rename to unmaintained/db2/connections/connections.factor diff --git a/extra/db2/db2-tests.factor b/unmaintained/db2/db2-tests.factor similarity index 100% rename from extra/db2/db2-tests.factor rename to unmaintained/db2/db2-tests.factor diff --git a/extra/db2/db2.factor b/unmaintained/db2/db2.factor similarity index 100% rename from extra/db2/db2.factor rename to unmaintained/db2/db2.factor diff --git a/extra/db2/errors/errors.factor b/unmaintained/db2/errors/errors.factor similarity index 100% rename from extra/db2/errors/errors.factor rename to unmaintained/db2/errors/errors.factor diff --git a/extra/db2/errors/summary.txt b/unmaintained/db2/errors/summary.txt similarity index 100% rename from extra/db2/errors/summary.txt rename to unmaintained/db2/errors/summary.txt diff --git a/extra/db2/fql/authors.txt b/unmaintained/db2/fql/authors.txt similarity index 100% rename from extra/db2/fql/authors.txt rename to unmaintained/db2/fql/authors.txt diff --git a/extra/db2/fql/fql-tests.factor b/unmaintained/db2/fql/fql-tests.factor similarity index 100% rename from extra/db2/fql/fql-tests.factor rename to unmaintained/db2/fql/fql-tests.factor diff --git a/extra/db2/fql/fql.factor b/unmaintained/db2/fql/fql.factor similarity index 100% rename from extra/db2/fql/fql.factor rename to unmaintained/db2/fql/fql.factor diff --git a/extra/db2/introspection/authors.txt b/unmaintained/db2/introspection/authors.txt similarity index 100% rename from extra/db2/introspection/authors.txt rename to unmaintained/db2/introspection/authors.txt diff --git a/extra/db2/introspection/introspection.factor b/unmaintained/db2/introspection/introspection.factor similarity index 100% rename from extra/db2/introspection/introspection.factor rename to unmaintained/db2/introspection/introspection.factor diff --git a/extra/db2/pools/authors.txt b/unmaintained/db2/pools/authors.txt similarity index 100% rename from extra/db2/pools/authors.txt rename to unmaintained/db2/pools/authors.txt diff --git a/extra/db2/pools/pools-tests.factor b/unmaintained/db2/pools/pools-tests.factor similarity index 100% rename from extra/db2/pools/pools-tests.factor rename to unmaintained/db2/pools/pools-tests.factor diff --git a/extra/db2/pools/pools.factor b/unmaintained/db2/pools/pools.factor similarity index 100% rename from extra/db2/pools/pools.factor rename to unmaintained/db2/pools/pools.factor diff --git a/extra/db2/result-sets/authors.txt b/unmaintained/db2/result-sets/authors.txt similarity index 100% rename from extra/db2/result-sets/authors.txt rename to unmaintained/db2/result-sets/authors.txt diff --git a/extra/db2/result-sets/result-sets.factor b/unmaintained/db2/result-sets/result-sets.factor similarity index 100% rename from extra/db2/result-sets/result-sets.factor rename to unmaintained/db2/result-sets/result-sets.factor diff --git a/extra/db2/sqlite/authors.txt b/unmaintained/db2/sqlite/authors.txt similarity index 100% rename from extra/db2/sqlite/authors.txt rename to unmaintained/db2/sqlite/authors.txt diff --git a/extra/db2/sqlite/connections/authors.txt b/unmaintained/db2/sqlite/connections/authors.txt similarity index 100% rename from extra/db2/sqlite/connections/authors.txt rename to unmaintained/db2/sqlite/connections/authors.txt diff --git a/extra/db2/sqlite/connections/connections-tests.factor b/unmaintained/db2/sqlite/connections/connections-tests.factor similarity index 100% rename from extra/db2/sqlite/connections/connections-tests.factor rename to unmaintained/db2/sqlite/connections/connections-tests.factor diff --git a/extra/db2/sqlite/connections/connections.factor b/unmaintained/db2/sqlite/connections/connections.factor similarity index 100% rename from extra/db2/sqlite/connections/connections.factor rename to unmaintained/db2/sqlite/connections/connections.factor diff --git a/extra/db2/sqlite/db/authors.txt b/unmaintained/db2/sqlite/db/authors.txt similarity index 100% rename from extra/db2/sqlite/db/authors.txt rename to unmaintained/db2/sqlite/db/authors.txt diff --git a/extra/db2/sqlite/db/db.factor b/unmaintained/db2/sqlite/db/db.factor similarity index 100% rename from extra/db2/sqlite/db/db.factor rename to unmaintained/db2/sqlite/db/db.factor diff --git a/extra/db2/sqlite/errors/authors.txt b/unmaintained/db2/sqlite/errors/authors.txt similarity index 100% rename from extra/db2/sqlite/errors/authors.txt rename to unmaintained/db2/sqlite/errors/authors.txt diff --git a/extra/db2/sqlite/errors/errors.factor b/unmaintained/db2/sqlite/errors/errors.factor similarity index 100% rename from extra/db2/sqlite/errors/errors.factor rename to unmaintained/db2/sqlite/errors/errors.factor diff --git a/extra/db2/sqlite/ffi/ffi.factor b/unmaintained/db2/sqlite/ffi/ffi.factor similarity index 100% rename from extra/db2/sqlite/ffi/ffi.factor rename to unmaintained/db2/sqlite/ffi/ffi.factor diff --git a/extra/db2/sqlite/introspection/authors.txt b/unmaintained/db2/sqlite/introspection/authors.txt similarity index 100% rename from extra/db2/sqlite/introspection/authors.txt rename to unmaintained/db2/sqlite/introspection/authors.txt diff --git a/extra/db2/sqlite/introspection/introspection-tests.factor b/unmaintained/db2/sqlite/introspection/introspection-tests.factor similarity index 100% rename from extra/db2/sqlite/introspection/introspection-tests.factor rename to unmaintained/db2/sqlite/introspection/introspection-tests.factor diff --git a/extra/db2/sqlite/introspection/introspection.factor b/unmaintained/db2/sqlite/introspection/introspection.factor similarity index 100% rename from extra/db2/sqlite/introspection/introspection.factor rename to unmaintained/db2/sqlite/introspection/introspection.factor diff --git a/extra/db2/sqlite/lib/lib.factor b/unmaintained/db2/sqlite/lib/lib.factor similarity index 100% rename from extra/db2/sqlite/lib/lib.factor rename to unmaintained/db2/sqlite/lib/lib.factor diff --git a/extra/db2/sqlite/result-sets/authors.txt b/unmaintained/db2/sqlite/result-sets/authors.txt similarity index 100% rename from extra/db2/sqlite/result-sets/authors.txt rename to unmaintained/db2/sqlite/result-sets/authors.txt diff --git a/extra/db2/sqlite/result-sets/result-sets.factor b/unmaintained/db2/sqlite/result-sets/result-sets.factor similarity index 100% rename from extra/db2/sqlite/result-sets/result-sets.factor rename to unmaintained/db2/sqlite/result-sets/result-sets.factor diff --git a/extra/db2/sqlite/sqlite.factor b/unmaintained/db2/sqlite/sqlite.factor similarity index 100% rename from extra/db2/sqlite/sqlite.factor rename to unmaintained/db2/sqlite/sqlite.factor diff --git a/extra/db2/sqlite/statements/authors.txt b/unmaintained/db2/sqlite/statements/authors.txt similarity index 100% rename from extra/db2/sqlite/statements/authors.txt rename to unmaintained/db2/sqlite/statements/authors.txt diff --git a/extra/db2/sqlite/statements/statements.factor b/unmaintained/db2/sqlite/statements/statements.factor similarity index 100% rename from extra/db2/sqlite/statements/statements.factor rename to unmaintained/db2/sqlite/statements/statements.factor diff --git a/extra/db2/sqlite/types/authors.txt b/unmaintained/db2/sqlite/types/authors.txt similarity index 100% rename from extra/db2/sqlite/types/authors.txt rename to unmaintained/db2/sqlite/types/authors.txt diff --git a/extra/db2/sqlite/types/types.factor b/unmaintained/db2/sqlite/types/types.factor similarity index 100% rename from extra/db2/sqlite/types/types.factor rename to unmaintained/db2/sqlite/types/types.factor diff --git a/extra/db2/statements/authors.txt b/unmaintained/db2/statements/authors.txt similarity index 100% rename from extra/db2/statements/authors.txt rename to unmaintained/db2/statements/authors.txt diff --git a/extra/db2/statements/statements-tests.factor b/unmaintained/db2/statements/statements-tests.factor similarity index 100% rename from extra/db2/statements/statements-tests.factor rename to unmaintained/db2/statements/statements-tests.factor diff --git a/extra/db2/statements/statements.factor b/unmaintained/db2/statements/statements.factor similarity index 100% rename from extra/db2/statements/statements.factor rename to unmaintained/db2/statements/statements.factor diff --git a/extra/db2/tester/authors.txt b/unmaintained/db2/tester/authors.txt similarity index 100% rename from extra/db2/tester/authors.txt rename to unmaintained/db2/tester/authors.txt diff --git a/extra/db2/tester/tester-tests.factor b/unmaintained/db2/tester/tester-tests.factor similarity index 100% rename from extra/db2/tester/tester-tests.factor rename to unmaintained/db2/tester/tester-tests.factor diff --git a/extra/db2/tester/tester.factor b/unmaintained/db2/tester/tester.factor similarity index 100% rename from extra/db2/tester/tester.factor rename to unmaintained/db2/tester/tester.factor diff --git a/extra/db2/transactions/authors.txt b/unmaintained/db2/transactions/authors.txt similarity index 100% rename from extra/db2/transactions/authors.txt rename to unmaintained/db2/transactions/authors.txt diff --git a/extra/db2/transactions/transactions.factor b/unmaintained/db2/transactions/transactions.factor similarity index 100% rename from extra/db2/transactions/transactions.factor rename to unmaintained/db2/transactions/transactions.factor diff --git a/extra/db2/types/authors.txt b/unmaintained/db2/types/authors.txt similarity index 100% rename from extra/db2/types/authors.txt rename to unmaintained/db2/types/authors.txt diff --git a/extra/db2/types/types.factor b/unmaintained/db2/types/types.factor similarity index 100% rename from extra/db2/types/types.factor rename to unmaintained/db2/types/types.factor diff --git a/extra/db2/utils/authors.txt b/unmaintained/db2/utils/authors.txt similarity index 100% rename from extra/db2/utils/authors.txt rename to unmaintained/db2/utils/authors.txt diff --git a/extra/db2/utils/utils.factor b/unmaintained/db2/utils/utils.factor similarity index 100% rename from extra/db2/utils/utils.factor rename to unmaintained/db2/utils/utils.factor From 11be11605f48c90fc3fac66ed45b6c6888d98471 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 21 Apr 2009 02:15:01 -0500 Subject: [PATCH 34/37] remove db2 from unmaintained --- unmaintained/db2/authors.txt | 1 - unmaintained/db2/connections/authors.txt | 1 - .../db2/connections/connections-tests.factor | 8 - .../db2/connections/connections.factor | 20 --- unmaintained/db2/db2-tests.factor | 5 - unmaintained/db2/db2.factor | 78 ---------- unmaintained/db2/errors/errors.factor | 42 ------ unmaintained/db2/errors/summary.txt | 1 - unmaintained/db2/fql/authors.txt | 1 - unmaintained/db2/fql/fql-tests.factor | 72 --------- unmaintained/db2/fql/fql.factor | 116 -------------- unmaintained/db2/introspection/authors.txt | 1 - .../db2/introspection/introspection.factor | 34 ----- unmaintained/db2/pools/authors.txt | 1 - unmaintained/db2/pools/pools-tests.factor | 23 --- unmaintained/db2/pools/pools.factor | 20 --- unmaintained/db2/result-sets/authors.txt | 1 - .../db2/result-sets/result-sets.factor | 33 ---- unmaintained/db2/sqlite/authors.txt | 1 - .../db2/sqlite/connections/authors.txt | 1 - .../connections/connections-tests.factor | 4 - .../db2/sqlite/connections/connections.factor | 17 --- unmaintained/db2/sqlite/db/authors.txt | 1 - unmaintained/db2/sqlite/db/db.factor | 12 -- unmaintained/db2/sqlite/errors/authors.txt | 1 - unmaintained/db2/sqlite/errors/errors.factor | 35 ----- unmaintained/db2/sqlite/ffi/ffi.factor | 142 ------------------ .../db2/sqlite/introspection/authors.txt | 1 - .../introspection/introspection-tests.factor | 38 ----- .../sqlite/introspection/introspection.factor | 16 -- unmaintained/db2/sqlite/lib/lib.factor | 110 -------------- .../db2/sqlite/result-sets/authors.txt | 1 - .../db2/sqlite/result-sets/result-sets.factor | 30 ---- unmaintained/db2/sqlite/sqlite.factor | 12 -- .../db2/sqlite/statements/authors.txt | 1 - .../db2/sqlite/statements/statements.factor | 19 --- unmaintained/db2/sqlite/types/authors.txt | 1 - unmaintained/db2/sqlite/types/types.factor | 104 ------------- unmaintained/db2/statements/authors.txt | 1 - .../db2/statements/statements-tests.factor | 73 --------- unmaintained/db2/statements/statements.factor | 53 ------- unmaintained/db2/tester/authors.txt | 2 - unmaintained/db2/tester/tester-tests.factor | 7 - unmaintained/db2/tester/tester.factor | 96 ------------ unmaintained/db2/transactions/authors.txt | 1 - .../db2/transactions/transactions.factor | 26 ---- unmaintained/db2/types/authors.txt | 1 - unmaintained/db2/types/types.factor | 17 --- unmaintained/db2/utils/authors.txt | 1 - unmaintained/db2/utils/utils.factor | 32 ---- 50 files changed, 1315 deletions(-) delete mode 100644 unmaintained/db2/authors.txt delete mode 100644 unmaintained/db2/connections/authors.txt delete mode 100644 unmaintained/db2/connections/connections-tests.factor delete mode 100644 unmaintained/db2/connections/connections.factor delete mode 100644 unmaintained/db2/db2-tests.factor delete mode 100644 unmaintained/db2/db2.factor delete mode 100644 unmaintained/db2/errors/errors.factor delete mode 100644 unmaintained/db2/errors/summary.txt delete mode 100644 unmaintained/db2/fql/authors.txt delete mode 100644 unmaintained/db2/fql/fql-tests.factor delete mode 100644 unmaintained/db2/fql/fql.factor delete mode 100644 unmaintained/db2/introspection/authors.txt delete mode 100644 unmaintained/db2/introspection/introspection.factor delete mode 100644 unmaintained/db2/pools/authors.txt delete mode 100644 unmaintained/db2/pools/pools-tests.factor delete mode 100644 unmaintained/db2/pools/pools.factor delete mode 100644 unmaintained/db2/result-sets/authors.txt delete mode 100644 unmaintained/db2/result-sets/result-sets.factor delete mode 100644 unmaintained/db2/sqlite/authors.txt delete mode 100644 unmaintained/db2/sqlite/connections/authors.txt delete mode 100644 unmaintained/db2/sqlite/connections/connections-tests.factor delete mode 100644 unmaintained/db2/sqlite/connections/connections.factor delete mode 100644 unmaintained/db2/sqlite/db/authors.txt delete mode 100644 unmaintained/db2/sqlite/db/db.factor delete mode 100644 unmaintained/db2/sqlite/errors/authors.txt delete mode 100644 unmaintained/db2/sqlite/errors/errors.factor delete mode 100644 unmaintained/db2/sqlite/ffi/ffi.factor delete mode 100644 unmaintained/db2/sqlite/introspection/authors.txt delete mode 100644 unmaintained/db2/sqlite/introspection/introspection-tests.factor delete mode 100644 unmaintained/db2/sqlite/introspection/introspection.factor delete mode 100644 unmaintained/db2/sqlite/lib/lib.factor delete mode 100644 unmaintained/db2/sqlite/result-sets/authors.txt delete mode 100644 unmaintained/db2/sqlite/result-sets/result-sets.factor delete mode 100644 unmaintained/db2/sqlite/sqlite.factor delete mode 100644 unmaintained/db2/sqlite/statements/authors.txt delete mode 100644 unmaintained/db2/sqlite/statements/statements.factor delete mode 100644 unmaintained/db2/sqlite/types/authors.txt delete mode 100644 unmaintained/db2/sqlite/types/types.factor delete mode 100644 unmaintained/db2/statements/authors.txt delete mode 100644 unmaintained/db2/statements/statements-tests.factor delete mode 100644 unmaintained/db2/statements/statements.factor delete mode 100644 unmaintained/db2/tester/authors.txt delete mode 100644 unmaintained/db2/tester/tester-tests.factor delete mode 100644 unmaintained/db2/tester/tester.factor delete mode 100644 unmaintained/db2/transactions/authors.txt delete mode 100644 unmaintained/db2/transactions/transactions.factor delete mode 100644 unmaintained/db2/types/authors.txt delete mode 100644 unmaintained/db2/types/types.factor delete mode 100644 unmaintained/db2/utils/authors.txt delete mode 100644 unmaintained/db2/utils/utils.factor diff --git a/unmaintained/db2/authors.txt b/unmaintained/db2/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/connections/authors.txt b/unmaintained/db2/connections/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/connections/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/connections/connections-tests.factor b/unmaintained/db2/connections/connections-tests.factor deleted file mode 100644 index f96a201bf6..0000000000 --- a/unmaintained/db2/connections/connections-tests.factor +++ /dev/null @@ -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 diff --git a/unmaintained/db2/connections/connections.factor b/unmaintained/db2/connections/connections.factor deleted file mode 100644 index 7957cb918a..0000000000 --- a/unmaintained/db2/connections/connections.factor +++ /dev/null @@ -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 diff --git a/unmaintained/db2/db2-tests.factor b/unmaintained/db2/db2-tests.factor deleted file mode 100644 index 30ee7b3581..0000000000 --- a/unmaintained/db2/db2-tests.factor +++ /dev/null @@ -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 - diff --git a/unmaintained/db2/db2.factor b/unmaintained/db2/db2.factor deleted file mode 100644 index b14ee969be..0000000000 --- a/unmaintained/db2/db2.factor +++ /dev/null @@ -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 sql-command ; - -M: string sql-query ( string -- sequence ) - f f 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 ; diff --git a/unmaintained/db2/errors/errors.factor b/unmaintained/db2/errors/errors.factor deleted file mode 100644 index 45353f6fb9..0000000000 --- a/unmaintained/db2/errors/errors.factor +++ /dev/null @@ -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 diff --git a/unmaintained/db2/errors/summary.txt b/unmaintained/db2/errors/summary.txt deleted file mode 100644 index 1cd102173f..0000000000 --- a/unmaintained/db2/errors/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Errors thrown by database library diff --git a/unmaintained/db2/fql/authors.txt b/unmaintained/db2/fql/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/fql/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/fql/fql-tests.factor b/unmaintained/db2/fql/fql-tests.factor deleted file mode 100644 index 84698c09c2..0000000000 --- a/unmaintained/db2/fql/fql-tests.factor +++ /dev/null @@ -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" } 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 diff --git a/unmaintained/db2/fql/fql.factor b/unmaintained/db2/fql/fql.factor deleted file mode 100644 index 0896899b01..0000000000 --- a/unmaintained/db2/fql/fql.factor +++ /dev/null @@ -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 "?" ", " 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 ; diff --git a/unmaintained/db2/introspection/authors.txt b/unmaintained/db2/introspection/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/introspection/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/introspection/introspection.factor b/unmaintained/db2/introspection/introspection.factor deleted file mode 100644 index 8ab08876aa..0000000000 --- a/unmaintained/db2/introspection/introspection.factor +++ /dev/null @@ -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 ) - skip-whitespace - [ " " take-until-sequence ] - [ take-token sqlite-type>fql-type ] - [ take-rest ] tri ; - -: parse-columns ( string -- seq ) - "," split [ parse-column ] map ; - -M: object parse-create-statement ( string -- table-schema ) - { - [ "CREATE TABLE " take-sequence* ] - [ "(" take-until-sequence ] - [ "(" take-sequence* ] - [ take-rest [ CHAR: ) = ] trim-tail parse-columns ] - } cleave ; - -: query-table-schema ( name -- table-schema ) - query-table-schema* [ parse-create-statement ] map ; diff --git a/unmaintained/db2/pools/authors.txt b/unmaintained/db2/pools/authors.txt deleted file mode 100644 index 1901f27a24..0000000000 --- a/unmaintained/db2/pools/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/unmaintained/db2/pools/pools-tests.factor b/unmaintained/db2/pools/pools-tests.factor deleted file mode 100644 index d61b745b03..0000000000 --- a/unmaintained/db2/pools/pools-tests.factor +++ /dev/null @@ -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 - -\ 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 "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 diff --git a/unmaintained/db2/pools/pools.factor b/unmaintained/db2/pools/pools.factor deleted file mode 100644 index 2b1aa2f0bf..0000000000 --- a/unmaintained/db2/pools/pools.factor +++ /dev/null @@ -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 - swap >>db ; - -: with-db-pool ( db quot -- ) - [ ] 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 diff --git a/unmaintained/db2/result-sets/authors.txt b/unmaintained/db2/result-sets/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/result-sets/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/result-sets/result-sets.factor b/unmaintained/db2/result-sets/result-sets.factor deleted file mode 100644 index 499808930a..0000000000 --- a/unmaintained/db2/result-sets/result-sets.factor +++ /dev/null @@ -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 ; diff --git a/unmaintained/db2/sqlite/authors.txt b/unmaintained/db2/sqlite/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/sqlite/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/sqlite/connections/authors.txt b/unmaintained/db2/sqlite/connections/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/sqlite/connections/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/sqlite/connections/connections-tests.factor b/unmaintained/db2/sqlite/connections/connections-tests.factor deleted file mode 100644 index ed80810508..0000000000 --- a/unmaintained/db2/sqlite/connections/connections-tests.factor +++ /dev/null @@ -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 diff --git a/unmaintained/db2/sqlite/connections/connections.factor b/unmaintained/db2/sqlite/connections/connections.factor deleted file mode 100644 index ae96e58d28..0000000000 --- a/unmaintained/db2/sqlite/connections/connections.factor +++ /dev/null @@ -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 ; - -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 ; diff --git a/unmaintained/db2/sqlite/db/authors.txt b/unmaintained/db2/sqlite/db/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/sqlite/db/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/sqlite/db/db.factor b/unmaintained/db2/sqlite/db/db.factor deleted file mode 100644 index d5d580cb1a..0000000000 --- a/unmaintained/db2/sqlite/db/db.factor +++ /dev/null @@ -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 ; - -: ( path -- sqlite-db ) - sqlite-db new - swap >>path ; - - diff --git a/unmaintained/db2/sqlite/errors/authors.txt b/unmaintained/db2/sqlite/errors/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/sqlite/errors/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/sqlite/errors/errors.factor b/unmaintained/db2/sqlite/errors/errors.factor deleted file mode 100644 index 61e70f210d..0000000000 --- a/unmaintained/db2/sqlite/errors/errors.factor +++ /dev/null @@ -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 - -EBNF: parse-sqlite-sql-error - -TableMessage = " already exists" -SyntaxError = ": syntax error" - -SqliteError = - "table " (!(TableMessage).)+:table TableMessage:message - => [[ table >string ]] - | "near " (!(SyntaxError).)+:syntax SyntaxError:message - => [[ syntax >string ]] - | "no such table: " .+:table - => [[ table >string ]] - | .*:error - => [[ error >string ]] -;EBNF - -: throw-sqlite-error ( n -- * ) - dup sqlite-error-messages nth sqlite-error ; diff --git a/unmaintained/db2/sqlite/ffi/ffi.factor b/unmaintained/db2/sqlite/ffi/ffi.factor deleted file mode 100644 index 2594978ddf..0000000000 --- a/unmaintained/db2/sqlite/ffi/ffi.factor +++ /dev/null @@ -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 ) ; diff --git a/unmaintained/db2/sqlite/introspection/authors.txt b/unmaintained/db2/sqlite/introspection/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/sqlite/introspection/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/sqlite/introspection/introspection-tests.factor b/unmaintained/db2/sqlite/introspection/introspection-tests.factor deleted file mode 100644 index d8ebc4d60e..0000000000 --- a/unmaintained/db2/sqlite/introspection/introspection-tests.factor +++ /dev/null @@ -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 diff --git a/unmaintained/db2/sqlite/introspection/introspection.factor b/unmaintained/db2/sqlite/introspection/introspection.factor deleted file mode 100644 index 41def2c558..0000000000 --- a/unmaintained/db2/sqlite/introspection/introspection.factor +++ /dev/null @@ -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 ; diff --git a/unmaintained/db2/sqlite/lib/lib.factor b/unmaintained/db2/sqlite/lib/lib.factor deleted file mode 100644 index e366305fcd..0000000000 --- a/unmaintained/db2/sqlite/lib/lib.factor +++ /dev/null @@ -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*" - [ 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*" "void*" - [ 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? ; - diff --git a/unmaintained/db2/sqlite/result-sets/authors.txt b/unmaintained/db2/sqlite/result-sets/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/sqlite/result-sets/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/sqlite/result-sets/result-sets.factor b/unmaintained/db2/sqlite/result-sets/result-sets.factor deleted file mode 100644 index 3b3226ef39..0000000000 --- a/unmaintained/db2/sqlite/result-sets/result-sets.factor +++ /dev/null @@ -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 ; diff --git a/unmaintained/db2/sqlite/sqlite.factor b/unmaintained/db2/sqlite/sqlite.factor deleted file mode 100644 index 82337ae30b..0000000000 --- a/unmaintained/db2/sqlite/sqlite.factor +++ /dev/null @@ -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 ; - -: ( handle -- db-connection ) - sqlite-db-connection new-db-connection ; diff --git a/unmaintained/db2/sqlite/statements/authors.txt b/unmaintained/db2/sqlite/statements/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/sqlite/statements/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/sqlite/statements/statements.factor b/unmaintained/db2/sqlite/statements/statements.factor deleted file mode 100644 index 0033ad06e1..0000000000 --- a/unmaintained/db2/sqlite/statements/statements.factor +++ /dev/null @@ -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 ( 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 ; diff --git a/unmaintained/db2/sqlite/types/authors.txt b/unmaintained/db2/sqlite/types/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/sqlite/types/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/sqlite/types/types.factor b/unmaintained/db2/sqlite/types/types.factor deleted file mode 100644 index d2047c1aeb..0000000000 --- a/unmaintained/db2/sqlite/types/types.factor +++ /dev/null @@ -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 ; diff --git a/unmaintained/db2/statements/authors.txt b/unmaintained/db2/statements/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/statements/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/statements/statements-tests.factor b/unmaintained/db2/statements/statements-tests.factor deleted file mode 100644 index 8a872293d9..0000000000 --- a/unmaintained/db2/statements/statements-tests.factor +++ /dev/null @@ -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 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 - sql-bind-command - ] unit-test - - [ { { "windows" } } ] [ - "select os from computer where name = ?;" - { "clubber" } f sql-bind-query - ] unit-test - - [ { { "windows" 7 } } ] [ - "select os, version from computer where name = ?;" - { { VARCHAR "clubber" } } - { VARCHAR INTEGER } - sql-bind-typed-query - ] unit-test - - [ ] [ - "insert into computer (name, os, version) values(?, ?, ?);" - { - { VARCHAR "paulie" } - { VARCHAR "netbsd" } - { INTEGER 7 } - } f - sql-bind-typed-command - ] unit-test - - ; - -[ test-sql-command ] test-dbs diff --git a/unmaintained/db2/statements/statements.factor b/unmaintained/db2/statements/statements.factor deleted file mode 100644 index 9ddd74ded7..0000000000 --- a/unmaintained/db2/statements/statements.factor +++ /dev/null @@ -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: 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 ; diff --git a/unmaintained/db2/tester/authors.txt b/unmaintained/db2/tester/authors.txt deleted file mode 100644 index f372b574ae..0000000000 --- a/unmaintained/db2/tester/authors.txt +++ /dev/null @@ -1,2 +0,0 @@ -Slava Pestov -Doug Coleman diff --git a/unmaintained/db2/tester/tester-tests.factor b/unmaintained/db2/tester/tester-tests.factor deleted file mode 100644 index b3e8f19e6a..0000000000 --- a/unmaintained/db2/tester/tester-tests.factor +++ /dev/null @@ -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 diff --git a/unmaintained/db2/tester/tester.factor b/unmaintained/db2/tester/tester.factor deleted file mode 100644 index 471752f413..0000000000 --- a/unmaintained/db2/tester/tester.factor +++ /dev/null @@ -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 ; - -! 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 ) - - "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 - ] [ - [ - 10 [ - 10 [ - f 100 random 100 random 100 random test-1 boa - insert-tuple yield - ] times - ] parallel-each - ] with-pooled-db - ] bi ; -*/ diff --git a/unmaintained/db2/transactions/authors.txt b/unmaintained/db2/transactions/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/transactions/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/transactions/transactions.factor b/unmaintained/db2/transactions/transactions.factor deleted file mode 100644 index fd0e6ade74..0000000000 --- a/unmaintained/db2/transactions/transactions.factor +++ /dev/null @@ -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 diff --git a/unmaintained/db2/types/authors.txt b/unmaintained/db2/types/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/types/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/types/types.factor b/unmaintained/db2/types/types.factor deleted file mode 100644 index 97f9ca0a0c..0000000000 --- a/unmaintained/db2/types/types.factor +++ /dev/null @@ -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 ; diff --git a/unmaintained/db2/utils/authors.txt b/unmaintained/db2/utils/authors.txt deleted file mode 100644 index b4bd0e7b35..0000000000 --- a/unmaintained/db2/utils/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman \ No newline at end of file diff --git a/unmaintained/db2/utils/utils.factor b/unmaintained/db2/utils/utils.factor deleted file mode 100644 index 0557593209..0000000000 --- a/unmaintained/db2/utils/utils.factor +++ /dev/null @@ -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 ; From 3d5995b3b4faadd0e71e604f0ef1a01c67abba40 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 21 Apr 2009 16:10:42 -0500 Subject: [PATCH 35/37] Two quick fixes --- basis/compiler/tree/optimizer/optimizer.factor | 1 - basis/compiler/tree/propagation/inlining/inlining.factor | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/basis/compiler/tree/optimizer/optimizer.factor b/basis/compiler/tree/optimizer/optimizer.factor index daa8f072ca..fe3c7acb92 100644 --- a/basis/compiler/tree/optimizer/optimizer.factor +++ b/basis/compiler/tree/optimizer/optimizer.factor @@ -29,7 +29,6 @@ SYMBOL: check-optimizer? normalize propagate cleanup - ?check dup run-escape-analysis? [ escape-analysis unbox-tuples diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor index 7ae44a5293..df9c7be024 100755 --- a/basis/compiler/tree/propagation/inlining/inlining.factor +++ b/basis/compiler/tree/propagation/inlining/inlining.factor @@ -170,7 +170,7 @@ SYMBOL: history ] if ; : inline-word ( #call word -- ? ) - dup specialized-def inline-word-def ; + dup def>> inline-word-def ; : inline-method-body ( #call word -- ? ) 2dup should-inline? [ inline-word ] [ 2drop f ] if ; From bd8787d540f624d6a2c4211d7e4d3ae37e871fa0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 21 Apr 2009 16:23:54 -0500 Subject: [PATCH 36/37] Tweak unit test in classes vocab to yield more information on failure --- core/classes/classes-tests.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor index 08746d1ba7..61d153f064 100644 --- a/core/classes/classes-tests.factor +++ b/core/classes/classes-tests.factor @@ -3,7 +3,7 @@ io.streams.string kernel math namespaces parser prettyprint sequences strings tools.test vectors words quotations classes classes.private classes.union classes.mixin classes.predicate classes.algebra vectors definitions source-files compiler.units -kernel.private sorting vocabs memory eval accessors ; +kernel.private sorting vocabs memory eval accessors sets ; IN: classes.tests [ t ] [ 3 object instance? ] unit-test @@ -22,10 +22,11 @@ M: method-forget-class method-forget-test ; [ ] [ [ \ method-forget-class forget ] with-compilation-unit ] unit-test [ t ] [ \ method-forget-test "methods" word-prop assoc-empty? ] unit-test -[ t ] [ +[ { } { } ] [ all-words [ class? ] filter implementors-map get keys - [ natural-sort ] bi@ = + [ natural-sort ] bi@ + [ diff ] [ swap diff ] 2bi ] unit-test ! Minor leak From b18081929c70920265194d37528ca37846c6228e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 21 Apr 2009 16:25:04 -0500 Subject: [PATCH 37/37] Remove copyright notice from license --- license.txt | 2 -- 1 file changed, 2 deletions(-) diff --git a/license.txt b/license.txt index 8f4f53585a..e9cd58a5e4 100644 --- a/license.txt +++ b/license.txt @@ -1,5 +1,3 @@ -Copyright (C) 2003, 2009 Slava Pestov and friends. - Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: