From 509399b620e7046abac9bb67a84ce1a90c6b3b04 Mon Sep 17 00:00:00 2001
From: Maxim Savchenko <pdunan@gmail.com>
Date: Wed, 1 Apr 2009 19:11:08 -0400
Subject: [PATCH 01/34] 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
+
+<PRIVATE
+
+ERROR: sandbox-error vocab ;
+
+: sandbox-use+ ( alias -- )
+ dup whitelist get at [ use+ ] [ sandbox-error ] ?if ;
+
+PRIVATE>
+
+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 <erg@jobim.local>
Date: Sat, 11 Apr 2009 13:02:47 -0500
Subject: [PATCH 02/34] 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
+
+<PRIVATE
+
+: execute-sql-string ( string -- )
+ f f <statement> [ 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> [ 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: <statement> 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 <erg@jobim.local>
Date: Sat, 11 Apr 2009 13:44:06 -0500
Subject: [PATCH 03/34] 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 <sql-table-exists> ]]
+ | Error ("relation "|"table ")(!(" does not exist").)+:table " does not exist"
+ => [[ table >string unquote <sql-table-missing> ]]
+
+FunctionError =
+ Error "function" (!(" already exists").)+:table " already exists"
+ => [[ table >string <sql-function-exists> ]]
+ | Error "function" (!(" does not exist").)+:table " does not exist"
+ => [[ table >string <sql-function-missing> ]]
+
+SyntaxError =
+ Error "syntax error at end of input":error
+ => [[ error >string <sql-syntax-error> ]]
+ | Error "syntax error at or near " .+:syntaxerror
+ => [[ syntaxerror >string unquote <sql-syntax-error> ]]
+
+UnknownError = .* => [[ >string <sql-unknown-error> ]]
+
+PostgresqlSqlError = (TableError | FunctionError | SyntaxError | UnknownError)
+
+;EBNF
+
+
+ERROR: parse-postgresql-location column line text ;
+C: <parse-postgresql-location> parse-postgresql-location
+
+EBNF: parse-postgresql-line-error
+
+Line = "LINE " [0-9]+:line ": " .+:sql
+ => [[ f line >string string>number sql >string <parse-postgresql-location> ]]
+
+;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 <sqlite-db> [
+
+ [
+ "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> 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 ]]
+
+SqliteError =
+ "table " (!(TableMessage).)+:table TableMessage:message
+ => [[ table >string message sqlite-table-error ]]
+ | "no such table: " .+:table
+ => [[ table >string <sql-table-missing> ]]
+ | .*:error
+ => [[ error >string <unparsed-sqlite-error> ]]
+;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 ;
+
+\ <db-pool> must-infer
+
+{ 1 0 } [ [ ] with-db-pool ] must-infer-as
+
+{ 1 0 } [ [ ] with-pooled-db ] must-infer-as
+
+! Test behavior after image save/load
+USE: db.sqlite
+
+[ "pool-test.db" temp-file delete-file ] ignore-errors
+
+[ ] [ "pool-test.db" temp-file <sqlite-db> <db-pool> "pool" set ] unit-test
+
+[ ] [ "pool" get expired>> t >>expired drop ] unit-test
+
+[ ] [ 1000 [ "pool" get [ ] with-pooled-db ] times ] unit-test
+
+[ ] [ "pool" get dispose ] unit-test
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 )
+ db-pool <pool>
+ swap >>db ;
+
+: with-db-pool ( db quot -- )
+ [ <db-pool> ] dip with-pool ; inline
+
+M: db-pool make-connection ( pool -- )
+ db>> db-open ;
+
+: with-pooled-db ( pool quot -- )
+ '[ db-connection _ with-variable ] with-pooled-connection ; inline
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*" <c-object>
+ [ sqlite3_open sqlite-check-result ] keep *void* ;
+
+: sqlite-close ( db -- )
+ sqlite3_close sqlite-check-result ;
+
+: sqlite-prepare ( db sql -- handle )
+ utf8 encode dup length "void*" <c-object> "void*" <c-object>
+ [ sqlite3_prepare_v2 sqlite-check-result ] 2keep
+ drop *void* ;
+
+: sqlite-bind-parameter-index ( handle name -- index )
+ sqlite3_bind_parameter_index ;
+
+: parameter-index ( handle name text -- handle name text )
+ [ dupd sqlite-bind-parameter-index ] dip ;
+
+: sqlite-bind-text ( handle index text -- )
+ utf8 encode dup length SQLITE_TRANSIENT
+ sqlite3_bind_text sqlite-check-result ;
+
+: sqlite-bind-int ( handle i n -- )
+ sqlite3_bind_int sqlite-check-result ;
+
+: sqlite-bind-int64 ( handle i n -- )
+ sqlite3_bind_int64 sqlite-check-result ;
+
+: sqlite-bind-uint64 ( handle i n -- )
+ sqlite3-bind-uint64 sqlite-check-result ;
+
+: sqlite-bind-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 <erg@jobim.local>
Date: Sat, 11 Apr 2009 13:46:25 -0500
Subject: [PATCH 04/34] 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 <erg@jobim.local>
Date: Sat, 11 Apr 2009 16:19:41 -0500
Subject: [PATCH 05/34] 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" <sequence-parser> take-c-integer ] unit-test
+
+[ 36 ]
+[
+ " //jofiejoe\n //eoieow\n/*asdf*/\n "
+ <sequence-parser> skip-whitespace/comments n>>
+] unit-test
+
+[ f ]
+[ "\n" <sequence-parser> take-integer ] unit-test
+
+[ "\n" ] [ "\n" <sequence-parser> [ ] take-while ] unit-test
+[ f ] [ "\n" <sequence-parser> [ 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 <erg@jobim.local>
Date: Sat, 11 Apr 2009 20:21:04 -0500
Subject: [PATCH 06/34] 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
\ <db-pool> 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 ;
+
+: <sqlite-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 <erg@jobim.local>
Date: Sat, 11 Apr 2009 21:05:18 -0500
Subject: [PATCH 07/34] 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 <sql-table-exists> ]]
- | Error ("relation "|"table ")(!(" does not exist").)+:table " does not exist"
- => [[ table >string unquote <sql-table-missing> ]]
-
-FunctionError =
- Error "function" (!(" already exists").)+:table " already exists"
- => [[ table >string <sql-function-exists> ]]
- | Error "function" (!(" does not exist").)+:table " does not exist"
- => [[ table >string <sql-function-missing> ]]
-
-SyntaxError =
- Error "syntax error at end of input":error
- => [[ error >string <sql-syntax-error> ]]
- | Error "syntax error at or near " .+:syntaxerror
- => [[ syntaxerror >string unquote <sql-syntax-error> ]]
-
-UnknownError = .* => [[ >string <sql-unknown-error> ]]
-
-PostgresqlSqlError = (TableError | FunctionError | SyntaxError | UnknownError)
-
-;EBNF
-
-
-ERROR: parse-postgresql-location column line text ;
-C: <parse-postgresql-location> parse-postgresql-location
-
-EBNF: parse-postgresql-line-error
-
-Line = "LINE " [0-9]+:line ": " .+:sql
- => [[ f line >string string>number sql >string <parse-postgresql-location> ]]
-
-;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 <sqlite-db> [
-
- [
- "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 ;
+
+: <sqlite-db-connection> ( handle -- db-connection )
+ sqlite-db-connection new-db-connection ;
+
+M: sqlite-db db-open ( db -- db-connection )
+ path>> sqlite-open <sqlite-db-connection> ;
+
+M: sqlite-db-connection db-close ( db-connection -- )
+ handle>> sqlite-close ;
+
+M: sqlite-db-connection parse-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 ;
+
+: <sqlite-db> ( 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> unparsed-sqlite-error
-SINGLETONS: table-exists table-missing ;
-
: sqlite-table-error ( table message -- error )
{
- { table-exists [ <sql-table-exists> ] }
+ { sql-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 <statement> ( 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 <sqlite-db> ;
+
+! These words leak resources, but are useful for interactivel testing
+: set-sqlite-db ( -- )
+ sqlite-db db-open db-connection set ;
+
+: test-sqlite ( quot -- )
+ '[
+ [ ] [ sqlite-test-db _ with-db ] unit-test
+ ] call ; inline
+
+: test-dbs ( quot -- )
+ {
+ [ test-sqlite ]
+ } cleave ;
+
+/*
+: postgresql-test-db ( -- postgresql-db )
+ <postgresql-db>
+ "localhost" >>host
+ "postgres" >>username
+ "thepasswordistrust" >>password
+ "factor-test" >>database ;
+
+: set-postgresql-db ( -- )
+ postgresql-db db-open db-connection set ;
+
+: test-postgresql ( quot -- )
+ '[
+ os windows? cpu x86.64? and [
+ [ ] [ postgresql-test-db _ with-db ] unit-test
+ ] unless
+ ] call ; inline
+
+TUPLE: test-1 id a b c ;
+
+test-1 "TEST1" {
+ { "id" "ID" INTEGER +db-assigned-id+ }
+ { "a" "A" { VARCHAR 256 } +not-null+ }
+ { "b" "B" { VARCHAR 256 } +not-null+ }
+ { "c" "C" { VARCHAR 256 } +not-null+ }
+} define-persistent
+
+TUPLE: test-2 id x y z ;
+
+test-2 "TEST2" {
+ { "id" "ID" INTEGER +db-assigned-id+ }
+ { "x" "X" { VARCHAR 256 } +not-null+ }
+ { "y" "Y" { VARCHAR 256 } +not-null+ }
+ { "z" "Z" { VARCHAR 256 } +not-null+ }
+} define-persistent
+
+: db-tester ( test-db -- )
+ [
+ [
+ test-1 ensure-table
+ test-2 ensure-table
+ ] with-db
+ ] [
+ 10 [
+ drop
+ 10 [
+ dup [
+ f 100 random 100 random 100 random test-1 boa
+ insert-tuple yield
+ ] with-db
+ ] times
+ ] with parallel-each
+ ] bi ;
+
+: db-tester2 ( test-db -- )
+ [
+ [
+ test-1 ensure-table
+ test-2 ensure-table
+ ] with-db
+ ] [
+ <db-pool> [
+ 10 [
+ 10 [
+ f 100 random 100 random 100 random test-1 boa
+ insert-tuple yield
+ ] times
+ ] parallel-each
+ ] with-pooled-db
+ ] bi ;
+*/
From 48a0858135321fda82cc02befb147ffca87f382f Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Mon, 13 Apr 2009 15:37:29 -0500
Subject: [PATCH 08/34] 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> [ 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> unparsed-sqlite-error
-: sqlite-table-error ( table message -- error )
- {
- { sql-table-exists [ <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 <sql-table-exists> ]]
+ | "near " (!(SyntaxError).)+:syntax SyntaxError:message
+ => [[ syntax >string <sql-syntax-error> ]]
| "no such table: " .+:table
=> [[ table >string <sql-table-missing> ]]
| .*:error
=> [[ error >string <unparsed-sqlite-error> ]]
;EBNF
+
+: throw-sqlite-error ( n -- * )
+ dup sqlite-error-messages nth sqlite-error ;
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 <statement> ( 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: <statement> 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 <erg@jobim.local>
Date: Mon, 13 Apr 2009 17:27:31 -0500
Subject: [PATCH 09/34] 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
<PRIVATE
@@ -19,3 +20,20 @@ PRIVATE>
: sql-query ( sql -- sequence )
f f <statement> [ statement>result-sequence ] with-disposal ;
+: sql-bind-command ( sequence string -- )
+ f f <statement> [
+ 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 <statement> [
+ 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 <erg@jobim.local>
Date: Mon, 13 Apr 2009 17:40:35 -0500
Subject: [PATCH 10/34] 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 <statement> [
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 <statement> [
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 <erg@jobim.local>
Date: Mon, 13 Apr 2009 18:04:06 -0500
Subject: [PATCH 11/34] 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
<PRIVATE
@@ -25,7 +26,7 @@ PRIVATE>
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 <statement> [
+ 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 <statement> [
+ 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 <erg@jobim.local>
Date: Mon, 13 Apr 2009 18:19:37 -0500
Subject: [PATCH 12/34] 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 <statement> [
- 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 <statement> [
- 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 <statement> [
- 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 <statement> [
- 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: <statement> db-connection ( sql in out -- statement )
GENERIC: statement>result-set* ( statement -- result-set )
GENERIC: execute-statement* ( statement type -- )
+GENERIC: prepare-statement* ( statement -- statement' )
+GENERIC: bind-sequence ( 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 <erg@jobim.local>
Date: Mon, 13 Apr 2009 19:51:19 -0500
Subject: [PATCH 13/34] 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
-<PRIVATE
+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 )
-: execute-sql-string ( string -- )
+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 <statement> [ 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> [ statement>result-sequence ] with-disposal ;
-: sql-bind-command ( sequence string -- )
+M: string sql-bind-command* ( sequence string -- )
f f <statement> [
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 <statement> [
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 <statement> [
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 <statement> [
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" } <insert> 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 "?" <array> ", " 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 <erg@jobim.local>
Date: Mon, 13 Apr 2009 19:53:53 -0500
Subject: [PATCH 14/34] 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 <erg@jobim.local>
Date: Mon, 13 Apr 2009 20:26:48 -0500
Subject: [PATCH 15/34] 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 <erg@jobim.local>
Date: Mon, 13 Apr 2009 20:50:32 -0500
Subject: [PATCH 16/34] 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 <erg@jobim.local>
Date: Mon, 13 Apr 2009 21:41:01 -0500
Subject: [PATCH 17/34] 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 <erg@jobim.local>
Date: Tue, 14 Apr 2009 11:26:54 -0500
Subject: [PATCH 18/34] 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 )
+ <sequence-parser> skip-whitespace
+ [ " " take-until-sequence ]
+ [ take-token sqlite-type>fql-type ]
+ [ take-rest ] tri <column> ;
+
+: parse-columns ( string -- seq )
+ "," split [ parse-column ] map ;
+
+M: object parse-create-statement ( string -- table-schema )
+ <sequence-parser> {
+ [ "CREATE TABLE " take-sequence* ]
+ [ "(" take-until-sequence ]
+ [ "(" take-sequence* ]
+ [ take-rest [ CHAR: ) = ] trim-tail parse-columns ]
+ } cleave <table-schema> ;
+
+: query-table-schema ( name -- table-schema )
+ query-table-schema* [ parse-create-statement ] map ;
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 ;
-
-: <sqlite-db-connection> ( handle -- db-connection )
- sqlite-db-connection new-db-connection ;
-
M: sqlite-db db-open ( db -- db-connection )
path>> sqlite-open <sqlite-db-connection> ;
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 <erg@jobim.local>
Date: Tue, 14 Apr 2009 16:14:40 -0500
Subject: [PATCH 19/34] 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 <statement> [ execute-statement ] with-disposal ;
+M: string sql-command ( string -- )
+ f f <statement> sql-command ;
-M: string sql-query ( sql -- sequence )
- f f <statement> [ statement>result-sequence ] with-disposal ;
+M: string sql-query ( string -- sequence )
+ f f <statement> sql-query ;
-M: string sql-bind-command* ( sequence string -- )
- f f <statement> [
+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 <statement> [
+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 <statement> [
+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 <statement> [
+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 <statement> 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 <statement>
+ sql-bind-command
] unit-test
[ { { "windows" } } ] [
- { "clubber" }
- "select os from computer where name = ?;" sql-bind-query*
+ "select os from computer where name = ?;"
+ { "clubber" } f <statement> 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 <statement> 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 <statement>
+ 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: <statement> db-connection ( sql in out -- statement )
GENERIC: statement>result-set* ( statement -- result-set )
GENERIC: execute-statement* ( statement type -- )
GENERIC: prepare-statement* ( statement -- statement' )
-GENERIC: bind-sequence ( 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 <erg@jobim.local>
Date: Tue, 14 Apr 2009 17:10:16 -0500
Subject: [PATCH 20/34] 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 <statement> sql-bind-typed-query
+ { VARCHAR }
+ <statement> 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 <erg@jobim.local>
Date: Tue, 14 Apr 2009 17:18:48 -0500
Subject: [PATCH 21/34] 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 <statement>
sql-bind-command
] unit-test
@@ -51,23 +51,23 @@ IN: db2.statements.tests
{ "clubber" } f <statement> 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 }
<statement> 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 <statement>
sql-bind-typed-command
] unit-test
-
;
[ test-sql-command ] test-dbs
From 8644c9854938dcb1efb1cd2c253cc0e06e308dd0 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Tue, 14 Apr 2009 22:47:39 -0500
Subject: [PATCH 22/34] 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 ;
! <string-writer> [ 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 <erg@jobim.local>
Date: Tue, 14 Apr 2009 22:54:28 -0500
Subject: [PATCH 23/34] 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 <erg@jobim.local>
Date: Tue, 14 Apr 2009 22:59:45 -0500
Subject: [PATCH 24/34] 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 <erg@jobim.local>
Date: Wed, 15 Apr 2009 18:32:07 -0500
Subject: [PATCH 25/34] 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*" <c-object>
[ 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 <erg@jobim.local>
Date: Thu, 16 Apr 2009 15:19:05 -0500
Subject: [PATCH 26/34] 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 <erg@jobim.local>
Date: Mon, 20 Apr 2009 21:11:50 -0500
Subject: [PATCH 27/34] 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 <erg@jobim.local>
Date: Mon, 20 Apr 2009 21:17:18 -0500
Subject: [PATCH 28/34] 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 <erg@jobim.local>
Date: Mon, 20 Apr 2009 21:32:23 -0500
Subject: [PATCH 29/34] 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 <erg@jobim.local>
Date: Mon, 20 Apr 2009 21:47:16 -0500
Subject: [PATCH 30/34] 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" {
<db-pool> [
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 <doug.coleman@gmail.com>
Date: Mon, 20 Apr 2009 23:23:16 -0500
Subject: [PATCH 31/34] 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 <erg@jobim.local>
Date: Tue, 21 Apr 2009 01:44:25 -0500
Subject: [PATCH 32/34] 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 <erg@jobim.local>
Date: Tue, 21 Apr 2009 02:01:35 -0500
Subject: [PATCH 33/34] 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 <erg@jobim.local>
Date: Tue, 21 Apr 2009 02:15:01 -0500
Subject: [PATCH 34/34] 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 <statement> sql-command ;
-
-M: string sql-query ( string -- sequence )
- f f <statement> sql-query ;
-
-M: statement sql-command ( statement -- )
- [ execute-statement ] with-disposal ;
-
-M: statement sql-query ( statement -- sequence )
- [ statement>result-sequence ] with-disposal ;
-
-M: statement sql-bind-command ( statement -- )
- [
- guard-in
- prepare-statement
- [ bind-sequence ] [ statement>result-set drop ] bi
- ] with-disposal ;
-
-M: statement sql-bind-query ( statement -- sequence )
- [
- guard-in
- prepare-statement
- [ bind-sequence ] [ statement>result-sequence ] bi
- ] with-disposal ;
-
-M: statement sql-bind-typed-command ( statement -- )
- [
- guard-in
- prepare-statement
- [ bind-typed-sequence ] [ statement>result-set drop ] bi
- ] with-disposal ;
-
-M: statement sql-bind-typed-query ( statement -- sequence )
- [
- guard-in
- guard-out
- prepare-statement
- [ bind-typed-sequence ] [ statement>typed-result-sequence ] bi
- ] with-disposal ;
-
-M: sequence sql-command [ sql-command ] each ;
-M: sequence sql-query [ sql-query ] map ;
-M: sequence sql-bind-command [ sql-bind-command ] each ;
-M: sequence sql-bind-query [ sql-bind-query ] map ;
-M: sequence sql-bind-typed-command [ sql-bind-typed-command ] each ;
-M: sequence sql-bind-typed-query [ sql-bind-typed-query ] map ;
-
-M: integer sql-command throw ;
-M: integer sql-query throw ;
-M: integer sql-bind-command throw ;
-M: integer sql-bind-query throw ;
-M: integer sql-bind-typed-command throw ;
-M: integer sql-bind-typed-query throw ;
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" } <insert> expand-fql
- sql>>
- ] unit-test
-
- [ "select name, os from computer" ]
- [
- select new
- { "name" "os" } >>names
- "computer" >>from
- expand-fql sql>>
- ] unit-test
-
- [ "select name, os from computer group by os order by lol offset 100 limit 3" ]
- [
- select new
- { "name" "os" } >>names
- "computer" >>from
- "os" >>group-by
- "lol" >>order-by
- 100 >>offset
- 3 >>limit
- expand-fql sql>>
- ] unit-test
-
- [
- "select name, os from computer where (hmm > 1 or foo is NULL) group by os order by lol offset 100 limit 3"
- ] [
- select new
- { "name" "os" } >>names
- "computer" >>from
- T{ or f { "hmm > 1" "foo is NULL" } } >>where
- "os" >>group-by
- "lol" >>order-by
- 100 >>offset
- 3 >>limit
- expand-fql sql>>
- ] unit-test
-
- [ "delete from computer order by omg limit 3" ]
- [
- delete new
- "computer" >>tables
- "omg" >>order-by
- 3 >>limit
- expand-fql sql>>
- ] unit-test
-
- [ "update computer set name = oscar order by omg limit 3" ]
- [
- update new
- "computer" >>tables
- "name" >>keys
- "oscar" >>values
- "omg" >>order-by
- 3 >>limit
- expand-fql sql>>
- ] unit-test
-
- ;
-
-[ test-fql ] test-dbs
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 "?" <array> ", " join % ");" % ]
- [ values>> >>in ]
- } cleave
- ] "" make >>sql ;
-
-M: update expand-fql*
- [ statement new ] dip
- [
- {
- [ "update " % tables>> ", " join % ]
- [
- " set " % [ keys>> ] [ values>> ] bi
- zip [ ", " % ] [ first2 [ % ] dip " = " % % ] interleave
- ]
- ! [ " " % from>> ", " join % ]
- [ where>> [ " where " % expand-fql* % ] when* ]
- [ order-by>> [ " order by " % ", " join % ] when* ]
- [ limit>> [ " limit " % # ] when* ]
- } cleave
- ] "" make >>sql ;
-
-M: delete expand-fql*
- [ statement new ] dip
- [
- {
- [ "delete from " % tables>> ", " join % ]
- [ where>> [ " where " % expand-fql* % ] when* ]
- [ order-by>> [ " order by " % ", " join % ] when* ]
- [ limit>> [ " limit " % # ] when* ]
- } cleave
- ] "" make >>sql ;
-
-M: select expand-fql*
- [ statement new ] dip
- [
- {
- [ "select " % names>> ", " join % ]
- [ " from " % from>> ", " join % ]
- [ where>> [ " where " % expand-fql* % ] when* ]
- [ group-by>> [ " group by " % ", " join % ] when* ]
- [ order-by>> [ " order by " % ", " join % ] when* ]
- [ offset>> [ " offset " % # ] when* ]
- [ limit>> [ " limit " % # ] when* ]
- } cleave
- ] "" make >>sql ;
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 )
- <sequence-parser> skip-whitespace
- [ " " take-until-sequence ]
- [ take-token sqlite-type>fql-type ]
- [ take-rest ] tri <column> ;
-
-: parse-columns ( string -- seq )
- "," split [ parse-column ] map ;
-
-M: object parse-create-statement ( string -- table-schema )
- <sequence-parser> {
- [ "CREATE TABLE " take-sequence* ]
- [ "(" take-until-sequence ]
- [ "(" take-sequence* ]
- [ take-rest [ CHAR: ) = ] trim-tail parse-columns ]
- } cleave <table-schema> ;
-
-: query-table-schema ( name -- table-schema )
- query-table-schema* [ parse-create-statement ] map ;
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
-
-\ <db-pool> must-infer
-
-{ 1 0 } [ [ ] with-db-pool ] must-infer-as
-
-{ 1 0 } [ [ ] with-pooled-db ] must-infer-as
-
-! Test behavior after image save/load
-
-[ "pool-test.db" temp-file delete-file ] ignore-errors
-
-[ ] [ "pool-test.db" temp-file <sqlite-db> <db-pool> "pool" set ] unit-test
-
-[ ] [ "pool" get expired>> t >>expired drop ] unit-test
-
-[ ] [ 1000 [ "pool" get [ ] with-pooled-db ] times ] unit-test
-
-[ ] [ "pool" get dispose ] unit-test
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 )
- db-pool <pool>
- swap >>db ;
-
-: with-db-pool ( db quot -- )
- [ <db-pool> ] dip with-pool ; inline
-
-M: db-pool make-connection ( pool -- )
- db>> db-open ;
-
-: with-pooled-db ( pool quot -- )
- '[ db-connection _ with-variable ] with-pooled-connection ; inline
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 <sqlite-db-connection> ;
-
-M: sqlite-db-connection db-close ( db-connection -- )
- handle>> sqlite-close ;
-
-M: sqlite-db-connection parse-sql-error ( error -- error' )
- dup n>> {
- { 1 [ string>> parse-sqlite-sql-error ] }
- [ drop ]
- } case ;
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 ;
-
-: <sqlite-db> ( 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> unparsed-sqlite-error
-
-EBNF: parse-sqlite-sql-error
-
-TableMessage = " already exists"
-SyntaxError = ": syntax error"
-
-SqliteError =
- "table " (!(TableMessage).)+:table TableMessage:message
- => [[ table >string <sql-table-exists> ]]
- | "near " (!(SyntaxError).)+:syntax SyntaxError:message
- => [[ syntax >string <sql-syntax-error> ]]
- | "no such table: " .+:table
- => [[ table >string <sql-table-missing> ]]
- | .*:error
- => [[ error >string <unparsed-sqlite-error> ]]
-;EBNF
-
-: throw-sqlite-error ( n -- * )
- dup sqlite-error-messages nth sqlite-error ;
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*" <c-object>
- [ sqlite3_open sqlite-check-result ] keep *void* ;
-
-: sqlite-close ( db -- )
- sqlite3_close sqlite-check-result ;
-
-: sqlite-prepare ( db sql -- handle )
- utf8 encode dup length "void*" <c-object> "void*" <c-object>
- [ sqlite3_prepare_v2 sqlite-check-result ] 2keep
- drop *void* ;
-
-: sqlite-bind-parameter-index ( handle name -- index )
- sqlite3_bind_parameter_index ;
-
-: parameter-index ( handle name text -- handle name text )
- [ dupd sqlite-bind-parameter-index ] dip ;
-
-: sqlite-bind-text ( handle index text -- )
- utf8 encode dup length SQLITE_TRANSIENT
- sqlite3_bind_text sqlite-check-result ;
-
-: sqlite-bind-int ( handle i n -- )
- sqlite3_bind_int sqlite-check-result ;
-
-: sqlite-bind-int64 ( handle i n -- )
- sqlite3_bind_int64 sqlite-check-result ;
-
-: sqlite-bind-uint64 ( handle i n -- )
- sqlite3-bind-uint64 sqlite-check-result ;
-
-: sqlite-bind-boolean ( handle name obj -- )
- >boolean 1 0 ? sqlite-bind-int ;
-
-: sqlite-bind-double ( handle i x -- )
- sqlite3_bind_double sqlite-check-result ;
-
-: sqlite-bind-null ( handle i -- )
- sqlite3_bind_null sqlite-check-result ;
-
-: sqlite-bind-blob ( handle i byte-array -- )
- dup length SQLITE_TRANSIENT
- sqlite3_bind_blob sqlite-check-result ;
-
-: sqlite-bind-text-by-name ( handle name text -- )
- parameter-index sqlite-bind-text ;
-
-: sqlite-bind-int-by-name ( handle name int -- )
- parameter-index sqlite-bind-int ;
-
-: sqlite-bind-int64-by-name ( handle name int64 -- )
- parameter-index sqlite-bind-int64 ;
-
-: sqlite-bind-uint64-by-name ( handle name int64 -- )
- parameter-index sqlite-bind-uint64 ;
-
-: sqlite-bind-boolean-by-name ( handle name obj -- )
- >boolean 1 0 ? parameter-index sqlite-bind-int ;
-
-: sqlite-bind-double-by-name ( handle name double -- )
- parameter-index sqlite-bind-double ;
-
-: sqlite-bind-blob-by-name ( handle name blob -- )
- parameter-index sqlite-bind-blob ;
-
-: sqlite-bind-null-by-name ( handle name obj -- )
- parameter-index drop sqlite-bind-null ;
-
-: sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ;
-: sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ;
-: sqlite-clear-bindings ( handle -- )
- sqlite3_clear_bindings sqlite-check-result ;
-: sqlite-#columns ( query -- int ) sqlite3_column_count ;
-: sqlite-column ( handle index -- string ) sqlite3_column_text ;
-: sqlite-column-name ( handle index -- string ) sqlite3_column_name ;
-: sqlite-column-type ( handle index -- string ) sqlite3_column_type ;
-
-: sqlite-column-blob ( handle index -- byte-array/f )
- [ sqlite3_column_bytes ] 2keep
- pick zero? [
- 3drop f
- ] [
- sqlite3_column_blob swap memory>byte-array
- ] if ;
-
-: sqlite-step-has-more-rows? ( prepared -- ? )
- {
- { SQLITE_ROW [ t ] }
- { SQLITE_DONE [ f ] }
- [ sqlite-check-result f ]
- } case ;
-
-: sqlite-next ( prepared -- ? )
- sqlite3_step sqlite-step-has-more-rows? ;
-
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 ;
-
-: <sqlite-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 <statement> ( string in out -- obj )
- sqlite-statement new-statement ;
-
-M: sqlite-statement dispose
- handle>>
- [ [ sqlite3_reset drop ] [ sqlite-finalize ] bi ] when* ;
-
-M: sqlite-statement prepare-statement* ( statement -- statement )
- db-connection get handle>> over sql>> sqlite-prepare
- >>handle ;
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 <statement> sql-query
- ] unit-test
-
- [ "insert into" sql-command ]
- [ sql-syntax-error? ] must-fail-with
-
- [ "selectt" sql-query ]
- [ sql-syntax-error? ] must-fail-with
-
- [ ] [
- "insert into computer (name, os, version) values(?, ?, ?);"
- { "clubber" "windows" "7" }
- f <statement>
- sql-bind-command
- ] unit-test
-
- [ { { "windows" } } ] [
- "select os from computer where name = ?;"
- { "clubber" } f <statement> sql-bind-query
- ] unit-test
-
- [ { { "windows" 7 } } ] [
- "select os, version from computer where name = ?;"
- { { VARCHAR "clubber" } }
- { VARCHAR INTEGER }
- <statement> sql-bind-typed-query
- ] unit-test
-
- [ ] [
- "insert into computer (name, os, version) values(?, ?, ?);"
- {
- { VARCHAR "paulie" }
- { VARCHAR "netbsd" }
- { INTEGER 7 }
- } f <statement>
- sql-bind-typed-command
- ] unit-test
-
- ;
-
-[ test-sql-command ] test-dbs
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: <statement> db-connection ( sql in out -- statement )
-GENERIC: statement>result-set* ( statement -- result-set )
-GENERIC: execute-statement* ( statement type -- )
-GENERIC: prepare-statement* ( statement -- statement' )
-GENERIC: bind-sequence ( statement -- )
-GENERIC: bind-typed-sequence ( statement -- )
-
-: statement>result-set ( statement -- result-set )
- [ statement>result-set* ]
- [ dup sql-error? [ parse-sql-error ] when rethrow ] recover ;
-
-M: object execute-statement* ( statement type -- )
- drop statement>result-set dispose ;
-
-: execute-one-statement ( statement -- )
- dup type>> execute-statement* ;
-
-: execute-statement ( statement -- )
- dup sequence?
- [ [ execute-one-statement ] each ]
- [ execute-one-statement ] if ;
-
-: prepare-statement ( statement -- statement )
- dup handle>> [ prepare-statement* ] unless ;
-
-: result-set-each ( statement quot: ( statement -- ) -- )
- over more-rows?
- [ [ call ] 2keep over advance-row result-set-each ]
- [ 2drop ] if ; inline recursive
-
-: result-set-map ( statement quot -- sequence )
- accumulator [ result-set-each ] dip { } like ; inline
-
-: statement>result-sequence ( statement -- sequence )
- statement>result-set [ [ sql-row ] result-set-map ] with-disposal ;
-
-: statement>typed-result-sequence ( statement -- sequence )
- statement>result-set
- [ [ sql-row-typed ] result-set-map ] with-disposal ;
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 <sqlite-db> ;
-
-! These words leak resources, but are useful for interactivel testing
-: set-sqlite-db ( -- )
- sqlite-db db-open db-connection set ;
-
-: test-sqlite ( quot -- )
- '[
- [ ] [ sqlite-test-db _ with-db ] unit-test
- ] call ; inline
-
-: test-dbs ( quot -- )
- {
- [ test-sqlite ]
- } cleave ;
-
-/*
-: postgresql-test-db ( -- postgresql-db )
- <postgresql-db>
- "localhost" >>host
- "postgres" >>username
- "thepasswordistrust" >>password
- "factor-test" >>database ;
-
-: set-postgresql-db ( -- )
- postgresql-db db-open db-connection set ;
-
-: test-postgresql ( quot -- )
- '[
- os windows? cpu x86.64? and [
- [ ] [ postgresql-test-db _ with-db ] unit-test
- ] unless
- ] call ; inline
-
-TUPLE: test-1 id a b c ;
-
-test-1 "TEST1" {
- { "id" "ID" INTEGER +db-assigned-id+ }
- { "a" "A" { VARCHAR 256 } +not-null+ }
- { "b" "B" { VARCHAR 256 } +not-null+ }
- { "c" "C" { VARCHAR 256 } +not-null+ }
-} define-persistent
-
-TUPLE: test-2 id x y z ;
-
-test-2 "TEST2" {
- { "id" "ID" INTEGER +db-assigned-id+ }
- { "x" "X" { VARCHAR 256 } +not-null+ }
- { "y" "Y" { VARCHAR 256 } +not-null+ }
- { "z" "Z" { VARCHAR 256 } +not-null+ }
-} define-persistent
-
-: db-tester ( test-db -- )
- [
- [
- test-1 ensure-table
- test-2 ensure-table
- ] with-db
- ] [
- 10 [
- drop
- 10 [
- dup [
- f 100 random 100 random 100 random test-1 boa
- insert-tuple yield
- ] with-db
- ] times
- ] with parallel-each
- ] bi ;
-
-: db-tester2 ( test-db -- )
- [
- [
- test-1 ensure-table
- test-2 ensure-table
- ] with-db
- ] [
- <db-pool> [
- 10 [
- 10 [
- f 100 random 100 random 100 random test-1 boa
- insert-tuple yield
- ] times
- ] parallel-each
- ] with-pooled-db
- ] bi ;
-*/
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 ;