From a7afae250d4de6f18fe9e98e4ae5621e0d793477 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 1 Jun 2008 00:48:38 -0500 Subject: [PATCH 1/7] clean up code some make \# retries user configurable --- extra/db/db.factor | 4 ++-- extra/db/queries/queries.factor | 10 +++++----- extra/db/sql/sql.factor | 4 +++- extra/db/tuples/tuples.factor | 14 ++++++++------ 4 files changed, 18 insertions(+), 14 deletions(-) diff --git a/extra/db/db.factor b/extra/db/db.factor index 8d1feca6c7..889eff196c 100755 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -35,7 +35,7 @@ HOOK: db-close db ( handle -- ) handle>> db-close ] with-variable ; -TUPLE: statement handle sql in-params out-params bind-params bound? type ; +TUPLE: statement handle sql in-params out-params bind-params bound? type retries ; TUPLE: simple-statement < statement ; TUPLE: prepared-statement < statement ; @@ -89,7 +89,7 @@ M: object execute-statement* ( statement type -- ) swap >>out-params swap >>in-params swap >>sql ; - + : sql-row ( result-set -- seq ) dup #columns [ row-column ] with map ; diff --git a/extra/db/queries/queries.factor b/extra/db/queries/queries.factor index 59ee60aa1f..d524080e57 100644 --- a/extra/db/queries/queries.factor +++ b/extra/db/queries/queries.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel math namespaces sequences random strings math.parser math.intervals combinators -math.bitfields.lib namespaces.lib db db.tuples db.types ; +math.bitfields.lib namespaces.lib db db.tuples db.types +sequences.lib ; IN: db.queries GENERIC: where ( specs obj -- ) @@ -99,16 +100,15 @@ M: string where ( spec obj -- ) object-where ; ] with filter ; : where-clause ( tuple specs -- ) - dupd filter-slots - dup empty? [ - 2drop + dupd filter-slots [ + drop ] [ " where " 0% [ " and " 0% ] [ 2dup slot-name>> swap get-slot-named where ] interleave drop - ] if ; + ] if-empty ; M: db ( tuple table -- sql ) [ diff --git a/extra/db/sql/sql.factor b/extra/db/sql/sql.factor index 82c6e370bd..756aeea7c0 100755 --- a/extra/db/sql/sql.factor +++ b/extra/db/sql/sql.factor @@ -5,7 +5,9 @@ IN: db.sql SYMBOLS: insert update delete select distinct columns from as where group-by having order-by limit offset is-null desc all -any count avg table values ; +any count avg table values ? ; + +! Output an s-exp sql statement and an alist of keys/values : input-spec, 1, ; : output-spec, 2, ; diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index bac141d6d2..b7bf6a7fbe 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -55,6 +55,7 @@ SINGLETON: retryable [ make-retryable ] map ] [ retryable >>type + 10 >>retries ] if ; : regenerate-params ( statement -- statement ) @@ -69,12 +70,13 @@ SINGLETON: retryable ] 2map >>bind-params ; M: retryable execute-statement* ( statement type -- ) - drop - [ - [ query-results dispose t ] - [ ] - [ regenerate-params bind-statement* f ] cleanup - ] curry 10 retry drop ; + drop [ + [ + [ query-results dispose t ] + [ ] + [ regenerate-params bind-statement* f ] cleanup + ] curry + ] [ retries>> ] bi retry drop ; : resulting-tuple ( class row out-params -- tuple ) rot class new [ From 96ce30a534f744cc160b1075bd92de6525805f9d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 1 Jun 2008 11:25:09 -0500 Subject: [PATCH 2/7] add advanced-select word --- extra/db/tuples/tuples.factor | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index b7bf6a7fbe..09fd63b233 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -154,3 +154,7 @@ M: retryable execute-statement* ( statement type -- ) : select-tuple ( tuple -- tuple/f ) dup dup class f f f 1 do-select ?first ; + +: advanced-select ( tuple groups order offset limit -- tuples ) + >r >r >r >r dup dup class r> r> r> r> + do-select ; From 95663e56ce0c57cf7ee7ccb2a67e823e66b4f135 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jun 2008 10:48:05 -0500 Subject: [PATCH 3/7] commit local changes --- extra/db/queries/queries.factor | 47 ++++++++++++++++++++++++++--- extra/db/sql/sql.factor | 32 ++++++++++++-------- extra/db/tuples/tuples-tests.factor | 6 ++-- extra/db/tuples/tuples.factor | 22 +++++++++++--- 4 files changed, 82 insertions(+), 25 deletions(-) diff --git a/extra/db/queries/queries.factor b/extra/db/queries/queries.factor index d524080e57..29abe9bddc 100644 --- a/extra/db/queries/queries.factor +++ b/extra/db/queries/queries.factor @@ -3,7 +3,7 @@ USING: accessors kernel math namespaces sequences random strings math.parser math.intervals combinators math.bitfields.lib namespaces.lib db db.tuples db.types -sequences.lib ; +sequences.lib db.sql classes words shuffle arrays ; IN: db.queries GENERIC: where ( specs obj -- ) @@ -146,7 +146,7 @@ M: db ( tuple class -- statement ) number>string " limit " prepend append ] curry change-sql drop ; -: make-advanced-statement ( tuple advanced -- tuple' ) +: make-query ( tuple query -- tuple' ) dupd { [ group>> [ do-group ] [ drop ] if* ] @@ -155,6 +155,43 @@ M: db ( tuple class -- statement ) [ offset>> [ do-offset ] [ drop ] if* ] } 2cleave ; -M: db ( tuple class group order limit offset -- tuple ) - advanced-statement boa - [ ] dip make-advanced-statement ; +M: db ( tuple class group order limit offset -- tuple ) + \ query boa + [ ] dip make-query ; + +! select ID, NAME, SCORE from EXAM limit 1 offset 3 + +: select-tuples* ( tuple -- statement ) + dup + [ + select 0, + dup class db-columns [ ", " 0, ] + [ dup column-name>> 0, 2, ] interleave + from 0, + class word-name 0, + ] { { } { } { } } nmake + >r >r parse-sql 4drop r> r> + maybe-make-retryable do-select ; + +M: db ( tuple class groups -- statement ) + f f f \ query boa + [ [ "select count(*) from " 0% 0% where-clause ] query-make ] + dip make-query ; + +: where-clause* ( tuple specs -- ) + dupd filter-slots [ + drop + ] [ + \ where 0, + [ 2dup slot-name>> swap get-slot-named where ] map 2array 0, + drop + ] if-empty ; + +: delete-tuple* ( tuple -- sql ) + dup + [ + delete 0, from 0, dup class db-table 0, + dup class db-columns where-clause* + ] { { } { } { } } nmake + >r >r parse-sql 4drop r> r> + maybe-make-retryable do-select ; diff --git a/extra/db/sql/sql.factor b/extra/db/sql/sql.factor index 756aeea7c0..dc8b5d1fb1 100755 --- a/extra/db/sql/sql.factor +++ b/extra/db/sql/sql.factor @@ -5,7 +5,7 @@ IN: db.sql SYMBOLS: insert update delete select distinct columns from as where group-by having order-by limit offset is-null desc all -any count avg table values ? ; +any count avg table values ; ! Output an s-exp sql statement and an alist of keys/values @@ -25,12 +25,27 @@ DEFER: sql% : sql-function, ( seq function -- ) sql% "(" sql% unclip sql% ")" sql% [ sql% ] each ; +: sql-where ( seq -- ) +B + [ + [ second 0, ] + [ first 0, ] + [ third 1, \ ? 0, ] tri + ] each ; + : sql-array% ( array -- ) +B unclip { + { \ create [ "create table" sql% ] } + { \ drop [ "drop table" sql% ] } + { \ insert [ "insert into" sql% ] } + { \ update [ "update" sql% ] } + { \ delete [ "delete" sql% ] } + { \ select [ B "select" sql% "," (sql-interleave) ] } { \ columns [ "," (sql-interleave) ] } { \ from [ "from" "," sql-interleave ] } - { \ where [ "where" "and" sql-interleave ] } + { \ where [ B "where" 0, sql-where ] } { \ group-by [ "group by" "," sql-interleave ] } { \ having [ "having" "," sql-interleave ] } { \ order-by [ "order by" "," sql-interleave ] } @@ -51,7 +66,7 @@ DEFER: sql% ERROR: no-sql-match ; : sql% ( obj -- ) { - { [ dup string? ] [ " " 0% 0% ] } + { [ dup string? ] [ 0, ] } { [ dup array? ] [ sql-array% ] } { [ dup number? ] [ number>string sql% ] } { [ dup symbol? ] [ unparse sql% ] } @@ -61,13 +76,4 @@ ERROR: no-sql-match ; } cond ; : parse-sql ( obj -- sql in-spec out-spec in out ) - [ - unclip { - { \ create [ "create table" sql% ] } - { \ drop [ "drop table" sql% ] } - { \ insert [ "insert into" sql% ] } - { \ update [ "update" sql% ] } - { \ delete [ "delete" sql% ] } - { \ select [ "select" sql% ] } - } case [ sql% ] each - ] { "" { } { } { } { } } nmake ; + [ [ sql% ] each ] { { } { } { } } nmake ; diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index f9a597e814..665afa6a51 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -227,7 +227,7 @@ TUPLE: exam id name score ; : random-exam ( -- exam ) f - 6 [ CHAR: a CHAR: b [a,b] random ] replicate >string + 6 [ CHAR: a CHAR: z [a,b] random ] replicate >string 100 random exam boa ; @@ -340,7 +340,9 @@ TUPLE: exam id name score ; } ] [ T{ exam } select-tuples - ] unit-test ; + ] unit-test + + [ 4 ] [ T{ exam } count-tuples ] unit-test ; TUPLE: bignum-test id m n o ; : ( m n o -- obj ) diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 09fd63b233..d121e06445 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -42,8 +42,9 @@ HOOK: db ( class -- obj ) HOOK: db ( class -- obj ) HOOK: db ( tuple class -- obj ) HOOK: db ( tuple class -- tuple ) -TUPLE: advanced-statement group order offset limit ; -HOOK: db ( tuple class group order offset limit -- tuple ) +TUPLE: query group order offset limit ; +HOOK: db ( tuple class group order offset limit -- tuple ) +HOOK: db ( tuple class -- n ) HOOK: insert-tuple* db ( tuple statement -- ) @@ -152,9 +153,20 @@ M: retryable execute-statement* ( statement type -- ) dup dup class do-select ; : select-tuple ( tuple -- tuple/f ) - dup dup class f f f 1 + dup dup class f f f 1 do-select ?first ; -: advanced-select ( tuple groups order offset limit -- tuples ) +: query ( tuple groups order offset limit -- tuples ) >r >r >r >r dup dup class r> r> r> r> - do-select ; + do-select ; + +: do-count ( exemplar-tuple statement -- tuples ) + [ + [ bind-tuple ] [ nip default-query ] 2bi + ] with-disposal ; + +: count-tuples ( tuple groups -- n ) + >r dup dup class r> do-count + dup length 1 = [ first first string>number ] [ + [ first string>number ] map + ] if ; From a0dbee6e2a2c26e24f5a5d9ca492a684ab3d2ddf Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 8 Jun 2008 16:33:07 -0500 Subject: [PATCH 4/7] clean up html parser prettyprinter a bit --- extra/html/parser/printer/printer.factor | 47 +++++++++++++++++------- extra/html/parser/utils/utils.factor | 11 ++---- 2 files changed, 36 insertions(+), 22 deletions(-) diff --git a/extra/html/parser/printer/printer.factor b/extra/html/parser/printer/printer.factor index 3078cf23a5..d352a97688 100644 --- a/extra/html/parser/printer/printer.factor +++ b/extra/html/parser/printer/printer.factor @@ -2,7 +2,7 @@ USING: assocs html.parser html.parser.utils combinators continuations hashtables hashtables.private io kernel math namespaces prettyprint quotations sequences splitting -state-parser strings ; +strings ; IN: html.parser.printer SYMBOL: no-section @@ -16,7 +16,8 @@ TUPLE: state section ; TUPLE: text-printer ; TUPLE: ui-printer ; TUPLE: src-printer ; -UNION: printer text-printer ui-printer src-printer ; +TUPLE: html-prettyprinter ; +UNION: printer text-printer ui-printer src-printer html-prettyprinter ; HOOK: print-tag printer ( tag -- ) HOOK: print-text-tag printer ( tag -- ) HOOK: print-comment-tag printer ( tag -- ) @@ -47,7 +48,7 @@ M: printer print-comment-tag ( tag -- ) tag-text write "-->" write ; -M: printer print-dtd-tag +M: printer print-dtd-tag ( tag -- ) "" write ; @@ -70,8 +71,8 @@ M: printer print-closing-named-tag ( tag -- ) M: src-printer print-opening-named-tag ( tag -- ) "<" write - dup tag-name write - tag-attributes dup assoc-empty? [ drop ] [ print-attributes ] if + [ tag-name write ] + [ tag-attributes dup assoc-empty? [ drop ] [ print-attributes ] if ] bi ">" write ; M: src-printer print-closing-named-tag ( tag -- ) @@ -79,9 +80,30 @@ M: src-printer print-closing-named-tag ( tag -- ) tag-name write ">" write ; -TUPLE: unknown-tag-error tag ; +SYMBOL: tab-width +SYMBOL: #indentations -C: unknown-tag-error +: html-pp ( vector -- ) + [ + 0 #indentations set + 2 tab-width set + + ] with-scope ; + +: print-tabs ( -- ) + tab-width get #indentations get * CHAR: \s write ; + +M: html-prettyprinter print-opening-named-tag ( tag -- ) + print-tabs "<" write + tag-name write + ">\n" write ; + +M: html-prettyprinter print-closing-named-tag ( tag -- ) + "" write ; + +ERROR: unknown-tag-error tag ; M: printer print-tag ( tag -- ) { @@ -92,15 +114,12 @@ M: printer print-tag ( tag -- ) [ print-closing-named-tag ] } { [ dup tag-name string? ] [ print-opening-named-tag ] } - [ throw ] + [ unknown-tag-error ] } cond ; -SYMBOL: tablestack - -: with-html-printer - [ - V{ } clone tablestack set - ] with-scope ; +! SYMBOL: tablestack +! : with-html-printer ( vector quot -- ) + ! [ V{ } clone tablestack set ] with-scope ; ! { { 1 2 } { 3 4 } } ! H{ { table-gap { 10 10 } } } [ diff --git a/extra/html/parser/utils/utils.factor b/extra/html/parser/utils/utils.factor index 5083b1cec2..592503e3dd 100644 --- a/extra/html/parser/utils/utils.factor +++ b/extra/html/parser/utils/utils.factor @@ -1,7 +1,7 @@ USING: assocs circular combinators continuations hashtables hashtables.private io kernel math namespaces prettyprint quotations sequences splitting -state-parser strings ; +state-parser strings sequences.lib ; IN: html.parser.utils : string-parse-end? @@ -13,7 +13,7 @@ IN: html.parser.utils dup length rot length 1- - head next* ; : trim1 ( seq ch -- newseq ) - [ ?head drop ] keep ?tail drop ; + [ ?head drop ] [ ?tail drop ] bi ; : single-quote ( str -- newstr ) >r "'" r> "'" 3append ; @@ -26,11 +26,7 @@ IN: html.parser.utils [ double-quote ] [ single-quote ] if ; : quoted? ( str -- ? ) - dup length 1 > [ - [ first ] keep peek [ = ] keep "'\"" member? and - ] [ - drop f - ] if ; + [ [ first ] [ peek ] bi [ = ] keep "'\"" member? and ] [ f ] if-seq ; : ?quote ( str -- newstr ) dup quoted? [ quote ] unless ; @@ -39,4 +35,3 @@ IN: html.parser.utils dup quoted? [ but-last-slice rest-slice >string ] when ; : quote? ( ch -- ? ) "'\"" member? ; - From 5f9aca57251855e866260af313b60548755a5bea Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 12 Jun 2008 18:04:01 -0500 Subject: [PATCH 5/7] refactor add url objects --- extra/db/postgresql/lib/lib.factor | 4 +++- extra/db/postgresql/postgresql.factor | 1 + extra/db/queries/queries.factor | 10 +++++----- extra/db/sqlite/lib/lib.factor | 4 +++- extra/db/sqlite/sqlite.factor | 1 + extra/db/tuples/tuples-tests.factor | 2 +- extra/db/tuples/tuples.factor | 22 ++++++++-------------- extra/db/types/types.factor | 2 +- 8 files changed, 23 insertions(+), 23 deletions(-) diff --git a/extra/db/postgresql/lib/lib.factor b/extra/db/postgresql/lib/lib.factor index e99bc41449..9d2ced3afa 100755 --- a/extra/db/postgresql/lib/lib.factor +++ b/extra/db/postgresql/lib/lib.factor @@ -5,7 +5,7 @@ quotations sequences db.postgresql.ffi alien alien.c-types db.types tools.walker ascii splitting math.parser combinators libc shuffle calendar.format byte-arrays destructors prettyprint accessors strings serialize io.encodings.binary io.encodings.utf8 -alien.strings io.streams.byte-array inspector ; +alien.strings io.streams.byte-array inspector present urls ; IN: db.postgresql.lib : postgresql-result-error-message ( res -- str/f ) @@ -84,6 +84,7 @@ M: postgresql-result-null summary ( obj -- str ) { TIME [ dup [ timestamp>hms ] when default-param-value ] } { DATETIME [ dup [ timestamp>ymdhms ] when default-param-value ] } { TIMESTAMP [ dup [ timestamp>ymdhms ] when default-param-value ] } + { URL [ dup [ present ] when default-param-value ] } [ drop default-param-value ] } case 2array ] 2map flip dup empty? [ @@ -164,6 +165,7 @@ M: postgresql-malloc-destructor dispose ( obj -- ) { TIMESTAMP [ pq-get-string dup [ ymdhms>timestamp ] when ] } { DATETIME [ pq-get-string dup [ ymdhms>timestamp ] when ] } { BLOB [ pq-get-blob ] } + { URL [ pq-get-string dup [ >url ] when ] } { FACTOR-BLOB [ pq-get-blob dup [ bytes>object ] when ] } diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index f55897db88..1734fb6df4 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -239,6 +239,7 @@ M: postgresql-db persistent-table ( -- hashtable ) { TIMESTAMP { "timestamp" "timestamp" f } } { BLOB { "bytea" "bytea" f } } { FACTOR-BLOB { "bytea" "bytea" f } } + { URL { "string" "string" f } } { +foreign-id+ { f f "references" } } { +autoincrement+ { f f "autoincrement" } } { +unique+ { f f "unique" } } diff --git a/extra/db/queries/queries.factor b/extra/db/queries/queries.factor index 29abe9bddc..807aeda74a 100644 --- a/extra/db/queries/queries.factor +++ b/extra/db/queries/queries.factor @@ -149,14 +149,13 @@ M: db ( tuple class -- statement ) : make-query ( tuple query -- tuple' ) dupd { - [ group>> [ do-group ] [ drop ] if* ] - [ order>> [ do-order ] [ drop ] if* ] + [ group>> [ do-group ] [ drop ] if-seq ] + [ order>> [ do-order ] [ drop ] if-seq ] [ limit>> [ do-limit ] [ drop ] if* ] [ offset>> [ do-offset ] [ drop ] if* ] } 2cleave ; -M: db ( tuple class group order limit offset -- tuple ) - \ query boa +M: db ( tuple class query -- tuple ) [ ] dip make-query ; ! select ID, NAME, SCORE from EXAM limit 1 offset 3 @@ -174,7 +173,8 @@ M: db ( tuple class group order limit offset -- tuple ) maybe-make-retryable do-select ; M: db ( tuple class groups -- statement ) - f f f \ query boa + \ query new + swap >>group [ [ "select count(*) from " 0% 0% where-clause ] query-make ] dip make-query ; diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index b652e8fed7..4c440acc55 100755 --- a/extra/db/sqlite/lib/lib.factor +++ b/extra/db/sqlite/lib/lib.factor @@ -4,7 +4,7 @@ USING: alien.c-types arrays assocs kernel math math.parser namespaces sequences db.sqlite.ffi db combinators continuations db.types calendar.format serialize io.streams.byte-array byte-arrays io.encodings.binary -io.backend db.errors ; +io.backend db.errors present urls ; IN: db.sqlite.lib ERROR: sqlite-error < db-error n string ; @@ -107,6 +107,7 @@ ERROR: sqlite-sql-error < sql-error n string ; 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 ] } @@ -147,6 +148,7 @@ ERROR: sqlite-sql-error < sql-error n string ; { TIMESTAMP [ sqlite3_column_text dup [ ymdhms>timestamp ] when ] } { DATETIME [ sqlite3_column_text dup [ ymdhms>timestamp ] when ] } { BLOB [ sqlite-column-blob ] } + { URL [ sqlite3_column_text dup [ >url ] when ] } { FACTOR-BLOB [ sqlite-column-blob dup [ bytes>object ] when diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index cc4e4d116a..c7c9065b43 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -182,6 +182,7 @@ M: sqlite-db persistent-table ( -- assoc ) { DOUBLE { "real" "real" } } { BLOB { "blob" "blob" } } { FACTOR-BLOB { "blob" "blob" } } + { URL { "text" "text" } } { +autoincrement+ { f f "autoincrement" } } { +unique+ { f f "unique" } } { +default+ { f f "default" } } diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 665afa6a51..7ccee7c637 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -342,7 +342,7 @@ TUPLE: exam id name score ; T{ exam } select-tuples ] unit-test - [ 4 ] [ T{ exam } count-tuples ] unit-test ; + [ 4 ] [ T{ exam } f count-tuples ] unit-test ; TUPLE: bignum-test id m n o ; : ( m n o -- obj ) diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index b7cc6c81c2..4903adff5c 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -43,8 +43,8 @@ HOOK: db ( class -- obj ) HOOK: db ( tuple class -- obj ) HOOK: db ( tuple class -- tuple ) TUPLE: query group order offset limit ; -HOOK: db ( tuple class group order offset limit -- tuple ) -HOOK: db ( tuple class -- n ) +HOOK: db ( tuple class query -- statement' ) +HOOK: db ( tuple class groups -- n ) HOOK: insert-tuple* db ( tuple statement -- ) @@ -149,19 +149,14 @@ M: retryable execute-statement* ( statement type -- ) : do-select ( exemplar-tuple statement -- tuples ) [ [ bind-tuple ] [ query-tuples ] 2bi ] with-disposal ; +: query ( tuple query -- tuples ) + >r dup dup class r> do-select ; + : select-tuples ( tuple -- tuples ) dup dup class do-select ; -: count-tuples ( tuple -- n ) - select-tuples length ; - : select-tuple ( tuple -- tuple/f ) - dup dup class f f f 1 - do-select ?first ; - -: query ( tuple groups order offset limit -- tuples ) - >r >r >r >r dup dup class r> r> r> r> - do-select ; + dup dup class \ query new 1 >>limit do-select ?first ; : do-count ( exemplar-tuple statement -- tuples ) [ @@ -170,6 +165,5 @@ M: retryable execute-statement* ( statement type -- ) : count-tuples ( tuple groups -- n ) >r dup dup class r> do-count - dup length 1 = [ first first string>number ] [ - [ first string>number ] map - ] if ; + dup length 1 = + [ first first string>number ] [ [ first string>number ] map ] if ; diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index 03e6b15bdb..f6d54404de 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -65,7 +65,7 @@ SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+ SYMBOLS: INTEGER BIG-INTEGER SIGNED-BIG-INTEGER UNSIGNED-BIG-INTEGER DOUBLE REAL BOOLEAN TEXT VARCHAR DATE TIME DATETIME TIMESTAMP BLOB -FACTOR-BLOB NULL ; +FACTOR-BLOB NULL URL ; : spec>tuple ( class spec -- tuple ) 3 f pad-right From a226bf5de846eb74fb6f2cb9d8d207fd2f83b8db Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 12 Jun 2008 18:20:15 -0500 Subject: [PATCH 6/7] fix url objects, use new accessors more in db.tuples-tests --- extra/db/postgresql/postgresql.factor | 2 +- extra/db/tuples/tuples-tests.factor | 47 ++++++++++++++------------- 2 files changed, 26 insertions(+), 23 deletions(-) diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index 1734fb6df4..e57efbc360 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -239,7 +239,7 @@ M: postgresql-db persistent-table ( -- hashtable ) { TIMESTAMP { "timestamp" "timestamp" f } } { BLOB { "bytea" "bytea" f } } { FACTOR-BLOB { "bytea" "bytea" f } } - { URL { "string" "string" f } } + { URL { "varchar" "varchar" f } } { +foreign-id+ { f f "references" } } { +autoincrement+ { f f "autoincrement" } } { +unique+ { f f "unique" } } diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 7ccee7c637..b5b80355fe 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -8,22 +8,23 @@ math.ranges strings sequences.lib ; IN: db.tuples.tests TUPLE: person the-id the-name the-number the-real -ts date time blob factor-blob ; +ts date time blob factor-blob url ; -: ( name age real ts date time blob factor-blob -- person ) - { - set-person-the-name - set-person-the-number - set-person-the-real - set-person-ts - set-person-date - set-person-time - set-person-blob - set-person-factor-blob - } person construct ; +: ( name age real ts date time blob factor-blob url -- person ) + person new + swap >>url + swap >>factor-blob + swap >>blob + swap >>time + swap >>date + swap >>ts + swap >>the-real + swap >>the-number + swap >>the-name ; -: ( id name age real ts date time blob factor-blob -- person ) - [ set-person-the-id ] keep ; +: ( id name age real ts date time blob factor-blob url -- person ) + + swap >>the-id ; SYMBOL: person1 SYMBOL: person2 @@ -120,19 +121,20 @@ SYMBOL: person4 { "time" "T" TIME } { "blob" "B" BLOB } { "factor-blob" "FB" FACTOR-BLOB } + { "url" "U" URL } } define-persistent - "billy" 10 3.14 f f f f f person1 set - "johnny" 10 3.14 f f f f f person2 set + "billy" 10 3.14 f f f f f f person1 set + "johnny" 10 3.14 f f f f f f person2 set "teddy" 10 3.14 T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f f f f 12 34 56 T{ duration f 0 0 0 0 0 0 } } - B{ 115 116 111 114 101 105 110 97 98 108 111 98 } f person3 set + B{ 115 116 111 114 101 105 110 97 98 108 111 98 } f f person3 set "eddie" 10 3.14 T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f f f f 12 34 56 T{ duration f 0 0 0 0 0 0 } } - f H{ { 1 2 } { 3 4 } { 5 "lol" } } person4 set ; + f H{ { 1 2 } { 3 4 } { 5 "lol" } } f person4 set ; : user-assigned-person-schema ( -- ) person "PERSON" @@ -146,20 +148,21 @@ SYMBOL: person4 { "time" "T" TIME } { "blob" "B" BLOB } { "factor-blob" "FB" FACTOR-BLOB } + { "url" "U" URL } } define-persistent - 1 "billy" 10 3.14 f f f f f person1 set - 2 "johnny" 10 3.14 f f f f f person2 set + 1 "billy" 10 3.14 f f f f f f person1 set + 2 "johnny" 10 3.14 f f f f f f person2 set 3 "teddy" 10 3.14 T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f f f f 12 34 56 T{ duration f 0 0 0 0 0 0 } } B{ 115 116 111 114 101 105 110 97 98 108 111 98 } - f person3 set + f f person3 set 4 "eddie" 10 3.14 T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f f f f 12 34 56 T{ duration f 0 0 0 0 0 0 } } - f H{ { 1 2 } { 3 4 } { 5 "lol" } } person4 set ; + f H{ { 1 2 } { 3 4 } { 5 "lol" } } f person4 set ; TUPLE: paste n summary author channel mode contents timestamp annotations ; TUPLE: annotation n paste-id summary author mode contents ; From 216bf23e6c6687123ef8af4ece65ad0f889c7e7c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 12 Jun 2008 18:23:46 -0500 Subject: [PATCH 7/7] test url objects --- extra/db/tuples/tuples-tests.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index b5b80355fe..36e84187eb 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -4,7 +4,7 @@ USING: io.files kernel tools.test db db.tuples classes db.types continuations namespaces math math.ranges prettyprint calendar sequences db.sqlite math.intervals db.postgresql accessors random math.bitfields.lib -math.ranges strings sequences.lib ; +math.ranges strings sequences.lib urls ; IN: db.tuples.tests TUPLE: person the-id the-name the-number the-real @@ -104,6 +104,7 @@ SYMBOL: person4 T{ timestamp f f f f 12 34 56 T{ duration f 0 0 0 0 0 0 } } f H{ { 1 2 } { 3 4 } { 5 "lol" } } + URL" http://www.google.com/search?hl=en&q=trailer+park+boys&btnG=Google+Search" } ] [ T{ person f 4 } select-tuple ] unit-test @@ -134,7 +135,7 @@ SYMBOL: person4 T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f f f f 12 34 56 T{ duration f 0 0 0 0 0 0 } } - f H{ { 1 2 } { 3 4 } { 5 "lol" } } f person4 set ; + f H{ { 1 2 } { 3 4 } { 5 "lol" } } URL" http://www.google.com/search?hl=en&q=trailer+park+boys&btnG=Google+Search" person4 set ; : user-assigned-person-schema ( -- ) person "PERSON" @@ -162,7 +163,7 @@ SYMBOL: person4 T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } } T{ timestamp f f f f 12 34 56 T{ duration f 0 0 0 0 0 0 } } - f H{ { 1 2 } { 3 4 } { 5 "lol" } } f person4 set ; + f H{ { 1 2 } { 3 4 } { 5 "lol" } } URL" http://www.google.com/search?hl=en&q=trailer+park+boys&btnG=Google+Search" person4 set ; TUPLE: paste n summary author channel mode contents timestamp annotations ; TUPLE: annotation n paste-id summary author mode contents ;